Question

我有以下数据集：

df<-data.frame (fact= c("a,b,c,d","f,g,h,v"), value = c("0,1,0,1" , "0,0,1,0"))

这是数据：

   fact   value
1 a,b,c,d 0,1,0,1
2 f,g,h,v 0,0,1,0

我希望在值为1 时拆分它。所以，我的理想输出是：

 fact     value

1:  a,b     0,1
2:  c,d     0,1
3: f,g,h    0,0,1
4:  v       0

首先，我想我可以通过使用cut来找到一种方法：

cut(as.numeric(strsplit(as.character(df$value), split = ",")), breaks =1)

但我的尝试都没有结束。

Answer 1

首先，我们将fact和value中的字符串拆分为单独的值，并将它们堆叠起来，使每个字符串成为数据框中的值列。现在，使用value，我们希望每次运行零后跟1成为一个组。这些是我们想要在最后粘贴在一起的值组。我们将dplyr分别对每个组进行操作以返回最终数据框。

library(dplyr) 
library(purrr)  # For map function
library(tidyr)  # For separate_rows function

df %>% 
  separate_rows(fact, value, sep=",") %>%
  mutate(group = lag(cumsum(value == 1), default=0)) %>%
  group_by(group) %>%
  summarise(fact = paste(fact, collapse=","),
            value = paste(value, collapse=",")) %>%
  select(-group)     

   fact value 
1   a,b   0,1
2   c,d   0,1
3 f,g,h 0,0,1
4     v     0

Answer 2

一种方法是使用fact将原始数据框中value和","的字符向量分割为strsplit，然后确定第一个"1"的位置分裂value中的1}}。然后使用此位置确定fact和value的分割：

sv <- strsplit(df$value,",")
sf <- strsplit(df$fact,",")
pos <- sapply(sv, function(sv) {j <- which(sv=="1"); if (length(j)==0) NA else j[1]})
out <- do.call(rbind,lapply(1:length(pos),function(i,sv,sf,pos) {
  if (is.na(pos[i]) || pos[i] == length(sf[[i]])) 
    data.frame(fact=toString(sf[[i]]),value=toString(sv[[i]])) 
  else 
    data.frame(fact=c(toString(sf[[i]][1:pos[i]]),
                      toString(sf[[i]][(pos[i]+1):length(sf[[i]])])),
               value=c(toString(sv[[i]][1:pos[i]]),
                       toString(sv[[i]][(pos[i]+1):length(sv[[i]])])))
  },sv,sf,pos))
##     fact   value
##1    a, b    0, 1
##2    c, d    0, 1
##3 f, g, h 0, 0, 1
##4       v       0

此答案假设"1"中有value要分割。如果"1"没有或value位于df的末尾，则<slot>中的该行不会在输出中分割。

Answer 3

另一个基础R尝试：

sf <- strsplit(as.character(df$fact), ",")
sv <- strsplit(as.character(df$value), ",")
spl <- lapply(sv, function(x) -rev(cumsum(as.numeric(rev(x)))) )
#[[1]]
#[1] -2 -2 -1 -1
#
#[[2]]
#[1] -1 -1 -1  0

joinfun <- function(x) sapply(unlist(Map(split, x, spl), rec=FALSE), paste, collapse=",")

# to show you what is happening:
#> Map(split, sf, spl)
#[[1]]
#[[1]]$`-2`
#[1] "a" "b"
#
#[[1]]$`-1`
#[1] "c" "d"
# 
#
#[[2]]
#[[2]]$`-1`
#[1] "f" "g" "h"
#
#[[2]]$`0`
#[1] "v"

data.frame(fact  = joinfun(sf), value = joinfun(sv) )
#   fact value
#1   a,b   0,1
#2   c,d   0,1
#3 f,g,h 0,0,1
#4     v     0

Answer 4

一种data.table方法如下。您使用fact包中的value拆分cSplit()和splitstackshape中的每个元素。这将以长格式创建data.table。获得结果后，使用diff()和cumsum()创建一个组变量。只要value中的差异小于0，R就会创建一个新组。然后，您要将paste()同时应用于fact和value。您可以使用lapply(.SD ...)实现此目的。这是summarise_at()包中dplyr的等效性。最后，删除组变量。

library(splitstackshape)
library(data.table)

cSplit(df, splitCols = c("fact", "value"),
       direction = "long", sep = ",") -> temp

temp[, group := cumsum(c(FALSE, diff(value) < 0))][,
       lapply(.SD, function(x){paste(x, collapse = ",")}),
       .SDcols = fact:value,
       by = group][, group :=NULL] -> out

#    fact value
#1:   a,b   0,1
#2:   c,d   0,1
#3: f,g,h 0,0,1
#4:     v     0

Answer 5

派对有点晚，但这是一个利用regular expressions和tidyverse功能的解决方案：

#install.packages("devtools")
#devtools::install_github("hadley/tidyverse")

library(tidyverse)

dff <- data.frame(fact= c("a,b,c,d","f,g,h,v"), 
                   value = c("0,1,0,1" , "0,0,1,0"), 
                   stringsAsFactors = F)

dff %>% 
  mutate(value = gsub("(?<=1),(?=0)","-", value, perl = T)) %>%
  group_by(value) %>%
  mutate(indices = which(strsplit(value,split="")[[1]]=="-"),
         fact = sprintf("%s-%s", 
                        substr(fact, 0, indices - 1), 
                        substr(fact, indices + 1, nchar(fact)))) %>%
  select(fact, value) %>% 
  ungroup() %>%
  separate_rows(fact, value, sep = "-")

这会在1列的value后面找到逗号，然后用短划线（-）替换这些逗号。然后，它会在value列的每一行中获取这些破折号的索引，并将它们提供给fact列，以便用破折号替换相应的逗号。随后，它使用separate_rows拆分这些破折号上的fact和value列。它应该产生以下结果：

#     fact value
#   <chr> <chr>
# 1   a,b   0,1
# 2   c,d   0,1
# 3 f,g,h 0,0,1
# 4     v     0

Answer 6

用这个更简单的解决方案取代了解决方案。

不使用任何套餐。 df的列可能是字符或因子 - 代码将它们转换为字符。输入中的value个条目可能不包含任何条目。输入的同一行上的fact和value组件应具有相同数量的逗号分隔字段，但在不同行上可能具有不同数量的字段。

do.call("rbind", by(df, 1:nrow(df), function(x) {
  long <- lapply(x, function(x) unlist(strsplit(as.character(x), ",")))
  g <- -rev(cumsum(rev(long$value == 1)))
  aggregate(long, list(g), paste, collapse = ",")[names(x)]
}))

，并提供：

   fact value
1   a,b   0,1
2   c,d   0,1
5 f,g,h 0,0,1
6     v     0

by调用每行显示一次的匿名函数。对于每一行，它以逗号分隔每列，为该行提供长格式long。例如，对于处理df第一行的迭代，long的值为：

long <- list(fact = c("a", "b", "c", "d"), value = c("0", "1", "0", "1"))

然后我们为该行计算分组变量g。例如，对于第一次迭代，它等于：

g <- c(-2L, -2L, -1L, -1L)

最后，我们通过g聚合来自具有相同组的每个列的元素。我们删除了aggegate添加的额外列。

最后，我们rbind将所有行的data.frames放在一起。

拆分字符串并将其添加为新行

6 个答案: