tests/testthat/test-star_database.R

In rolap: Obtaining Star Databases from Flat Tables

test_that("star_database() define a a star database", {
  expect_equal({
    s <- star_schema() |>
      define_facts(fact_schema(
        name = "MRS Cause",
        measures = c("Pneumonia and Influenza Deaths",
                     "All Deaths")
      )) |>
      define_dimension(dimension_schema(name = "When",
                                        attributes = c("Year"))) |>
      define_dimension(dimension_schema(
        name = "Where",
        attributes = c("REGION",
                       "State")
      ))
    star_database(s, ft_num)
  },
  structure(
    list(
      name = "mrs_cause",
      operations = list(mrs_cause = structure(list(
        operations = structure(
          list(
            operation = "star_database",
            name = "mrs_cause",
            details = "___UNKNOWN___",
            details2 = "",
            order = 1
          ),
          row.names = c(NA,-1L),
          class = "data.frame"
        )
      ), class = "star_operation")),
      lookup_tables = list(mrs_cause = 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")
            ), 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,
                           2L, 2L, 3L, 3L),
              where_key = c(1L, 2L, 1L, 2L, 1L, 2L),
              `Pneumonia and Influenza Deaths` = c(14L, 27L, 14L,
                                                   10L, 11L, 35L),
              `All Deaths` = c(235L, 594L, 238L, 276L,
                               98L, 653L),
              nrow_agg = c(5L, 3L, 4L, 1L, 2L, 5L)
            ),
            class = c("tbl_df",
                      "tbl", "data.frame"),
            row.names = c(NA, -6L)
          )
        ),
        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:2,
                REGION = c("1",
                           "1"),
                State = c("CT", "MA")
              ),
              row.names = c(NA, -2L),
              class = c("tbl_df", "tbl", "data.frame")
            )
          ),
          class = "dimension_table"
        )
      ),
      rpd = list(),
      geo = list(),
      scd = list()
    ),
    class = "star_database"
  ))
})

test_that("star_database() define a a star database", {
  expect_equal({
    s <- star_schema() |>
      define_facts(fact_schema(name = "MRS Cause")) |>
      define_dimension(dimension_schema(name = "When",
                                        attributes = c("Year"))) |>
      define_dimension(dimension_schema(
        name = "Where",
        attributes = c("REGION",
                       "State")
      ))
    star_database(s, ft_num)
  },
  structure(
    list(
      name = "mrs_cause",
      operations = list(mrs_cause = structure(list(
        operations = structure(
          list(
            operation = "star_database",
            name = "mrs_cause",
            details = "___UNKNOWN___",
            details2 = "",
            order = 1
          ),
          row.names = c(NA,-1L),
          class = "data.frame"
        )
      ), class = "star_operation")),
      lookup_tables = list(mrs_cause = NULL),
      schemas = list(mrs_cause = structure(
        list(
          facts = list(mrs_cause = structure(
            list(
              name = "MRS Cause",
              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",
                                             "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(nrow_agg = "SUM"),
          dim_int_names = c("when",
                            "where"),
          table = structure(
            list(
              when_key = c(1L, 1L,
                           2L, 2L, 3L, 3L),
              where_key = c(1L, 2L, 1L, 2L, 1L, 2L),
              nrow_agg = c(5L, 3L, 4L, 1L, 2L, 5L)
            ),
            class = c("tbl_df",
                      "tbl", "data.frame"),
            row.names = c(NA, -6L)
          )
        ),
        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:2,
                REGION = c("1",
                           "1"),
                State = c("CT", "MA")
              ),
              row.names = c(NA, -2L),
              class = c("tbl_df", "tbl", "data.frame")
            )
          ),
          class = "dimension_table"
        )
      ),
      rpd = list(),
      geo = list(),
      scd = list()
    ),
    class = "star_database"
  ))
})



