inst/doc/x02_Conversion.R

In tidyfun: Tidy Functional Data Wrangling and Visualization

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "##",
  fig.width = 6,
  fig.height = 4,
  dpi = 72,
  fig.retina = 1,
  out.width = "90%"
)

library(tidyverse)
library(viridisLite)
library(lme4)
library(gridExtra)

theme_set(theme_minimal() + theme(legend.position = "bottom"))

options(
  ggplot2.continuous.colour = "viridis",
  ggplot2.continuous.fill = "viridis"
)
scale_colour_discrete <- scale_colour_viridis_d
scale_fill_discrete <- scale_fill_viridis_d

library("tidyfun")

pal_5 <- viridis(7)[-(1:2)]
set.seed(1221)

## -----------------------------------------------------------------------------
dti_df <- tibble(
  id = refund::DTI$ID,
  visit = refund::DTI$visit,
  sex = refund::DTI$sex,
  case = factor(ifelse(refund::DTI$case, "MS", "control"))
)

dti_df$cca <- tfd(refund::DTI$cca, arg = seq(0, 1, length.out = 93))
dti_df$rcst <- tfd(refund::DTI$rcst, arg = seq(0, 1, length.out = 55))

## -----------------------------------------------------------------------------
dti_df

## -----------------------------------------------------------------------------
dti_df |>
  tf_ggplot(aes(tf = cca, col = case, alpha = 0.2 + 0.4 * (case == "control"))) +
  geom_line() +
  facet_wrap(~sex) +
  scale_alpha(guide = "none", range = c(0.2, 0.4))

## -----------------------------------------------------------------------------
canada <- tibble(
  place = fda::CanadianWeather$place,
  region = fda::CanadianWeather$region,
  lat = fda::CanadianWeather$coordinates[, 1],
  lon = -fda::CanadianWeather$coordinates[, 2]
) |>
  mutate(
    temp = t(fda::CanadianWeather$dailyAv[, , 1]) |>
      tfd(arg = 1:365),
    precipl10 = t(fda::CanadianWeather$dailyAv[, , 3]) |>
      tfd(arg = 1:365) |>
      tf_smooth()
  )

## -----------------------------------------------------------------------------
canada

## -----------------------------------------------------------------------------
temp_panel <- canada |>
  tf_ggplot(aes(tf = temp, color = region)) +
  geom_line()

precip_panel <- canada |>
  tf_ggplot(aes(tf = precipl10, color = region)) +
  geom_line()

gridExtra::grid.arrange(temp_panel, precip_panel, nrow = 1)

## -----------------------------------------------------------------------------
data("sleepstudy", package = "lme4")
sleepstudy <- as_tibble(sleepstudy)

sleepstudy

## -----------------------------------------------------------------------------
sleepstudy_tf <- sleepstudy |>
  tf_nest(Reaction, .id = Subject, .arg = Days)

sleepstudy_tf

## -----------------------------------------------------------------------------
sleepstudy_tf |>
  tf_ggplot(aes(tf = Reaction)) +
  geom_line()

## -----------------------------------------------------------------------------
tibble(
  Subject = unique(sleepstudy$Subject), 
  Reaction = tfd(sleepstudy, id = "Subject", arg = "Days", value = "Reaction")
)

## ----eval = FALSE-------------------------------------------------------------
# ALA::fev1 |>
#   group_by(id) |>
#   mutate(n_obs = n()) |>
#   filter(n_obs > 1) |>
#   ungroup() |>
#   tf_nest(logFEV1, height, .arg = age) |>
#   glimpse()

## -----------------------------------------------------------------------------
dti_df <- refund::DTI |>
  janitor::clean_names() |>
  select(-starts_with("rcst")) |>
  glimpse()

dti_df |>
  tf_gather(starts_with("cca")) |>
  glimpse()

## -----------------------------------------------------------------------------
# reload the tidyfun version of the DTI data
data(dti_df, package = "tidyfun")

# raw functional data
cca_raw <- dti_df$cca[1:5]
cca_raw

# represent in a spline basis
cca_basis <- tfb(dti_df$cca[1:5], k = 25)
cca_basis

# re-express the raw data in the same basis representation
cca_rebased <- tf_rebase(cca_raw, basis_from = cca_basis)
cca_rebased

# or convert a spline-based representation to a grid-based one for a specific grid:
tf_rebase(cca_basis, basis_from = cca_raw)

## -----------------------------------------------------------------------------
# split CCA profiles at their midpoint
cca_halves <- tf_split(dti_df$cca[1:10], splits = 0.5)

# result is a list of tf vectors, one per segment
cca_halves[[1]]
cca_halves[[2]]

# recombine
cca_recombined <- tf_combine(cca_halves[[1]], cca_halves[[2]])
cca_recombined 

## -----------------------------------------------------------------------------
# create an fd object from the Canadian weather data
weather_basis <- fda::create.fourier.basis(c(0, 365), nbasis = 65)
weather_fd <- fda::smooth.basis(
  argvals = 1:365,
  y = fda::CanadianWeather$dailyAv[, , 1],
  fdParobj = weather_basis
)

# convert fdSmooth to tfb
weather_tf <- tfb_spline(weather_fd)
weather_tf[1:3]

## -----------------------------------------------------------------------------
tibble(
  place = fda::CanadianWeather$place,
  region = fda::CanadianWeather$region,
  temp = weather_tf
) |>
  tf_ggplot(aes(tf = temp, color = region)) +
  geom_line(alpha = 0.5)

## -----------------------------------------------------------------------------
sleepstudy_tf |>
  tf_unnest(cols = Reaction) |>
  glimpse()

## -----------------------------------------------------------------------------
sleepstudy_tf |>
  tf_spread() |>
  glimpse()

## -----------------------------------------------------------------------------
reaction_matrix <- sleepstudy_tf |> pull(Reaction) |> as.matrix() 
 
head(reaction_matrix)

# argument values of input data saved in `arg`-attribute:
attr(reaction_matrix, "arg")

## -----------------------------------------------------------------------------
sleepstudy_tf |> pull(Reaction) |> 
  as.data.frame(unnest = TRUE) |>
  head()