R/functions_zipcode.R

Defines functions alt_txt_zipcode table_zipcodes plot_zipcodes_line plot_zipcodes_dotplot_alueprofiili plot_zipcodes_bar map_zipcodes_alueprofiili map_zipcodes get_koodit_zip get_region_zipdata process_zipdata_timeseries process_zipdata

Documented in alt_txt_zipcode get_koodit_zip get_region_zipdata map_zipcodes map_zipcodes_alueprofiili plot_zipcodes_bar plot_zipcodes_dotplot_alueprofiili plot_zipcodes_line process_zipdata process_zipdata_timeseries table_zipcodes

if (F){
  library(karttasovellus)
  library(dplyr)
  library(glue)
  library(ggplot2)
  library(sf)
  library(hrbrthemes)
  library(leaflet)
  library(tidyr)
  library(forcats)
}


#' Process cross-sectional zipcode data
#' 
#' @param varname A string.
#'
#' @export
process_zipdata <- function(varname = "Kokonaislukema"){
  load(system.file("data", "dfzip_v20230224.rda", package="karttasovellus"))
  dtmp <- dfzip_v20230224[dfzip_v20230224$variable %in% varname, ]
  return(dtmp)
}

# dd2 <- process_zipdata()

#' Process time-series zipcode data
#' 
#' @param varname A string.
#'
#' @export
process_zipdata_timeseries <- function(varname = "Kokonaislukema"){
  load(system.file("data", "dfzip_v20230224_aikasarja.rda", package="karttasovellus"))
  dtmp <- dfzip_v20230224_aikasarja[dfzip_v20230224_aikasarja$variable %in% varname, ]
  return(dtmp)
}

# dd3 <- process_zipdata_timeseries()

#' Get zipcode region data
#' 
#' @export
get_region_zipdata <- function(){
  load(system.file("data", "region_data_zip.rda", package="karttasovellus"))
  return(region_data_zip)
}

# dd4 <- get_region_zipdata()

#' Process time-series zipcode data
#' 
#' @param regio_selected A numeric
#' @param value_regio_level A string
#'
#' @export
get_koodit_zip <- function(regio_selected = 161, 
                           value_regio_level = "Seutukunnat"){
  # region_data_kunta <- karttasovellus::region_data
  aluedata <- geofi::municipality_key_2021
  # haetaan valitun alueen kuntanumerot
  if (value_regio_level == "Kunnat"){
    kuntanrot <- regio_selected
  } else if (value_regio_level == "Seutukunnat"){
    # if (!regio_selected %in% aluedata$seutukunta_code) return()
    kuntanrot <- aluedata[aluedata$seutukunta_code %in% regio_selected,]$municipality_code
  } else if (value_regio_level == "Hyvinvointialueet"){
    kuntanrot <- aluedata[aluedata$hyvinvointialue_code %in% regio_selected,]$municipality_code
  }
  
  load(system.file("data", "region_data_zip.rda", package="karttasovellus"))
  neigh <- region_data_zip[region_data_zip$kuntanro %in% kuntanrot,]$region_code

  return(neigh)
}


