根据R中的样本大小合并组

Question

I have a table in the following format. I simplified it so illustrate the problem (number of samples are random, in my data they add up to 10000 but the structure is the same)

# 0-5    5-10    10-15    15-20    20-25    25-30    30-35    35-40    40-45    45-50
# 700    1000    1400     1700     1900     1500     1000      300       50      1   

The groups are created dynamically based on the min and max value of my input. y refers to my input random sample. I created this table using the following code.

groups <- seq(0, 50, (50-0) / 10)
assoc <- cut(sr$y, groups, include.lowest = TRUE)
tab <- tabulate(assoc, nbins = length(groups) -1 )

Now my goal is to merge the colums (and its samples) with the next one if it does not fullfill the condition of eg 100 samples. I got to the point of checking with a which:

sn <- which(tab < 60) + 1

And now I am stuck with merging the colums and its sample data. I really would appreciate some help.

Answer 1

One solution can be achieved using gather , separate , unite and spread from tidyr package.

The approach is:

• Use Spread and separate to get data in row-wise format with from & to
• Assign group by merging a row with samples less 100 with next row.
• Calculate min of from , max of to and sum of samples
• Finally unite and spread to get the data.frame in original format.

Solution#1

library(dplyr)
library(tidyr)

gather(df, key, samples) %>%
separate(key, c("from", "to"), sep = "-") %>%
group_by(grp = ifelse(samples >= 100 | lag(samples)<100,row_number(), row_number()+1)) %>%
summarise(from = min(from), to = max(to), samples = sum(samples)) %>%
select(-grp) %>%
mutate(from = sprintf("%2s",from)) %>%
unite("key", from, to, sep="-") %>%
spread(key, samples) %>% as.data.frame()
#    0-5  5-10 10-15 15-20 20-25 25-30 30-35 35-40 40-50
# 1  700  1000  1400  1700  1900  1500  1000   300    51

Solution#2:

if OP's intention is to continue groping of columns until a target samples (eg 100) is reached then we need a custom function to create group. The function will be as:

findGroup <- function(x, targetVal = 100){
  grp <- seq_along(x)
  for(i in seq_along(x[-length(x)])){
    if(x[i] < targetVal){
      x[i+1] = x[i+1] + x[i]
      grp[i+1] = grp[i]
    }
  }
  grp
}

# Use findGroup function to organize data. Just line with `group_by` has been changed.
gather(df, key, samples) %>%
  separate(key, c("from", "to"), sep = "-") %>%
  group_by(grp = findGroup(samples)) %>%
  summarise(from = min(from), to = max(to), samples = sum(samples)) %>%
  select(-grp) %>%
  mutate(from = sprintf("%2s",from)) %>%
  unite("key", from, to, sep="-") %>%
  spread(key, samples) %>% as.data.frame()

#    0-5  5-10 10-15 15-20 20-25 25-30 30-35 35-40 40-50
# 1  700  1000  1400  1700  1900  1500  1000   300    51

Data

df <- structure(list(`0-5` = 700L, `5-10` = 1000L,  `10-15` = 1400L, `15-20` = 1700L, 
                     `20-25` = 1900L, `25-30` = 1500L, `30-35` = 1000L, `35-40` = 300L, 
                     `40-45` = 50L, `45-50` = 1L), .Names = c("0-5", "5-10",
                     "10-15", "15-20", "20-25", "25-30", "30-35", "35-40", "40-45", 
                     "45-50"), class = "data.frame", row.names = 1L)
df
  #   0-5 5-10 10-15 15-20 20-25 25-30 30-35 35-40 40-45 45-50
  # 1 700 1000  1400  1700  1900  1500  1000   300    50     1