x_location_code <- params$location_code
x_tag <- params$tag
x_county_code <- fd::norway_locations()[municip_code==x_location_code]$county_code
x_location_name <- fd::get_location_name(x_location_code)

fd::initialize("sykdomspuls")

library(data.table)
library(ggplot2)
library(kableExtra)

d <- fd::tbl("spuls_standard_results") %>% 
  dplyr::filter(
    tag== !! x_tag & 
    county_code == !! x_county_code &
    granularity_time=="weekly") %>% 
  dplyr::collect() %>%
  fd::latin1_to_utf8()
if(x_location_code=="municip0301"){
  d <- d[location_code!="county03"]
}
yrwks_summary <- rev(unique(d[,yrwk]))[1:12]
yrwks_lines <- rev(unique(d[,yrwk]))[1:25]

d <- d[yrwk %in% yrwks_lines]

d[,status:=factor(
  status,
  levels=c("Normal","Medium","High")
)]

county_order <- fd::norway_locations_long()[location_code %in% d$location_code]
county_order <- rbind(county_order[.N],county_order[-.N])
county_order <- county_order[.N:1]
county_order[,location_name := factor(location_name, levels = location_name)]
d[,location_name:=NULL]
d[county_order,on="location_code", location_name:=location_name]

d[,age:=factor(age,levels=rev(names(CONFIG$AGES)))]
d[,yrwkdate:=glue::glue("{yrwk} ({date})",yrwk=yrwk,date=date)]

analyses_municip <- unique(d[yrwk %in% yrwks_summary[1] & status!="Normal", location_code])
analyses_municip <- c(x_location_code, analyses_municip[analyses_municip!=x_location_code])
tiles_municip <- function(pd){
  name_display <- pd$location_name[1]
  if(pd$location_code[1]==pd$county_code[1]){
    title <- glue::glue("Fylke: {name_display}")
  } else {
    title <- glue::glue("Kommune: {name_display}")
  }

  q <- ggplot(pd, aes(x = yrwkdate, y = age, fill = status))
  q <- q + geom_tile(colour = "black")
  q <- q + scale_fill_manual("",
    values = c(
      "Normal" = "#91bfdb", 
      "Medium" = "#ffffbf", 
      "High" = "#fc8d59"
      ),
    labels = c(
      "Forventet/lavere\nenn forventet",
      "H\u00F8yere\nenn forventet",
      "Betydelig h\u00F8yere\nenn forventet"
    ),
    drop = FALSE
  )
  q <- q + labs(title = title)
  q <- q + scale_x_discrete("\u00C5r-uke (dato)", expand=c(0,0))
  q <- q + scale_y_discrete("", expand=c(0,0))
  #q <- q + labs(caption = sprintf("Sist oppdatert: %s", strftime(dateData, format = "%d/%m/%Y")))
  q <- q + fhiplot::theme_fhi_basic(legend_position = "bottom")
  q <- q + fhiplot::set_x_axis_vertical()
  print(q)
}