#' Create zipcode map
#' 
#' @param input_value_region_selected A numeric
#' @param input_value_regio_show_mode A string
#' @param input_value_variable A string
#' @param leaflet A logical
#' @param alueprofiili A logical
#' @param alueprofiili_doc A logical
#'
#' @import leaflet
#' @import leaflet.extras
#'
#' @export
map_zipcodes <- function(input_value_region_selected = 72,
                         input_value_regio_level = "Kunnat",
                         input_value_variable = "Kokonaislukema",
                         leaflet = FALSE, 
                         alueprofiili = FALSE,
                         alueprofiili_doc = FALSE,
                         basesize = 6, 
                         plottextsize = 2.5,
  add_caption = TRUE){
  
  
  # input_value_regio_level <- "Postinumeroalueet"
  region_data <- get_region_zipdata()
  dat <- process_zipdata(varname = input_value_variable)
  dat <- left_join(region_data %>% select(-kuntanro),
                   dat,by = c("region_code" = "aluekoodi"), keep = TRUE) 

  dat <- dat %>%
    mutate(color = ifelse(aluenimi %in% input_value_region_selected, TRUE, FALSE))
  
    zipcodes <- get_koodit_zip(regio_selected = input_value_region_selected, 
                                    value_regio_level = input_value_regio_level)
    dat <- dat %>% filter(aluekoodi %in% zipcodes)
  nregios <- dat %>% filter(!is.na(value)) %>%  nrow()
  
  # luodaan alaotsikko
  kuvan_subtitle <- glue("Aluetaso: {input_value_regio_level}")
  
  if (!leaflet){
    
    ggplot(data = dat, aes(fill = value)) +
      geom_sf(color = alpha("white", 1/3))  +
      geom_sf(aes(color = color), fill = NA, show.legend = FALSE)  +    
      scale_color_manual(values = c(alpha("white", 1/3), "black")) +
      theme_ipsum(base_family = "Lato",
                  plot_title_family = "Lato",
                  base_size = basesize,
                  plot_title_size = basesize+5, 
                  strip_text_size = basesize+3, 
                  subtitle_size =  basesize+4,
                  subtitle_family = "Lato",
                  grid_col = "white",
                  plot_title_face = "plain") -> p
    
    if (nregios > 1){
      p <- p +  scale_fill_fermenter(palette = "YlGnBu", type = "seq", direction = 1, 
                                     guide = guide_colourbar(direction = "horizontal", title.position = "top", barwidth = 10))
      }
    
    
    if (add_caption){
      caption_text <- glue("Huono-osaisuus Suomessa -karttasovellus (Diak)\nData: Tilastokeskus Paavo (perusdata) & Diak (mediaanisuhteutus)\nTiedot haettu:{Sys.Date()}")
    } else {
      caption_text <- ""
        }
    
    p <- p + theme(axis.text.x = element_blank(),
              axis.text.y = element_blank(),
              axis.title.x = element_blank(),
              axis.title.y = element_blank(),
              panel.grid.major = element_blank(),
              panel.grid.minor = element_blank(),
              # legend.position = c(0.1, 0.9),
              legend.position = "top",
              plot.title.position = "plot") +
      labs(title = add_line_break2(glue("{input_value_variable}"),30),
           subtitle = kuvan_subtitle,
           caption = caption_text,
           fill = paste0(add_line_break2(input_value_variable, 38), " (suhdeluku)"))
    
    
    
    if (!alueprofiili){
    p <- p + ggrepel::geom_label_repel(data = dat %>%  
                                  sf::st_set_geometry(NULL) %>%
                                  bind_cols(dat %>%
                                              sf::st_centroid() %>%
                                              sf::st_coordinates() %>% as_tibble()),
                                aes(label = paste0(aluenimi,aluekoodi,"\n",
                                                   round(value)), x = X, y = Y), label.size = 0, label.padding = 0,
                                plottextsize = 2.5,
                                color = "black", fill = "white", family = "Lato", lineheight = .8)      
    }
    if (!alueprofiili_doc & nregios <= 20){
      p <- p + ggrepel::geom_label_repel(data = dat %>%  
                                           sf::st_set_geometry(NULL) %>%
                                           bind_cols(dat %>%
                                                       sf::st_centroid() %>%
                                                       sf::st_coordinates() %>% as_tibble()),
                                         aes(label = paste0(aluenimi,aluekoodi, "\n",
                                                            round(value)), x = X, y = Y), label.size = 0, label.padding = 0,
                                         plottextsize = 2.5,
                                         color = "black", fill = "white", family = "Lato", lineheight = .8)      
    }
    if (alueprofiili_doc){
      p <- p + ggrepel::geom_label_repel(data = dat %>% sf::st_set_geometry(NULL) %>%
      # p <- p + geom_label(data = dat %>%  sf::st_set_geometry(NULL) %>%
                                           bind_cols(dat %>%
                                                       sf::st_centroid() %>%
                                                       sf::st_coordinates() %>% as_tibble()
                                                     ),
                                         aes(label = paste(aluenimi,"(",aluekoodi,")", 
                                                            round(value)), x = X, y = Y),
                                         color = "black", 
                          fill = "white",
                          label.size = 0,  
                          family = "Lato", size = plottextsize)      
      
    }
    
    p
  } else {
    dat_wgs84 <- sf::st_transform(x = dat, crs = "+proj=longlat +datum=WGS84")
    
    pal <- leaflet::colorNumeric(palette = "YlGnBu", domain = dat_wgs84$value)
    
    labels <- sprintf(
      "<italic>%s</italic> (%s)<br/>%s<br/><strong>%s</strong>",
      dat_wgs84$region_name, dat_wgs84$region_code, dat_wgs84$kuntanimi, round(dat_wgs84$value,1)
    ) %>% lapply(htmltools::HTML)
    
    # EPSG3067 <- leaflet::leafletCRS(crsClass = "L.Proj.CRS",
    #                                 code = "EPSG:3067", 
    #                                 proj4def = "+proj=utm +zone=35 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs",
    #                                 resolutions = 1.5^(25:15))
    
    base <- leaflet(data = dat_wgs84#, 
                    # options = leafletOptions(worldCopyJump = F, 
                    #                          crs = EPSG3067)
                    ) %>% 
      addTiles(#urlTemplate = "https://tiles.kartat.kapsi.fi/taustakartta_3067/{z}/{x}/{y}.jpg",
              urlTemplate = "https://tiles.kartat.kapsi.fi/taustakartta/{z}/{x}/{y}.jpg",
               options = tileOptions(opacity = .4, continuousWorld = T))

    base %>%   
      addPolygons(fillColor = ~pal(value),
                  color = "white",
                  weight = 2,
                  opacity = .6,
                  dashArray = "3",
                  fillOpacity = 0.7,
                  highlight = highlightOptions(
                    weight = 2,
                    color = "#666",
                    dashArray = "",
                    fillOpacity = 0.4,
                    bringToFront = TRUE),
                  label = labels,
                  labelOptions = labelOptions(opacity = .7,
                                              style = list("font-weight" = "normal",
                                                           padding = "2px 4px"),
                                              textsize = "12px",
                                              direction = "auto")
      ) %>% 
      addLegend(pal = pal, 
                values = ~value, 
                opacity = 0.7,
                # labFormat = labelFormat(transform = function(x) sort(x, decreasing = TRUE)),
                title = input_value_variable,
                position = "bottomright") %>% 
      leaflet.extras::addFullscreenControl()
  }
}


