R/dsttest.R

In adviceas/adviceverse: Tools for Data and Survey Analysis, Advice A/S

#' Check sampling DST
#' NB! This is a development version. Things can/will/should change.
#'
#' @param df Data frame of survey responses (acccepts Haven labels)
#' @param gender Factor variable, levels: "Kvinde", "Mand" ..
#' @param age Numeric age variable
#' @param region Factor variable, levels: "Region Hovedstaden"...
#' @param education NOT DEVELOPED: Factor variable, levels: ....
#' @param gender_dst Setting. Vector. Default setting.
#' @param age3_dst Setting. Vector with _three_ age categories e.g. c("18-34", "35-49", "50-70")
#' @param region_dst Setting. Vector. Default setting.
check_sampling_dk <- function(df,
                              gender,
                              age,
                              region,
                              education,
                              gender_dst = c("Kvinde", "Mand"),
                              age3_dst = c("18-34", "35-49", "50-70"),
                              region_dst = c("Region Hovedstaden", "Region Sjælland", "Region Syddanmark", "Region Midtjylland", "Region Nordjylland")) {

  # NB! Ikke færdigudviklet per 30. april 2020.
  # Funktioner bør dekobles. Denne funktion bør udgøres af mindst 3-5 funktioner. For meget kodegentagelse.

  if (!is.numeric(df[[age]]))
    stop("Parameter 'age' need to be numeric.")

  if (!sum(c("Region Hovedstaden", "Region Sjælland", "Region Syddanmark", "Region Midtjylland", "Region Nordjylland") %in% levels(df[[region]]) >= 1))
    stop("Parameter 'region' has no recognized factor levels.")

  if (!sum(c("Mand", "Kvinde") %in% levels(df[[gender]]) >= 1))
    stop("Parameter 'gender' has no recognized factor levels.")

  # Get age categories

  age3_list <- strsplit(age3_dst, "-")

  # Danmarks Statistik, 2020K1
  # https://www.statistikbanken.dk/FOLK1A

  # Konstruktion af DST_2020K1
  # DST_2020K1 <-
  #  dst_excel %>%
  #  pivot_longer(cols = ends_with("år"), names_to = c("age"), values_to = "countDST") %>%
  #  mutate(age = as.numeric(str_remove(age, "\\..*"))) %>% # Formater "0.år" til 0 (fjern alt efter punktum)
  #  mutate(gender = case_when(gender == "Mænd" ~ "Mand", gender == "Kvinder" ~ "Kvinde"))
  # usethis::use_data(DST_2020K1, internal = TRUE)

  # TODO: DST bør være i sin egen funktion

  DST <-
    DST_2020K1 %>% # DST-data er lagt internt i sysdata
    dplyr::filter(region %in% region_dst) %>%
    dplyr::filter(gender %in% gender_dst) %>%
    dplyr::mutate(age = case_when( # TODO: Lav en funktion der gør det her
      age >= age3_list[[1]][1] & age <= age3_list[[1]][2] ~ age3_dst[[1]],
      age >= age3_list[[2]][1] & age <= age3_list[[2]][2] ~ age3_dst[[2]],
      age >= age3_list[[3]][1] & age <= age3_list[[3]][2] ~ age3_dst[[3]],
      T ~ NA_character_
    )) %>%
    dplyr::count(region, age, gender, wt = countDST, name = "nDST") %>%
    tidyr::drop_na() %>%
    dplyr::mutate(propDST = nDST/sum(nDST)) %>%
    dplyr::select(-nDST)

  # TODO: Lav evt. pænere dplyr-version af syntax med quoting i stedet for at definere ny tibble
  # TODO: Løs quick fixet ift. factorer og characters..
  # TODO: Lav evt. et opsamlende og mindre detaljeret output..

  tib <-
    tibble::tibble(
      region = df[[region]],
      age = dplyr::case_when(
        df[[age]] >= age3_list[[1]][1] & df[[age]] <= age3_list[[1]][2] ~ age3_dst[[1]],
        df[[age]] >= age3_list[[2]][1] & df[[age]] <= age3_list[[2]][2] ~ age3_dst[[2]],
        df[[age]] >= age3_list[[3]][1] & df[[age]] <= age3_list[[3]][2] ~ age3_dst[[3]],
        T ~ NA_character_
      ),
      gender = df[[gender]]
    ) %>%
    dplyr::count(region, age, gender, name = "nSAMPLE") %>%
    dplyr::mutate(propSAMPLE = nSAMPLE/sum(nSAMPLE)) %>%
    dplyr::mutate_if(is.factor, as.character) %>% # Quick fix.
    dplyr::left_join(DST) %>% # left_join preserves x rows if there is no matches in the DST table
    dplyr::mutate(diff = propSAMPLE - propDST) %>%
    dplyr::mutate(check = dplyr::case_when(abs(diff) <= 0.02 ~ "I VINKEL (Afvigelse < 2%)",
                                           abs(diff) <= 0.05 ~ "I VINKEL (Afvigelse < 5%)",
                                           T ~ "UDE PÅ LØJER (Afvigelse > 5%)")) %>%
    print(n = Inf)

  # Uddannelse
  # TODO: Ryde op i kode
  # TODO: Hent data fra DST: www.statistikbanken.dk/HFUDD10
  # TODO: Brug oversættelsen mellem forskellige typer af uddannelsesvariable mere elegant
  # Userneeds og andre bruger ikke uddannelse interlocked - også pga. samvariation med køn, alder, region.

  DST_edu1 <-
    tibble::tribble(
      ~nameDST,                                            ~nameSAMPLE, ~shortnameSAMPLE,    ~countDST,
      "H10 Grundskole",                              "Grundskole (folkeskole)",           "Kort",  724265L,
      "H20 Gymnasiale uddannelser", "Gymnasial uddannelse (f.eks. STX, HHX, HTX eller HF)",         "Mellem",  387924L,
      "H30 Erhvervsfaglige uddannelser",                                   "Erhvervsuddannelse",         "Mellem", 1205090L,
      "H35 Adgangsgivende uddannelsesforløb",                               "Andet, skriv venligst:",         "Andet",    3735L,
      "H40 Korte videregående uddannelser, KVU",           "Kort videregående uddannelse (indtil 3 år)",         "Mellem",  197668L,
      "H50 Mellemlange videregående uddannelser, MVU",          "Mellemlang videregående uddannelse (3-4 år)",           "Lang",  586814L,
      "H60 Bacheloruddannelser, BACH",          "Mellemlang videregående uddannelse (3-4 år)",           "Lang",   92559L,
      "H70 Lange videregående uddannelser, LVU",          "Mellemlang videregående uddannelse (3-4 år)",           "Lang",  383787L,
      "H80 Ph.d. og forskeruddannelser",       "Lang videregående uddannelse (5 år eller mere)",           "Lang",   33144L,
      "H90 Uoplyst mv.",                               "Andet, skriv venligst:",          "Andet",   67219L
    ) %>%
    select(-nameDST, -nameSAMPLE) %>% # Quick fix
    dplyr::count(shortnameSAMPLE, wt = countDST, name = "nDST") %>%
    mutate(propDST = nDST/sum(nDST))

  tib_edu1 <-
    tibble::tibble(education = as.character(df[[education]])) %>% # Quick fix
    dplyr::transmute(shortnameSAMPLE = case_when(education == "Grundskole (folkeskole)" ~ "Kort", # Kan i princippet uden mutate, fordi alle typer af navne står ovenfor, men bevares pt.
                                                 education == "Gymnasial uddannelse (f.eks. STX, HHX, HTX eller HF)" ~ "Mellem",
                                                 education == "Erhvervsuddannelse" ~ "Mellem",
                                                 education == "Kort videregående uddannelse (indtil 3 år)" ~ "Mellem",
                                                 education == "Mellemlang videregående uddannelse (3-4 år)" ~ "Lang",
                                                 education == "Lang videregående uddannelse (5 år eller mere)" ~ "Lang",
                                                 T ~ "Andet")) %>%
    dplyr::count(shortnameSAMPLE, name = "nSAMPLE") %>%
    dplyr::mutate(propSAMPLE = nSAMPLE/sum(nSAMPLE)) %>%
    dplyr::left_join(DST_edu1) %>%
    dplyr::mutate(diff = propSAMPLE - propDST) %>%
    dplyr::mutate(check = dplyr::case_when(abs(diff) <= 0.02 ~ "I VINKEL (Afvigelse < 2%)",
                                           abs(diff) <= 0.05 ~ "I VINKEL (Afvigelse < 5%)",
                                           T ~ "UDE PÅ LØJER (Afvigelse > 5%)")) %>%
    dplyr::select(-nDST) %>%
    print()

}