Skip to content

Instantly share code, notes, and snippets.

@njtierney
Created February 6, 2023 03:32
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save njtierney/67f559d922116b6dae8419ebeed4142d to your computer and use it in GitHub Desktop.
Save njtierney/67f559d922116b6dae8419ebeed4142d to your computer and use it in GitHub Desktop.
library(distributional)
library(tidyverse)

dat <- tibble(
  id = 1:10,
  mean = c(1:10),
  sd = c(1:10)
) %>% 
  mutate(dist = dist_normal(
    sigma = sd,
    mean = mean
  ))

dat
#> # A tibble: 10 × 4
#>       id  mean    sd       dist
#>    <int> <int> <int>     <dist>
#>  1     1     1     1    N(1, 1)
#>  2     2     2     2    N(2, 4)
#>  3     3     3     3    N(3, 9)
#>  4     4     4     4   N(4, 16)
#>  5     5     5     5   N(5, 25)
#>  6     6     6     6   N(6, 36)
#>  7     7     7     7   N(7, 49)
#>  8     8     8     8   N(8, 64)
#>  9     9     9     9   N(9, 81)
#> 10    10    10    10 N(10, 100)

# using distributional
dat %>% 
  mutate(
    samples = generate(dist, 10) 
  ) %>% 
  unnest_longer(
    col = samples
  )
#> # A tibble: 100 × 5
#>       id  mean    sd    dist samples
#>    <int> <int> <int>  <dist>   <dbl>
#>  1     1     1     1 N(1, 1)  1.21  
#>  2     1     1     1 N(1, 1)  1.80  
#>  3     1     1     1 N(1, 1)  0.845 
#>  4     1     1     1 N(1, 1)  2.83  
#>  5     1     1     1 N(1, 1)  2.18  
#>  6     1     1     1 N(1, 1)  0.0218
#>  7     1     1     1 N(1, 1)  1.34  
#>  8     1     1     1 N(1, 1)  1.11  
#>  9     1     1     1 N(1, 1)  1.99  
#> 10     1     1     1 N(1, 1)  0.930 
#> # … with 90 more rows


dat_fun <- tibble(
  id = 1:10,
  mean = c(2:10, 100),
  sd = 0,
  wat = list(\(x) paste0(mean,"_", sd, "_", x)),
  fun = list(\(x) rnorm(mean = mean, sd = 0, n = x)),
  fun_map = map2(mean, sd, function(x,y){
    function(n){
      rnorm(n = n, mean = x, sd = y)
    }
  })
)

dat_fun
#> # A tibble: 10 × 6
#>       id  mean    sd wat    fun    fun_map
#>    <int> <dbl> <dbl> <list> <list> <list> 
#>  1     1     2     0 <fn>   <fn>   <fn>   
#>  2     2     3     0 <fn>   <fn>   <fn>   
#>  3     3     4     0 <fn>   <fn>   <fn>   
#>  4     4     5     0 <fn>   <fn>   <fn>   
#>  5     5     6     0 <fn>   <fn>   <fn>   
#>  6     6     7     0 <fn>   <fn>   <fn>   
#>  7     7     8     0 <fn>   <fn>   <fn>   
#>  8     8     9     0 <fn>   <fn>   <fn>   
#>  9     9    10     0 <fn>   <fn>   <fn>   
#> 10    10   100     0 <fn>   <fn>   <fn>

dat_fun$wat[[1]]("thing")
#>  [1] "2_0_thing"   "3_0_thing"   "4_0_thing"   "5_0_thing"   "6_0_thing"  
#>  [6] "7_0_thing"   "8_0_thing"   "9_0_thing"   "10_0_thing"  "100_0_thing"

# rnorm takes vectors?!
rnorm(mean = c(1,10,100), n = 1)
#> [1] 3.034248
rnorm(mean = c(1,10,100), n = 2)
#> [1]  0.815239 11.148280
rnorm(mean = c(1,10,100), n = 3)
#> [1] -0.3813014 10.7340930 98.1872477

dat_fun$fun
#> [[1]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[2]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[3]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[4]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[5]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[6]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[7]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[8]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[9]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>
#> 
#> [[10]]
#> \(x) rnorm(mean = mean, sd = 0, n = x)
#> <environment: 0x11a8976a0>

dat_fun$fun[[1]](1)
#> [1] 2
dat_fun$fun[[1]](2)
#> [1] 2 3
dat_fun$fun[[1]](3)
#> [1] 2 3 4
dat_fun$fun[[1]](4)
#> [1] 2 3 4 5
dat_fun$fun[[1]](10)
#>  [1]   2   3   4   5   6   7   8   9  10 100

# old way
mean(dat_fun$fun[[1]](100))
#> [1] 15.4
mean(dat_fun$fun[[10]](100))
#> [1] 15.4