#' Create leaflet only zipcode map for alueprofiili
#' 
#' @param input_value_region_selected A numeric
#' @param input_value_regio_show_mode A string
#'
#' @import leaflet
#' @import leaflet.extras
#'
#' @export
map_zipcodes_alueprofiili <- function(input_value_region_selected = 91,
                         input_value_regio_level = "Kunnat", 
                         zipvars = c('Kokonaislukema',
                                     'Alimpaan tuloluokkaan kuuluvat taloudet',
                                     'Alimpaan tuloluokkaan kuuluvat täysi-ikäiset',
                                     'Työttömät',
                                     'Peruskoulutuksen omaavat')){

  region_data <- get_region_zipdata()
  load(system.file("data", "dfzip_v20230224.rda", package="karttasovellus"))
  # dfzip <- dfzip_v20230224 %>% 
  #   pivot_wider(names_from = variable, values_from = value)  
  dat <- left_join(region_data %>% select(-kuntanro),
                   dfzip_v20230224,by = c("region_name" = "aluenimi"), keep = TRUE)
  
  zipcodes <- get_koodit_zip(regio_selected = input_value_region_selected, 
                             value_regio_level = input_value_regio_level)
  dat <- dat %>% filter(aluekoodi %in% zipcodes)
  
  dat_wgs84 <- sf::st_transform(x = dat, crs = "+proj=longlat +datum=WGS84")
    
  base <- leaflet(data = dat_wgs84) %>% 
    addTiles(urlTemplate = "https://tiles.kartat.kapsi.fi/taustakartta/{z}/{x}/{y}.jpg",
             options = tileOptions(opacity = .4))
  
  for (ii in seq_along(zipvars)){
  
  dat_wgs84_tmp <- dat_wgs84[dat_wgs84$variable %in% zipvars[ii],]
  
  pal <- leaflet::colorNumeric(palette = "YlGnBu", domain = dat_wgs84_tmp[["value"]])

  lab <- sprintf(
      "<strong>%s</strong><br/><italic>%s</italic> (%s)<br/>%s<br/><strong>%s</strong>",
      zipvars[ii],
      dat_wgs84_tmp$region_name, 
      dat_wgs84_tmp$region_code, 
      dat_wgs84_tmp$kuntanimi, 
      round(dat_wgs84_tmp$value,1)
    ) %>% lapply(htmltools::HTML)

  
  highlight_opts <- highlightOptions(
      weight = 2,
      color = "#666",
      dashArray = "",
      fillOpacity = 0.4,
      bringToFront = TRUE)
    
  label_opts <- labelOptions(opacity = .7,
                 style = list("font-weight" = "normal",
                              padding = "2px 4px"),
                 textsize = "12px",
                 direction = "auto")

  base <- base %>%   
      addPolygons(data = dat_wgs84_tmp,
                  fillColor = ~pal(value),
                  group = zipvars[ii],
                  color = "white",
                  weight = 2,
                  opacity = .6,
                  dashArray = "3",
                  fillOpacity = 0.7,
                  highlight = highlight_opts,
                  label = lab,
                  labelOptions = label_opts) #%>% 
    # addLegend(pal = pal, values = ~value, group = zipvars[ii], position = "bottomright", title = zipvars[ii])
    

  }
  base %>% 
  # addLegend(pal = pal1,
  #           values = ~Kokonaislukema,
  #           opacity = 0.7,
  #           title = "",
  #           position = "bottomright") %>%
    addLayersControl(
      baseGroups = zipvars,
      options = layersControlOptions(collapsed = FALSE)
    ) %>% 
    leaflet.extras::addFullscreenControl()
  
}

