Newton Cooling with Purrr

_explanation.md

Applying a function across rows of a tibble

A problem I often am faced with is applying a function to data from a simulation, for instance computing the Newton Cooling of a bunch of materials. I asked this question on Twitter https://twitter.com/JennyBryan/status/930475618210213888 and @JennyBryan provided two options for solving this problem using dplyr and purrr as comments on the newton-cooling-with-purrr.R file below.

The material properties might be provided as follows:

material_details <- tribble(
  ~material, ~k.cooling.constant,
  "copper", 0.1,
  "graphite", 0.01
)
## A tibble: 2 x 2
#  material k.cooling.constant
#     <chr>              <dbl>
#1   copper               0.10
#2 graphite               0.01

Initial temperatures as follows:

initial_temperatures <- tribble(
  ~material, ~t.zero, ~t.surroundings,
  "copper", 350, 273,
  "graphite", 300, 273
)
# A tibble: 2 x 3
#  material t.zero t.surroundings
#     <chr>  <dbl>          <dbl>
#1   copper    350            273
#2 graphite    300            273

Newton's Law of Cooling is as follows:

newton_cooling <- function(t,
                           t.zero = 300,
                           t.surroundings = 273,
                           k.cooling.constant = 0.001) {
  t.surroundings + (t.zero - t.surroundings) * exp(-k.cooling.constant * t)
}

Now how can the cooling of these materials be simulated at time points seq(0, 100, 0.5) most easily using the tidyverse?

newton-cooling-with-purrr.R

library("tidyverse")
newton_cooling <- function(t,
                           t.zero = 300,
                           t.surroundings = 273,
                           k.cooling.constant = 0.001) {
  t.surroundings + (t.zero - t.surroundings) * exp(-k.cooling.constant * t)
}

initial_temperatures <- tribble(
  ~material, ~t.zero, ~t.surroundings,
  "copper", 350, 273,
  "graphite", 300, 273
)

material_details <- tribble(
  ~material, ~k.cooling.constant,
  "copper", 0.1,
  "graphite", 0.01
)

time_values <- seq(0, 100, 0.5)

Here are some ideas:

library("tidyverse")

data <- list(
  material = c("copper", "graphite"),
  t = seq(0, 100, 0.5)
)

initial_temperatures <- tribble(
  ~material, ~t.zero, ~t.surroundings,
  "copper", 350, 273,
  "graphite", 300, 273
)

material_details <- tribble(
  ~material, ~k.cooling.constant,
  "copper", 0.1,
  "graphite", 0.01
)

newton_cooling <- function(t,
                           t.zero = 300,
                           t.surroundings = 273,
                           k.cooling.constant = 0.001) {
  t.surroundings + (t.zero - t.surroundings) * exp(-k.cooling.constant * t)
}

data %>%
  cross_df() %>% 
  left_join(initial_temperatures) %>% 
  left_join(material_details) %>% 
  mutate(nc = newton_cooling(t, t.zero, t.surroundings, k.cooling.constant))
#> Joining, by = "material"
#> Joining, by = "material"
#> # A tibble: 402 x 6
#>    material     t t.zero t.surroundings k.cooling.constant       nc
#>       <chr> <dbl>  <dbl>          <dbl>              <dbl>    <dbl>
#>  1   copper   0.0    350            273               0.10 350.0000
#>  2 graphite   0.0    300            273               0.01 300.0000
#>  3   copper   0.5    350            273               0.10 346.2447
#>  4 graphite   0.5    300            273               0.01 299.8653
#>  5   copper   1.0    350            273               0.10 342.6725
#>  6 graphite   1.0    300            273               0.01 299.7313
#>  7   copper   1.5    350            273               0.10 339.2745
#>  8 graphite   1.5    300            273               0.01 299.5980
#>  9   copper   2.0    350            273               0.10 336.0423
#> 10 graphite   2.0    300            273               0.01 299.4654
#> # ... with 392 more rows

## or use purrr::pmap()
## add `...` to this function to absorb unused arguments

newton_cooling2 <- function(t,
                           t.zero = 300,
                           t.surroundings = 273,
                           k.cooling.constant = 0.001, ...) {
  t.surroundings + (t.zero - t.surroundings) * exp(-k.cooling.constant * t)
}

data %>%
  cross_df() %>% 
  left_join(initial_temperatures) %>% 
  left_join(material_details) %>% 
  mutate(nc = pmap_dbl(., newton_cooling2))
#> Joining, by = "material"
#> Joining, by = "material"
#> # A tibble: 402 x 6
#>    material     t t.zero t.surroundings k.cooling.constant       nc
#>       <chr> <dbl>  <dbl>          <dbl>              <dbl>    <dbl>
#>  1   copper   0.0    350            273               0.10 350.0000
#>  2 graphite   0.0    300            273               0.01 300.0000
#>  3   copper   0.5    350            273               0.10 346.2447
#>  4 graphite   0.5    300            273               0.01 299.8653
#>  5   copper   1.0    350            273               0.10 342.6725
#>  6 graphite   1.0    300            273               0.01 299.7313
#>  7   copper   1.5    350            273               0.10 339.2745
#>  8 graphite   1.5    300            273               0.01 299.5980
#>  9   copper   2.0    350            273               0.10 336.0423
#> 10 graphite   2.0    300            273               0.01 299.4654
#> # ... with 392 more rows