Hi Jim,
I added more codes besides your original ones. I bet there should be
simpler way(s) to do this but this is the best I can think of. Any
feedback from you and others will be highly appreciated.
Thanks a lot!
Steve
result<-read.table(text=
"intercept decision expected.decision
1 reject reject
2 reject reject
3 reject reject
0 pass pass
3 reject skip
0 pass skip
3 reject skip
5 reject skip
0 pass skip
0 pass pass
3 reject skip
1 reject skip
0 pass skip
0 pass skip
2 reject skip
1 reject reject
0 pass pass
3 reject skip
0 pass skip
2 reject skip
0 pass skip
1 reject skip
2 reject reject
2 reject reject
",
header=TRUE,stringsAsFactors=FALSE)
int <- result$intercept
int
# [1] 1 2 3 0 3 0 3 5 0 0 3 1 0 0 2 1 0 3 0 2 0 1 2 2
pass.theo <- which(int==0)
pass.theo
#[1] 4 6 9 10 13 14 17 19 21
lv1 <- int==0
lv1
# [1] FALSE FALSE FALSE TRUE FALSE TRUE FALSE FALSE TRUE TRUE FALSE
FALSE
#[13] TRUE TRUE FALSE FALSE TRUE FALSE TRUE FALSE TRUE FALSE FALSE
FALSE
pass.1st <- min(which(lv1==TRUE))
pass.1st
#[1] 4
m <- c(0:100)
interval <- 6*m + pass.1st
interval
# [1] 4 10 16 22 28 34 40 46 52 58 64 70 76 82 88 94 100
106
#[19] 112 118 124 130 136 142 148 154 160 166 172 178 184 190 196 202 208
214
#[37] 220 226 232 238 244 250 256 262 268 274 280 286 292 298 304 310 316
322
#[55] 328 334 340 346 352 358 364 370 376 382 388 394 400 406 412 418 424
430
#[73] 436 442 448 454 460 466 472 478 484 490 496 502 508 514 520 526 532
538
#[91] 544 550 556 562 568 574 580 586 592 598 604
interval2 <- c(interval[interval<=length(int)], length(int))
interval2
#[1] 4 10 16 22 24
pass.theo
#[1] 4 6 9 10 13 14 17 19 21
res <- as.list(NULL)
> for(i in 1:(length(interval2)-1)){
res[[i]] <- min(pass.theo[pass.theo >= interval2[i] & pass.theo <
interval2[i+1]])
res
}
#Warning message:
#In min(pass.theo[pass.theo >= interval2[i] & pass.theo < interval2[i + :
# no non-missing arguments to min; returning Inf
res
#[[1]]
#[1] 4
#[[2]]
#[1] 10
#[[3]]
#[1] 17
#[[4]]
#[1] Inf
res <- unlist(res)
passes <- res[is.finite(res)]
passes
#[1] 4 10 17
skips<-as.vector(sapply(passes,function(x) return(x+1:5)))
skips2 <- skips[skips<=length(int)]
new.decision <- result$decision
new.decision[skips2] <- 'skip'
new.decision
# [1] "reject" "reject" "reject" "pass" "skip" "skip" "skip"
"skip"
#[9] "skip" "pass" "skip" "skip" "skip" "skip" "skip"
"reject"
#[17] "pass" "skip" "skip" "skip" "skip" "skip" "reject"
"reject"
cbind(result, new.decision)
# intercept decision expected.decision new.decision
#1 1 reject reject reject
#2 2 reject reject reject
#3 3 reject reject reject
#4 0 pass pass pass
#5 3 reject skip skip
#6 0 pass skip skip
#7 3 reject skip skip
#8 5 reject skip skip
#9 0 pass skip skip
#10 0 pass pass pass
#11 3 reject skip skip
#12 1 reject skip skip
#13 0 pass skip skip
#14 0 pass skip skip
#15 2 reject skip skip
#16 1 reject reject reject
#17 0 pass pass pass
#18 3 reject skip skip
#19 0 pass skip skip
#20 2 reject skip skip
#21 0 pass skip skip
#22 1 reject skip skip
#23 2 reject reject reject
#24 2 reject reject reject
On Fri, Mar 3, 2017 at 8:00 AM, SH <empti...@gmail.com> wrote:
> Hi Jim,
>
> Thank you very much for replying back.
>
> I think the data I presented have not many 'pass' than I thought. The
> purpose of the code is to skip sampling for 5 consecutive rows when a
> previous row is found as 'pass'. Thus, because the fourth row is
> 'pass', sampling will be skipped next five rows (i.e., from 5th to 9th
> rows). Therefore any 'pass' within next 5 rows after first 'pass' should
> not affect 'skip'. Could you try this? Based on your code, I
> guess 'return' function may be one I should search. I haven't used it
> before so I am not familiar with the function. I made a new data set with
> 'expected.decision' column. In the data set, once a 'pass' is found, the
> next sampling starts 5 rows after. For example, since the forth row is
> 'pass', the next sampling starts at 10th row. Although 6th row should be
> 'pass', I want to label them as 'skip' since no sampling is made.
>
> The objective of the study is to investigate how many of 'reject' rows get
> 'skip' with a given sampling scheme, the rate of 'pass' because of skip
> sampling which should be 'reject'.
>
> Could you also try this data and give me your feedback? Thanks again for
> you helps!!!
>
> Steve
>
> result<-read.table(text=
> "intercept decision expected.decision
> 1 reject reject
> 2 reject reject
> 3 reject reject
> 0 pass pass
> 3 reject skip
> 0 pass skip
> 3 reject skip
> 5 reject skip
> 0 pass skip
> 0 pass pass
> 3 reject skip
> 1 reject skip
> 0 pass skip
> 0 pass skip
> 2 reject skip
> 1 reject reject
> 0 pass pass
> 3 reject skip
> 0 pass skip
> 2 reject skip
> 0 pass skip
> 1 reject skip
> 2 reject reject
> 2 reject reject
> ",
> header=TRUE,stringsAsFactors=FALSE)
> passes<-which(result$intercept == 0)
> skips<-as.vector(sapply(passes,function(x) return(x+1:5)))
> result$decision[skips]<-"skip"
> result
>
>
>
> On Thu, Mar 2, 2017 at 5:42 PM, Jim Lemon <drjimle...@gmail.com> wrote:
>
>> Hi Steve,
>> Try this:
>>
>> result<-read.table(text=
>> "intercept decision
>> 1 reject
>> 2 reject
>> 3 reject
>> 0 pass
>> 3 reject
>> 2 reject
>> 3 reject
>> 5 reject
>> 3 reject
>> 1 reject
>> 1 reject
>> 2 reject
>> 2 reject
>> 0 pass
>> 3 reject
>> 3 reject
>> 2 reject
>> 2 reject
>> 1 reject
>> 1 reject
>> 2 reject
>> 2 reject",
>> header=TRUE,stringsAsFactors=FALSE)
>> passes<-which(result$intercept == 0)
>> skips<-as.vector(sapply(passes,function(x) return(x+1:5)))
>> result$decision[skips]<-"skip"
>>
>> Note that result$decision must be a character variable for this to
>> work.If it is a factor, convert it to character.
>>
>> Jim
>>
>>
>> On Thu, Mar 2, 2017 at 11:54 PM, SH <empti...@gmail.com> wrote:
>> > Hi
>> >
>> > Although I posted this in stackoverflow yesterday, I am asking here to
>> get
>> > helps as soon as quickly.
>> >
>> > I need help make code for mocking sampling environment. Here is my code
>> > below:
>> >
>> > First, I generated mock units with 1000 groups of 100 units. Each row is
>> > considered as independent sample space.
>> >
>> > unit <- 100 # Total units
>> > bad.unit.rate <- .05 # Proportion of bad units
>> > bad.unit.num <- ceiling(unit*bad.unit.rate) # Bad units
>> > n.sim=1000
>> > unit.group <- matrix(0, nrow=n.sim, ncol=unit)for(i in 1:n.sim){
>> > unit.group[i, ] <- sample(rep(0:1, c(unit-bad.unit.num,
>> bad.unit.num)))}
>> > dim(unit.group)
>> >
>> > It gives 1000 by 100 groups
>> >
>> > ss <- 44 # Selected sample size
>> >
>> > 44 out of 100 units will be selected and decision (pass or reject) will
>> be
>> > made based on sampling.
>> >
>> > This below is decision code:
>> >
>> > intercept <- rep(0, nrow(unit.group))
>> > decision <- rep(0, nrow(unit.group))
>> > set.seed(2017)for(i in 1:nrow(unit.group)){
>> > selected.unit <- sample(1:unit, ss)
>> > intercept[i] <- sum(unit.group[i,][selected.unit])
>> > decision[i] <- ifelse(intercept[i]==0, 'pass', 'reject')
>> > result <- cbind(intercept, decision)
>> > result}
>> > dim(result)
>> > head(result, 30)
>> >
>> >> head(result, 30)
>> > intercept decision
>> > [1,] "1" "reject"
>> > [2,] "2" "reject"
>> > [3,] "3" "reject"
>> > [4,] "0" "pass"
>> > [5,] "3" "reject"
>> > [6,] "2" "reject"
>> > [7,] "3" "reject"
>> > [8,] "5" "reject"
>> > [9,] "3" "reject"
>> > [10,] "1" "reject"
>> > [11,] "1" "reject"
>> > [12,] "2" "reject"
>> > [13,] "2" "reject"
>> > [14,] "0" "pass"
>> > [15,] "3" "reject"
>> > [16,] "3" "reject"
>> > [17,] "2" "reject"
>> > [18,] "2" "reject"
>> > [19,] "1" "reject"
>> > [20,] "1" "reject"
>> > [21,] "2" "reject"
>> > [22,] "2" "reject"
>> >
>> > I was able to make a decision for each 1000 rows based on sampling as
>> above.
>> >
>> > Now, I want to make code for "second" decision option as follows.
>> Assuming
>> > the row number is in order of time or sequence, if 'intercept' value is
>> 0
>> > or 'decision' is 'pass' in the row 4 above, I want to skip any decision
>> > next following 5 (or else) and to label as 'skip', not 'reject'. In the
>> > example above, rows from 5 to 9 will be 'skip' than 'reject'. Also, rows
>> > from 15 to 19 should be 'skip' instead of 'reject'. Although I tried to
>> > make preliminary code with my post, I have no idea where to start. Could
>> > anyone help me to make code? Any feedback will be greatly appreciated.
>> >
>> > Thank you very much in advance!!!
>> >
>> > Steve
>> >
>> > [[alternative HTML version deleted]]
>> >
>> > ______________________________________________
>> > R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
>> > https://stat.ethz.ch/mailman/listinfo/r-help
>> > PLEASE do read the posting guide http://www.R-project.org/posti
>> ng-guide.html
>> > and provide commented, minimal, self-contained, reproducible code.
>>
>
>
[[alternative HTML version deleted]]
______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