#' Create zipcode bar chart
#' 
#' @param input_value_region_selected A numeric
#' @param input_value_regio_level A string
#' @param input_value_variable A string
#'
#' @export
plot_zipcodes_bar <- function(input_value_region_selected = 5,
                              input_value_regio_level = "Hyvinvointialueet",
                              input_value_variable = "Kokonaislukema"){
  
  region_data <- get_region_zipdata()
  dat <- process_zipdata(varname = input_value_variable)

  dat <- dat %>%
    mutate(color = ifelse(aluenimi %in% input_value_region_selected, TRUE, FALSE))

  naapurikoodit <- get_koodit_zip(regio_selected = input_value_region_selected,
                                  value_regio_level = input_value_regio_level)
  dat <- dat %>% filter(aluekoodi %in% naapurikoodit, 
                        !is.na(value))
  
  # luodaan alaotsikko
  kuvan_subtitle <- glue("Aluetaso: {input_value_regio_level}")
  
  dat$aluenimi <- paste0(dat$aluenimi, " (", dat$aluekoodi, ") ", dat$kuntanimi)
  med <- median(dat$value, na.rm = TRUE)
  
  if (input_value_regio_level == "Kunnat"){
    dat$value_nudge <- ifelse(dat$value >= 100, 
                              dat$value + med*.15, 
                              dat$value - med*.15)
  } else {
    dat$value_nudge <- ifelse(dat$value >= 100, 
                              dat$value + med*.22, 
                              dat$value - med*.22)
  }
  ggplot(data = dat, aes(y = reorder(aluenimi, value), 
                         x = value, 
                         fill = value)) +
    # geom_col() +
    # xlim(c(min(dat$value, na.rm = TRUE)*0.6,max(dat$value, na.rm = TRUE)*1.3)) +
    geom_vline(xintercept = 100, color = alpha("dim grey", 1/3), linetype = "dashed") +
    geom_segment(aes(x = 100, 
                     yend = reorder(aluenimi, value), 
                     xend = value), 
                 color = alpha("dim grey", 1/3), 
                 alpha=1, 
                 show.legend = FALSE) +
    geom_point(aes(fill = value), color = "dim grey", shape = 21, size = 5, show.legend = FALSE) + 
    geom_text(aes(label = round(value,0), 
                  x = value_nudge), 
              color = "black", 
              family = "Lato") +
    scale_fill_fermenter(palette = "YlGnBu", type = "seq", direction = 1) +
    scale_color_fermenter(palette = "YlGnBu", type = "seq", direction = 1) +
    theme_ipsum(base_family = "Lato",
                plot_title_family = "Lato",
                subtitle_family = "Lato",
                grid_col = "white",
                plot_title_face = "plain") + 
  theme(plot.title.position = "plot",
        legend.position = "none") +
    labs(title = glue("{input_value_variable}"),
         subtitle = kuvan_subtitle,
         caption = glue("Huono-osaisuus Suomessa -karttasovellus (Diak)\nData: Tilastokeskus Paavo (perusdata) & Diak (mediaanisuhteutus)\nTiedot haettu:{Sys.Date()}"),
         fill = paste0(add_line_break2(input_value_variable, 20), "\n(suhdeluku)")) -> p
  print(p)
}


