Разделить список на подмножество списков, которые не разделяют значения в R

Question

У меня есть вектор неуникальных значений, который довольно длинный.

Я хочу разделить этот вектор на четыре примерно одинаковых по длине вектора, где никакие два вектора не могут содержать одно и то же значение, но каждый из четырех векторов может содержать 1 или более разных значений.

Пример:

List <- c(1,1,1,2,3,3,5,5,5,5,9,11,11)

list1 = 1,1,1 list2 = 2,3,3 list3 = 5,5,5,5 list4 = 9,11,11

Что лучшеспособ реализовать это в R?

Answer 1

РЕДАКТИРОВАТЬ:

На основе комментариев после исходного вопроса, вы можете просто сделать:

my.sample <- function(x,n){

  samples <- rle(List)$lengths
  ng <- length(samples)
  groups <- cut(1:ng,n,labels=FALSE)
  reps <- tapply(samples,groups,sum)
  rep(1:n,reps)

}
> my.sample(List,4)
 [1] 1 1 1 1 2 2 3 3 3 3 4 4 4

, чтобы получить вектор, который вы можете использовать в split().

---

Проблемы возникают, если вы начинаете иметь векторы, подобные c (1,1,1,1,1,1,1,1,1,2,2,3,3,4,4).Если вы не возражаете против порядка смещения, вы можете построить для него функцию, основанную на следующей логике:

• разделить вектор на список векторов уникальных значений
• объедините их в n групп
• пройдитесь по n группам и проверьте, все ли они - больше или меньше равной длины.Если нет, переключите одно значение с самого большого на самое маленькое.
• продолжайте, пока разница не станет меньше, чем модуль общей длины и количества групп, или вы запустили алгоритм, скажем, 10 раз (вв некоторых крайних случаях вы можете получить бесконечный цикл while)

Это дает следующую функцию

my.sample <- function(x,n){
  # these are the unique values from which to sample
  samples <- split(x,x)
  ns <- length(samples)

  groups <- list()
  # make sure that sample() returns n groups
  while(length(groups)!=n){
    groups <- split(samples,sample(1:n,ns,replace =TRUE))
  }

  count <- 0
  lgroups <- c(1,ns)

  while(diff(range(lgroups)) > ns%%n & count < 10 ){

    lgroups <- sapply(groups,function(i)length(unlist(i))) # length of groups
    ngroups <- sapply(groups,length) # number of unique values
    id <- which(ngroups > 1) # which groups have more than one unique value

    #switch one value from the largest to the smallest group
    gmin <- which.min(lgroups)
    gmax <- id[which.max(lgroups[id])]
    gsw <- sample(1:length(groups[gmax]),1)
    groups[[gmin]] <- c(groups[[gmin]],groups[[gmax]][gsw])
    groups[[gmax]] <- groups[[gmax]][-gsw]
    count <- count+1
  }
  # create the output
  lapply(groups,unlist,use.names=FALSE)  

}

Может применяться следующим образом:

> my.sample(List,4)
$`1`
[1] 5 5 5 5

$`2`
[1] 11 11  2

$`3`
[1] 3 3 9

$`4`
[1] 1 1 1

Он все еще может быть настроен на ваши собственные нужды, но это похоже на R-подобный способ сделать это.

Answer 2

Подход, который пытается упаковать группы достаточно близко к «полному», путем объединения значений с наибольшим и наименьшим повторениями. Далеко не оптимально с точки зрения упаковки, но довольно быстро. Возвращает вектор, чтобы вы могли легко разбить весь data.frame на пакеты.

bucket = function(x, n) {
  x = factor(x)
  l = table(x)
  g = as.list(names(l[l >= n]))
  l = sort(rev(l[l < n]))
  while (length(l)) {
    big = names(which(cumsum(rev(l)) <= n))
    left = n - sum(l[big])
    l = l[seq_len(length(l) - length(big))]
    small = names(which(cumsum(l) <= left))
    l = l[seq_len(length(l) - length(small)) + length(small)]
    g = c(g, list(c(small, big)))
  }
  unname(setNames(rep(seq_along(g), sapply(g, length)), unlist(g))[levels(x)][x])
}

x = c(1,1,1,1,1,1,1,2,3,3,5,5,5,5,9,11,11)
n = 4

split(x, bucket(x, 4))

Answer 3

Это похоже на решение gsk3 в том, что оно использует rle, но вместо этого пытается найти наиболее близкое разбиение к желаемому квантилю. (Может произойти отключение из-за одной ошибки; я подозреваю, что я не сравниваю квантиль и результат из rle совершенно правильно.)

mysplit <- function(List, n) {
  q <- length(List)*(1:(n-1))/n
  d <- cumsum(rle(List)$lengths)
  x <- d[apply(abs(outer(q, d, `-`)),1,which.min)]
  x <- c(0,x,length(List))
  lapply(1:n, function(i) List[(x[i]+1):x[i+1]])
}

С выходом:

> List <- c(1,1,1,2,3,3,5,5,5,5,9,11,11)
> mysplit(List, 4)
[[1]]
[1] 1 1 1

[[2]]
[1] 2 3 3

[[3]]
[1] 5 5 5 5

[[4]]
[1]  9 11 11

Также обратите внимание, что это работает только при наличии достаточного количества уникальных идентификаторов, чтобы группы имели положительную длину; в частности, это не работает для примера Джориса.

Вот более простой способ, если одинаковая длина не важна; он просто заполняет четыре группы по порядку, одно уникальное значение за раз.

mysplit2 <- function(List, n) {
  spl <- split(List, List)
  lapply(0:(n-1), function(x) unname(unlist(spl[(seq_along(spl)-1) %% n == x])))
}

Возможно, это медленно, но довольно просто.

Answer 4

Вот очень посредственный алгоритм, который приближается к тому, что звучит так, как вы, возможно, захотите.

n.groups <- 4
L <- c(1,1,1,2,3,3,5,5,5,5,9,11,11)
N <- length(L)

L <- sort(L)
L.rle <- rle(L)

ave.grp.length <- N/n.groups

lgths <- L.rle$lengths
vals <- L.rle$values

res <- list(one=c(),two=c(),three=c(),four=c())
l <- 1
for(i in seq(length(vals)) ) {
  if( sum(res[[l]])>=ave.grp.length & l<n.groups ) {
    l <- l+1
  }
  res[[l]] <- c( res[[l]], rep(vals[i],lgths[i]) )
}

Пути, которыми это можно улучшить:

• Вы можете предпочесть свой вывод в сжатой форме, поскольку вы говорите, что ваш список довольно большой.Это может сэкономить вам некоторое серьезное время вычислений, поскольку репликация сжатых данных неэффективна.
• В настоящее время она работает в последовательном порядке.Это проще и быстрее в вычислительном отношении.Если вы действительно хотите, чтобы группы имели одинаковый размер, насколько это возможно, вы можете возиться с другими алгоритмами или добавить второй проход, чтобы вернуться в конец и даже выровнять их.
• Это циклна основе, который редко является лучшим способом сделать что-то в R.