Allocating untagged counts to other tags

user_3888000 0
Viewed 60

I have a quite long table that looks like this:

library(tidyverse)
x=structure(list(id = c(1L, 1L, 1L, 2L, 2L, 2L), loc = c("A", "B", "?", "A", "B", "?"), count1 = c(10L, 20L, 50L, 5L, 22L, 10L), count2 = c(324L, 564L, 121L, 87L, 66L, 445L)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))
x
#> # A tibble: 6 x 4
#>      id loc   count1 count2
#>   <int> <chr>  <int>  <int>
#> 1     1 A         10    324
#> 2     1 B         20    564
#> 3     1 ?         50    121
#> 4     2 A          5     87
#> 5     2 B         22     66
#> 6     2 ?         10    445

For each id, I would like to dispatch counts where loc is unknown uniformly to loc A and loc B.

For instance, for id==1 and column count1, loc A represent 1/3 of the total, therefore 1/3 of 50 is allocated to group A and 2/3 of 50 is allocated to group B, which would end on respectively 26.7 and 53.3. Rows with unknown loc should then be dropped.

There is (currently) no other possible value for loc than A, B or ?.

The ratio of A/A+B is different for every count and for every id.

I tried multiple ways of doing this, involving pivoting and transposing, but I never managed to achieve the intended result.

Here is the complete expected output:

expected=structure(list(id = c(1L, 1L, 2L, 2L), loc = c("A", "B", "A", "B"), count1 = c(26.67, 53.33, 6.85, 30.15), count2 = c(368.15, 640.85, 340.04, 257.96)), row.names = c(NA, -4L), class = c("tbl_df", "tbl", "data.frame"))

expected
#> # A tibble: 4 x 4
#>      id loc   count1 count2
#>   <int> <chr>  <dbl>  <dbl>
#> 1     1 A      26.7    368.
#> 2     1 B      53.3    641.
#> 3     2 A       6.85   340.
#> 4     2 B      30.2    258.

#Totals are obviously the same:
x %>% group_by(id) %>% summarise(across(count1:count2, sum))
#> # A tibble: 2 x 3
#>      id count1 count2
#>   <int>  <int>  <int>
#> 1     1     80   1009
#> 2     2     37    598
expected %>% group_by(id) %>% summarise(across(count1:count2, sum))
#> # A tibble: 2 x 3
#>      id count1 count2
#>   <int>  <dbl>  <dbl>
#> 1     1     80   1009
#> 2     2     37    598

Created on 2021-07-16 by the reprex package (v2.0.0)

data-wrangling dplyr r
3 Answers

Perhaps this helps

library(dplyr)
x %>% 
  group_by(id) %>%
  mutate(across(starts_with('count'), ~ {
        tmp <- .
        i1 <- loc == '?'
        tmp[!i1] <- tmp[!i1] + tmp[!i1]/
       sum(tmp[!i1]) * tmp[i1] 
      tmp})) %>%
  ungroup %>%
  filter(loc != '?')

-ouptut

# A tibble: 4 x 4
     id loc   count1 count2
  <int> <chr>  <dbl>  <dbl>
1     1 A      26.7    368.
2     1 B      53.3    641.
3     2 A       6.85   340.
4     2 B      30.1    258.
user_37322710

A bit verbose but will do the trick:

library(dplyr)

x %>% 
  filter(loc != "?") %>%
  left_join(x %>%
              filter(loc == "?"), by = "id") %>%
  group_by(id) %>%
  mutate(across(ends_with(".x") & !contains("loc"), ~ prop.table(.x), .names = '{.col}_prop'),
         across(ends_with(".x") & !contains("loc"), ~ 
           get(gsub(".x", ".y", cur_column())) * get(paste(cur_column(), "_prop", sep = "")) + .x)) %>%
  select(1:4) %>%
  rename_with(~ gsub(".x", "", .), !id)

# A tibble: 4 x 4
# Groups:   id [2]
     id loc   count1 count2
  <int> <chr>  <dbl>  <dbl>
1     1 A      26.7    368.
2     1 B      53.3    641.
3     2 A       6.85   340.
4     2 B      30.1    258.
user_143145200

Here is an intutional solution with data.table

library(data.table)
x=structure(list(id = c(1L, 1L, 1L, 2L, 2L, 2L), loc = c("A", "B", "?", "A", "B", "?"), count1 = c(10L, 20L, 50L, 5L, 22L, 10L), count2 = c(324L, 564L, 121L, 87L, 66L, 445L)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"))
setDT(x)
x[,`:=`(count1 = as.double(count1),
        count2 = as.double(count2))]

x[,`:=`(count1 = fifelse(loc != "?", count1 + count1[3] * count1/(count1[1] + count1[2]), count1),
        count2 = fifelse(loc != "?", count2 + count2[3] * count2/(count2[1] + count2[2]), count2)),
      by=id][loc != "?"]
#>    id loc    count1   count2
#> 1:  1   A 26.666667 368.1486
#> 2:  1   B 53.333333 640.8514
#> 3:  2   A  6.851852 340.0392
#> 4:  2   B 30.148148 257.9608

Created on 2021-07-17 by the reprex package (v2.0.0)

user_75227640
Related