#' Create zipcode bar chart
#' 
#' @param input_value_region_selected A numeric
#' @param input_value_regio_level A string
#' @param zipvars A string
#'
#' @export
plot_zipcodes_dotplot_alueprofiili <- function(input_value_region_selected = 5,
                              input_value_regio_level = "Hyvinvointialueet",
                              basesize = 12, 
                              dotsize = 4,
                              plottextsize = 3, 
                              zipvars = c('Kokonaislukema',
                                          'Alimpaan tuloluokkaan kuuluvat taloudet',
                                          'Alimpaan tuloluokkaan kuuluvat täysi-ikäiset',
                                          'Työttömät',
                                          'Peruskoulutuksen omaavat')){
  region_data <- get_region_zipdata()
  dat <- process_zipdata(varname = zipvars)
  naapurikoodit <- get_koodit_zip(regio_selected = input_value_region_selected,
                                  value_regio_level = input_value_regio_level)
  dat <- dat %>% filter(aluekoodi %in% naapurikoodit, 
                        !is.na(value))
  
  # luodaan alaotsikko
  kuvan_subtitle <- glue("Aluetaso: {input_value_regio_level}")
  
  dat$aluenimi <- paste0(dat$aluenimi, " (", dat$aluekoodi, ") ", dat$kuntanimi)
  med <- median(dat$value, na.rm = TRUE)
  
  if (input_value_regio_level == "Kunnat"){
    dat$value_nudge <- ifelse(dat$value >= 100, 
                              dat$value + med*.15, 
                              dat$value - med*.15)
  } else {
    dat$value_nudge <- ifelse(dat$value >= 100, 
                              dat$value + med*.22, 
                              dat$value - med*.22)
  }
  dat$variable <- factor(dat$variable, levels = zipvars)
  
  aluenimet <- arrange(dat[dat$variable == "Kokonaislukema",], value) %>% pull(aluenimi)
  dat$aluenimi <- factor(dat$aluenimi, levels = aluenimet)
  dat$variable <- add_line_break2(dat$variable, n = 15)
  
  ggplot(data = dat, aes(y = aluenimi, 
                         x = value, 
                         fill = value)) +
    geom_vline(xintercept = 100, color = alpha("dim grey", 1/3), linetype = "dashed") +
    geom_segment(aes(x = 100, 
                     yend = reorder(aluenimi, value), 
                     xend = value), 
                 color = alpha("dim grey", 1/3), 
                 alpha=1, 
                 show.legend = FALSE) +
    geom_point(aes(fill = value), color = "dim grey", shape = 21, size = dotsize, show.legend = FALSE) + 
    geom_text(aes(label = round(value,0), 
                  x = value_nudge),
              color = "black", 
              family = "Lato", size = plottextsize) +
    scale_fill_fermenter(palette = "YlGnBu", type = "seq", direction = 1) +
    scale_color_fermenter(palette = "YlGnBu", type = "seq", direction = 1) +
    theme_ipsum(base_family = "Lato", 
                plot_title_size = basesize+7, 
                strip_text_size = basesize+4, 
                subtitle_size =  basesize+5,
                base_size = basesize,
                plot_title_family = "Lato",
                subtitle_family = "Lato",
                grid_col = "white",
                plot_title_face = "plain") + 
    theme(plot.title.position = "plot",
          legend.position = "top") +
    labs(title = "Kaikki postinumeroaluetason osoittimet",
         subtitle = kuvan_subtitle,
         caption = glue("Huono-osaisuus Suomessa -karttasovellus (Diak)\nData: Tilastokeskus Paavo (perusdata) & Diak (mediaanisuhteutus)\nTiedot haettu:{Sys.Date()}"),
         fill = NULL
         ) +
    facet_wrap(~variable, nrow = 1, scales = "free_x") -> p
  print(p)
}

