在满足阈值时使用循环编写函数

Question

I have a data frame (data) which consist of 639 data and has 6 columns. Each cell represents time in seconds. I computed threshold for each column.

So far I have done this: calculated thresholds per column. So 6 thresholds for 6 columns

threshold1
[1] 16 22 31  6 11 13

threshold2
[1] 200.0 275.0 387.5  75.0 137.5 162.5

This threshold represents min and max seconds per column. So I would like to (do this for all columns): in column 1 highlight all the cells that have value below 16 seconds and all cells that have value greater than 200 seconds.

I already did this by:

column1<-ifelse(data$column1<threshold1[1],"speeder",     
         ifelse(data$column1>threshold2[1], "slower",1))


column2<-ifelse(data$column2<threshold1[2],"speeder",     
         ifelse(data$column2>threshold2[2], "slower",1))

column3<-ifelse(data$column3<threshold1[3],"speeder",     
         ifelse(data$column3>threshold2[3], "slower",1))

and so on for all 6 columns.

Now I would like to write this in a loop so I wouldn't need to manually write function ifelse every time, because I have different data sets that consist of different number of columns.

Answer 1

First generate data, named "dat":

dat <- data.frame(
    column1 = runif(n = 638, min=0, max=220),
    column2 = runif(n = 638, min=0, max=300),
    column3 = runif(n = 638, min=0, max=400),
    column4 = runif(n = 638, min=0, max=100),
    column5 = runif(n = 638, min=0, max=150),
    column6 = runif(n = 638, min=0, max=200))

# define thresholds    
threshold1 <- c(16, 22, 31, 6, 11, 13)
threshold2 <- c(200.0, 275.0, 387.5, 75.0, 137.5, 162.5)

Using a loop

# Declare a list that will contain the results
results <- list()

# Loop over the columns
for(i in seq_len(ncol(dat))) {
    results[[colnames(dat)[i]]] <- ifelse(dat[,i] < threshold1[i],
                                          yes = "speeder", 
                                          no = ifelse(dat[,i] > threshold2[i], 
                                                      yes = "slower", no = 1))
}

Using lapply

You could also use lapply instead of a loop, like so:

results <- lapply(1:ncol(dat), function(x) {
    ifelse(dat[,x] < threshold1[x],
           yes = "speeder", 
           no = ifelse(dat[,x] > threshold2[x],
                       yes = "slower", no = 1))
})

names(results) <- colnames(dat)

Results

You can access the results with results[[1]] to results[[6]] or with results$column1 to results$column6

> head(results$column1, 100)

  [1] "1"       "1"       "1"       "1"       "1"       "1"       "slower" 
  [8] "1"       "slower"  "1"       "1"       "1"       "speeder" "1"      
 [15] "1"       "1"       "1"       "1"       "1"       "1"       "1"      
 [22] "slower"  "1"       "1"       "1"       "1"       "1"       "1"      
 [29] "1"       "1"       "1"       "slower"  "1"       "slower"  "slower" 
 [36] "1"       "1"       "1"       "1"       "speeder" "1"       "1"      
 [43] "1"       "1"       "speeder" "speeder" "1"       "1"       "slower" 
 [50] "1"       "1"       "slower"  "1"       "1"       "1"       "1"      
 [57] "1"       "1"       "1"       "1"       "1"       "1"       "1"      
 [64] "1"       "1"       "1"       "1"       "slower"  "1"       "1"      
 [71] "slower"  "1"       "1"       "1"       "speeder" "1"       "1"      
 [78] "1"       "1"       "1"       "1"       "slower"  "1"       "1"      
 [85] "1"       "1"       "1"       "1"       "1"       "1"       "1"      
 [92] "1"       "1"       "1"       "1"       "1"       "1"       "1"      
 [99] "speeder" "1" 

Answer 2

You can tryout lapply as well.. It would be faster than loop..

dat <- data.frame(
  column1 = runif(n = 638, min=0, max=220),
  column2 = runif(n = 638, min=0, max=300),
  column3 = runif(n = 638, min=0, max=400),
  column4 = runif(n = 638, min=0, max=100),
  column5 = runif(n = 638, min=0, max=150),
  column6 = runif(n = 638, min=0, max=200))

# define thresholds    
threshold1 <- c(16, 22, 31, 6, 11, 13)
threshold2 <- c(200.0, 275.0, 387.5, 75.0, 137.5, 162.5)

result = matrix(unlist(lapply(seq(6), function(i){
  ifelse(dat[,i] < threshold1[i],
         yes = "speeder", 
         no = ifelse(dat[,i] > threshold2[i], 
                     yes = "slower", no = 1))
})), ncol = 6, byrow = FALSE)

head(result)
     [,1]      [,2] [,3] [,4]     [,5] [,6]
[1,] "speeder" "1"  "1"  "slower" "1"  "1" 
[2,] "1"       "1"  "1"  "1"      "1"  "1" 
[3,] "1"       "1"  "1"  "1"      "1"  "1" 
[4,] "1"       "1"  "1"  "slower" "1"  "1" 
[5,] "1"       "1"  "1"  "1"      "1"  "1" 
[6,] "1"       "1"  "1"  "slower" "1"  "1"