如何迭代地将列传递给R中的函数

Question

我对R和堆栈溢出比较陌生，而且我没有编码方面的经验，我希望得到一些帮助。我有一个dataframe，我想对多个变量执行相同的操作。我为想要执行的操作编写了一个函数，但我不确定如何更改列名，以便该函数分别对每个变量进行操作。

#Fake Data

#index for a list of traits, and the current food type for each pet

shelterpets <- base::data.frame(
    ID                  = c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10"),
    index_agility       = round(runif(10, min=-0.4, max=0.4), digits = 2),
    index_boldness      = round(runif(10, min=-0.4, max=0.4), digits = 2),
    index_curiousity    = round(runif(10, min=-0.4, max=0.4), digits = 2),
    index_dexterity     = round(runif(10, min=-0.4, max=0.4), digits = 2),
    index_empathy       = round(runif(10, min=-0.4, max=0.4), digits = 2),
    food_type           = c("diet_food", "diet_food", "regular_food", "diet_food", "regular_food", "regular_food", "regular_food", "diet_food", "diet_food", "regular_food")
                                )


 
# function to look at index for each trait, current food type, and suggest changes to food type
function(petfood) {
 
# variable to capture predicted food type: diet_food, regular_food
shelterpets$food10_trait  <- NA

 
#pet previously on diet_food and above 0.10 then confirm diet_food, else predict regular_food
shelterpets$food10_trait  <- ifelse(shelterpets$food_type == "diet_food",
                                        ifelse(shelterpets$index_trait >= 0.10, "diet_food",  "regular_food"),
                                    shelterpets$food10_trait)

 
#pet previously on regular_food and below -0.10 then confirm regular_food, else predict diet_food
shelterpets$food10_trait  <- ifelse(shelterpets$food_type == "regular_food",
                                        ifelse(shelterpets$index_trait <=  -0.10, "regular_food",  "diet_food" ),
                                    shelterpets$food10_trait)

 
#typecast
shelterpets$food10_trait  <- as.factor(shelterpets$food10_trait)

 
#update trait so replace "trait" with "agility", then "boldness", etc.
       }

我想让它看起来像

 ID index_agility index_boldness index_curiousity index_dexterity index_empathy    food_type food10_agility food10_boldness
1  1          0.26          -0.28             0.17            0.17          0.28    diet_food      diet_food    regular_food
2  2          0.17          -0.12            -0.25            0.06          0.06    diet_food      diet_food    regular_food
3  3          0.24           0.14            -0.13            0.25          0.28 regular_food      diet_food       diet_food
4  4         -0.07           0.30            -0.32            0.06          0.23    diet_food   regular_food       diet_food
5  5          0.33           0.00             0.13            0.23         -0.18 regular_food      diet_food       diet_food
6  6          0.17          -0.20             0.01            0.25          0.17 regular_food      diet_food    regular_food

  food10_curiousity food10_dexterity food10_empathy
1         diet_food        diet_food      diet_food
2      regular_food     regular_food   regular_food
3      regular_food        diet_food      diet_food
4      regular_food     regular_food      diet_food
5         diet_food        diet_food   regular_food
6         diet_food        diet_food      diet_food

我做这个是为了开始

#get names in array to hopefully pass to the function, so drop ID and food_type
pet <- as.matrix(colnames(shelterpets))
pet <- pet[-c(1,7),,drop=F]

我看到了这些问题，但我没有完全理解它们是如何工作来适应它们的：

1. Pass a data.frame column name to a function
2. How to iteratively pass arguments into an R function

谢谢你能给我指点。

Answer 1

您的尝试已经接近完成，但是您可以遍历每个特性，并为您的数据帧分配一个新列，并得到该函数的结果。我做了一些小小的改动：

