In folkehelseinstituttet/dashboards_sykdomspuls: Depreciated - to be removed

fhi::DashboardInitialiseOpinionated("sykdomspuls",
                                    PACKAGE_DIR=params$package_dir,
                                    FORCE_DEV_PACKAGE_LOAD = params$dev,
                                    SILENT=TRUE)

suppressMessages(library(data.table))
suppressMessages(library(ggplot2))
suppressMessages(library(lubridate))
suppressMessages(library(kableExtra))
suppressMessages(library(fhiplot))

data <- AnalyseStats1()
alerts_z_2 <- data[["alert_summary"]][["z_2"]]
alerts_z_4 <- data[["alert_summary"]][["z_4"]]
resYearLine <- data[["resYearLine"]]
resYearLineMunicip <- data[["resYearLineMunicip"]]


conn <- DBI::dbConnect(odbc::odbc(),
    driver = fd::config$db_config$driver,
    server = fd::config$db_config$server,
    port = fd::config$db_config$port,
    user = fd::config$db_config$user,
    password = fd::config$db_config$password
    )
fd::use_db(conn, fd::config$db_config$db)
db <- dplyr::tbl(conn, "spuls_qp_diagnostics")
diagnostics <- db %>% dplyr::filter(location_code %like% 'municip%') %>% dplyr::collect()
setDT(diagnostics)



NorwayScale <- function(x, ...){
  arguments <- list(...)
  for (i in seq_along(arguments)) {
    if(names(arguments)[[i]]=="nsmall"){
      x <- round(x,arguments[[i]])
    }
  }

  retval <- format(x, ..., big.mark = ".", decimal.mark = 
",", scientific = FALSE) 
  retval <- stringr::str_replace_all(retval," ","")
  retval <- stringr::str_replace_all(retval,"NaN","")
  #retval <- paste0(" ",retval)
  return(retval)
}


alertChartByYear <- function(alerts){
  return (
   ggplot(alerts[!grepl("emerg", tag, fixed=TRUE),.N, by=.(year(floor_date(date, unit="year")), tag)]) +
     geom_col(aes(x=year,y=N), fill=fhiplot::base_color) + lemon::facet_rep_wrap(~tag, repeat.tick.labels = "y") +
     theme_fhi_lines() + fhiplot::set_x_axis_vertical() + 
     xlab("Year") +
     scale_fill_brewer(palette="Spectral")
  )
}


plotZscore <- function(data){
  return ( 
    ggplot(data) +
      geom_histogram(aes(x=zscore, y=..density..,
                         fill="Z-scores from data", colour="Z-scores from data")) +
      stat_function(fun = dnorm, n = 1001, args = list(mean = 0, sd = 1), 
                    aes(fill="Standard Normal Distribution",
                        colour="Standard Normal Distribution"),size=1) + 
      xlim(-7, 7) + 
      scale_fill_manual("Legend", values=c(fhiplot::vals$cols$primary[["B2"]],
                                           fhiplot::vals$cols$primary[["B1"]])) +
      scale_colour_manual("Legend", values=c(fhiplot::vals$cols$primary[["B2"]],
                                             fhiplot::vals$cols$primary[["B1"]]), guide="none") +
     theme_fhi_lines(legend_position = "bottom")
  )

}

Statistical properties

cat("Regression analysis failed for ", nrow(resYearLine[failed == TRUE]) + nrow(resYearLineMunicip[failed == TRUE]), "weeks")
cat("  \n \\medskip  \n ")

 if(nrow(resYearLine[failed == TRUE]) > 0){


    table <- resYearLine[failed == TRUE, .N, by=.(location_code)][data.table(fhidata::norway_locations_current), on=.(location_code=county_code), nomatch=0]

    k <- knitr::kable(table[order(-N), .(county_name, N)], "latex",
                      booktabs = T,
                      align = "c",
                      linesep = ""
                      ) %>%
      kableExtra::kable_styling(latex_options = "HOLD_position")
    print(k)


    k <- knitr::kable(resYearLine[failed == TRUE, .N, by=.(tag)][order(-N)], "latex",
                      booktabs = T,
                      align = "c",
                      linesep = ""
                      ) %>%
      kableExtra::kable_styling(latex_options = "HOLD_position")
   print(k)

 }
 if(nrow(resYearLineMunicip[failed == TRUE]) > 0){
    table <- resYearLineMunicip[failed == TRUE, .N, by=.(location_code)][data.table(fhidata::norway_locations_current), on=.(location_code=municip_code), nomatch=0]



    n_rows <- nrow(table)
    if(n_rows > 15){
       n_rows <- 15
    }
    if(n_rows == 35){
       cat("(top 35)\n")
    }
    k <- knitr::kable(table[order(-N), .(municip_name, N)][1:n_rows], "latex",
                      booktabs = T,
                      align = "c",
                      linesep = "",
                      caption = "Number of fails by municipality"
                      )%>%
      kableExtra::kable_styling(latex_options = "HOLD_position")
    print(k)


    k <- knitr::kable(resYearLineMunicip[failed == TRUE, .N, by=.(tag)][order(-N)], "latex",
                      booktabs = T,
                      align = "c",
                      linesep = "",
                      caption = "Weeks when regression failed by condition"
                      )%>%
      kableExtra::kable_styling(latex_options = "HOLD_position")
   print(k)


 }