# new way
mean(dat_fun$fun_map[[1]](1))
#> [1] 2
mean(dat_fun$fun_map[[10]](10))
#> [1] 100

# another way
dat_fun2 <- tibble(
  id = 1:10,
  mean = c(2:10, 100),
  sd = c(2:10, 100)
)

dat_fun2
#> # A tibble: 10 × 3
#>       id  mean    sd
#>    <int> <dbl> <dbl>
#>  1     1     2     2
#>  2     2     3     3
#>  3     3     4     4
#>  4     4     5     5
#>  5     5     6     6
#>  6     6     7     7
#>  7     7     8     8
#>  8     8     9     9
#>  9     9    10    10
#> 10    10   100   100

dat_fun2 %>% 
  mutate(
    samples = map2_dbl(
      .x = mean, 
      .y = sd, 
      .f = ~rnorm(mean = .x, 
                  sd = .y, 
                  n = 1)
    )
  )
#> # A tibble: 10 × 4
#>       id  mean    sd samples
#>    <int> <dbl> <dbl>   <dbl>
#>  1     1     2     2    2.90
#>  2     2     3     3    4.87
#>  3     3     4     4    9.74
#>  4     4     5     5   -3.00
#>  5     5     6     6    5.75
#>  6     6     7     7    2.18
#>  7     7     8     8    4.94
#>  8     8     9     9   10.6 
#>  9     9    10    10   20.4 
#> 10    10   100   100  135.

dat_fun %>% 
  mutate(
    samples = fun(10)
  )
#> Error in `mutate()`:
#> ℹ In argument: `samples = fun(10)`.
#> Caused by error in `fun()`:
#> ! could not find function "fun"

#> Backtrace:
#>      ▆
#>   1. ├─dat_fun %>% mutate(samples = fun(10))
#>   2. ├─dplyr::mutate(., samples = fun(10))
#>   3. ├─dplyr:::mutate.data.frame(., samples = fun(10))
#>   4. │ └─dplyr:::mutate_cols(.data, dplyr_quosures(...), by)
#>   5. │   ├─base::withCallingHandlers(...)
#>   6. │   └─dplyr:::mutate_col(dots[[i]], data, mask, new_columns)
#>   7. │     └─mask$eval_all_mutate(quo)
#>   8. │       └─dplyr (local) eval()
#>   9. └─base::.handleSimpleError(...)
#>  10.   └─dplyr (local) h(simpleError(msg, call))
#>  11.     └─rlang::abort(message, class = error_class, parent = parent, call = error_call)

Created on 2023-02-06 with reprex v2.0.2