test_that("snake_case() transform a a star database in snake case", {
  expect_equal({
    s <- star_schema() |>
      define_facts(fact_schema(
        name = "MRS Cause",
        measures = c("Pneumonia and Influenza Deaths",
                     "All Deaths")
      )) |>
      define_dimension(dimension_schema(name = "When",
                                        attributes = c("Year"))) |>
      define_dimension(dimension_schema(
        name = "Where",
        attributes = c("REGION",
                       "State")
      ))
    snake_case(star_database(s, ft_num))
  },
  structure(
    list(
      name = "mrs_cause",
      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")),
      lookup_tables = list(mrs_cause = 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")
            ), 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,
                           2L, 2L, 3L, 3L),
              where_key = c(1L, 2L, 1L, 2L, 1L, 2L),
              pneumonia_and_influenza_deaths = c(14L, 27L, 14L,
                                                 10L, 11L, 35L),
              all_deaths = c(235L, 594L, 238L, 276L,
                             98L, 653L),
              nrow_agg = c(5L, 3L, 4L, 1L, 2L, 5L)
            ),
            class = c("tbl_df",
                      "tbl", "data.frame"),
            row.names = c(NA, -6L)
          )
        ),
        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:2,
                region = c("1",
                           "1"),
                state = c("CT", "MA")
              ),
              row.names = c(NA, -2L),
              class = c("tbl_df", "tbl", "data.frame")
            )
          ),
          class = "dimension_table"
        )
      ),
      rpd = list(),
      geo = list(),
      scd = list()
    ),
    class = "star_database"
  ))
})

test_that("set_attribute_names() and get_attribute_names()",
          {
            expect_equal({
              db <- star_database(mrs_cause_schema, ft_num) |>
                set_attribute_names(name = "where",
                                    new = c("Region",
                                            "State",
                                            "City"))
              c(
                db$operations$mrs_cause$operation$operation,
                db |>
                  get_attribute_names(name = "where")
              )
            }, {
              c("star_database",
                "set_attribute_names",
                "Region",
                "State",
                "City")
            })
          })

test_that("set_attribute_names() and get_attribute_names()",
          {
            expect_equal({
              db <- star_database(mrs_cause_schema, ft_num) |>
                set_attribute_names(
                  name = "where",
                  old = c("REGION"),
                  new = c("Region")
                )
              c(
                db$operations$mrs_cause$operation$operation,
                db |>
                  get_attribute_names(name = "where")
              )
            }, {
              c("star_database",
                "set_attribute_names",
                "Region",
                "State",
                "City")
            })
          })

test_that("set_attribute_names() and get_attribute_names()",
          {
            expect_equal({
              new <- "Region"
              names(new) <- "REGION"
              db <- star_database(mrs_cause_schema, ft_num) |>
                set_attribute_names(name = "where",
                                    new = new)
              c(
                db$operations$mrs_cause$operation$operation,
                db |>
                  get_attribute_names(name = "where")
              )
            }, {
              c("star_database",
                "set_attribute_names",
                "Region",
                "State",
                "City")
            })
          })

test_that("set_measure_names() and get_measure_names()", {
  expect_equal({
    db <- star_database(mrs_cause_schema, ft_num) |>
      set_measure_names(new = c("Pneumonia and Influenza",
                                "All",
                                "Rows Aggregated"))
    c(db$operations$mrs_cause$operation$operation,
      db |>
        get_measure_names())
  }, {
    c(
      "star_database",
      "set_measure_names",
      "Pneumonia and Influenza",
      "All",
      "Rows Aggregated"
    )
  })
})

test_that("get_similar_attribute_values()", {
  expect_equal({
    db <- star_database(mrs_cause_schema, ft_num)
    db$dimensions$where$table$City[2] <- " BrId  gEport "
    db |> get_similar_attribute_values("where", col_as_vector = 'dput_instance')
  }, {
    list(structure(
      list(
        REGION = c("1", "1"),
        State = c("CT", "CT"),
        City = c(" BrId  gEport ", "Bridgeport"),
        dput_instance = c("c('1', 'CT', ' BrId  gEport ')",
                          "c('1', 'CT', 'Bridgeport')")
      ),
      row.names = c(NA,-2L),
      class = c("tbl_df",
                "tbl", "data.frame")
    ))
  })
})

