3

Is there a way for my map_df() call below to produce the output that looks like the desired_output below?

library(nlme)
library(tidyverse)

dat <- read.csv('https://raw.githubusercontent.com/rnorouzian/e/master/var.csv')
dat$fmonth <- factor(dat$month)

m5 <- lme(y ~ x*fmonth, random = ~1|id, data = dat, weights = varPower(form=~x|fmonth), 
          control = lmeControl(msMaxIter = 1e2))

hetro_var <- function(fit) coef(fit$modelStruct$varStruct, uncons = FALSE, allCoef = TRUE)
  

x_fmonth1 <- map_df(hetro_var(m5), ~sigma(m5)^2*abs(dat$x)^(2*hetro_var(m5)[.])) # Can this produce desired_output?

x_fmonth2 <- lapply(names(hetro_var(m5)), function(i)sigma(m5)^2*abs(dat$x)^(2*hetro_var(m5)[i]))

names(x_fmonth2) <- names(hetro_var(m5))

desired_output <- bind_rows(x_fmonth2) # can `map_df()` above produce this output?
rnorouzian
  • 7,397
  • 5
  • 27
  • 72
  • 1
    @RonakShah, `x_fmonth1` output is wrong, it just repeats the same column over and over! Did you see the difference? – rnorouzian Nov 05 '20 at 02:35

2 Answers2

2

You can use map_df(). Just need to pass in the names of hetro_var(m5) and name that list with itself.

mapdf_output <-
  names(hetro_var(m5)) %>%
  set_names(names(hetro_var(m5))) %>%
  map_df(function(i)sigma(m5)^2*abs(dat$x)^(2*hetro_var(m5)[i]))

assertthat::are_equal(mapdf_output, desired_output) # TRUE

It does seem a little funny that we have to name map inputs with their own values in some cases - I asked a question about this awhile back and it seems there's no getting around the set_names() duplication.

andrew_reece
  • 20,390
  • 3
  • 33
  • 58
1

You can use map_dfc and pass names as input same as the lapply call.

purrr::map_dfc(names(hetro_var(m5)), 
               ~tibble(!!.x := sigma(m5)^2*abs(dat$x)^(2*hetro_var(m5)[.x])))

# A tibble: 768 x 12
#     `5`   `6`   `9`  `10`  `12`   `3`   `4`  `11`    `8`   `2`   `1`    `7`
#   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl> <dbl> <dbl>  <dbl>
# 1 0.566 0.612 0.864 0.861 0.498 0.448 0.401 0.582 0.160  0.474 0.355 0.276 
# 2 0.691 0.748 1.06  1.06  0.608 0.546 0.487 0.710 0.192  0.578 0.431 0.334 
# 3 0.253 0.273 0.378 0.377 0.224 0.203 0.182 0.260 0.0757 0.214 0.162 0.127 
# 4 0.484 0.523 0.735 0.733 0.426 0.384 0.343 0.497 0.138  0.406 0.304 0.237 
# 5 0.376 0.406 0.568 0.567 0.332 0.300 0.269 0.386 0.109  0.317 0.239 0.186 
# 6 0.335 0.361 0.504 0.503 0.296 0.267 0.239 0.344 0.0981 0.282 0.213 0.167 
# 7 0.524 0.566 0.797 0.795 0.461 0.415 0.371 0.538 0.149  0.439 0.329 0.256 
# 8 0.229 0.247 0.342 0.341 0.203 0.184 0.165 0.235 0.0691 0.194 0.147 0.116 
# 9 0.261 0.282 0.391 0.390 0.231 0.209 0.188 0.268 0.0780 0.221 0.167 0.131 
#10 0.174 0.187 0.258 0.257 0.154 0.140 0.126 0.178 0.0535 0.148 0.113 0.0889
# … with 758 more rows

Or with imap_dfc :

purrr::imap_dfc(hetro_var(m5), ~sigma(m5)^2*abs(dat$x)^(2*hetro_var(m5)[.y]))
Ronak Shah
  • 377,200
  • 20
  • 156
  • 213
  • I think the key is to pass names in the function. When using `map` I pass names (which is referred as `.x`) while using `imap` names are referred as `.y`. – Ronak Shah Nov 05 '20 at 02:56
  • you can pass in custom curve fits using a mix of `method` and `formula` argument specifications in `geom_smooth()`. – andrew_reece Nov 05 '20 at 03:09
  • you have a complicated use case, i was just responding to your q about plotting curve functions in `ggplot`. it's possible, but may take some experimentation to fit your exact needs. give it a try, then post a separate question if you get stuck. – andrew_reece Nov 05 '20 at 03:24