2015-02-19 21 views
8

Ben R için yeni ve bu bir benden. Aşağıdaki betik, her biri iki sütunlu (A ve B) iki kukla tablo (sonuç ve sayı) kullanır. A ve B sonuçlarını karşılaştırmak için permütasyon testleri yapıyorum. Özellikle, A ve B için sonuç/sayıma bakıyorum. Hem sonuç hem de sayım 20 satır var ve ben bir permütasyon testi için bir döngü yazdım. Her birincinin ilk 10 satırı, sonra ilk 11, sonra 12, 20'ye kadar. Ne zaman işe yarıyorsa, sonuçta güzel bir grafik elde ediyorum.R hata '[<-. Data.frame' ... yedek # ürün var, ihtiyaç var #

#Set up the dummy data - two competing tables (result & count) 
result <- data.frame(matrix(runif(40)*100, nrow=20)) 
names(result)[1] <- paste("A"); names(result)[2] <- paste("B") 
count <- data.frame(matrix(runif(40)*100, nrow=20)) 
names(count)[1] <- paste("A"); names(count)[2] <- paste("B") 
n.iter <- 1e3 

#Run a permutation test 
permtest <- function(result, count) { 
    n <- dim(result)[1] 
# print(n) 
    stat <- function(x, y) abs(diff(range(colSums(x)/colSums(y)))) 
    swap <- function(x, i) { x[i, ] <- cbind(x[, "B"], x[, "A"])[i, ]; return (x) } 
    sim <- replicate(n.iter, { i <- runif(n) < 1/2; stat(swap(result, i), swap(count, i)) }) 
    result.stat <- stat(result, count) 
    p.value <- sum(sim >= result.stat)/length(sim) 
    return(list(sim, result.stat, p.value)) 
} 

#Compute evolution of p-values over time 
p.evol <- data.frame() 
for (i in 10:dim(result)[1]) { 
# print(i) 
    permresults <- permtest(result[1:i,], count[1:i,]) 
    p.value <- permresults[[3]] 
    p.evol <- rbind(p.evol, c(i, p.value, 1-p.value)) 
} 
colnames(p.evol) <- c("day", "p.value", "conf") 
dev.new() 
plot(p.evol[,1],p.evol[,3], type="b", xlab="Day",ylab="Percentage", main="Evolution of Confidence") 

sorun bazen sorun çalışırken, çoğu zaman Error in '[<-.data.frame'('*tmp*', i, , value = numeric(0)) : replacement has 0 items, need 24 elde edilmesi. Özellikle şaşırtıcı Ne

f(ngettext(m, "replacement has %d item, need %d", 
     "replacement has %d items, need %d"), m, n * p), domain = NA) 
16: `[<-.data.frame`(`*tmp*`, i, , value = numeric(0)) at errortest.R#16 
15: `[<-`(`*tmp*`, i, , value = numeric(0)) at errortest.R#16 
14: swap(result, i) 
13: is.data.frame(x) 
12: colSums(x) 
11: diff(range(colSums(x)/colSums(y))) at errortest.R#15 
10: stat(swap(result, i), swap(count, i)) at errortest.R#17 
9: FUN(c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)[[42L]], ...) 
8: lapply(X = X, FUN = FUN, ...) 
7: sapply(integer(n), eval.parent(substitute(function(...) expr)), 
     simplify = simplify) 
6: replicate(n.iter, { 
     i <- runif(n) < 1/2 
     stat(swap(result, i), swap(count, i)) 
    }) at errortest.R#17 
5: permtest(result[1:i, ], count[1:i, ]) at errortest.R#27 
4: eval(expr, envir, enclos) 
3: eval(ei, envir) 
2: withVisible(eval(ei, envir)) 
1: source("errortest.R", echo = F) 

o bazen çalışmasıdır: options(error=traceback) ile ben Anlamıyorum ki, bunlar çıktı olsun! Bu nasıl mümkün olabilir? Ayrıca, print(n) ve print(i) yorumlarını açıkladığımda, daha sık çalıştığı görülüyor, ancak yorumlanmadıklarında ve oldukları zaman çalıştıkları zaman başarısız olabilirler. Yardım için şimdiden teşekkürler!

cevap

12

Bu hata, şanssız olduğunuzda ve i <- runif(n) < 1/2 yalnızca FALSE, yani hiçbir izin verilmediğinde ortaya çıkar. Bu sorunu gidermek için swap işlevine bir denetim eklemeniz gerekir.

+0

Vay. Tam olarak öyle. Bunu nasıl anladın? 1e3 yinelemeyi çalıştırdığımı göz önüne aldığımızda çok sık göründüğümden, sanırım * sadece bir 'FALSE' den oluşan bir satır almadığım için şanslıyım. 'Çek' için fazladan dikkat etmeyi çok isterdim ama eminim ki buradan çözebilirim. ;-) –

+3

Traceback, sorunlu kodu yerelleştirmemde bana yardımcı oldu ve ben sadece o yere bir sürü baskı yaptım, bu yüzden hata oluştuğunda değişken durumları biliyordum. Burada değiştirilmiş "swap" işlevi: 'swap <- function (x, i) {x [i,] <- x [i, c (2,1)]; return (x)} '(bu şekilde yazıldığında bir çeke ihtiyaç duymaz) –

+0

Sweet. Swap <- function yazdım (x, i) {if (toplam (i)! = 0) {x [i,] <- cbind (x [, "B"], x [, "A"]) [ben, ] }; return (x)} 'ama seninki doğal olarak daha iyi. Bonus puan verilir ... –