#' Create zipcode line chart
#' 
#' @param input_value_region_selected A numeric
#' @param input_value_regio_show_mode A string
#' @param input_value_variable A string
#'
#' @export
plot_zipcodes_line <- function(input_value_region_selected = 91,
                               # input_value_regio_show_mode = "kaikki tason alueet"
                               input_value_regio_level = "Kunnat",
                               # input_value_regio_show_mode = "kaikki tason alueet",
                               input_value_variable = "Kokonaislukema"){
  
  region_data <- get_region_zipdata()
  dat <- process_zipdata_timeseries(varname = input_value_variable)
  
  dat <- dat %>% 
    mutate(color = ifelse(aluenimi %in% input_value_region_selected, TRUE, FALSE))
  
  naapurikoodit <- get_koodit_zip(regio_selected = input_value_region_selected, 
                                  value_regio_level = input_value_regio_level)
  dat <- dat %>% filter(aluekoodi %in% naapurikoodit)
  
  # luodaan alaotsikko
  kuvan_subtitle <- glue("Aluetaso: {input_value_regio_level}")
  
  dat$aluenimi <- paste0(dat$aluenimi, " (", dat$aluekoodi, ")\n", dat$kuntanimi)
  
  aika1 <- sort(unique(dat$aika)) - 1
  aika2 <- sort(unique(dat$aika)) + 1
  labels <- paste0(aika1,"-",aika2)

  ggplot(data = dat, aes(y = value, 
                         x = aika, 
                         color = aluenimi,
                         group = aluenimi)) +
    geom_line() +
    # scale_fill_fermenter(palette = "YlGnBu", type = "seq", direction = 1) +
    # scale_color_fermenter(palette = "YlGnBu", type = "seq", direction = 1) +
    theme_ipsum(base_family = "Lato",
                plot_title_family = "Lato",
                subtitle_family = "Lato",
                plot_title_face = "plain") -> p
  
  # if (input_value_regio_show_mode == "kaikki tason alueet"){
  #    
  #   
  # } else if (input_value_regio_show_mode %in% c("valittu alue ja sen naapurit","valittu alue")){
  # p <- p + ggrepel::geom_text_repel(  
  p <- p + geom_text(
      data = dat %>% filter(aika == max(aika, na.rm = TRUE)),
      aes(x = aika, y = value, color= aluenimi,
          label = paste(aluenimi, round(value,1))),
      family = "Lato", nudge_x = .3)
  # }
  p + theme(plot.title.position = "plot",
            legend.position = "none",
            panel.grid.major.x = element_line(),
            panel.grid.minor.x = element_blank(),
            panel.grid.major.y = element_blank()) +
    scale_x_continuous(breaks = sort(unique(dat$aika)), labels = labels) +
    labs(title = glue("{input_value_variable}"),
         subtitle = kuvan_subtitle,
         caption = glue("Huono-osaisuus Suomessa -karttasovellus (Diak)\nData: Tilastokeskus Paavo (perusdata) & Diak (mediaanisuhteutus)\nTiedot haettu:{Sys.Date()}"),
         fill = paste0(add_line_break2(input_value_variable, 20), "\n(suhdeluku)"))
}


