将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