通过sapply

时间:2015-11-02 13:51:41

标签: r function apply gsub sapply

我正在尝试复制在R-Bloggers上发布的sapply中应用多个功能的解决方案,但我无法以理想的方式使其工作。我正在使用一个简单的数据集,类似于下面生成的数据集:

require(datasets)
crs_mat <- cor(mtcars)

# Triangle function
get_upper_tri <- function(cormat){
  cormat[lower.tri(cormat)] <- NA
  return(cormat)
}

require(reshape2)
crs_mat <- melt(get_upper_tri(crs_mat))

我想在列 Var1 Var2 之间替换一些文本值。下面的错误的语法说明了我要实现的目标:

crs_mat[,1:2] <- sapply(crs_mat[,1:2], function(x) {
 # Replace first phrase
 gsub("mpg","MPG",x), 
 # Replace second phrase
  gsub("gear", "GeArr",x)
 # Ideally, perform other changes
})

当然,代码在语法上不正确并且失败。总而言之,我想做以下几点:

  1. 浏览前两列(Var1和Var2)中的所有值,并通过gsub执行简单替换。
  2. 理想情况下,我想避免定义一个单独的函数,如linked帖子中所讨论的那样,并将所有保留在 sapply语法
  3. 我不想要嵌套循环
  4. 我看过herehere讨论过的大致相似的主题,但如果可能的话,我想避免使用plyr。我也有兴趣替换列值而不是创建新列,我想避免指定任何列名。在使用现有数据框架时,使用列号更方便。

    修改

    以下非常有用的评论,我想要实现的目标可以在下面的解决方案中进行总结:

    fun.clean.columns <- function(x, str_width = 15) {
      # Make character
      x <- as.character(x)
      # Replace various phrases
      x <- gsub("perc85","something else", x)
      x <- gsub("again", x)
      x <- gsub("more","even more", x)
      x <- gsub("abc","ohmg", x)
      # Clean spaces
      x <- trimws(x)
      # Wrap strings
      x <- str_wrap(x, width = str_width)
      # Return object
      return(x)
    }
    mean_data[,1:2] <- sapply(mean_data[,1:2], fun.clean.columns)
    

    我的global.env中不需要此功能,因此我可以在此之后运行rm但是更好的解决方案会在apply内涉及挤压语法。

2 个答案:

答案 0 :(得分:3)

这是您的解决方案的开始,我认为您可以自己扩展它。可能有更优雅的方法,但我不会看到它们。

crs_mat[,1:2] <- sapply(crs_mat[,1:2], function(x) {
  # Replace first phrase
  step1 <- gsub("mpg","MPG",x)
  # Replace second phrase. Note that this operates on a modified dataframe. 
  step2 <- gsub("gear", "GeArr",step1)
  # Ideally, perform other changes
  return(step2)

  #or one nested line, not practical if more needs to be done
  #return(gsub("gear", "GeArr",gsub("mpg","MPG",x)))
})

答案 1 :(得分:3)

我们可以使用mgsub中的library(qdap)来替换多种模式。在这里,我使用lapply循环第一列和第二列,并将结果分配回crs_mat[,1:2]。请注意,我使用lapply代替sapply,因为lapply保持结构完整

library(qdap)
crs_mat[,1:2] <- lapply(crs_mat[,1:2], mgsub, 
   pattern=c('mpg', 'gear'), replacement=c('MPG', 'GeArr'))