如何為這個 function 申請“lapply”？ (右)

Question

我有一個 function 在給定每個時間點（0、15、30、... 120 分鍾）的某些值時計算“增量 AUC（曲線下面積）”。 我想應用此 function 來批量計算我的列，並理想地創建一個新的“列表”，其中僅包含每次運行的“auc”值，但在編碼時遇到問題。 我在想“lapply”可能有用，但想知道是否有更好的建議，因為我會創建類似的功能並在未來批量運行它們。 十分感謝大家。 下面是 function，其中數據幀=df1，CAT.12 是其中一列。 X 是時間，而 y 是變量（列）。

i_auc.fn <- function(x,y) {
  auc <- ifelse(y[2] > y[1], (y[2]-y[1])*(x[2]-x[1])/2, 0)
  seg.type <- 0
  for (i in 3:length(x)) {
    if (y[i] >= y[1] & y[i-1] >= y[1]) {
      auc[i-1] <- (((y[i]-y[1])/2) + (y[i-1]-y[1])/2) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 1
    } else if (y[i] >= y[1] & y[i-1] < y[1]) {
      auc[i-1] <- ((y[i]-y[1])^2/(y[i]-y[i-1])) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 2
    } else if (y[i] < y[1] & y[i-1] >= y[1]) {
      auc[i-1] <- ((y[i-1]-y[1])^2/(y[i-1]-y[i])) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 3
    } else if (y[i] < y[1] & y[i-1] < y[1]) {
      auc[i-1] <- 0
      seg.type[i-1] <- 4
    } else {
      # The above cases are exhaustive, so this should never happpen
      return(cat("i:", i, "Error: No condition met\n"))
    }
  }
  return(list(auc=sum(auc), segments=auc, seg.type=seg.type))
}
iAUC <- i_auc.fn(df1$time, df1$CAT.12)

我的 df1 看起來像這樣

Answer 1

lapply()將一個列表和一個 function 作為其輸入 arguments 到 output 一個結果。 在這里，您有一個 dataframe 而不是列表作為輸入參數。 因此，您不能按原樣對數據使用lapply() 。 以下是我可以提供的兩種選擇：

選項 1：誠然，這不是最優雅的解決方案，但它可以為您提供您想要的 output 列表。 只需循環遍歷您的 dataframe 的列期望時間列，並將每個結果保存為列表的新元素。 這是該方法的可重現示例：

set.seed(450)

time<-seq(0,120,15)
CAT.01<-rnorm(9, 5, 2)
CAT.02<-rnorm(9, 5, 0.4)
CAT.03<-rnorm(9, 5, 0.22)
CAT.04<-rnorm(9, 5, 1.52)
CAT.05<-rnorm(9, 5, 1.5)
CAT.06<-rnorm(9, 5, 2.1)
CAT.07<-rnorm(9, 5, 3)

LST<-data.frame(time, CAT.01, CAT.02, CAT.03, CAT.04, CAT.05, CAT.06, CAT.07)

i_auc.fn <- function(x,y) {
  auc <- ifelse(y[2] > y[1], (y[2]-y[1])*(x[2]-x[1])/2, 0)
  seg.type <- 0
  for (i in 3:length(x)) {
    if (y[i] >= y[1] & y[i-1] >= y[1]) {
      auc[i-1] <- (((y[i]-y[1])/2) + (y[i-1]-y[1])/2) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 1
    } else if (y[i] >= y[1] & y[i-1] < y[1]) {
      auc[i-1] <- ((y[i]-y[1])^2/(y[i]-y[i-1])) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 2
    } else if (y[i] < y[1] & y[i-1] >= y[1]) {
      auc[i-1] <- ((y[i-1]-y[1])^2/(y[i-1]-y[i])) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 3
    } else if (y[i] < y[1] & y[i-1] < y[1]) {
      auc[i-1] <- 0
      seg.type[i-1] <- 4
    } else {
      # The above cases are exhaustive, so this should never happpen
      return(cat("i:", i, "Error: No condition met\n"))
    }
  }
  return(list(auc=sum(auc), segments=auc, seg.type=seg.type))
}

OUT.LIST<-list()
for(i in 2:ncol(DF)){
  OUT.LIST[[i]]<-i_auc.fn(DF$time, DF[,i])
}

選項 2# 首先將您的輸入設為列表，然后使用lapply() 。 這是該方法的可重現示例：

set.seed(450)

time<-seq(0,120,15)
CAT.01<-rnorm(9, 5, 2)
CAT.02<-rnorm(9, 5, 0.4)
CAT.03<-rnorm(9, 5, 0.22)
CAT.04<-rnorm(9, 5, 1.52)
CAT.05<-rnorm(9, 5, 1.5)
CAT.06<-rnorm(9, 5, 2.1)
CAT.07<-rnorm(9, 5, 3)

DF<-list(CAT.01, CAT.02, CAT.03, CAT.04, CAT.05, CAT.06, CAT.07)

i_auc.fn <- function(x,y) {
  auc <- ifelse(y[2] > y[1], (y[2]-y[1])*(x[2]-x[1])/2, 0)
  seg.type <- 0
  for (i in 3:length(x)) {
    if (y[i] >= y[1] & y[i-1] >= y[1]) {
      auc[i-1] <- (((y[i]-y[1])/2) + (y[i-1]-y[1])/2) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 1
    } else if (y[i] >= y[1] & y[i-1] < y[1]) {
      auc[i-1] <- ((y[i]-y[1])^2/(y[i]-y[i-1])) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 2
    } else if (y[i] < y[1] & y[i-1] >= y[1]) {
      auc[i-1] <- ((y[i-1]-y[1])^2/(y[i-1]-y[i])) * (x[i]-x[i-1])/2
      seg.type[i-1] <- 3
    } else if (y[i] < y[1] & y[i-1] < y[1]) {
      auc[i-1] <- 0
      seg.type[i-1] <- 4
    } else {
      # The above cases are exhaustive, so this should never happpen
      return(cat("i:", i, "Error: No condition met\n"))
    }
  }
  return(list(auc=sum(auc), segments=auc, seg.type=seg.type))
}

OUT.LIST<-lapply(LST, i_auc.fn, time)

在plyr:: package 中可能有一種使用dlply()和colwise()函數的方法，但是由於您沒有沿時間序列拆分數據，因此結果只是一個列表元素。 其他人也許能夠找到一種方法來完成這項工作。