Warning: file_get_contents(/data/phpspider/zhask/data//catemap/4/r/78.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
R中的Dataframes:创建一个新列,其中包含第三列中命名的第二列中的值_R - Fatal编程技术网

R中的Dataframes:创建一个新列,其中包含第三列中命名的第二列中的值

R中的Dataframes:创建一个新列,其中包含第三列中命名的第二列中的值,r,R,我有一个如下所示的数据框: seq_c <- c("T", "A", "G", "T") A <- c(0,61,135,0) C <- c(69,125,0,0) T <- c(133,0,0,74) G <- c(0,134,75,0) test <- data.frame(seq_c,A,C,T,G) 我在这里的逻辑是,这将用test中与test$seq_c的值匹配的列中的值填充新的列c。但这不起作用 非常感谢您的帮助 您可以使用ifelse,这是一种

我有一个如下所示的数据框:

seq_c <- c("T", "A", "G", "T")
A <- c(0,61,135,0)
C <- c(69,125,0,0)
T <- c(133,0,0,74)
G <- c(0,134,75,0)
test <- data.frame(seq_c,A,C,T,G)
我在这里的逻辑是,这将用test中与test$seq_c的值匹配的列中的值填充新的列c。但这不起作用


非常感谢您的帮助

您可以使用ifelse,这是一种非常有用的方法

df<-data.frame(seq_c=c("T", "A", "G", "T"), A=c(0, 69, 133, 0), C=c(61, 125, 0, 134), T=c(135,125,0, 75), G=c(0, 0, 74, 0))

df$new<- ifelse(df$seq_c == "T", df$T, ifelse(df$seq_c == "A", df$A, ifelse(df$seq_c=="C", df$C, df$G)))

您可以通过使用match建立索引来实现这一点。match将在第二个向量中找到向量中每个元素的索引。然后,你可以简单地对有多少元素进行分析

df <- read.table(header=TRUE, text='
seq_c A C T G
T 0 61 135 0
A 69 125 0 0
G 133 0 0 74
T 0 134 75 0')

idx <- match(df$seq_c, colnames(df))
df$value <- sapply(1:nrow(df), function(i) df[i,idx[i]])

df
  seq_c   A   C   T  G value
1     T   0  61 135  0   135
2     A  69 125   0  0    69
3     G 133   0   0 74    74
4     T   0 134  75  0    75
基准测试


谢谢,这个方法也很有效!如果有任何想法能从这个和@ExpectoPatronum's'if else'?@利润中更快,那么akrun推荐的直接索引方法似乎赢得了速度竞赛。
seq_c   A   C   T  G new
T   0  61 135  0 135
A  69 125 125  0  69
G 133   0   0 74  74
T   0 134  75  0  75
df <- read.table(header=TRUE, text='
seq_c A C T G
T 0 61 135 0
A 69 125 0 0
G 133 0 0 74
T 0 134 75 0')

idx <- match(df$seq_c, colnames(df))
df$value <- sapply(1:nrow(df), function(i) df[i,idx[i]])

df
  seq_c   A   C   T  G value
1     T   0  61 135  0   135
2     A  69 125   0  0    69
3     G 133   0   0 74    74
4     T   0 134  75  0    75
df$value <- df[-1][cbind(1:nrow(df),match(df$seq_c, colnames(df[-1])))]
library(microbenchmark)

# bigger dataset
df <- data.frame(seq_c = sample(c("A","C","G","T"), 1000, TRUE),
                 A = sample(seq(1000), 1000),
                 C = sample(seq(1000), 1000),
                 G = sample(seq(1000), 1000),
                 T = sample(seq(1000), 1000))

fun1 <- function(df){
  idx <- match(df$seq_c, colnames(df))
  df$value <- sapply(1:nrow(df), function(i) df[i,idx[i]])
}

fun2 <- function(df){
  df[-1][cbind(1:nrow(df),match(df$seq_c, colnames(df[-1])))]
}

fun3 <- function(df){
  ifelse(df$seq_c == "T", df$T, ifelse(df$seq_c == "A", df$A, ifelse(df$seq_c=="C", df$C, df$G)))
}

microbenchmark(fun1(df), fun2(df), fun3(df), times=10L)

Unit: microseconds
     expr       min        lq       mean    median        uq       max neval
 fun1(df) 37197.120 37669.805 39538.5973 38291.358 39667.335 46515.902    10
 fun2(df)   384.268   467.937   480.8372   495.490   513.195   553.773    10
 fun3(df)  1913.233  1934.395  1996.7215  1979.757  2068.980  2102.713    10