test_that("get_similar_attribute_values()", {
  expect_equal({
    db <- star_database(mrs_cause_schema, ft_num)
    db$dimensions$where$table$City[2] <- " BrId  gEport "
    db$dimensions$where$table$State[1] <- " c   T "
    db$dimensions$when$table$Year[3] <- '1963.'
    db |> get_similar_attribute_values(col_as_vector = 'dput_instance')
  }, {
    list(when = list(structure(
      list(
        Year = c("1963", "1963."),
        dput_instance = c("c('1963')",
                          "c('1963.')")
      ),
      row.names = c(NA, -2L),
      class = c("tbl_df", "tbl",
                "data.frame")
    )),
    where = list(structure(
      list(
        REGION = c("1",
                   "1"),
        State = c(" c   T ", "CT"),
        City = c("Bridgeport", " BrId  gEport "),
        dput_instance = c("c('1', ' c   T ', 'Bridgeport')", "c('1', 'CT', ' BrId  gEport ')")
      ),
      row.names = c(NA, -2L),
      class = c("tbl_df", "tbl", "data.frame")
    )))
  })
})

test_that("get_similar_attribute_values()", {
  expect_equal({
    db <- star_database(mrs_cause_schema, ft_num)
    db$dimensions$where$table$City[2] <- " BrId  gEport "
    db$dimensions$where$table$State[1] <- " c   T "
    db$dimensions$when$table$Year[3] <- '1963.'
    db |> get_similar_attribute_values("where",
                                       attributes = c('City', 'State'),
                                       col_as_vector = 'dput_instance')
  }, {
    list(structure(
      list(
        City = c(" BrId  gEport ", "Bridgeport"),
        State = c("CT", " c   T "),
        dput_instance = c("c(' BrId  gEport ', 'CT')",
                          "c('Bridgeport', ' c   T ')")
      ),
      row.names = c(NA, -2L),
      class = c("tbl_df",
                "tbl", "data.frame")
    ))
  })
})

test_that("get_similar_attribute_values_individually()", {
  expect_equal({
    db <- star_database(mrs_cause_schema, ft_num)
    db$dimensions$where$table$City[2] <- " BrId  gEport "
    db$dimensions$where$table$State[1] <- " c   T "
    db$dimensions$when$table$Year[3] <- '1963.'
    db |> get_similar_attribute_values_individually()
  }, {
    list(when = list(structure(
      list(Year = c("1963", "1963.")),
      row.names = c(NA, -2L),
      class = c("tbl_df", "tbl", "data.frame")
    )),
    where = list(
      structure(
        list(State = c(" c   T ", "CT")),
        row.names = c(NA, -2L),
        class = c("tbl_df", "tbl", "data.frame")
      ),
      structure(
        list(City = c(" BrId  gEport ", "Bridgeport")),
        row.names = c(NA, -2L),
        class = c("tbl_df", "tbl", "data.frame")
      )
    ))
  })
})


test_that("get_unique_attribute_values()", {
  expect_equal({
    star_database(mrs_cause_schema, ft_num) |>
      get_unique_attribute_values()
  }, {
    list(
      when = structure(
        list(Year = c("1962", "1963", "1964")),
        row.names = c(NA, -3L),
        class = c("tbl_df", "tbl", "data.frame")
      ),
      where = structure(
        list(
          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")
      )
    )
  })
})


test_that("get_unique_attribute_values()", {
  expect_equal({
    star_database(mrs_cause_schema, ft_num) |>
      get_unique_attribute_values(name = "where")
  }, {
    structure(
      list(
        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")
    )
  })
})


test_that("get_unique_attribute_values()", {
  expect_equal({
    star_database(mrs_cause_schema, ft_num) |>
      get_unique_attribute_values("where",
                                  attributes = c("REGION", "State"))
  }, {
    structure(
      list(REGION = c("1", "1"), State = c("CT", "MA")),
      row.names = c(NA, -2L),
      class = c("tbl_df", "tbl", "data.frame")
    )
  })
})


test_that("replace_attribute_values()", {
  expect_equal({
    db <- star_database(mrs_cause_schema, ft_num)
    db <- db |> replace_attribute_values(
      "where",
      old = c('1', 'CT', 'Bridgeport'),
      new = c('1', 'CT', 'Hartford')
    )
    db$dimensions$where$table
  }, {
    structure(
      list(
        where_key = 1:4,
        REGION = c("1", "1", "1", "1"),
        State = c("CT", "CT", "MA", "MA"),
        City = c("Hartford", "Hartford",
                 "Boston", "Cambridge")
      ),
      row.names = c(NA,-4L),
      class = c("tbl_df",
                "tbl", "data.frame")
    )
  })
})

test_that("replace_attribute_values() with role_playing_dimension()", {
  expect_equal({
    db <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
      role_playing_dimension(rpd = "When",
                             roles = c("When Available", "When Received"))
    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"),
      15L,
      15L,
      15L,
      "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",
      "6",
      "9",
      "1",
      "3",
      "11",
      "2",
      "2",
      "3",
      "3",
      "3",
      "3",
      "4",
      "4",
      "5",
      "5",
      "6",
      "9",
      "1",
      "3",
      "11",
      "2",
      "2",
      "3",
      "3",
      "3",
      "3",
      "4",
      "4",
      "5",
      "5",
      "6",
      "9"
    )
  })
})


test_that("as_tibble_list() export star_database 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()

    db1 |>
      as_tibble_list()
  }, {
    list(
      when = structure(
        list(when_key = 1:2, year = c("1962", "1963")),
        row.names = c(NA,-2L),
        class = c("tbl_df", "tbl", "data.frame")
      ),
      where = structure(
        list(
          where_key = 1:3,
          region = c("1", "1", "1"),
          state = c("CT",
                    "CT", "MA"),
          city = c("Bridgeport", "Hartford", "Boston")
        ),
        row.names = c(NA,-3L),
        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)
        ),
        class = c("tbl_df",
                  "tbl", "data.frame"),
        row.names = c(NA,-6L)
      )
    )
  })
})

