如何获得一行从高于或低于R中的临界值更改的次数计数

我有一个我正在处理的数据帧，它是一系列概率，作为HMM的输出。我想知道概率从高于任意临界值切换到低于该值的次数，反之亦然。我对R非常陌生，虽然我开发了一个生成输出的代码，但它相当耗时

> Haplo                         #Subset of original dataframe
chr2L_502618 chr2L_502999 chr2L_504449 chr2L_504509 chr2L_504686 chr2L_504688 chr2L_504690 chr2L_504706 chr2L_505918 chr2L_506002
3       0.04865      0.04864       0.0486       0.0486       0.0486       0.0486       0.0486       0.0486      0.04857      0.04856
4       0.04769      0.04767      0.04764      0.04764      0.04764      0.04764      0.04764      0.04764      0.04761       0.0476
5       0.04817      0.04817      0.04813      0.04813      0.04813      0.04813      0.04813      0.04813      0.04808      0.04807
6        0.0612      0.06118      0.06114      0.06114      0.06114      0.06114      0.06113      0.06113      0.06112      0.06112
7       0.41175      0.41178      0.41193      0.41194      0.41194      0.41194      0.41194      0.41194      0.41206       0.4121
8       0.04754      0.04752      0.04749      0.04749      0.04749      0.04749      0.04749      0.04749      0.04746      0.04745
9       0.27742      0.27742      0.27751      0.27751      0.27751      0.27751      0.27751      0.27751      0.27756      0.27759
10      0.05761       0.0576      0.05757      0.05757      0.05756      0.05756      0.05756      0.05756      0.05753      0.05753
11      0.00067      0.00065      0.00059      0.00059      0.00059      0.00059      0.00059      0.00059      0.00055      0.00053
12      0.00075      0.00073      0.00067      0.00067      0.00067      0.00067      0.00067      0.00067      0.00063      0.00061
> probs <- array(0,dim=dim(Haplo))
> for (i in 1:ncol(probs)) {probs[,i] <- as.character(Haplo[,i])}
> crits <- matrix(as.numeric(probs>0.27751),nrow=nrow(probs),ncol=ncol(probs))
> crits              
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0    0    0    0    0    0    0    0     0
 [2,]    0    0    0    0    0    0    0    0    0     0
 [3,]    0    0    0    0    0    0    0    0    0     0
 [4,]    0    0    0    0    0    0    0    0    0     0
 [5,]    1    1    1    1    1    1    1    1    1     1
 [6,]    0    0    0    0    0    0    0    0    0     0
 [7,]    0    0    0    0    0    0    0    0    1     1
 [8,]    0    0    0    0    0    0    0    0    0     0
 [9,]    0    0    0    0    0    0    0    0    0     0
[10,]    0    0    0    0    0    0    0    0    0     0

---

澄清一下，R中的经验法则是，如果你想写一个快速的代码，你必须使用向量化的R函数，而不是循环。根据我对你问题的理解，我写了一个函数，可以满足你的要求：

find_switch <- function(test_ds, crit_val){
 m <- sapply(test_ds, function(x) as.integer(x > crit_val))
 tm <- t(m)
 nrtm <- nrow(tm)
 colSums(tm - rbind(tm[1,], tm[1:(nrtm-1),]) != 0)
}

速度的差异是的250倍。因此，这就是为什么使用矢量化函数很重要的原因

最后，让我们确保这两个函数产生相同的输出：

identical(find_switch(test_ds, 0.3), find_switch2(test_ds, 0.3))

您可以尝试：

colSums(diff(t(as.matrix(df) > .3)) != 0)

 1  2  3  4  5  6  7  8  9 10 
 2  2  2  0  2  2  3  2  1  2    

数据：

---

df我尝试在我的原始数据集上运行你的函数。你的函数似乎给了我行超过临界值的次数。我试图告诉它从超过变为低于临界值的次数，反之亦然。口头上，如果一行中有一半的数字高于或低于临界值，我需要知道这些被分为两个块（即，100个值先高于50，然后低于50），或者切换每个值（高于、低于、高于、低于…x25），或者介于两者之间。我可能能够使用ifelse函数进行调整。不过，这有一些有用的想法，所以谢谢。@HowlArgwen包含一个小的测试数据集（5 x 10）这是预期的结果，我更容易理解你的意思want@HowlArgwen请查看上面的测试数据集，如果需要，请更正预期输出。对于您的测试数据集，预期输出应为：1、0、0、1。我将尝试创建一个数据集，该数据集将更清楚地说明我需要的内容并发布。@HowlArgwen您解释了为什么第1行的输出为1？两个元素（第1列和第2列）与临界值0.3相交。只有值[5,3]在上面，[7,3]完全相等，其余的在下面。基于此为该子集选择临界值，但它似乎适用于测试中的任何给定值。@HowlArgwen添加一个小数据集（例如10行x5列）并显示您的预期输出。
find_switch2 <- function(test_ds, crit_val){
  crits <- matrix(as.numeric(test_ds > crit_val),nrow=nrow(test_ds),ncol=ncol(test_ds))
  shifts <- c()
  for (g in 1:nrow(crits)){
    for (i in 1:(ncol(crits)-1)){
      shifts <- c(shifts, sapply(crits[g,i], identical, y=crits[g,i+1]))
      }
  }

  shifts2 <- matrix(as.numeric(!shifts), nrow=nrow(crits), ncol=(ncol(crits)-1), byrow=TRUE)

  sums <- c()
  for (i in 1:nrow(shifts2)){
    sums <- c(sums, sum(shifts2[i,]))
    }
  sums
}

set.seed(123)
n_row <- 5e2

crit_val <- 0.3

test_ds <- data.frame(p1 = runif(n_row),
                      p2 = runif(n_row),
                      p3 = runif(n_row),
                      p4 = runif(n_row))

microbenchmark::microbenchmark(find_switch(test_ds, crit_val), find_switch2(test_ds, crit_val))

 #Unit: microseconds expr       min         lq       mean    median         uq       max neval
 #find_switch(test_ds, crit_val)    96.265   121.8295   177.7687   176.132   206.4575   352.265   100
 #find_switch2(test_ds, crit_val) 27499.848 31556.8755 36564.2898 34315.394 40223.6580 93957.460   100

identical(find_switch(test_ds, 0.3), find_switch2(test_ds, 0.3))

colSums(diff(t(as.matrix(df) > .3)) != 0)

 1  2  3  4  5  6  7  8  9 10 
 2  2  2  0  2  2  3  2  1  2    

df <- df <- read.table(text = "          X1         X2         X3        X4         X5
1  0.9650217 0.07409232 0.22213328 0.3121305 0.31466359
2  0.1475712 0.06802015 0.63699272 0.2434809 0.17147398
3  0.2951922 0.65086116 0.09405872 0.2389092 0.10440221
4  0.6780534 0.73516696 0.62324000 0.9203979 0.89965700
5  0.4788420 0.16794910 0.13661247 0.5266925 0.52919389
6  0.6738885 0.68843836 0.17165125 0.2478758 0.94910386
7  0.8461378 0.74790781 0.16186888 0.8145674 0.13336087
8  0.3557357 0.65646290 0.21965522 0.6859082 0.55574490
9  0.5262744 0.74453676 0.18037489 0.2106494 0.01274704
10 0.9694096 0.41149759 0.03084501 0.8243646 0.42332927", header = TRUE)