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) }
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)
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
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") }
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.