test_that("role_playing_dimension() define a rpd", {
  expect_equal({
    db <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
      role_playing_dimension(rpd = "When",
                             roles = c("When Available", "When Received"))
    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)
    )
  }, {
    list(
      "star_database",
      "role_playing_dimension",
      when = c("when", "when_available", "when_received"),
      15L,
      15L,
      15L,
      "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"
    )
  })
})

test_that("role_playing_dimension() define a rpd", {
  expect_equal({
    db <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
      role_playing_dimension(
        rpd = "When",
        roles = c("When Available", "When Received"),
        rpd_att_names = TRUE
      )

    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)
    )
  }, {
    list(
      "star_database",
      "role_playing_dimension",
      when = c("when", "when_available", "when_received"),
      15L,
      15L,
      15L,
      "when_key",
      "Year",
      "WEEK",
      "Week Ending Date",
      "when_available_key",
      "Year",
      "WEEK",
      "Week Ending Date",
      "when_received_key",
      "Year",
      "WEEK",
      "Week Ending Date"
    )
  })
})

test_that("role_playing_dimension() define a rpd", {
  expect_equal({
    db <- star_database(mrs_cause_schema_rpd, ft_cause_rpd) |>
      role_playing_dimension(
        rpd = "When",
        roles = c("When Available", "When Received"),
        att_names = c("Year", "Week", "Date")
      )

    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)
    )
  }, {
    list(
      "star_database",
      "role_playing_dimension",
      when = c("when", "when_available", "when_received"),
      15L,
      15L,
      15L,
      "when_key",
      "Year",
      "Week",
      "Date",
      "when_available_key",
      "Year",
      "Week",
      "Date",
      "when_received_key",
      "Year",
      "Week",
      "Date"
    )
  })
})

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

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

    db1 |>
      as_single_tibble_list()
  }, {
    list(mrs_cause = structure(
      list(
        year = c("1962", "1962", "1962",
                 "1963", "1963", "1963"),
        region = c("1", "1", "1", "1", "1",
                   "1"),
        state = c("CT", "CT", "MA", "CT", "CT", "MA"),
        city = c(
          "Bridgeport",
          "Hartford",
          "Boston",
          "Bridgeport",
          "Hartford",
          "Boston"
        ),
        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")
    ))
  })
})

test_that("as_single_tibble_list()", {
  expect_equal({
    db1 <- star_database(mrs_cause_schema, ft_num) |>
      snake_case()
    db2 <- star_database(mrs_age_schema, ft_age) |>
      snake_case()
    ct <- constellation("MRS", db1, db2)
    tl <- ct |>
      as_single_tibble_list()
    c(names(tl$mrs_cause), names(tl$mrs_age))
  }, {
    c(
      "year",
      "region",
      "state",
      "city",
      "pneumonia_and_influenza_deaths",
      "all_deaths",
      "nrow_agg",
      "year",
      "region",
      "state",
      "city",
      "age",
      "all_deaths",
      "nrow_agg"
    )
  })
})


