test_that("flat table operations", { ## --------------------------------------------------------------------------------------- usc_ft <- flat_table(name = 'us_cities', instances = maps::us.cities) ## --------------------------------------------------------------------------------------- capital_status <- data.frame( code = c('0', '1', '2'), status = c('non-capital', 'capital', 'state capital') ) cs_ft <- flat_table(name = 'capital_status', instances = capital_status) ## --------------------------------------------------------------------------------------- mrs_ft <- mrs_ft |> transform_to_measure( attributes = c( 'Pneumonia and Influenza Deaths', 'All Deaths', '<1 year (all cause deaths)', '1-24 years (all cause deaths)', '25-44 years', '45-64 years (all cause deaths)', '65+ years (all cause deaths)' ) ) ## --------------------------------------------------------------------------------------- mrs_ft <- mrs_ft |> transform_attribute_format(attributes = c('WEEK'), width = 2) ## --------------------------------------------------------------------------------------- usc_ft <- usc_ft |> transform_to_attribute(measures = 'capital') |> transform_to_attribute(measures = 'pop', width = 5) |> transform_to_attribute(measures = c('lat', 'long'), width = 2, decimal_places = 1) ## --------------------------------------------------------------------------------------- cs_ft <- cs_ft |> lookup_table(pk_attributes = 'code') ## --------------------------------------------------------------------------------------- usc_ft <- usc_ft |> join_lookup_table(fk_attributes = 'capital', lookup = cs_ft) ## --------------------------------------------------------------------------------------- usc_ft <- usc_ft |> lookup_table(pk_attributes = 'name') ## --------------------------------------------------------------------------------------- # function to define a derived column city_state <- function(table) { paste0(table$City, ' ', table$State) } mrs_ft_TMP <- mrs_ft |> add_custom_column(name = 'city_state', definition = city_state) ## --------------------------------------------------------------------------------------- result_lookup <- mrs_ft_TMP |> check_lookup_table(fk_attributes = 'city_state', lookup = usc_ft) ## --------------------------------------------------------------------------------------- mrs_ft <- mrs_ft |> replace_empty_values() ## --------------------------------------------------------------------------------------- mrs_ft <- mrs_ft |> add_custom_column(name = 'city_state', definition = city_state) ## --------------------------------------------------------------------------------------- usc_ft <- usc_ft |> replace_attribute_values( attributes = 'name', old = c('WASHINGTON DC'), new = c('Washington DC') ) mrs_ft <- mrs_ft |> replace_attribute_values( attributes = c('City', 'city_state'), old = c('Wilimington', 'Wilimington DE'), new = c('Wilmington', 'Wilmington DE') ) ## --------------------------------------------------------------------------------------- check_res <- mrs_ft |> check_lookup_table(fk_attributes = 'city_state', lookup = usc_ft) ## --------------------------------------------------------------------------------------- mrs_ft <- mrs_ft |> join_lookup_table(fk_attributes = 'city_state', lookup = usc_ft) ## --------------------------------------------------------------------------------------- mrs_ft <- mrs_ft |> select_attributes( attributes = c( 'Year', 'WEEK', 'Week Ending Date', 'REGION', 'State', 'City', 'city_state', 'status', 'pop', 'lat', 'long' ) ) ## --------------------------------------------------------------------------------------- l_mrs_ft <- mrs_ft |> separate_measures(measures = list( c('Pneumonia and Influenza Deaths', 'All Deaths'), c( '<1 year (all cause deaths)', '1-24 years (all cause deaths)', '25-44 years', '45-64 years (all cause deaths)', '65+ years (all cause deaths)' ) ), names = c('mrs_cause', 'mrs_age')) mrs_cause_ft <- l_mrs_ft[['mrs_cause']] mrs_age_ft <- l_mrs_ft[['mrs_age']] ## --------------------------------------------------------------------------------------- mrs_cause_ft <- mrs_cause_ft |> snake_case() ## --------------------------------------------------------------------------------------- mrs_age_ft <- mrs_age_ft |> transform_to_values(attribute = 'age', measure = 'all_deaths') ## --------------------------------------------------------------------------------------- mrs_age_ft <- mrs_age_ft |> snake_case() ## --------------------------------------------------------------------------------------- mrs_age_ft <- mrs_age_ft |> replace_string( attributes = 'age', string = ' (all cause deaths)', replacement = '' ) ## --------------------------------------------------------------------------------------- mrs_age_ft_TMP <- mrs_age_ft |> transform_from_values( attribute = 'age' ) ## --------------------------------------------------------------------------------------- when <- dimension_schema( name = 'when', attributes = c( 'year', 'week', 'week_ending_date' ) ) where <- dimension_schema( name = "where", attributes = c( 'region', 'state', 'city', 'city_state', 'status', 'pop', 'lat', 'long' ) ) s_cause <- star_schema() |> define_facts(fact_schema( name = 'mrs_cause', measures = c('pneumonia_and_influenza_deaths', 'all_deaths') )) |> define_dimension(when) |> define_dimension(where) ## --------------------------------------------------------------------------------------- mrs_cause_db <- mrs_cause_ft |> as_star_database(s_cause) ## --------------------------------------------------------------------------------------- who <- dimension_schema( name = 'who', attributes = c( 'age' ) ) s_age <- star_schema() |> define_facts(fact_schema( name = 'mrs_age', measures = c('all_deaths') )) |> define_dimension(when) |> define_dimension(where) |> define_dimension(who) ## --------------------------------------------------------------------------------------- mrs_age_db <- mrs_age_ft |> as_star_database(s_age) ## ----example5--------------------------------------------------------------------------- mrs_db_2 <- constellation("mrs", mrs_cause_db, mrs_age_db) ############################################################# expect_equal(cs_ft, structure( list( name = "capital_status", table = structure( list( code = c("0", "1", "2"), status = c("non-capital", "capital", "state capital") ), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame") ), unknown_value = "___UNKNOWN___", operations = structure(list( operations = structure( list( operation = c("flat_table", "lookup_table"), name = c("capital_status<|>___UNKNOWN___", "code"), details = c("code<|>status", "|"), details2 = c("", "|"), order = c(1, 2) ), row.names = c(NA, -2L), class = "data.frame" ) ), class = "star_operation"), pk_attributes = "code", lookup_tables = list(), attributes = c("code", "status"), measures = NULL ), class = "flat_table" )) ############################################################# expect_equal({ head(unique(sort(mrs_db_2$dimensions$when$table$week)), 12) }, { c(" 1", " 2", " 3", " 4", " 5", " 6", " 7", " 8", " 9", "10", "11", "12") }) ############################################################# expect_equal({ mrs_db_2 |> get_star_database("mrs_age") }, { mrs_age_db }) ############################################################# expect_equal({ mrs_db_2 |> get_star_database("mrs_cause") }, { mrs_cause_db }) ############################################################# expect_equal({ facts <- names(mrs_db_2$facts) names <- NULL for (f in facts) { names <- c(names, names(mrs_db_2$facts[[f]]$table)) } names }, { c("when_key", "where_key", "pneumonia_and_influenza_deaths", "all_deaths", "nrow_agg", "when_key", "where_key", "who_key", "all_deaths", "nrow_agg") } ) ############################################################# expect_equal({ mrs_db_2 }, { mrs_db } ) ############################################################# })