inst/doc/v70-star_query.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)

## -----------------------------------------------------------------------------
class(mrs_db)

## -----------------------------------------------------------------------------
mrs_db |>
  draw_tables()

## -----------------------------------------------------------------------------
mrs_db_geo <- mrs_db |>
  define_geoattribute(
    dimension = "where",
    attribute = "city",
    from_attribute = c("long", "lat")
  )

## -----------------------------------------------------------------------------
mrs_db_geo <- mrs_db_geo |>
  define_geoattribute(
    dimension = "where",
    attribute = "state",
    from_layer = us_layer_state,
    by = "STUSPS"
  )

## -----------------------------------------------------------------------------
mrs_db_geo <- mrs_db_geo |>
  define_geoattribute(
    dimension = "where",
    attribute = "region",
    from_layer = us_layer_state,
    by = "DIVISION"
  )

## -----------------------------------------------------------------------------
mrs_db_geo_2 <- mrs_db_geo |>
  define_geoattribute(
    dimension = "where",
    attribute = "region",
    from_attribute = "state"
  )

## -----------------------------------------------------------------------------
sq <- mrs_db_geo |>
  star_query()

## -----------------------------------------------------------------------------
sq_1 <- sq |>
  select_fact(
    name = "mrs_age",
    measures = "all_deaths",
    agg_functions = "MAX"
  )

## -----------------------------------------------------------------------------
sq_2 <- sq |>
  select_fact(name = "mrs_age",
              measures = "all_deaths")

## -----------------------------------------------------------------------------
sq_3 <- sq |>
  select_fact(name = "mrs_age")

## -----------------------------------------------------------------------------
sq_4 <- sq |>
  select_fact(name = "mrs_age",
              measures = "all_deaths") |>
  select_fact(name = "mrs_cause")

## -----------------------------------------------------------------------------
sq_1 <- sq |>
  select_dimension(name = "where",
                   attributes = c("city", "state"))

## -----------------------------------------------------------------------------
sq_2 <- sq |>
  select_dimension(name = "where")

## -----------------------------------------------------------------------------
sq <- sq |>
  filter_dimension(name = "when", week <= " 3") |>
  filter_dimension(name = "where", city == "Bridgeport")

## -----------------------------------------------------------------------------
sq <- star_query(mrs_db_geo) |>
  select_dimension(name = "where",
                   attributes = c("region", "state")) |>
  select_dimension(name = "when",
                   attributes = "year") |>
  select_fact(name = "mrs_age",
              measures = "all_deaths") |>
  select_fact(name = "mrs_cause",
              measures = "all_deaths") |>
  filter_dimension(name = "when", week <= " 3" & year >= "2010")

mrs_db_geo_3 <- mrs_db_geo |>
  run_query(sq)

class(mrs_db_geo_3)

## -----------------------------------------------------------------------------
mrs_db_geo_3 |>
  draw_tables()

## -----------------------------------------------------------------------------
ft <- mrs_db_geo_3 |>
  as_single_tibble_list()
ft_age <- ft[["mrs_age"]]

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

## -----------------------------------------------------------------------------
pt <- pivottabler::qpvt(
  ft_age,
  c("=", "region"),
  c("year"),
  c("Number of Deaths" = "sum(all_deaths)")
)

pt$renderPivot()

## -----------------------------------------------------------------------------
gl_state <- mrs_db_geo_3 |>
  as_geolayer(attribute = "state")

## -----------------------------------------------------------------------------
layer_state <- gl_state |>
  get_layer()
layer_state

var_state <- gl_state |>
  get_variables()
var_state

## -----------------------------------------------------------------------------
plot(sf::st_geometry(layer_state))
text(
  sf::st_coordinates(sf::st_centroid(sf::st_geometry(layer_state))),
  labels = layer_state$state,
  pos = 3,
  cex = 0.5
)

## -----------------------------------------------------------------------------
layer_state_all <- gl_state |>
  get_layer(keep_all_variables_na = TRUE)

plot(sf::st_shift_longitude(sf::st_geometry(layer_state_all)))

## -----------------------------------------------------------------------------
gl_state |>
  get_variable_description(c("var_01", "var_10"))

vd <- gl_state |>
  get_variable_description()
vd[c("var_01", "var_10")]

## -----------------------------------------------------------------------------
var_state_2 <- var_state |>
  dplyr::filter(year == '2016')

## -----------------------------------------------------------------------------
gl_state_2 <- gl_state |>
  set_variables(var_state_2)

layer_state_2 <- gl_state_2 |>
  get_layer()

## -----------------------------------------------------------------------------
plot(sf::st_geometry(layer_state_2))
text(
  sf::st_coordinates(sf::st_centroid(sf::st_geometry(layer_state_2))),
  labels = layer_state_2$state,
  pos = 3,
  cex = 0.5
)

## -----------------------------------------------------------------------------
sq_2 <- star_query(mrs_db_geo) |>
  select_dimension(name = "where",
                   attributes = "state") |>
  select_fact(name = "mrs_cause",
              measures = c("pneumonia_and_influenza_deaths", "all_deaths")) |>
  filter_dimension(name = "when", year >= "2010")

## -----------------------------------------------------------------------------
mrs_db_geo_3 <- mrs_db_geo |>
  run_query(sq_2)

## -----------------------------------------------------------------------------
gl_state_3 <- mrs_db_geo_3 |>
  as_geolayer(attribute = "state")

## -----------------------------------------------------------------------------
gl_state_3 |>
  get_variable_description()

layer <- gl_state_3 |>
  get_layer()

layer$tpc_deaths <- (layer$var_2 / layer$var_1) * 100

plot(layer[, "tpc_deaths"], main = "% pneumonia and influenza")

## -----------------------------------------------------------------------------
gl_state_3 <- gl_state_3 |>
  set_layer(layer)

## -----------------------------------------------------------------------------
f <- gl_state_3 |>
  as_GeoPackage(dir = tempdir())

sf::st_layers(f)