計數頻率

Question

這是我的示例數據集對空調值P1和P2的值不正確

set.seed(123) 
myd <- data.frame (sub = paste ("S", 1:10, sep = ""), P1 = sample(c(1,-1,2,0), 10, replace = TRUE), 
        P2 = sample(c(1,-1,2,0), 10, replace = TRUE), 
        I1 = sample(c(1,-1,2,0), 10, replace = TRUE), 
        I2 = sample(c(1,-1,2,0), 10, replace = TRUE), 
        I3 = sample(c(1,-1,2,0), 10, replace = TRUE), 
        I4 = sample(c(1,-1,2,0), 10, replace = TRUE), 
        I5 = sample(c(1,-1,2,0), 10, replace = TRUE), 
        I6 = sample(c(1,-1,2,0), 10, replace = TRUE) 
        ) 
myd 

    sub P1 P2 I1 I2 I3 I4 I5 I6 
1 S1 -1 0 0 0 1 1 2 0 
2 S2 0 -1 2 0 -1 -1 1 2 
3 S3 -1 2 2 2 -1 0 -1 2 
4 S4 0 2 0 0 -1 1 -1 1 
5 S5 0 1 2 1 1 2 0 -1 
6 S6 1 0 2 -1 1 1 -1 1 
7 S7 2 1 2 0 1 1 0 -1 
8 S8 0 1 2 1 -1 0 0 2 
9 S9 2 -1 -1 -1 -1 0 0 -1 
10 S10 -1 0 1 1 0 -1 -1 1 

轉換表： -1缺失值

Condition P1 P2   The value Incorrect 
    I   1  1   None 
    II  1  0   2 
    III  0  1   2 
    IV  2  0   2 or 0 
     V  0  2   2 or 0 
     VI  2  2   1 or 0 
     VII  1  2   0 
    VIII  2  1   0 

# if there is -1 in any of the value produce all values NA 
     IX  -1  0   NA 
     X  0  -1   NA 
     XI  -1  -1   NA 
     XII  -1  2   NA 
     XIII  2 -1   NA 
     XIV  -1  1   NA 
     XV  1  -1   NA 

以下是數據幀格式爲轉換表的短碼，除了**對於IV，V，VI條件，其中我不知道如何輸入，因爲有兩個值：

ttable <- data.frame (P1 = c(1,1,0,2,0,2,1,2,-1, 0,-1,-1,2,-1,1), 
        P2 = c(1,0,1,0,2,2,2,1,0,-1,-1,2,-1,1,1), 
        errort = c("None", 2,2,2, 2,1,0,0,NA, NA, NA, NA, NA, NA,NA)) 

什麼我想看看每個S1至S10行，我想檢查值P1和P2列，並與值I1匹配這I6列：

sub P1 P2 I1 I2 I3 I4 I5 I6 
1 S1 -1 0 0 0 1 1 2 0 

在這種情況下，P1和P2的值之一是-1，所以所有的值都是NA。

另一種情況：

​​

這裏P1 = 0，P2 = 2，所以下面的值 I1 =不正確的，I2 =錯誤，I3 = NA，I4 =正確，I5 = NA，I6 =正確

可被寫爲

sub P1 P2 I1  I2  I3 I4  I5 I6 
S4 0 2 0  0  -1 1  -1 1 

      FALSE, FALSE, NA, TRUE, NA, TRUE 

該匹配條件（V）和0或1是不正確的，而1是正確的，-1缺失

另一種情況：在這裏P1 = 0和P2 = 1，匹配條件（III）中的匹配表，從而不正確的值將是2

5 S5 0 1 2  1  1  2  0  -1 
       FALSE, TRUE, TRUE FALSE TRUE NA 

我需要的假計算出的頻率，我嘗試了很多if-else語句，但沒有給出所需的輸出，我感到與許多這樣的messey有關，並且我不認爲這對我將使用的大數據集有效。

qcfun <- function (x) { 
x <- x[3:length(x)] 
obs1 = table(c(x, 2, 0, 1, -1)) 
obs = obs1-1 
ov <- NULL 
if (x[1] == 1 & x[2] == 0){ 
ov = round (as.numeric (obs[4]/sum(obs)), 2) 
} else { 
if (x[1] == 0 & x[2] == 1){ 
ov = round (as.numeric (obs[4]/sum(obs)), 2) 
} else { 
if (x[1] == 1 & x[2] == 2){ 
ov = round (as.numeric (obs[2]/sum(obs)), 2) 
} else { 
if (x[1] == 2 & x[2] == 1){ 
ov = round (as.numeric (obs[2]/sum(obs)), 2) 
} else { 
if (x[1] == 1 & x[2] == 1){ 
ov = 0 
} else { 
ov = NA 
} 
}}}} 
return (ov) 
} 
out1 <- apply(myd, 1,qcfun) 
table (out1) 
tout1 <- table (out1) 

是否有這樣做的快速/有效的方式？

Answer 1

您可以使用此矢量功能，這將是有效爲大量的行：

fixI <- function(p1, p2, i){ 
    negative <- (p1 < 0) | (p2 < 0) | (i < 0) 
    result <- ifelse(negative, NA, TRUE) # conditions IX to XV 

    p <- p1 * 10 + p2 

    result[!negative & p %in% c(10,1,20,2) & i==2] <- FALSE 
    result[!negative & p %in% c(20,2,22,12,21) & i==0] <- FALSE 
    result[!negative & p==22 & i==1] <- FALSE 

    result 
} 

它應用到I列myd：

mat <- sapply(myd[,paste0("I",1:6)], fixI, p1=myd$P1, p2=myd$P2) 

rownames(mat) <- myd$sub 

結果：

 I1 I2 I3 I4 I5 I6 
S1  NA NA NA NA NA NA 
S2  NA NA NA NA NA NA 
S3  NA NA NA NA NA NA 
S4 FALSE FALSE NA TRUE NA TRUE 
S5 FALSE TRUE TRUE FALSE TRUE NA 
S6 FALSE NA TRUE TRUE NA TRUE 
S7 TRUE FALSE TRUE TRUE FALSE NA 
S8 FALSE TRUE NA TRUE TRUE FALSE 
S9  NA NA NA NA NA NA 
S10 NA NA NA NA NA NA 

現在你可以計數FALSE這樣的：

乘行時：

apply(!mat, 1, sum, na.rm=TRUE) 

S1 S2 S3 S4 S5 S6 S7 S8 S9 S10 
    0 0 0 2 2 1 2 2 0 0 

通過柱：

apply(!mat, 2, sum, na.rm=TRUE) 

I1 I2 I3 I4 I5 I6 
    4 2 0 1 1 1