tests/testthat/test-constellation.R

In rolap: Obtaining Star Databases from Flat Tables

test_that("constellation geo operations", {

  t <- sf::st_drop_geometry(us_layer_state)
  t <- t |>
    dplyr::filter(!(STUSPS %in% c("IL", "MN", "OR")))
  t <- dplyr::inner_join(t, us_layer_state, by = "STUSPS")
  us_layer_state_incomplet <- sf::st_as_sf(t)

  mrs_age <- mrs_db |>
    get_star_database("mrs_age")  |>
    define_geoattribute(
      dimension = "where",
      attribute = "state",
      from_layer = us_layer_state,
      by = "STUSPS"
    )

  mrs_cause <- mrs_db |>
    get_star_database("mrs_cause")  |>
    define_geoattribute(
      dimension = "where",
      attribute = "region",
      from_layer = us_layer_state,
      by = "DIVISION"
    )

  mrs_cause_2 <- mrs_db |>
    get_star_database("mrs_cause")  |>
    define_geoattribute(
      dimension = "where",
      attribute = "state",
      from_layer = us_layer_state,
      by = "STUSPS"
    )

  mrs_age_2 <- mrs_db |>
    get_star_database("mrs_age")  |>
    define_geoattribute(
      dimension = "where",
      attribute = "state",
      from_layer = us_layer_state_incomplet,
      by = "STUSPS"
    )

  ct_geo_1 <- constellation("MRS", mrs_age, mrs_cause)
  ct_geo_2 <- constellation("MRS", mrs_age, mrs_cause_2)
  ct_geo_2 <- constellation("MRS", mrs_age_2, mrs_cause_2)

  mrs_age_3 <- mrs_db |>
    define_geoattribute(
      dimension = "where",
      attribute = "state",
      from_layer = us_layer_state,
      by = "STUSPS"
    ) |>
    get_star_database("mrs_age")



  expect_equal({
    names(mrs_age_3$geo$where$state)
  },
  c("polygon", "point"))

  expect_equal({
    names(ct_geo_1$geo$where)
  },
  c("state", "region"))

  expect_equal({
    names(ct_geo_2$geo$where)
  },
  "state")

  expect_equal({
    ct_geo_2$geo$where$state$polygon$state
  },
  c(
    "AK",
    "AL",
    "AR",
    "AZ",
    "CA",
    "CO",
    "CT",
    "DC",
    "DE",
    "FL",
    "GA",
    "HI",
    "IA",
    "ID",
    "IN",
    "KS",
    "KY",
    "LA",
    "MA",
    "MD",
    "ME",
    "MI",
    "MO",
    "MS",
    "MT",
    "NC",
    "ND",
    "NE",
    "NH",
    "NJ",
    "NM",
    "NV",
    "NY",
    "OH",
    "OK",
    "PA",
    "PR",
    "RI",
    "SC",
    "SD",
    "TN",
    "TX",
    "UT",
    "VA",
    "VT",
    "WA",
    "WI",
    "WV",
    "WY",
    "IL",
    "MN",
    "OR"
  ))

})



