inst/doc/rolap.R

In rolap: Obtaining Star Databases from Flat Tables

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup, echo = FALSE, message=FALSE---------------------------------------
library(rolap)

## ----results = "asis", echo = FALSE-------------------------------------------
pander::pandoc.table(ft, split.table = Inf)

## -----------------------------------------------------------------------------
library(rolap)

ft_num <- ft |>
  dplyr::mutate(`Pneumonia and Influenza Deaths` = as.integer(`Pneumonia and Influenza Deaths`)) |>
  dplyr::mutate(`All Deaths` = as.integer(`All Deaths`))

ft_age <- ft |>
  dplyr::select(-`Pneumonia and Influenza Deaths`,-`All Deaths`) |>
  tidyr::gather("Age", "All Deaths", 7:11) |>
  dplyr::mutate(`All Deaths` = as.integer(`All Deaths`)) |>
  dplyr::mutate(Age = stringr::str_replace(Age, " \\(all cause deaths\\)", ""))

## ----results = "asis", echo = FALSE-------------------------------------------
pander::pandoc.table(head(ft_age, 15), split.table = Inf)

## -----------------------------------------------------------------------------
dput(colnames(ft_num))

dput(colnames(ft_age))

## -----------------------------------------------------------------------------
s <- star_schema()

## -----------------------------------------------------------------------------
# definition 1
when <- dimension_schema(name = "When",
                         attributes = c("Year",
                                        "WEEK"))
s_age <- star_schema() |>
  define_dimension(when)

# definition 2
s_age <- star_schema() |>
  define_dimension(name = "When",
                         attributes = c("Year",
                                        "WEEK"))

## -----------------------------------------------------------------------------
# definition 1
mrs_cause <- fact_schema(name = "MRS Cause",
               measures = c("Pneumonia and Influenza Deaths",
                            "All Deaths"))
s_cause <- star_schema() |>
  define_facts(mrs_cause)

# definition 2
s_cause <- star_schema() |>
  define_facts(name = "MRS Cause",
               measures = c("Pneumonia and Influenza Deaths",
                            "All Deaths"))

## -----------------------------------------------------------------------------
s_cause <- star_schema() |>
  define_facts(name = "MRS Cause",
               measures = c("Pneumonia and Influenza Deaths",
                            "All Deaths"),
               agg_functions = c("MAX", "SUM"),
               nrow_agg = "Num" 
               )

## -----------------------------------------------------------------------------
s_cause <- star_schema() |>
  define_facts(name = "MRS Cause",
               measures = c("Pneumonia and Influenza Deaths",
                            "All Deaths"),
               nrow_agg = "Num") |>
  define_dimension(name = "When",
                         attributes = c("Year",
                                        "WEEK",
                                        "Week Ending Date")) |>
  define_dimension(name = "Where",
                          attributes = c("REGION",
                                         "State",
                                         "City"))

## -----------------------------------------------------------------------------
db_cause <- star_database(s_cause, ft_num)

## -----------------------------------------------------------------------------
l_cause <- db_cause |>
  snake_case() |>
  as_tibble_list()

## ----results = "asis", echo = FALSE-------------------------------------------
for (i in 1:length(l_cause)) {
  pander::pandoc.table(l_cause[[i]], split.table = Inf)
}

## -----------------------------------------------------------------------------
nrow(ft_num)

nrow(l_cause[[3]])

## -----------------------------------------------------------------------------
when <- dimension_schema(name = "When",
                         attributes = c("Year"))

where <- dimension_schema(name = "Where",
                          attributes = c("State",
                                         "City"))
s_cause <- star_schema() |>
  define_facts(name = "MRS Cause",
               measures = c("Pneumonia and Influenza Deaths",
                            "All Deaths")) |>
  define_dimension(when) |>
  define_dimension(where)

ft_num2 <- ft_num |>
  dplyr::filter(Year > "1962") |>
  dplyr::filter(City == "Boston" | City == "Bridgeport")

db_cause <- star_database(s_cause, ft_num2) |>
  snake_case()

l_cause <- db_cause |>
  as_tibble_list()

## ----results = "asis", echo = FALSE-------------------------------------------
for (i in 1:length(l_cause)) {
  pander::pandoc.table(l_cause[[i]], split.table = Inf)
}

## -----------------------------------------------------------------------------
s_age <- star_schema() |>
  define_facts(name = "MRS Age",
               measures = c("All Deaths")) |>
  define_dimension(when) |>
  define_dimension(where) |>
  define_dimension(name = "Who",
                         attributes = c("Age"))

ft_age2 <- ft_age |>
  dplyr::filter(Year < "1964") |>
  dplyr::filter(City != "Boston" & City != "Bridgeport")

db_age <- star_database(s_age, ft_age2) |>
  snake_case()

l_age <- db_age |>
  as_tibble_list()

## ----results = "asis", echo = FALSE-------------------------------------------
for (i in 1:length(l_age)) {
  pander::pandoc.table(l_age[[i]], split.table = Inf)
}

## ----example5-----------------------------------------------------------------
ct <- constellation("MRS", db_cause, db_age)

## ----example6-----------------------------------------------------------------
lc <- ct |>
  as_tibble_list()

## ----results = "asis", echo = FALSE-------------------------------------------
for (i in 1:length(lc)) {
  pander::pandoc.table(lc[[i]], split.table = Inf)
}

## -----------------------------------------------------------------------------
s_age2 <- star_schema() |>
  define_facts(name = "MRS Age 2",
               measures = c("All Deaths")) |>
  define_dimension(when) |>
  define_dimension(where) |>
  define_dimension(name = "Who",
                         attributes = c("Age"))

db_age2 <- star_database(s_age2, ft_age) |>
  snake_case()

## -----------------------------------------------------------------------------
ct2 <- constellation("MRS2", ct, db_age2)

## -----------------------------------------------------------------------------
db_cause |>
  as_tibble_list()

## -----------------------------------------------------------------------------
ct |>
  as_tibble_list()

## -----------------------------------------------------------------------------
# star database
db_cause_dm <- db_cause |>
  as_dm_class()
class(db_cause_dm)
db_cause_dm

## -----------------------------------------------------------------------------
# constellation
ct_dm <- ct |>
  as_dm_class(pk_facts = TRUE)
class(ct_dm)
ct_dm

## -----------------------------------------------------------------------------
ct_dm |> 
  dm::dm_draw(rankdir = "LR", view_type = "all")

## -----------------------------------------------------------------------------
db <- DBI::dbConnect(RSQLite::SQLite())
ct_dm_db <- dm::copy_dm_to(db, ct_dm)
ct_dm_db
DBI::dbDisconnect(db)

## -----------------------------------------------------------------------------
db_cause |>
  as_single_tibble_list()

## -----------------------------------------------------------------------------
ct |>
  as_single_tibble_list()