test_that("as_single_tibble_list()", {
  expect_equal({
    s <- star_schema() |>
      define_facts(fact_schema(
        name = "mrs_cause",
        measures = c("Pneumonia and Influenza Deaths",
                     "All Deaths")
      )) |>
      define_dimension(dimension_schema(
        name = "When",
        attributes = c("Year",
                       "WEEK",
                       "Week Ending Date")
      )) |>
      define_dimension(dimension_schema(
        name = "When Available",
        attributes = c(
          "Data Availability Year",
          "Data Availability Week",
          "Data Availability Date"
        )
      )) |>
      define_dimension(dimension_schema(
        name = "When Received",
        attributes = c("Reception Year",
                       "Reception Week",
                       "Reception Date")
      )) |>
      define_dimension(dimension_schema(
        name = "where",
        attributes = c("REGION",
                       "State",
                       "City")
      ))

    db <- star_database(s, ft_cause_rpd) |>
      role_playing_dimension(
        rpd = "When",
        roles = c("When Available", "When Received"),
        rpd_att_names = TRUE
      )
    r <- db |> as_single_tibble_list()
    names(r[[1]])
  }, {
    c(
      "Year",
      "WEEK",
      "Week Ending Date",
      "Year_when_available",
      "WEEK_when_available",
      "Week Ending Date_when_available",
      "Year_when_received",
      "WEEK_when_received",
      "Week Ending Date_when_received",
      "REGION",
      "State",
      "City",
      "Pneumonia and Influenza Deaths",
      "All Deaths",
      "nrow_agg"
    )
  })
})

test_that("as_single_tibble_list()", {
  expect_equal({
    db1 <- star_database(mrs_cause_schema, ft_num) |>
      snake_case()
    db2 <- star_database(mrs_age_schema, ft_age) |>
      snake_case()
    ct1 <- constellation("MRS", db1, db2)
    r <- ct1 |> as_single_tibble_list()
    c(names(r[[1]]), names(r[[2]]))
  }, {
    c(
      "year",
      "region",
      "state",
      "city",
      "pneumonia_and_influenza_deaths",
      "all_deaths",
      "nrow_agg",
      "year",
      "region",
      "state",
      "city",
      "age",
      "all_deaths",
      "nrow_agg"
    )
  })
})

test_that("get_star_database()", {
  expect_equal({
    db1 <- star_database(mrs_cause_schema, ft_num) |>
      snake_case()
    db2 <- star_database(mrs_age_schema, ft_age) |>
      snake_case()
    ct <- constellation("MRS", db1, db2)
    names <- ct |>
      get_fact_names()
    st <- ct |>
      get_star_database(names[1])
  }, {
    db2
  })
})

test_that("get_star_database()", {
  expect_equal({
    db1 <- star_database(mrs_cause_schema, ft_num) |>
      snake_case()
    db2 <- star_database(mrs_age_schema, ft_age) |>
      snake_case()
    ct <- constellation("MRS", db1, db2)
    names <- ct |>
      get_fact_names()
    st <- ct |>
      get_star_database(names[2])
  }, {
    db1
  })
})

test_that("get_dimension_names()", {
  db1 <- star_database(mrs_cause_schema, ft_num) |>
    snake_case()
  db2 <- star_database(mrs_age_schema, ft_age) |>
    snake_case()
  ct <- constellation("MRS", db1, db2)

  expect_equal({
    ct |>
      get_dimension_names()
  }, {
    c("when", "where", "who")
  })

  expect_equal({
    ct |>
      get_fact_names()
  }, {
    c("mrs_age", "mrs_cause")
  })

  expect_equal({
    ct |>
      get_table_names()
  }, {
    c("mrs_age", "mrs_cause", "when", "where", "who")
  })

  expect_equal({
    t <- ct |>
      get_dimension_table("where")
  }, {
    structure(
      list(
        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")
    )
  })
})