Случайным выбор из подмножества строк

Question

У меня есть данные в блоках [[I]], где I = от 4 до 6, как так

Stimulus Response PM 
    stretagost  s <NA> 
    colpublo  s <NA> 
    zoning   d <NA> 
    epilepsy  d <NA> 
    resumption  d <NA> 
    incisive  d <NA> 

440 строк в каждом блоке [[I]].

В настоящее время мой скрипт делает некоторые вещи по 1 случайным образом выбранному элементу из каждых 15 испытаний (за исключением первых 5 испытаний каждые 110, также у меня он установлен так, что я никогда не смогу выбрать строки менее 2 раз) для каждого блока [ [я]].

То, что я хотел бы сделать, состоит в том, чтобы делать вещи по 1 статье из каждых 15 испытаний, случайно выбранных только из тех, где ответ == "d". т. е. я не хочу, чтобы мой случайный выбор когда-либо делал материал в строки, где response == "s". Я понятия не имею, как этого добиться, но вот сценарий я до сих пор, что просто случайно выбирает 1 строку из каждого 15:

PMpositions <- list() 
for (i in 4:6){ 
    positions <- c() 
    x <- 0 
    for (j in c(seq(5, 110-15, 15),seq(115, 220-15, 15),seq(225, 330-15, 15),seq(335,440-15, 15))) 
    { 
    sub.samples <- setdiff(1:15 + j, seq(x-2,x+2,1)) 
    x <- sample(sub.samples, 1) 
    positions <- c(positions,x) 
    } 
    PMpositions[[i]] <- positions 
    blocks[[i]]$Response[PMpositions[[i]]] <- Wordresponse 
    blocks[[i]]$PM[PMpositions[[i]]] <- PMresponse 
    blocks[[i]][PMpositions[[i]],]$Stimulus <- F[[i]] 
} 

я в конечном итоге дело с ним, как так

PMpositions <- list() 
for (i in 1:3){ 
startingpositions <- c(seq(5, 110-15, 15),seq(115, 220-15, 15),seq(225, 330-15,  
15),seq(335, 440-15, 15)) 
positions <- c() 
x <- 0 
for (j in startingpositions) 
{ 
sub.samples <- setdiff(1:15 + j, seq(x-2,x+2,1)) 
x <- sample(sub.samples, 1) 
positions <- c(positions,x) 
} 
repeat { 
positions[which(blocks[[i]][positions,2]==Nonwordresponse)]<- 
startingpositions[which(blocks[[i]][positions,2]==Nonwordresponse)]+sample(1:15, 
size=length(which(blocks[[i]][positions,2]==Nonwordresponse)), replace = TRUE) 
distancecheck<- which (abs(c(positions[2:length(positions)],0)-positions) < 2) 
if (length(positions[which(blocks[[i]][positions,2]==Nonwordresponse)])== 0 & length 
(distancecheck)== 0) break 
} 
PMpositions[[i]] <- positions 
blocks[[i]]$Response[PMpositions[[i]]] <- Wordresponse 
blocks[[i]]$PM[PMpositions[[i]]] <- PMresponse 
blocks[[i]][PMpositions[[i]],]$Stimulus <- as.character(NF[[i]][,1]) 
Nonfocal[[i]] <- blocks[[i]] 
} 

Я понял, когда застрял в повторяющихся циклах, иногда у меня 15 "s" в ответ подряд! DOH. Было бы неплохо иметь возможность исправить это, но это нормально для того, что мне нужно, когда я застрял. Я просто запускаю его снова (расположение d/s генерируется случайным образом).

Answer 1

РЕДАКТИРОВАТЬ: Здесь используется другой подход, в котором используются только образцы 'd' строк. Это довольно индивидуальный код, но основная идея состоит в том, чтобы использовать аргумент prob только для выборочных строк, где «Response» == «d» и установить, вероятно, выборки всех остальных строк на ноль.

Response <- rep(c("s","d"),220) 
chunk <- sort(rep(1:30,15))[1:440] # chunks of 15 up to 440 

# function to randomly sample from each set of 15 rows 
sampby15 <- function(i){ 
    sample((1:440)[chunk==i], 1, 
     # use the `prob` argument to only sample 'd' values 
     prob=rep(1,length=440)[chunk==i]*(Response=="d")[chunk==i]) 
} 
s <- sapply(1:15,FUN=sampby15) # apply to each chunk to get sample rows 
Response[s] # confirm only 'd' values 

# then you have code to do whatever to those rows... 

Answer 2

Так что на самом деле основная функция вы хотите работать на каждом блоке, как это:

subsetminor <- function(dataset, only = "d", rows = 1) { 
    remainder <- subset(dataset, Response == only) 
    return(remainder[sample(1:nrow(remainder), size = rows), ]) 
} 

Мы ели его немного, чтобы избежать ряда рядом друг с другом:

subsetminor <- function(dataset, only = "d", rows = 1) { 
    remainder <- subset(dataset, Response == only) 
    if(rows > 1) { 
    sampled <- sample(1:nrow(remainder), size = rows) 
    pairwise <- t(combn(sampled, 2)) 
    while(any(abs(pairwise[, 1] - pairwise[, 2]) <= 2)) { 
     sampled <- sample(1:nrow(remainder), size = rows) 
     pairwise <- t(combn(sampled, 2)) 
    } 
    } 
    out <- remainder[sampled, ] 
    return(out) 
} 

Вышеуказанное может быть упрощено/DRY'd довольно много, но оно должно выполнить свою работу.