\newpage

Z-scores from regional Level

cat(glue::glue('Comparing the observed z-scores from the regression model with a standard normal for counties'))
cat("\n\n")
plotZscore(resYearLine)
cat("\n\n")
n_tot = nrow(resYearLine)

cat("Observed ", nrow(resYearLine[zscore >=2]), " alerts with z>2 compared to  an expected ", round((1 - pnorm(2, 0, 1)) * n_tot, 0)," and we observed " , nrow(resYearLine[zscore >=4]), " alerts with z>4 compared to an expected" , round((1 - pnorm(4, 0, 1)) * n_tot,0), ".")

\newpage

Z-scores from municipal level

cat(glue::glue('Comparing the observed z-scores from the regression model with a standard normal for municipalties'))
cat("\n\n")
plotZscore(resYearLineMunicip)
cat("\n\n")
n_tot = nrow(resYearLineMunicip)
cat("Observed ", nrow(resYearLineMunicip[zscore >=2]), " alerts with z>2 compared to  an expected ", round((1 - pnorm(2, 0, 1)) * n_tot, 0)," and we observed " , nrow(resYearLineMunicip[zscore >=4]), " alerts with z>4 compared to an expected" , round((1 - pnorm(4, 0, 1)) * n_tot,0), ".")

Alerts by Municipality size

pop <- fhidata::norway_population_current

pop <- data.table(pop)[year==max(resYearLineMunicip[, year]), .(pop=sum(pop)), by=.(location_code)]

n_alerts = resYearLineMunicip[, .(N_z2=sum(status=="Medium"), N_z4=sum(status=="High")), by=.(location_code)]

n_alerts <- n_alerts[pop, on="location_code", nomatch=0]

n_alerts[, size:= "empty"]
n_alerts[size=="empty" & pop < 10000, size:="Small (< 10,000)"]
n_alerts[size=="empty" & pop <= 100000, size:="Medium(10,000- 100,000)"]
n_alerts[size=="empty" & pop > 100000, size:="Large(> 100,000)"]


table <- n_alerts[, .(N=.N, N_z2=sum(N_z2), N_z4=sum(N_z4)),keyby=size]

table[, N_z2_per_mun:=N_z2/N]
table[, N_z4_per_mun:=N_z4/N]

names(table) <- c("Municipality size", "Municipalties", "N (z>2)",
                  "N (z>4)", "N (z>2) per municip",
                  "N(z>4) per municip")

k <- knitr::kable(table, "latex",
                  booktabs = T,
                  digits=2,
                  align = "c",
                  linesep = ""
                  )%>%
      kableExtra::kable_styling(latex_options = "HOLD_position")
print(k)

\newpage

Number of alerts

for(xtag in unique(alerts_z_2$tag)){
  cat("  \n  \n ")
  cat("## ",xtag," alerts per area per year  \n")
  ## cat(tufte::margin_note(glue::glue('
  ##                                   We compare the number of alerts ("\\# Alerts"), \
  ##                                   number of cases ("\\# Cases"), and number of cases \
  ##                                   greater than expected ("Cases>Expected") under two \
  ##                                   different alert designations: a) Z-score>2, and b) Z-score>4
  ##                                   ')))

  tabd <- alerts_z_2[tag==xtag, c("subtype","expected",
                  names(alerts_z_2)[4:7]), with=FALSE]
  setnames(tabd,c("Area","Expected",
                  names(tabd)[4:7]))



  k <- knitr::kable(tabd, "latex",
                    booktabs = T,
                    align = "c",
                    linesep = "",
                    digits=2,
                    caption = "Alerts with 2 < Z < 4"
                    ) %>%
      kableExtra::kable_styling(latex_options=c("HOLD_position"))

  cat(k)
  tabd <- alerts_z_4[tag==xtag, c("subtype","expected",
                  names(alerts_z_2)[4:7]), with=FALSE]
  setnames(tabd,c("Area","Expected",
                  names(tabd)[4:7]))

  cat("\\medskip")
  k <- knitr::kable(tabd, "latex",
                    booktabs = T,
                    align = "c",
                    linesep = "",
                    digits=2,
                    caption = "Alerts with Z > 4"
                    )%>%
      kableExtra::kable_styling(latex_options=c("HOLD_position"))


  cat(k)


  cat(" \\newpage ")
}

Regression Parameters - Municipalities

for(tag_name in unique(diagnostics[, tag])){
    for(time_gran in c("weekly")){
      cat("##", tag_name, " ",  time_gran, "\n")
      for(column in colnames(diagnostics)){
        if(paste(column, "_se", sep="") %in% colnames(diagnostics)){
          values <- diagnostics[tag==tag_name & age=="Totalt" & granularity_time==time_gran, get(column)]
          if(!all(is.na(values))){
            q <- quantile(values, probs=c(0.01, 0.99), na.rm=TRUE)
            trimmed_values <- values[values > q[["1%"]] & values < q[["99%"]]]
            q <- ggplot() + geom_histogram(aes(trimmed_values), bins=30, fill=fhiplot::base_color) +
              xlab(column) + 
              theme_fhi_lines()
            cat("\n\n")
            print(q)
            cat("\n\n")
          }
        }
    }
    cat("\\newpage \n")
  }

}