lines_municip <- function(pd){
  name_display <- pd$location_name[1]
  if(pd$location_code[1]==pd$county_code[1]){
    title <- glue::glue("Fylke: {name_display}")
  } else {
    title <- glue::glue("Kommune: {name_display}")
  }

  pd[,age:=factor(age,levels=names(CONFIG$AGES))]
  pd[,xval:=1:.N, by =age]

  labs <- pd[age == "Totalt"]
  labs <- labs[seq(1,.N,2),c("xval","yrwkdate","yrwk")]

  pd_nor <- pd[status=="Normal"]
  pd_med <- pd[status=="Medium"]
  pd_hig <- pd[status=="High"]

  q <- ggplot(pd, aes(x=xval))
  q <- q + lemon::facet_rep_wrap(~age, repeat.tick.labels = "y", ncol=2, scales="free_y")
  q <- q + geom_ribbon(aes(ymin = -Inf, ymax = threshold2, fill = "1low"))
  q <- q + geom_ribbon(aes(ymin = threshold2, ymax = threshold4, fill = "2med"))
  q <- q + geom_ribbon(aes(ymin = threshold4, ymax = Inf, fill = "3hig"))
  q <- q + geom_line(aes(y=n))
  if(nrow(pd_med)>0){
    q <- q + geom_point(data=pd_med, mapping=aes(y=n), size=3)
    q <- q + geom_point(data=pd_med, mapping=aes(y=n, colour = "2med"), size=1)
  }
  if(nrow(pd_hig)>0){
    q <- q + geom_point(data=pd_hig, mapping=aes(y=n), size=3)
    q <- q + geom_point(data=pd_hig, mapping=aes(y=n, colour = "3hig"), size=1)
  }
  q <- q + expand_limits(y=0)
  q <- q + labs(title = title)
  q <- q + scale_y_continuous("Konsultasjoner", expand=c(0,0))
  q <- q + scale_x_continuous(
    "\u00C5r-uke",
    breaks=labs$xval,
    labels=labs$yrwk,
    expand = expand_scale(mult = c(0, 0.02))
    )
  q <- q + scale_fill_manual("",
    values = c(
      "1low" = "#91bfdb",
      "2med" = "#ffffbf",
      "3hig" = "#fc8d59"
      ),
    labels = c(
      "Forventet/lavere\nenn forventet",
      "H\u00F8yere\nenn forventet",
      "Betydelig h\u00F8yere\nenn forventet"
    ),
    drop = FALSE
  )
  q <- q + scale_color_manual("",
    values = c(
      "1low" = "#91bfdb",
      "2med" = "#ffffbf",
      "3hig" = "#fc8d59"
      ),
    labels = c(
      "Forventet/lavere\nenn forventet",
      "H\u00F8yere\nenn forventet",
      "Betydelig h\u00F8yere\nenn forventet"
    ),
    drop = FALSE
  )
  q <- q + guides(color = FALSE)
  q <- q + fhiplot::theme_fhi_lines(legend_position = "bottom")
  q <- q + fhiplot::set_x_axis_vertical()
  print(q)
}

Varselkilde (r x_location_name)

pd <- d[yrwk %in% yrwks_summary & location_code==x_location_code]
tiles_municip(pd)
pd <- d[yrwk %in% yrwks_lines & location_code==x_location_code]
lines_municip(pd)

Fylkesoversikt

for(x_age in names(CONFIG$AGES)){
  pd <- d[yrwk %in% yrwks_summary & age==x_age] 

  q <- ggplot(pd, aes(x = yrwkdate, y = location_name, fill = status))
  q <- q + geom_tile(colour = "black")
  q <- q + scale_fill_manual("",
    values = c(
      "Normal" = "#91bfdb", 
      "Medium" = "#ffffbf", 
      "High" = "#fc8d59"
      ),
    labels = c(
      "Forventet/lavere\nenn forventet",
      "H\u00F8yere\nenn forventet",
      "Betydelig h\u00F8yere\nenn forventet"
    ),
    drop = FALSE
  )
  q <- q + labs(title = glue::glue("Aldersgruppe: {x_age}"))
  q <- q + scale_x_discrete("\u00C5r-uke (dato)", expand=c(0,0))
  q <- q + scale_y_discrete("", expand=c(0,0))
  #q <- q + labs(caption = sprintf("Sist oppdatert: %s", strftime(dateData, format = "%d/%m/%Y")))
  q <- q + fhiplot::theme_fhi_basic(legend_position = "bottom")
  q <- q + fhiplot::set_x_axis_vertical()
  print(q)
  cat("\\newpage\n\n")
}

\newpage

Område med høyere enn forventet konsultasjoner i nærheten

for(i in analyses_municip){
  pd <- d[yrwk %in% yrwks_summary & location_code==i]
  tiles_municip(pd)
  cat("\\newpage\n\n")
  pd <- d[yrwk %in% yrwks_lines & location_code==i]
  lines_municip(pd)
  cat("\\newpage\n\n")
}


folkehelseinstituttet/dashboards_ui documentation built on May 12, 2020, 10:10 p.m.