Session info
sessioninfo::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#>  setting  value
#>  version  R version 4.2.2 (2022-10-31)
#>  os       macOS Ventura 13.2
#>  system   aarch64, darwin20
#>  ui       X11
#>  language (EN)
#>  collate  en_US.UTF-8
#>  ctype    en_US.UTF-8
#>  tz       Australia/Hobart
#>  date     2023-02-06
#>  pandoc   2.19.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
#> 
#> ─ Packages ───────────────────────────────────────────────────────────────────
#>  package        * version date (UTC) lib source
#>  assertthat       0.2.1   2019-03-21 [1] CRAN (R 4.2.0)
#>  backports        1.4.1   2021-12-13 [1] CRAN (R 4.2.0)
#>  broom            1.0.3   2023-01-25 [1] CRAN (R 4.2.0)
#>  cellranger       1.1.0   2016-07-27 [1] CRAN (R 4.2.0)
#>  cli              3.6.0   2023-01-09 [1] CRAN (R 4.2.0)
#>  colorspace       2.1-0   2023-01-23 [1] CRAN (R 4.2.0)
#>  crayon           1.5.2   2022-09-29 [1] CRAN (R 4.2.0)
#>  DBI              1.1.3   2022-06-18 [1] CRAN (R 4.2.0)
#>  dbplyr           2.3.0   2023-01-16 [1] CRAN (R 4.2.0)
#>  digest           0.6.31  2022-12-11 [1] CRAN (R 4.2.0)
#>  distributional * 0.3.1   2022-09-02 [1] CRAN (R 4.2.0)
#>  dplyr          * 1.1.0   2023-01-29 [1] CRAN (R 4.2.1)
#>  ellipsis         0.3.2   2021-04-29 [1] CRAN (R 4.2.0)
#>  evaluate         0.20    2023-01-17 [1] CRAN (R 4.2.0)
#>  fansi            1.0.4   2023-01-22 [1] CRAN (R 4.2.0)
#>  farver           2.1.1   2022-07-06 [1] CRAN (R 4.2.0)
#>  fastmap          1.1.0   2021-01-25 [1] CRAN (R 4.2.0)
#>  forcats        * 1.0.0   2023-01-29 [1] CRAN (R 4.2.0)
#>  fs               1.6.0   2023-01-23 [1] CRAN (R 4.2.0)
#>  gargle           1.3.0   2023-01-30 [1] CRAN (R 4.2.0)
#>  generics         0.1.3   2022-07-05 [1] CRAN (R 4.2.0)
#>  ggplot2        * 3.4.0   2022-11-04 [1] CRAN (R 4.2.0)
#>  glue             1.6.2   2022-02-24 [1] CRAN (R 4.2.0)
#>  googledrive      2.0.0   2021-07-08 [1] CRAN (R 4.2.0)
#>  googlesheets4    1.0.1   2022-08-13 [1] CRAN (R 4.2.0)
#>  gtable           0.3.1   2022-09-01 [1] CRAN (R 4.2.0)
#>  haven            2.5.1   2022-08-22 [1] CRAN (R 4.2.0)
#>  hms              1.1.2   2022-08-19 [1] CRAN (R 4.2.0)
#>  htmltools        0.5.4   2022-12-07 [1] CRAN (R 4.2.0)
#>  httr             1.4.4   2022-08-17 [1] CRAN (R 4.2.0)
#>  jsonlite         1.8.4   2022-12-06 [1] CRAN (R 4.2.0)
#>  knitr            1.42    2023-01-25 [1] CRAN (R 4.2.0)
#>  lifecycle        1.0.3   2022-10-07 [1] CRAN (R 4.2.0)
#>  lubridate        1.9.1   2023-01-24 [1] CRAN (R 4.2.0)
#>  magrittr         2.0.3   2022-03-30 [1] CRAN (R 4.2.0)
#>  modelr           0.1.10  2022-11-11 [1] CRAN (R 4.2.0)
#>  munsell          0.5.0   2018-06-12 [1] CRAN (R 4.2.0)
#>  pillar           1.8.1   2022-08-19 [1] CRAN (R 4.2.0)
#>  pkgconfig        2.0.3   2019-09-22 [1] CRAN (R 4.2.0)
#>  purrr          * 1.0.1   2023-01-10 [1] CRAN (R 4.2.0)
#>  R.cache          0.16.0  2022-07-21 [1] CRAN (R 4.2.0)
#>  R.methodsS3      1.8.2   2022-06-13 [1] CRAN (R 4.2.0)
#>  R.oo             1.25.0  2022-06-12 [1] CRAN (R 4.2.0)
#>  R.utils          2.12.2  2022-11-11 [1] CRAN (R 4.2.0)
#>  R6               2.5.1   2021-08-19 [1] CRAN (R 4.2.0)
#>  readr          * 2.1.3   2022-10-01 [1] CRAN (R 4.2.0)
#>  readxl           1.4.1   2022-08-17 [1] CRAN (R 4.2.0)
#>  reprex           2.0.2   2022-08-17 [1] CRAN (R 4.2.0)
#>  rlang            1.0.6   2022-09-24 [1] CRAN (R 4.2.0)
#>  rmarkdown        2.20    2023-01-19 [1] CRAN (R 4.2.0)
#>  rstudioapi       0.14    2022-08-22 [1] CRAN (R 4.2.0)
#>  rvest            1.0.3   2022-08-19 [1] CRAN (R 4.2.0)
#>  scales           1.2.1   2022-08-20 [1] CRAN (R 4.2.0)
#>  sessioninfo      1.2.2   2021-12-06 [1] CRAN (R 4.2.0)
#>  stringi          1.7.12  2023-01-11 [1] CRAN (R 4.2.0)
#>  stringr        * 1.5.0   2022-12-02 [1] CRAN (R 4.2.0)
#>  styler           1.9.0   2023-01-15 [1] CRAN (R 4.2.0)
#>  tibble         * 3.1.8   2022-07-22 [1] CRAN (R 4.2.0)
#>  tidyr          * 1.3.0   2023-01-24 [1] CRAN (R 4.2.0)
#>  tidyselect       1.2.0   2022-10-10 [1] CRAN (R 4.2.0)
#>  tidyverse      * 1.3.2   2022-07-18 [1] CRAN (R 4.2.0)
#>  timechange       0.2.0   2023-01-11 [1] CRAN (R 4.2.0)
#>  tzdb             0.3.0   2022-03-28 [1] CRAN (R 4.2.0)
#>  utf8             1.2.3   2023-01-31 [1] CRAN (R 4.2.0)
#>  vctrs            0.5.2   2023-01-23 [1] CRAN (R 4.2.0)
#>  withr            2.5.0   2022-03-03 [1] CRAN (R 4.2.0)
#>  xfun             0.37    2023-01-31 [1] CRAN (R 4.2.0)
#>  xml2             1.3.3   2021-11-30 [1] CRAN (R 4.2.0)
#>  yaml             2.3.7   2023-01-23 [1] CRAN (R 4.2.0)
#> 
#>  [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library
#> 
#> ──────────────────────────────────────────────────────────────────────────────
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment