按因子级别拆分的Cut函数

Question

我对cut函数有一个问题。我有这样的情况：

 codice
1 11GP2-0016
2 11GP2-0016
3 11GP2-0016
4  11OL2-074
5  11OL2-074    

我希望有一个新的变量"campione“被变量"codice”拆分，如下所示：

    codice campione
1 11GP2-0016    [1,3]
2 11GP2-0016    [1,3]
3 11GP2-0016    [1,3]
4  11OL2-074    (4,5]
5  11OL2-074    (4,5]

我如何使用cut函数来拆分"codice“，创建一个变量来显示从1到3我有相同的代码，从4到5相同的代码等等？

我需要解决另一个问题。对于相同的问题，我希望获得：

 codice campione
1 11GP2-0016    [11GP2-0016,11GP2-0016,11GP2-0016]
2 11GP2-0016    [11GP2-0016,11GP2-0016,11GP2-0016]
3 11GP2-0016    [11GP2-0016,11GP2-0016,11GP2-0016]
4  11OL2-074    (11OL2-074,11OL2-074]
5  11OL2-074    (11OL2-074,11OL2-074]

有什么解决方案可以解决这个问题吗？

Answer 1

这样就可以了。如果需要，您可以添加方括号/括号。

dat <- read.table(text='codice
1 11GP2-0016
2 11GP2-0016
3 11GP2-0016
4  11OL2-074
5  11OL2-074', header=TRUE)

within(dat, 
    campione <- with(rle(as.character(codice)), {
        starts <- which(! duplicated(codice))
        ends <- starts + lengths - 1
        inverse.rle(list(values=paste(starts, ends, sep=','), lengths=lengths))
    })
)

#       codice campione
# 1 11GP2-0016      1,3
# 2 11GP2-0016      1,3
# 3 11GP2-0016      1,3
# 4  11OL2-074      4,5
# 5  11OL2-074      4,5       

Answer 2

使用您的数据：

d <- read.table(text = "1 11GP2-0016
2 11GP2-0016
3 11GP2-0016
4  11OL2-074
5  11OL2-074", row.names = 1, stringsAsFactors = FALSE)
names(d) <- "codice"

下面是一个使用rle()的稍微复杂的示例

drle <- with(d, rle(codice))

这为我们提供了codice的运行长度

> drle
Run Length Encoding
  lengths: int [1:2] 3 2
  values : chr [1:2] "11GP2-0016" "11OL2-074"

我操作的$lengths组件创建了两个指示，开始位置(ind1)和结束位置(ind2)：

ind1 <- with(drle, rep(seq_along(lengths), times = lengths) +
                     rep(c(0, head(lengths, -1) - 1), times = lengths))
ind2 <- ind1 + with(drle, rep(lengths- 1, times = lengths))

然后我将这些粘贴在一起：

d <- transform(d, campione = paste0("[", ind1, ",", ind2, "]"))

给予

> head(d)
      codice campione
1 11GP2-0016    [1,3]
2 11GP2-0016    [1,3]
3 11GP2-0016    [1,3]
4  11OL2-074    [4,5]
5  11OL2-074    [4,5]

Answer 3

另一种方法是使用rank

left <- rank(factor(d$codice), ties.method = "min")
right <- rank(factor(d$codice), ties.method = "max")
d$campione <- paste("[", left, ",", right, "]", sep = "")