Mutate new column from random value in existing columns

user_19410269 0
Viewed 75

I'm looking to mutate my data and create a new column which randomly selects a value from the existing data. My data looks something like:

individual age_2010 age_2011 age_2012 age_2013
a 20 21 NA 21
b 33 34 35 36
c 76 NA 78 79
d 46 46 48 49

And I want it to look like:

individual age_2010 age_2011 age_2012 age_2013 Random Sample
a 20 21 22 NA 21
b 33 34 35 36 36
c 76 NA 78 79 78
d 46 46 48 49 48

Is there any way to add a new column which includes a random figure from any of the previous age columns, and preferably keeping the data in wide form?

data.table sample aggregate random
2 Answers

I think this is an easier approach:

d[, RandomSample:=sample(na.omit(t(.SD)),1),individual]

If dealing with the edge cases discussed above is desired, and one wanted to follow this approach, we could do this:

f <- function(df) {
  s = na.omit(t(df))
  ifelse(length(s)>0, sample(s,1),NA_real_)
}
d[, RandomSample:=f(.SD),individual]

Or, we could just wrap the original approach in tryCatch

d[, RandomSample:=tryCatch(sample(na.omit(t(.SD)),1),error=\(e) NA),individual]
user_44475400

You can reshape longer, then do grouped sampling:

library(data.table)

# Sample data
d <- structure(list(individual = c("a", "b", "c", "d"), age_2010 = c(20, 33, 76, 46), age_2011 = c(21, 34, NA, 46), age_2012 = c(NA, 35, 78, 48), age_2013 = c(21, 36, 79, 49)), row.names = c(NA, -4L), spec = structure(list(cols = list(individual = structure(list(), class = c("collector_character", "collector")), age_2010 = structure(list(), class = c("collector_double", "collector")), age_2011 = structure(list(), class = c("collector_double", "collector")), age_2012 = structure(list(), class = c("collector_double", "collector")), age_2013 = structure(list(), class = c("collector_double", "collector"))), default = structure(list(), class = c("collector_guess", "collector")), skip = 2L), class = "col_spec"), class = c("data.table", "data.frame"))
d
#>    individual age_2010 age_2011 age_2012 age_2013
#> 1:          a       20       21       NA       21
#> 2:          b       33       34       35       36
#> 3:          c       76       NA       78       79
#> 4:          d       46       46       48       49

# Solution
d[, "Random Sample"] <- d |> 
    melt("individual") |> # go long
    (`[`)(!is.na(value), # drop NAs
          .(x = sample(value, 1)), # sampling
          keyby = .(individual)) |> # Grouping variable
    (`[[`)(2) # extract vector from frame
d
#>    individual age_2010 age_2011 age_2012 age_2013 Random Sample
#> 1:          a       20       21       NA       21            21
#> 2:          b       33       34       35       36            33
#> 3:          c       76       NA       78       79            76
#> 4:          d       46       46       48       49            49

Alternatively, you can also use apply(), which is less verbose but much slower:

d[, "Random Sample"] <- apply(d[, -1], 1, \(x) x |> na.omit() |> sample(1))

See the benchmark here for speed comparison. On just 40k observations, apply() needs 59 times longer and 8 times the memory.

# Make large sample data set
d_large <- d |> 
  list() |> 
  rep(1e4) |> 
  rbindlist()

bench::mark(
  base = apply(d_large[, -1], 1, \(x) x |> na.omit() |> sample(1)),
  dt = d_large |> 
    melt("individual") |> 
    (`[`)(!is.na(value), 
          .(x = sample(value, 1)), 
          keyby = .(individual)) |> 
    (`[[`)(2),
  check = F
)
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
#> # A tibble: 2 × 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 base       617.86ms  617.9ms      1.62   103.3MB     12.9
#> 2 dt           6.96ms   10.5ms     80.9     13.1MB     47.3

Created on 2022-07-27 by the reprex package (v2.0.1)

Edit:

Here are versions that work with the edge case where all years are NA. In the first case I went for a join with the original table, which is a bit more expensive than the other version

# Solution with Data Table
d <- d |> 
    melt("individual") |> # go long
    (`[`)(!is.na(value), # drop NAs
          .(`Random Sample` = sample(value, 1)), # sampling
          keyby = .(individual)) |> # Grouping variable
    (`[`)(d) #  right join with original frame

Here I simply used purrr::possibly() to return NA when sampling a zero length vector.

# Solution with apply
d[, "Random Sample"] <- apply(d[, -1], 1, 
                              \(x) x |> na.omit() |> purrr::possibly(sample, NA)(1))
user_119329360
Related