#' Create zipcode table
#' 
#' @param input_value_region_selected A numeric
#' @param input_value_regio_level A string
#'
#' @export
table_zipcodes <- function(input_value_region_selected = 91,
                           input_value_regio_level = "Kunnat", 
                           zipvars = c('Kokonaislukema',
                                       'Alimpaan tuloluokkaan kuuluvat taloudet',
                                       'Alimpaan tuloluokkaan kuuluvat täysi-ikäiset',
                                       'Työttömät',
                                       'Peruskoulutuksen omaavat'),
                           print = FALSE){
  
  naapurikoodit <- get_koodit_zip(regio_selected = input_value_region_selected,
                                  value_regio_level = input_value_regio_level)
  load(system.file("data", "dfzip_v20230224.rda", package="karttasovellus"))
  dfzip_v20230224 %>% 
    filter(aluekoodi %in% naapurikoodit) %>% 
    select(aluekoodi, aluenimi, variable, value) %>% 
    mutate(value = round(value, 1),
           variable = factor(variable, levels = zipvars)) %>% 
    arrange(variable) %>% 
    pivot_wider(names_from = variable, values_from = value) %>% 
    arrange(desc(Kokonaislukema)) -> tmpt
  if (print){
    print(kable(tmpt,
                format = "pipe", 
                row.names = FALSE))
  } else {
    gt::gt(tmpt)
  }
}


#' Alt text function
#' 
#' @param which_plot A string.
#' @param input_value_regio_level A string.
#' @param input_value_variable A string.
#' @param input_value_region_selected A string.
#'
#' @export
alt_txt_zipcode <- function(
  which_plot = "dotplot", # map # timeseries
  input_value_variable = "Huono-osaisuus yhteensä",
  input_value_regio_level = "Hyvinvointialueet",
  input_value_region_selected = "Etelä-Karjalan HVA"
){
  kuvatyyppi <- ifelse(which_plot == "dotplot", "Pistekuviossa", 
                       ifelse(which_plot == "map", "Kartassa", "Aikasarjakuviossa"))
  taytto <- ifelse(which_plot == "dotplot", "pisteiden väri", 
                   ifelse(which_plot == "map", "alueiden väri", "pisteiden ja viivan väri"))
  spessu <- ifelse(which_plot == "dotplot", 
                   "\nPistekuviossa vaaka-akselilla on osoittimen arvo ja pystyakselilla postinumeroalueiden nimet laskevassa järjestyksessä osoittimen arvon mukaan. Kunkin alueen pisteestä on vaakaviiva osoittimen mediaaniarvoon 100, jonka kohdalla on pystyviiva.", 
                   ifelse(which_plot == "map", 
                          "", 
                          ""))
  kertoo_mista <- ifelse(which_plot == "timeseries",
                         "erottaa alueiden aikasarjat toisistaan",
                         "kertoo osoittimen arvon niin että tummempi väri kertoo korkeammasta osoittimen arvosta")
  region_data <- get_region_data()
  regioname <- region_data[region_data$level == input_value_regio_level & region_data$region_code == input_value_region_selected, ]$region_name
  
  alt_teksti <- glue::glue("
{kuvatyyppi} näytetään osoittimen {input_value_variable} arvot kaikilla postinumeroalueilla, jotka kuuluvat alueeseen {regioname} aluetasolla {input_value_regio_level}. 
{kuvatyyppi} {taytto} {kertoo_mista}.{spessu}")
  
  return(alt_teksti)
}
DiakGit/karttasovellus documentation built on March 18, 2023, 12:06 p.m.