将ks.test、var.test、t.test和wilcox.test组合成决策树型函数或r中的if-else函数
我的数据如下:将ks.test、var.test、t.test和wilcox.test组合成决策树型函数或r中的if-else函数,r,if-statement,decision-tree,R,If Statement,Decision Tree,我的数据如下: df1 <- read.table(text = "A1 A2 A3 A4 B1 B2 B3 B4 1 2 4 12 33 17 77 69 34 20 59 21 90 20 43 44 11 16 23 24 19 12 55 98 29 111 335 34 61 88 110 320 51 58 45 39 55 87 55 89", stringsAsFactors = FALSE, header = TRUE, row.names=c("N1","N2","N3
df1 <- read.table(text = "A1 A2 A3 A4 B1 B2 B3 B4
1 2 4 12 33 17 77 69
34 20 59 21 90 20 43 44
11 16 23 24 19 12 55 98
29 111 335 34 61 88 110 320
51 58 45 39 55 87 55 89", stringsAsFactors = FALSE, header = TRUE, row.names=c("N1","N2","N3","N4","N5"))
然后我计算了ks.test
和var.test
的p值,用于对数据进行分组:
ks_AB<-apply(df1,1,kstest,grp1=grepl("^A",colnames(df1)),grp2=grepl("^B",colnames(df1)))
ks_AB
[1] 0.02857143 0.69937420 0.77142857 0.77142857 0.21055163
var_AB<-apply(df1,1,vartest,grp1=grepl("^A",colnames(df1)),grp2=grepl("^B",colnames(df1)))
var_AB
[1] 0.01700168 0.45132827 0.01224175 0.76109048 0.19561742
df1$ks_AB<-ks_AB
df1$var_AB<-var_AB
ks_AB这应该可以做到:
FOO <- function(df, grp1, grp2){
# perform rowwise kolmogorov smirnov test
ks_AB <- apply(df, 1, kstest, grp1 = grp1, grp2 = grp2)
# subset data by significance of ks test
sub1 <- df[ks_AB < .05, ]
sub2 <- df[ks_AB >= .05, ]
if(nrow(sub1) > 0){
# perform wilcoxon rank sum test on non-normally distributed data
wilc_AB <- apply(sub1, 1, wilcox, grp1 = grp1, grp2 = grp2)
}
if(nrow(sub2) > 0){
# perform f test on normally distributed data
var_AB <- apply(sub2, 1, vartest, grp1 = grp1, grp2 = grp2)
# subset data by significance of f test
varsub1 <- sub2[var_AB < .05, ]
varsub2 <- sub2[var_AB >= .05, ]
if(nrow(varsub1) > 0){
# perform t test with unequal variance on subset with unequal variance
t_uneq_AB <- apply(varsub1, 1, ttest_unequal, grp1 = grp1, grp2 = grp2)
}
if(nrow(varsub2) > 0){
# perform t test with equal variance on subset with equal variance
t_eq_AB <- apply(varsub2, 1, ttest_equal, grp1 = grp1, grp2 = grp2)
}
}
# put together output dataframe
df$ks_AB <- ks_AB
if(exists("var_AB")){
df$var_AB <- NA
df$var_AB[row.names(df) %in% names(var_AB)] <- var_AB
}
df$pvalue <- NA
if(exists("wilc_AB")){
df$pvalue[row.names(df) %in% names(wilc_AB)] <- wilc_AB
}
if(exists("t_uneq_AB")){
df$pvalue[row.names(df) %in% names(t_uneq_AB)] <- t_uneq_AB
}
if(exists("t_eq_AB")){
df$pvalue[row.names(df) %in% names(t_eq_AB)] <- t_eq_AB
}
# return output
return(df)
}
您可以在函数中使用suppressWarnings()
来抑制这些警告,但我希望显示它们,以便您知道何时测试可能不准确。非常感谢@LAP的回复。我可以知道有没有可能像你一样把几个if语句组合在一起?我是R新手,所以我不太熟悉if-else函数。您所发布的内容对我非常有用,但我期望的是更简单的代码语句ifelse()
函数通常用于矢量化条件输出,在您的情况下并不真正有用。您可能可以通过删除异常来简化我的函数,但这会给您留下一个不适用于边缘情况的函数。
df_wilcox<-df1[df1$ks_AB<0.05,]
df_ttest_equal<-df1[df1$ks_AB>=0.05 & df1$var_AB>=0.05,]
df_ttest_unequal<-df1[df1$ks_AB>=0.05 & df1$var_AB<0.05,]
wilcox_AB<-as.matrix(apply(df_wilcox,1,wilcox,grp1=grepl("^A",colnames(df_wilcox)),grp2=grepl("^B",colnames(df_wilcox))))
ttest_equal_AB<-as.matrix(apply(df_ttest_equal,1,ttest_equal,grp1=grepl("^A",colnames(df_ttest_equal)),grp2=grepl("^B",colnames(df_ttest_equal))))
ttest_unequal_AB<-as.matrix(apply(df_ttest_unequal,1,ttest_unequal,grp1=grepl("^A",colnames(df_ttest_unequal)),grp2=grepl("^B",colnames(df_ttest_unequal))))
p_value<-rbind(wilcox_AB,ttest_equal_AB,ttest_unequal_AB)
colnames(p_value)<-c("pvalue")
df<-merge(df1,p_value,by="row.names")
df
Row.names A1 A2 A3 A4 B1 B2 B3 B4 ks_AB var_AB pvalue
1 N1 1 2 4 12 33 17 77 69 0.02857143 0.01700168 0.02857143
2 N2 34 20 59 21 90 20 43 44 0.69937420 0.45132827 0.39648631
3 N3 11 16 23 24 19 12 55 98 0.77142857 0.01224175 0.25822839
4 N4 29 111 335 34 61 88 110 320 0.77142857 0.76109048 0.85703939
5 N5 51 58 45 39 55 87 55 89 0.21055163 0.19561742 0.06610608
FOO <- function(df, grp1, grp2){
# perform rowwise kolmogorov smirnov test
ks_AB <- apply(df, 1, kstest, grp1 = grp1, grp2 = grp2)
# subset data by significance of ks test
sub1 <- df[ks_AB < .05, ]
sub2 <- df[ks_AB >= .05, ]
if(nrow(sub1) > 0){
# perform wilcoxon rank sum test on non-normally distributed data
wilc_AB <- apply(sub1, 1, wilcox, grp1 = grp1, grp2 = grp2)
}
if(nrow(sub2) > 0){
# perform f test on normally distributed data
var_AB <- apply(sub2, 1, vartest, grp1 = grp1, grp2 = grp2)
# subset data by significance of f test
varsub1 <- sub2[var_AB < .05, ]
varsub2 <- sub2[var_AB >= .05, ]
if(nrow(varsub1) > 0){
# perform t test with unequal variance on subset with unequal variance
t_uneq_AB <- apply(varsub1, 1, ttest_unequal, grp1 = grp1, grp2 = grp2)
}
if(nrow(varsub2) > 0){
# perform t test with equal variance on subset with equal variance
t_eq_AB <- apply(varsub2, 1, ttest_equal, grp1 = grp1, grp2 = grp2)
}
}
# put together output dataframe
df$ks_AB <- ks_AB
if(exists("var_AB")){
df$var_AB <- NA
df$var_AB[row.names(df) %in% names(var_AB)] <- var_AB
}
df$pvalue <- NA
if(exists("wilc_AB")){
df$pvalue[row.names(df) %in% names(wilc_AB)] <- wilc_AB
}
if(exists("t_uneq_AB")){
df$pvalue[row.names(df) %in% names(t_uneq_AB)] <- t_uneq_AB
}
if(exists("t_eq_AB")){
df$pvalue[row.names(df) %in% names(t_eq_AB)] <- t_eq_AB
}
# return output
return(df)
}
> FOO(df1, grepl("^A",colnames(df1)), grp2=grepl("^B",colnames(df1)))
A1 A2 A3 A4 B1 B2 B3 B4 ks_AB var_AB pvalue
N1 1 2 4 12 33 17 77 69 0.02857143 NA 0.02857143
N2 34 20 59 21 90 20 43 44 0.69937420 0.45132827 0.39648631
N3 11 16 23 24 19 12 55 98 0.77142857 0.01224175 0.25822839
N4 29 111 335 34 61 88 110 320 0.77142857 0.76109048 0.85703939
N5 51 58 45 39 55 87 55 89 0.21055163 0.19561742 0.06610608
Warning messages:
1: In ks.test(x, y, alternative = c("two.sided")) :
cannot compute exact p-value with ties
2: In ks.test(x, y, alternative = c("two.sided")) :
cannot compute exact p-value with ties