如何根据一组简单的规则映射矢量?

时间:2014-07-23 22:38:32

标签: r vector

我是一名新的R学习者,并试图想出一种更快捷的方式来快速映射R中的东西。

通常我需要在热图旁边添加一个颜色侧边栏,指示不同的表型,在很多情况下,我有这个布尔向量,表明它是否是A型(与B型相反):

is.a.type <- c(T, T, F, F, F, T)

现在我需要将此矢量映射到&#34;红色&#34; &#34;蓝色&#34;向量,TRUE映射到&#34; red&#34;和FALSE映射到&#34; blue&#34;。在许多其他语言中,这通常是单行的(例如,在Mathematica中,我们可以做类似isAType /. {True -> "red", False -> "Blue"}的事情,这是简洁,清晰和优雅的)。但是在R中,我不知道什么是优雅的(或#34;规范&#34;)方式。

一种易于思考的方法当然是使用sapply

sapply(is.a.type, function (x) if (x) "red" else "blue")
对我来说,这对于不必要的功能构建来说听起来很笨拙。我能想到的另一种方法是使用R&#39的索引语法:

colors <- is.a.type
colors[is.a.type] <- "red"
colors[!is.a.type] <- "blue"

对我来说这是一个更清晰的方式,但有点过于冗长(我必须分配一个临时变量名,并多次引用它)。我能想到的第三种方式是利用布尔值的黑客可以在类型转换中升级为整数:

c("blue", "red")[is.a.type+1]

这是最短的,但我不喜欢它,因为它对于这个特定的问题是如此密切且非常特殊,而且难以概括。

您认为有更好的解决方案吗?我实际上正在寻找一种通用的方法来根据R中的一个简单规则来映射事物。

2 个答案:

答案 0 :(得分:1)

在R中你可以做很多不同的事情,很多!诀窍是找到最快的方法并使用它。第一:矢量

is.a.type <- sample(c(T, F),1e07,replace=T)

system.time(res <- sapply(is.a.type, function (x) if (x) "red" else "blue"))
    user  system elapsed 
  23.921   0.068  24.040 # SLOW


Colors <- function(x) {
  x <- as.character(x) # This step seems odd, but makes it considerably faster
  x[x == "TRUE"] <- "red"
  x[x == "FALSE"] <- "blue"
  return(x)
}

system.time(res2 <- Colors(is.a.type))
   user  system elapsed 
  4.248   0.000   4.256 # Vectorised = best

system.time(res3 <- ifelse(is.a.type, "red", "blue"))
   user  system elapsed 
  7.417   0.132   7.560 # Ok, but not as good as a vectorised function

system.time(res <- c("blue", "red")[is.a.type+1])
 user  system elapsed 
0.276   0.080   0.357 # fastest but like you said, cryptic
R是关于使自己的功能去做特定的事情,我不会把它想象成&#34;不必要的功能构建&#34;完全是,而是利用R的设计方式。

旁注:颜色已经是一个功能,因此为该名称指定变量会导致麻烦

答案 1 :(得分:1)

如果担心速度可读性,这可能是最快的选择:

x <- rep("blue", length(is.a.type))
x[is.a.type] <- "red"
x

我能想到的另一个显而易见的选择是使用factor。如果您关注的是提出一个易于推广的解决方案,那么这将是最合乎逻辑的方法。

factor(is.a.type, c(TRUE, FALSE), c("red", "blue"))

哪个应该相当快 - 比基本的子集和替换方法更快,至少。

以下是@ JeremyS的样本数据的一些时间:

AMfun1 <- function() factor(is.a.type, c(TRUE, FALSE), c("red", "blue"))
AMfun2 <- function() {
    x <- rep("blue", length(is.a.type))
    x[is.a.type] <- "red"
    x
}
OPfun1 <- function() {
  colors <- is.a.type
  colors[is.a.type] <- "red"
  colors[!is.a.type] <- "blue"
  colors
}
OPfun2 <- function() {
  c("blue", "red")[is.a.type+1]
}

library(microbenchmark)
microbenchmark(AMfun1(), AMfun2(), OPfun1(), OPfun2(), times = 20)
# Unit: milliseconds
#      expr       min        lq    median        uq        max neval
#  AMfun1() 6712.2610 6828.3065 7317.3582 7558.5444  8327.1019    20
#  AMfun2() 1055.2700 1114.6305 1192.7697 1285.2160  1341.8424    20
#  OPfun1() 8366.5327 8737.7971 9134.3010 9589.4956 10557.5743    20
#  OPfun2()  483.5799  530.0979  559.4926  592.9353   703.8037    20