ifelse(shelterpets$index_trait

至

ifelse(shelterpets[, paste0('index_', trait)]

输入可以是每个trait作为字符串，返回值也可以是as.factor(...)。

# function to look at index for each trait, current food type, and suggest changes to food type
f <- function(trait, data = shelterpets) {
  
  # variable to capture predicted food type: diet_food, regular_food
  data$food10_trait  <- NA
  
  
  #pet previously on diet_food and above 0.10 then confirm diet_food, else predict regular_food
  data$food10_trait  <- ifelse(data$food_type == "diet_food",
                                      ifelse(data[, paste0('index_', trait)] >= 0.10, "diet_food",  "regular_food"),
                               data$food10_trait)
  
  
  #pet previously on regular_food and below -0.10 then confirm regular_food, else predict diet_food
  data$food10_trait  <- ifelse(data$food_type == "regular_food",
                                      ifelse(data[, paste0('index_', trait)] <=  -0.10, "regular_food",  "diet_food" ),
                               data$food10_trait)
  
  
  #typecast
  as.factor(data$food10_trait)
  
  
  #update trait so replace "trait" with "agility", then "boldness", etc.
}

## test
f('agility')
# [1] diet_food    diet_food    regular_food regular_food diet_food    regular_food regular_food diet_food    regular_food diet_food   
# Levels: diet_food regular_food

适用于每一个性状

traits <- gsub('.*_', '', grep('index', names(shelterpets), value = TRUE))
shelterpets[, paste0('food10_', traits)] <- lapply(traits, f)

#    ID index_agility index_boldness index_curiousity index_dexterity index_empathy    food_type food10_agility food10_boldness food10_curiousity food10_dexterity food10_empathy
# 1   1          0.06          -0.34            -0.25            0.28          0.22    diet_food   regular_food    regular_food      regular_food        diet_food      diet_food
# 2   2          0.37          -0.01            -0.13            0.22          0.35    diet_food      diet_food    regular_food      regular_food        diet_food      diet_food
# 3   3          0.33          -0.07            -0.03            0.20          0.22 regular_food      diet_food       diet_food         diet_food        diet_food      diet_food
# 4   4          0.07          -0.23            -0.14           -0.29          0.05    diet_food   regular_food    regular_food      regular_food     regular_food   regular_food
# 5   5          0.23           0.06             0.09            0.24         -0.17 regular_food      diet_food       diet_food         diet_food        diet_food   regular_food
# 6   6         -0.27          -0.19            -0.23            0.37         -0.35 regular_food   regular_food    regular_food      regular_food        diet_food   regular_food
# 7   7          0.17           0.30            -0.14           -0.14         -0.11 regular_food      diet_food       diet_food      regular_food     regular_food   regular_food
# 8   8         -0.22           0.13             0.21           -0.06          0.08    diet_food   regular_food       diet_food         diet_food     regular_food   regular_food
# 9   9         -0.25           0.21            -0.02            0.09         -0.29    diet_food   regular_food       diet_food      regular_food     regular_food   regular_food
# 10 10         -0.35           0.39            -0.34            0.20          0.13 regular_food   regular_food       diet_food      regular_food        diet_food      diet_food

Answer 2

您只需编写如下所示的函数：

my_function<- function(x, y){
  ifelse(y == "diet_food",
       ifelse(x >= 0.10,  "diet_food", "regular_food"),
       ifelse(x <= -0.10, "regular_food",  "diet_food"))
}

data.frame(lapply(df[2:6], my_function, y=df[,7]))
  index_agility index_boldness index_curiousity index_dexterity index_empathy
1     diet_food   regular_food        diet_food       diet_food     diet_food
2     diet_food   regular_food     regular_food    regular_food  regular_food
3     diet_food      diet_food     regular_food       diet_food     diet_food
4  regular_food      diet_food     regular_food    regular_food     diet_food
5     diet_food      diet_food        diet_food       diet_food  regular_food
6     diet_food   regular_food        diet_food       diet_food     diet_food

然后可以使用cbind将结果绑定到原始df。您也可以使用sapply而不是lapply

Answer 3

如前所述，考虑使用较长的数据(通常是首选的格式)进行分析操作，包括合并、绘图、建模等，而不是使用更宽(通常更好)的格式来表示和报告。虽然数据确实会产生更多行，但避免对向量化操作进行循环。还请考虑within，以避免在新列计算中重复数据帧名称。

index_cols <- names(shelterpets)[grep("index", names(shelterpets))]

shelterpets_long <- stats::reshape(
    shelterpets, varying=index_cols, times=index_cols,
    v.names="value", timevar="indicator", ids=NULL, 
    idvar=c("ID", "food_type"), direction="long",
    new.row.names = 1:1E5
)

shelterpets_long <- base::within(shelterpets_long, {
  # pet previously on diet_food and above 0.10 then confirm diet_food, else predict regular_food
  food10_trait <- ifelse(food_type == "diet_food", 
                         ifelse(value >= 0.10, "diet_food", "regular_food"),
                         NA)
  
  # pet previously on regular_food and below -0.10 then confirm regular_food, else predict diet_food
  food10_trait  <- ifelse(food_type == "regular_food",
                          ifelse(value <=  -0.10, "regular_food",  "diet_food" ),
                          food10_trait)
  # typecast
  food10_trait  <- as.factor(food10_trait)
})

head(shelterpets_long)
#   ID    food_type     indicator value food10_trait
# 1  1    diet_food index_agility -0.29 regular_food
# 2  2    diet_food index_agility -0.39 regular_food
# 3  3 regular_food index_agility  0.23    diet_food
# 4  4    diet_food index_agility -0.36 regular_food
# 5  5 regular_food index_agility -0.34 regular_food
# 6  6 regular_food index_agility -0.01    diet_food

为了可能更快地将reshape转换为长格式：

shelterpets_long2 <- base::data.frame(
    base::expand.grid(ID=unique(shelterpets$ID), indicator=index_cols, 
                      stringsAsFactors = FALSE),
    food_type = shelterpets$food_type,
    index = base::matrix(data.matrix(shelterpets[index_cols]), 
                         ncol=1, byrow=TRUE)
)

all.equal(shelterpets_long[c("ID", "food_type", "indicator", "value")],
          shelterpets_long2[c("ID", "food_type", "indicator", "value")])
# [1] TRUE

如果您需要修改为wide，请使用这种快速的方法，只需稍微修改@Moody_Mudskipper的answer即可。根据需要，merge改为shelterpet，按ID变量：

### FASTER RESHAPE WIDE
### (https://stackoverflow.com/a/55973705/1422451)
matrix_spread <- function(df1, id, key, value){
  unique_ids <- unique(df1[[key]])
  mat <- matrix( df1[[value]], ncol=length(unique_ids), byrow = FALSE)
  df2 <- data.frame(unique(df1[[id]]), mat)
  names(df2) <- c(id, paste0(value,"_",unique_ids))
  df2
}

shelterpets_wide <- matrix_spread(
    shelterpets_long, 
    id = "ID",
    key = "indicator",
    value = "food10_trait"
)

shelterpets_wide
#    ID food10_trait_index_agility food10_trait_index_boldness food10_trait_index_curiousity food10_trait_index_dexterity food10_trait_index_empathy
# 1   1               regular_food                regular_food                     diet_food                 regular_food               regular_food
# 2   2               regular_food                regular_food                  regular_food                 regular_food               regular_food
# 3   3                  diet_food                   diet_food                     diet_food                    diet_food                  diet_food
# 4   4               regular_food                regular_food                  regular_food                 regular_food               regular_food
# 5   5               regular_food                   diet_food                     diet_food                 regular_food                  diet_food
# 6   6                  diet_food                regular_food                     diet_food                 regular_food               regular_food
# 7   7               regular_food                   diet_food                     diet_food                    diet_food               regular_food
# 8   8               regular_food                   diet_food                     diet_food                 regular_food                  diet_food
# 9   9                  diet_food                regular_food                  regular_food                 regular_food               regular_food
# 10 10               regular_food                regular_food                  regular_food                 regular_food               regular_food