test_that("constellation() define constellation", {
  expect_equal({
    ft1 <- ft_num  |>
      dplyr::filter(City != "Cambridge") |>
      dplyr::filter(Year <= "1963")

    db1 <- star_database(mrs_cause_schema, ft1) |>
      snake_case()

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

    db2 <- star_database(mrs_age_schema, ft2) |>
      snake_case()

    ct <- constellation("MRS", db1, db2)
  }, {
    structure(
      list(
        name = "MRS",
        operations = list(
          mrs_cause = structure(list(
            operations = structure(
              list(
                operation = c("star_database",
                              "snake_case"),
                name = c("mrs_cause", ""),
                details = c("___UNKNOWN___",
                            ""),
                details2 = c("", ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation"),
          mrs_age = structure(list(
            operations = structure(
              list(
                operation = c("star_database",
                              "snake_case"),
                name = c("mrs_age", ""),
                details = c("___UNKNOWN___",
                            ""),
                details2 = c("", ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation")
        ),
        lookup_tables = list(mrs_cause = NULL, mrs_age = NULL),
        schemas = list(
          mrs_cause = structure(list(
            facts = list(mrs_cause = structure(
              list(
                name = "MRS Cause",
                measures = c("Pneumonia and Influenza Deaths",
                             "All Deaths"),
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When",
                attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "State", "City")
              ), class = "dimension_schema")
            )
          ), class = "star_schema"),
          mrs_age = structure(list(
            facts = list(mrs_age = structure(
              list(
                name = "MRS Age",
                measures = "All Deaths",
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When", attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "State", "City")
              ), class = "dimension_schema"),
              who = structure(list(
                name = "Who", attributes = "Age"
              ), class = "dimension_schema")
            )
          ), class = "star_schema")
        ),
        refresh = list(),
        deploy = list(),
        facts = list(
          mrs_cause = structure(
            list(
              name = "mrs_cause",
              surrogate_keys = c("when_key", "where_key"),
              agg = c(
                pneumonia_and_influenza_deaths = "SUM",
                all_deaths = "SUM",
                nrow_agg = "SUM"
              ),
              dim_int_names = c("when", "where"),
              table = structure(
                list(
                  when_key = c(1L, 1L, 1L, 2L, 2L, 2L),
                  where_key = c(1L,
                                2L, 3L, 1L, 2L, 3L),
                  pneumonia_and_influenza_deaths = c(9L,
                                                     5L, 23L, 2L, 12L, 10L),
                  all_deaths = c(131L, 104L, 555L,
                                 46L, 192L, 276L),
                  nrow_agg = c(3L, 2L, 2L, 1L, 3L, 1L)
                ),
                row.names = c(NA,-6L),
                class = c("tbl_df", "tbl",
                          "data.frame")
              )
            ),
            class = "fact_table"
          ),
          mrs_age = structure(
            list(
              name = "mrs_age",
              surrogate_keys = c("when_key", "where_key",
                                 "who_key"),
              agg = c(all_deaths = "SUM", nrow_agg = "SUM"),
              dim_int_names = c("when", "where", "who"),
              table = structure(
                list(
                  when_key = c(2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L,
                               3L, 3L, 3L, 3L, 3L),
                  where_key = c(2L, 2L, 2L, 2L, 2L,
                                2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L),
                  who_key = c(1L,
                              2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L),
                  all_deaths = c(5L, 13L, 51L, 107L, 16L, 0L, 2L, 16L,
                                 28L, 7L, 0L, 4L, 25L, 52L, 3L),
                  nrow_agg = c(3L, 3L,
                               3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L)
                ),
                row.names = c(NA,-15L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "fact_table"
          )
        ),
        dimensions = list(
          when = structure(
            list(
              name = "when",
              surrogate_key = "when_key",
              table = structure(
                list(
                  when_key = 1:3,
                  year = c("1962",
                           "1963", "1964")
                ),
                row.names = c(NA,-3L),
                class = c("tbl_df",
                          "tbl", "data.frame")
              )
            ),
            class = "dimension_table"
          ),
          where = structure(
            list(
              name = "where",
              surrogate_key = "where_key",
              table = structure(
                list(
                  where_key = 1:4,
                  region = c("1", "1", "1", "1"),
                  state = c("CT", "CT", "MA", "MA"),
                  city = c("Bridgeport",
                           "Hartford", "Boston", "Cambridge")
                ),
                row.names = c(NA,-4L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "dimension_table"
          ),
          who = structure(
            list(
              name = "who",
              surrogate_key = "who_key",
              table = structure(
                list(
                  who_key = 1:5,
                  age = c(
                    "1-24 years",
                    "25-44 years",
                    "45-64 years",
                    "65+ years",
                    "<1 year"
                  )
                ),
                row.names = c(NA,-5L),
                class = c("tbl_df", "tbl",
                          "data.frame")
              )
            ),
            class = "dimension_table"
          )
        ),
        rpd = list(),
        geo = list(),
        scd = list()
      ),
      class = "star_database"
    )
  })
})

test_that("constellation() define constellation", {
  expect_equal({
    ft1 <- ft_num  |>
      dplyr::filter(City != "Cambridge") |>
      dplyr::filter(Year <= "1963")

    db1 <- star_database(mrs_cause_schema, ft1) |>
      snake_case()

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

    db2 <- star_database(mrs_age_schema, ft2) |>
      snake_case()

    s <- star_schema() |>
      define_facts(fact_schema(name = "MRS Cause 2")) |>
      define_dimension(dimension_schema(name = "When",
                                        attributes = c("Year"))) |>
      define_dimension(dimension_schema(
        name = "Where",
        attributes = c("REGION",
                       "City",
                       "State")
      ))
    db3 <- star_database(s, ft_num) |>
      snake_case()

    ct <- constellation("MRS", db1, db2, db3)
  }, {
    structure(
      list(
        name = "MRS",
        operations = list(
          mrs_cause = structure(list(
            operations = structure(
              list(
                operation = c("star_database",
                              "snake_case"),
                name = c("mrs_cause", ""),
                details = c("___UNKNOWN___",
                            ""),
                details2 = c("", ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation"),
          mrs_age = structure(list(
            operations = structure(
              list(
                operation = c("star_database",
                              "snake_case"),
                name = c("mrs_age", ""),
                details = c("___UNKNOWN___",
                            ""),
                details2 = c("", ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation"),
          mrs_cause_2 = structure(list(
            operations = structure(
              list(
                operation = c("star_database", "snake_case"),
                name = c("mrs_cause_2",
                         ""),
                details = c("___UNKNOWN___", ""),
                details2 = c("",
                             ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation")
        ),
        lookup_tables = list(
          mrs_cause = NULL,
          mrs_age = NULL,
          mrs_cause_2 = NULL
        ),
        schemas = list(
          mrs_cause = structure(list(
            facts = list(mrs_cause = structure(
              list(
                name = "MRS Cause",
                measures = c("Pneumonia and Influenza Deaths",
                             "All Deaths"),
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When",
                attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "State", "City")
              ), class = "dimension_schema")
            )
          ), class = "star_schema"),
          mrs_age = structure(list(
            facts = list(mrs_age = structure(
              list(
                name = "MRS Age",
                measures = "All Deaths",
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When", attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "State", "City")
              ), class = "dimension_schema"),
              who = structure(list(
                name = "Who", attributes = "Age"
              ), class = "dimension_schema")
            )
          ), class = "star_schema"),
          mrs_cause_2 = structure(list(
            facts = list(mrs_cause_2 = structure(
              list(
                name = "MRS Cause 2",
                measures = NULL,
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When", attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "City", "State")
              ), class = "dimension_schema")
            )
          ), class = "star_schema")
        ),
        refresh = list(),
        deploy = list(),
        facts = list(
          mrs_cause = structure(
            list(
              name = "mrs_cause",
              surrogate_keys = c("when_key", "where_key"),
              agg = c(
                pneumonia_and_influenza_deaths = "SUM",
                all_deaths = "SUM",
                nrow_agg = "SUM"
              ),
              dim_int_names = c("when", "where"),
              table = structure(
                list(
                  when_key = c(1L, 1L, 1L, 2L, 2L, 2L),
                  where_key = c(1L,
                                2L, 3L, 1L, 2L, 3L),
                  pneumonia_and_influenza_deaths = c(9L,
                                                     5L, 23L, 2L, 12L, 10L),
                  all_deaths = c(131L, 104L, 555L,
                                 46L, 192L, 276L),
                  nrow_agg = c(3L, 2L, 2L, 1L, 3L, 1L)
                ),
                row.names = c(NA,-6L),
                class = c("tbl_df", "tbl",
                          "data.frame")
              )
            ),
            class = "fact_table"
          ),
          mrs_age = structure(
            list(
              name = "mrs_age",
              surrogate_keys = c("when_key", "where_key",
                                 "who_key"),
              agg = c(all_deaths = "SUM", nrow_agg = "SUM"),
              dim_int_names = c("when", "where", "who"),
              table = structure(
                list(
                  when_key = c(2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L,
                               3L, 3L, 3L, 3L, 3L),
                  where_key = c(2L, 2L, 2L, 2L, 2L,
                                2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L),
                  who_key = c(1L,
                              2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L),
                  all_deaths = c(5L, 13L, 51L, 107L, 16L, 0L, 2L, 16L,
                                 28L, 7L, 0L, 4L, 25L, 52L, 3L),
                  nrow_agg = c(3L, 3L,
                               3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L)
                ),
                row.names = c(NA,-15L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "fact_table"
          ),
          mrs_cause_2 = structure(
            list(
              name = "mrs_cause_2",
              surrogate_keys = c("when_key",
                                 "where_key"),
              agg = c(nrow_agg = "SUM"),
              dim_int_names = c("when", "where"),
              table = structure(
                list(
                  when_key = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L,
                               3L),
                  where_key = c(3L, 1L, 4L, 2L, 3L, 1L, 2L, 3L, 1L,
                                4L, 2L),
                  nrow_agg = c(2L, 3L, 1L, 2L, 1L, 1L, 3L, 2L,
                               1L, 3L, 1L)
                ),
                row.names = c(NA,-11L),
                class = c("tbl_df",
                          "tbl", "data.frame")
              )
            ),
            class = "fact_table"
          )
        ),
        dimensions = list(
          when = structure(
            list(
              name = "when",
              surrogate_key = "when_key",
              table = structure(
                list(
                  when_key = 1:3,
                  year = c("1962",
                           "1963", "1964")
                ),
                row.names = c(NA,-3L),
                class = c("tbl_df",
                          "tbl", "data.frame")
              )
            ),
            class = "dimension_table"
          ),
          where = structure(
            list(
              name = "where",
              surrogate_key = "where_key",
              table = structure(
                list(
                  where_key = 1:4,
                  region = c("1", "1", "1", "1"),
                  state = c("CT", "CT", "MA", "MA"),
                  city = c("Bridgeport",
                           "Hartford", "Boston", "Cambridge")
                ),
                row.names = c(NA,-4L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "dimension_table"
          ),
          who = structure(
            list(
              name = "who",
              surrogate_key = "who_key",
              table = structure(
                list(
                  who_key = 1:5,
                  age = c(
                    "1-24 years",
                    "25-44 years",
                    "45-64 years",
                    "65+ years",
                    "<1 year"
                  )
                ),
                row.names = c(NA,-5L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "dimension_table"
          )
        ),
        rpd = list(),
        geo = list(),
        scd = list()
      ),
      class = "star_database"
    )
  })
})

test_that("constellation() define constellation", {
  expect_equal({
    ft1 <- ft_num  |>
      dplyr::filter(City != "Cambridge") |>
      dplyr::filter(Year <= "1963")

    db1 <- star_database(mrs_cause_schema, ft1) |>
      snake_case()

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

    db2 <- star_database(mrs_age_schema, ft2) |>
      snake_case()

    s <- star_schema() |>
      define_facts(fact_schema(name = "MRS Cause 2")) |>
      define_dimension(dimension_schema(name = "When",
                                        attributes = c("Year"))) |>
      define_dimension(dimension_schema(
        name = "Where",
        attributes = c("REGION",
                       "City",
                       "State")
      ))
    db3 <- star_database(s, ft1) |>
      snake_case()

    ct <- constellation("MRS", db1, db3)
    constellation("MRS", db2, ct)
  }, {
    structure(
      list(
        name = "MRS",
        operations = list(
          mrs_age = structure(list(
            operations = structure(
              list(
                operation = c("star_database",
                              "snake_case"),
                name = c("mrs_age", ""),
                details = c("___UNKNOWN___",
                            ""),
                details2 = c("", ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation"),
          mrs_cause = structure(list(
            operations = structure(
              list(
                operation = c("star_database",
                              "snake_case"),
                name = c("mrs_cause", ""),
                details = c("___UNKNOWN___",
                            ""),
                details2 = c("", ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation"),
          mrs_cause_2 = structure(list(
            operations = structure(
              list(
                operation = c("star_database", "snake_case"),
                name = c("mrs_cause_2",
                         ""),
                details = c("___UNKNOWN___", ""),
                details2 = c("",
                             ""),
                order = c(1, 2)
              ),
              row.names = c(NA,-2L),
              class = "data.frame"
            )
          ), class = "star_operation")
        ),
        lookup_tables = list(
          mrs_age = NULL,
          mrs_cause = NULL,
          mrs_cause_2 = NULL
        ),
        schemas = list(
          mrs_age = structure(list(
            facts = list(mrs_age = structure(
              list(
                name = "MRS Age",
                measures = "All Deaths",
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When", attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "State", "City")
              ), class = "dimension_schema"),
              who = structure(list(
                name = "Who", attributes = "Age"
              ), class = "dimension_schema")
            )
          ), class = "star_schema"),
          mrs_cause = structure(list(
            facts = list(mrs_cause = structure(
              list(
                name = "MRS Cause",
                measures = c("Pneumonia and Influenza Deaths",
                             "All Deaths"),
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When",
                attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "State", "City")
              ), class = "dimension_schema")
            )
          ), class = "star_schema"),
          mrs_cause_2 = structure(list(
            facts = list(mrs_cause_2 = structure(
              list(
                name = "MRS Cause 2",
                measures = NULL,
                agg_functions = NULL,
                nrow_agg = NULL
              ),
              class = "fact_schema"
            )),
            dimensions = list(
              when = structure(list(
                name = "When", attributes = "Year"
              ), class = "dimension_schema"),
              where = structure(list(
                name = "Where",
                attributes = c("REGION",
                               "City", "State")
              ), class = "dimension_schema")
            )
          ), class = "star_schema")
        ),
        refresh = list(),
        deploy = list(),
        facts = list(
          mrs_age = structure(
            list(
              name = "mrs_age",
              surrogate_keys = c("when_key",
                                 "where_key", "who_key"),
              agg = c(all_deaths = "SUM", nrow_agg = "SUM"),
              dim_int_names = c("when", "where", "who"),
              table = structure(
                list(
                  when_key = c(2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L,
                               3L, 3L, 3L, 3L, 3L),
                  where_key = c(2L, 2L, 2L, 2L, 2L,
                                2L, 2L, 2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L),
                  who_key = c(1L,
                              2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L),
                  all_deaths = c(5L, 13L, 51L, 107L, 16L, 0L, 2L, 16L,
                                 28L, 7L, 0L, 4L, 25L, 52L, 3L),
                  nrow_agg = c(3L, 3L,
                               3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L)
                ),
                row.names = c(NA,-15L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "fact_table"
          ),
          mrs_cause = structure(
            list(
              name = "mrs_cause",
              surrogate_keys = c("when_key",
                                 "where_key"),
              agg = c(
                pneumonia_and_influenza_deaths = "SUM",
                all_deaths = "SUM",
                nrow_agg = "SUM"
              ),
              dim_int_names = c("when",
                                "where"),
              table = structure(
                list(
                  when_key = c(1L, 1L,
                               1L, 2L, 2L, 2L),
                  where_key = c(1L, 2L, 3L, 1L, 2L, 3L),
                  pneumonia_and_influenza_deaths = c(9L, 5L, 23L, 2L,
                                                     12L, 10L),
                  all_deaths = c(131L, 104L, 555L, 46L, 192L,
                                 276L),
                  nrow_agg = c(3L, 2L, 2L, 1L, 3L, 1L)
                ),
                row.names = c(NA,-6L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "fact_table"
          ),
          mrs_cause_2 = structure(
            list(
              name = "mrs_cause_2",
              surrogate_keys = c("when_key",
                                 "where_key"),
              agg = c(nrow_agg = "SUM"),
              dim_int_names = c("when",
                                "where"),
              table = structure(
                list(
                  when_key = c(1L, 1L,
                               1L, 2L, 2L, 2L),
                  where_key = c(3L, 1L, 2L, 3L, 1L, 2L),
                  nrow_agg = c(2L, 3L, 2L, 1L, 1L, 3L)
                ),
                row.names = c(NA,-6L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "fact_table"
          )
        ),
        dimensions = list(
          when = structure(
            list(
              name = "when",
              surrogate_key = "when_key",
              table = structure(
                list(
                  when_key = 1:3,
                  year = c("1962",
                           "1963", "1964")
                ),
                row.names = c(NA,-3L),
                class = c("tbl_df",
                          "tbl", "data.frame")
              )
            ),
            class = "dimension_table"
          ),
          where = structure(
            list(
              name = "where",
              surrogate_key = "where_key",
              table = structure(
                list(
                  where_key = 1:4,
                  region = c("1", "1", "1", "1"),
                  state = c("CT", "CT", "MA", "MA"),
                  city = c("Bridgeport",
                           "Hartford", "Boston", "Cambridge")
                ),
                row.names = c(NA,-4L),
                class = c("tbl_df", "tbl", "data.frame")
              )
            ),
            class = "dimension_table"
          ),
          who = structure(
            list(
              name = "who",
              surrogate_key = "who_key",
              table = structure(
                list(
                  who_key = 1:5,
                  age = c(
                    "1-24 years",
                    "25-44 years",
                    "45-64 years",
                    "65+ years",
                    "<1 year"
                  )
                ),
                row.names = c(NA,-5L),
                class = c("tbl_df", "tbl",
                          "data.frame")
              )
            ),
            class = "dimension_table"
          )
        ),
        rpd = list(),
        geo = list(),
        scd = list()
      ),
      class = "star_database"
    )
  })
})

test_that("constellation() define constellation", {
  expect_equal({
    ft1 <- ft_num  |>
      dplyr::filter(City != "Cambridge") |>
      dplyr::filter(Year <= "1963")

    db1 <- star_database(mrs_cause_schema, ft1) |>
      snake_case()

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

    db2 <- star_database(mrs_age_schema, ft2) |>
      snake_case()

    s <- star_schema() |>
      define_facts(fact_schema(name = "MRS Cause 2")) |>
      define_dimension(dimension_schema(name = "When",
                                        attributes = c("Year"))) |>
      define_dimension(dimension_schema(
        name = "Where",
        attributes = c("REGION",
                       "City",
                       "State")
      ))
    db3 <- star_database(s, ft1) |>
      snake_case()

    ct <- constellation("MRS", db1, db3)
    constellation("MRS", db2, ct)
  }, {
    ft1 <- ft_num  |>
      dplyr::filter(City != "Cambridge") |>
      dplyr::filter(Year <= "1963")

    db1 <- star_database(mrs_cause_schema, ft1) |>
      snake_case()

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

    db2 <- star_database(mrs_age_schema, ft2) |>
      snake_case()

    s <- star_schema() |>
      define_facts(fact_schema(name = "MRS Cause 2")) |>
      define_dimension(dimension_schema(name = "When",
                                        attributes = c("Year"))) |>
      define_dimension(dimension_schema(
        name = "Where",
        attributes = c("REGION",
                       "City",
                       "State")
      ))
    db3 <- star_database(s, ft1) |>
      snake_case()

    ct <- constellation("MRS", db2, db1)
    constellation("MRS", ct, db3)
  })
})

test_that("as_tibble_list() export constellation as a list of tibbles", {
  expect_equal({
    ft1 <- ft_num  |>
      dplyr::filter(City != "Cambridge") |>
      dplyr::filter(Year <= "1963")

    db1 <- star_database(mrs_cause_schema, ft1) |>
      snake_case()

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

    db2 <- star_database(mrs_age_schema, ft2) |>
      snake_case()

    constellation("MRS", db1, db2) |>
      as_tibble_list()
  }, {
    list(
      when = structure(
        list(
          when_key = 1:3,
          year = c("1962", "1963",
                   "1964")
        ),
        row.names = c(NA, -3L),
        class = c("tbl_df", "tbl",
                  "data.frame")
      ),
      where = structure(
        list(
          where_key = 1:4,
          region = c("1",
                     "1", "1", "1"),
          state = c("CT", "CT", "MA", "MA"),
          city = c("Bridgeport",
                   "Hartford", "Boston", "Cambridge")
        ),
        row.names = c(NA, -4L),
        class = c("tbl_df",
                  "tbl", "data.frame")
      ),
      who = structure(
        list(
          who_key = 1:5,
          age = c(
            "1-24 years",
            "25-44 years",
            "45-64 years",
            "65+ years",
            "<1 year"
          )
        ),
        row.names = c(NA, -5L),
        class = c("tbl_df", "tbl", "data.frame")
      ),
      mrs_cause = structure(
        list(
          when_key = c(1L, 1L, 1L, 2L, 2L, 2L),
          where_key = c(1L, 2L,
                        3L, 1L, 2L, 3L),
          pneumonia_and_influenza_deaths = c(9L, 5L,
                                             23L, 2L, 12L, 10L),
          all_deaths = c(131L, 104L, 555L, 46L,
                         192L, 276L),
          nrow_agg = c(3L, 2L, 2L, 1L, 3L, 1L)
        ),
        row.names = c(NA, -6L),
        class = c("tbl_df", "tbl", "data.frame")
      ),
      mrs_age = structure(
        list(
          when_key = c(2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L,
                       3L, 3L, 3L, 3L),
          where_key = c(2L, 2L, 2L, 2L, 2L, 2L, 2L,
                        2L, 2L, 2L, 4L, 4L, 4L, 4L, 4L),
          who_key = c(1L, 2L, 3L,
                      4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L),
          all_deaths = c(5L,
                         13L, 51L, 107L, 16L, 0L, 2L, 16L, 28L, 7L, 0L, 4L, 25L, 52L,
                         3L),
          nrow_agg = c(3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L,
                       3L, 3L, 3L, 3L, 3L)
        ),
        row.names = c(NA, -15L),
        class = c("tbl_df",
                  "tbl", "data.frame")
      )
    )
  })
})

test_that("constellation() define constellation with rpd", {
  expect_equal({
    db1 <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
      role_playing_dimension(rpd = "When",
                             roles = c("When Available", "When Received"))

    db2 <- star_database(mrs_age_schema_rpd, ft_age_rpd) |>
      role_playing_dimension(rpd = "When Arrived",
                             roles = c("When Available"))
    db <- constellation("MRS", db1, db2)
    c(
      db$rpd,
      nrow(db$dimensions$when$table),
      nrow(db$dimensions$when_available$table),
      nrow(db$dimensions$when_arrived$table),
      nrow(db$dimensions$when_received$table),
      names(db$dimensions$when$table),
      names(db$dimensions$when_available$table),
      names(db$dimensions$when_arrived$table),
      names(db$dimensions$when_received$table)
    )
  }, {
    list(
      when = c("when", "when_available", "when_received", "when_arrived"),
      25L,
      25L,
      25L,
      25L,
      "when_key",
      "Year",
      "WEEK",
      "Week Ending Date",
      "when_available_key",
      "Data Availability Year",
      "Data Availability Week",
      "Data Availability Date",
      "when_arrived_key",
      "Arrival Year",
      "Arrival Week",
      "Arrival Date",
      "when_received_key",
      "Reception Year",
      "Reception Week",
      "Reception Date"
    )
  })
})

test_that("constellation() get_role_playing_dimension_names()", {
  expect_equal({
    db1 <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
      role_playing_dimension(rpd = "When",
                             roles = c("When Available", "When Received"))

    db2 <- star_database(mrs_age_schema_rpd, ft_age_rpd) |>
      role_playing_dimension(rpd = "When Arrived",
                             roles = c("When Available"))
    constellation("MRS", db1, db2) |>
      get_role_playing_dimension_names()
  }, {
    list(rpd_1 = c("when", "when_arrived", "when_available", "when_received"))
  })
})

test_that("constellation() replace_attribute_values() with role_playing_dimension()",
          {
            expect_equal({
              db1 <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
                role_playing_dimension(rpd = "When",
                                       roles = c("When Available", "When Received"))

              db2 <-
                star_database(mrs_age_schema_rpd, ft_age_rpd) |>
                role_playing_dimension(rpd = "When Arrived",
                                       roles = c("When Available"))
              db <- constellation("MRS", db1, db2)
              db <- db |> replace_attribute_values(
                name = "When Available",
                old = c('1962', '11', '1962-03-14'),
                new = c('1962', '3', '1962-01-15')
              )
              c(
                db$operations$mrs_cause$operation$operation,
                db$rpd,
                nrow(db$dimensions$when$table),
                nrow(db$dimensions$when_available$table),
                nrow(db$dimensions$when_received$table),
                names(db$dimensions$when$table),
                names(db$dimensions$when_available$table),
                names(db$dimensions$when_received$table),
                as.vector(db$dimensions$when$table$WEEK),
                as.vector(
                  db$dimensions$when_available$table$`Data Availability Week`
                ),
                as.vector(db$dimensions$when_received$table$`Reception Week`)
              )
            }, {
              list(
                "star_database",
                "role_playing_dimension",
                "replace_attribute_values",
                when = c("when", "when_available", "when_received", "when_arrived"),
                25L,
                25L,
                25L,
                "when_key",
                "Year",
                "WEEK",
                "Week Ending Date",
                "when_available_key",
                "Data Availability Year",
                "Data Availability Week",
                "Data Availability Date",
                "when_received_key",
                "Reception Year",
                "Reception Week",
                "Reception Date",
                "1",
                "3",
                "11",
                "2",
                "2",
                "3",
                "3",
                "3",
                "3",
                "4",
                "4",
                "5",
                "5",
                "5",
                "6",
                "6",
                "6",
                "6",
                "7",
                "7",
                "8",
                "8",
                "9",
                "9",
                "9",
                "1",
                "3",
                "11",
                "2",
                "2",
                "3",
                "3",
                "3",
                "3",
                "4",
                "4",
                "5",
                "5",
                "5",
                "6",
                "6",
                "6",
                "6",
                "7",
                "7",
                "8",
                "8",
                "9",
                "9",
                "9",
                "1",
                "3",
                "11",
                "2",
                "2",
                "3",
                "3",
                "3",
                "3",
                "4",
                "4",
                "5",
                "5",
                "5",
                "6",
                "6",
                "6",
                "6",
                "7",
                "7",
                "8",
                "8",
                "9",
                "9",
                "9"
              )
            })
          })

test_that("constellation() replace_attribute_values() with role_playing_dimension()",
          {
            expect_equal({
              db1 <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
                role_playing_dimension(rpd = "When",
                                       roles = c("When Available", "When Received"))

              db2 <-
                star_database(mrs_age_schema_rpd, ft_age_rpd) |>
                role_playing_dimension(rpd = "When Arrived",
                                       roles = c("When Available"))
              db <- constellation("MRS", db1, db2)

              db <- db |> replace_attribute_values(
                name = "When Available",
                old = c('1962', '11', '1962-03-14'),
                new = c('1962', '3', '1962-01-15')
              ) |>
                group_dimension_instances(name = "When") |>
                group_dimension_instances(name = "Who")

              c(
                db$operations$mrs_cause$operation$operation,
                db$operations$mrs_age$operation$operation,
                db$rpd,
                nrow(db$dimensions$when$table),
                nrow(db$dimensions$when_available$table),
                nrow(db$dimensions$when_received$table),
                names(db$dimensions$when$table),
                names(db$dimensions$when_available$table),
                names(db$dimensions$when_received$table),
                as.vector(db$dimensions$when$table$WEEK),
                as.vector(
                  db$dimensions$when_available$table$`Data Availability Week`
                ),
                as.vector(db$dimensions$when_received$table$`Reception Week`)
              )
            }, {
              list(
                "star_database",
                "role_playing_dimension",
                "replace_attribute_values",
                "group_dimension_instances",
                "star_database",
                "role_playing_dimension",
                "replace_attribute_values",
                "group_dimension_instances",
                "group_dimension_instances",
                when = c("when", "when_available",
                         "when_received", "when_arrived"),
                24L,
                24L,
                24L,
                "when_key",
                "Year",
                "WEEK",
                "Week Ending Date",
                "when_available_key",
                "Data Availability Year",
                "Data Availability Week",
                "Data Availability Date",
                "when_received_key",
                "Reception Year",
                "Reception Week",
                "Reception Date",
                "1",
                "11",
                "2",
                "2",
                "3",
                "3",
                "3",
                "3",
                "4",
                "4",
                "5",
                "5",
                "5",
                "6",
                "6",
                "6",
                "6",
                "7",
                "7",
                "8",
                "8",
                "9",
                "9",
                "9",
                "1",
                "11",
                "2",
                "2",
                "3",
                "3",
                "3",
                "3",
                "4",
                "4",
                "5",
                "5",
                "5",
                "6",
                "6",
                "6",
                "6",
                "7",
                "7",
                "8",
                "8",
                "9",
                "9",
                "9",
                "1",
                "11",
                "2",
                "2",
                "3",
                "3",
                "3",
                "3",
                "4",
                "4",
                "5",
                "5",
                "5",
                "6",
                "6",
                "6",
                "6",
                "7",
                "7",
                "8",
                "8",
                "9",
                "9",
                "9"
              )
            })
          })