inst/doc/groupedHyperframe.R

In groupedHyperframe: Grouped Hyper Data Frame: An Extension of Hyper Data Frame

## -----------------------------------------------------------------------------
#| warning: false
#| eval: false
# remotes::install_github('tingtingzhan/groupedHyperframe')


## -----------------------------------------------------------------------------
#| warning: false
#| eval: false
# utils::install.packages('groupedHyperframe') # Developers, do NOT use!!


## -----------------------------------------------------------------------------
#| label: prerequisite
#| warning: false
#| eval: false
# remotes::install_github('spatstat/spatstat')
# remotes::install_github('spatstat/spatstat.data')
# remotes::install_github('spatstat/spatstat.explore')
# remotes::install_github('spatstat/spatstat.geom')
# remotes::install_github('spatstat/spatstat.linnet')
# remotes::install_github('spatstat/spatstat.model')
# remotes::install_github('spatstat/spatstat.random')
# remotes::install_github('spatstat/spatstat.sparse')
# remotes::install_github('spatstat/spatstat.univar')
# remotes::install_github('spatstat/spatstat.utils')


## -----------------------------------------------------------------------------
#| message: false
library(groupedHyperframe)
library(survival) # to help hyperframe understand Surv object


## -----------------------------------------------------------------------------
#| echo: false
op = par(no.readonly = TRUE)
options(mc.cores = 1L) # for CRAN submission


## -----------------------------------------------------------------------------
wrobel_lung0 = wrobel_lung |>
  within.data.frame(expr = {
    x = y = NULL
    dapi = phenotype = tissue = NULL
  })


## -----------------------------------------------------------------------------
wrobel_lung0 |> head()


## -----------------------------------------------------------------------------
(wrobel_lung0g = wrobel_lung0 |> as.groupedHyperframe(group = ~ patient_id/image_id))


## -----------------------------------------------------------------------------
unclass(object.size(wrobel_lung0g)) / unclass(object.size(wrobel_lung0))


## -----------------------------------------------------------------------------
f_g = tempfile(fileext = '.rds')
wrobel_lung0g |> saveRDS(file = f_g, compress = 'xz')
f = tempfile(fileext = '.rds')
wrobel_lung0 |> saveRDS(file = f, compress = 'xz')
file.size(f_g) / file.size(f) # not much reduction


## -----------------------------------------------------------------------------
#| message: false
wrobel_lung0g |>
  aggregate_quantile(by = ~ patient_id, probs = seq.int(from = .01, to = .99, by = .01))


## -----------------------------------------------------------------------------
data(Ki67, package = 'groupedHyperframe')
Ki67


## -----------------------------------------------------------------------------
#| message: false
s = Ki67 |>
  aggregate_quantile(by = ~ patientID, probs = seq.int(from = .01, to = .99, by = .01))
s |> head()


## -----------------------------------------------------------------------------
spatstat.data::osteo |> 
  as.groupedHyperframe(group = ~ id/brick)


## -----------------------------------------------------------------------------
(s = wrobel_lung |>
   grouped_ppp(formula = hladr + phenotype ~ OS + gender + age | patient_id/image_id))


## -----------------------------------------------------------------------------
#| code-fold: true
#| code-summary: "See for yourself"
0 / c(2.6e-324, 2.5e-324)
c(2.5e-324, 2.6e-324) / 0


## -----------------------------------------------------------------------------
spatstat.data::spruces |> 
  spatstat.explore::markcorr()


## -----------------------------------------------------------------------------
spatstat.data::spruces |> 
  spatstat.explore::markcorr(r = 0:90) |>
  spatstat.explore::as.data.frame.fv() |>
  utils::tail(n = 10L)


## -----------------------------------------------------------------------------
#| results: hide
s |>
  Emark_(correction = 'none')


## -----------------------------------------------------------------------------
r = seq.int(from = 0, to = 250, by = 10)
out = s |>
  Emark_(r = r, correction = 'none') |> # slow
  # Vmark_(r = r, correction = 'none') |> # slow
  # markcorr_(r = r, correction = 'none') |> # slow
  # markvario_(r = r, correction = 'none') |> # slow
  # Kmark_(r = r, correction = 'none') |> # fast
  Gcross_(i = 'CK+.CD8-', j = 'CK-.CD8+', r = r, correction = 'none') |> # fast
  # Kcross_(i = 'CK+.CD8-', j = 'CK-.CD8+', r = r, correction = 'none') |> # fast
  nncross_(i = 'CK+.CD8-', j = 'CK-.CD8+', correction = 'none') # fast


## -----------------------------------------------------------------------------
out


## -----------------------------------------------------------------------------
#| message: false
(afv = out |>
  aggregate_fv(by = ~ patient_id, f_aggr_ = pmean))


## -----------------------------------------------------------------------------
afv$hladr.E.cumtrapz |> .slice(j = '50')


## -----------------------------------------------------------------------------
#| results: hide
r = seq.int(from = 0, to = 1000, by = 50)
s |>
  Emark_(r = r, correction = 'none') |>
  aggregate_fv(by = ~ patient_id, f_aggr_ = pmean)


## -----------------------------------------------------------------------------
#| message: false
out |>
  aggregate_quantile(by = ~ patient_id, probs = seq.int(from = 0, to = 1, by = .1))


## -----------------------------------------------------------------------------
#| message: false
(mdist = out$phenotype.nncross |> unlist() |> max())
out |> 
  aggregate_kerndens(by = ~ patient_id, from = 0, to = mdist)


## -----------------------------------------------------------------------------
data(shapley, package = 'spatstat.data')
shapley


## -----------------------------------------------------------------------------
km = shapley |> .kmeans(formula = ~ x + y + Mag, centers = 3L)
km |> class()


## -----------------------------------------------------------------------------
km1 = shapley |> .kmeans(formula = ~ x + Mag, centers = 3L)
km1 |> class()


## -----------------------------------------------------------------------------
km2 = shapley |> .kmeans(formula = ~ x + y, centers = 3L)
km2 |> class()


## -----------------------------------------------------------------------------
km3 = shapley |> .kmeans(formula = ~ x + y, clusterSize = 1e3L)
km3 |> class()
km3$centers # 5 clusters needed
km3$cluster |> table()


## -----------------------------------------------------------------------------
data(flu, package = 'spatstat.data')
flu$pattern[[1L]] |> 
  spatstat.geom::markformat()


## -----------------------------------------------------------------------------
flu$pattern[] = flu$pattern |> 
  lapply(FUN = `mark_name<-`, value = 'stain') # read ?flu carefully
flu$pattern[[1L]] |> 
  spatstat.geom::markformat()


## -----------------------------------------------------------------------------
flu$pattern[[1L]] |> split_kmeans(formula = ~ x + y, centers = 3L)


## -----------------------------------------------------------------------------
flu$pattern[1:2] |> split_kmeans(formula = ~ x + y, centers = 3L) 


## -----------------------------------------------------------------------------
flu[1:2,] |> split_kmeans(formula = ~ x + y, centers = 3L)


## -----------------------------------------------------------------------------
data(finpines, package = 'spatstat.data')
(r = finpines |> pairwise_cor_spatial())


## -----------------------------------------------------------------------------
r |> as.matrix()