In rplzzz/vdhcovid: COVID-19 data by health district from Virginia Department of Health

knitr::opts_chunk$set(echo = FALSE)
library('vdhcovid')
library('ggplot2')
library('ggthemes')
library('dplyr')

plotdist <- function(district, yrng=NULL) 
{
  pltdata <-
    dplyr::filter(vaweeklytests, HealthDistrict==district) %>%
    group_by(week, date) %>%
    summarise(ntest=sum(ntest), npos=sum(npos), neff=sum(neff), nposeff=sum(nposeff)) %>%
    mutate(fpos=npos/ntest, fposeff=nposeff/neff)

  plt <- 
    ggplot(pltdata, aes(x=date)) + 
    geom_point(aes(y=fpos, color='nominal'), size=1.5) +
    geom_point(aes(y=fposeff, color='effective'), size=1.5,
               position=position_jitter(width=0, height=0.005)) +
    scale_color_solarized() + 
    ylab('Positive test fraction') +
    labs(color='type', title=paste(district, 'Health District')) +
    theme_bw(14)

  if(is.null(yrng)) {
    plt
  }
  else {
    plt + coord_cartesian(ylim=yrng)
  }
}

testposcmp <- function(district=NA, mindate=as.Date('2020-07-01'))
{
    testdata <-
      dplyr::select(vaweeklytests, HealthDistrict, date, ntest, npos, neff, nposeff) %>%
      dplyr::filter(date >= mindate)

    if(!is.na(district)) {
      testdata <- dplyr::filter(testdata, HealthDistrict == district)
    }

    testdata <-
      group_by(testdata, date) %>%
      summarise(ntest=sum(ntest), npos=sum(npos), neff=sum(neff), nposeff=sum(nposeff)) %>%
      mutate(fpos=npos/ntest, fposeff=nposeff/neff)

    rawd <- 
      dplyr::select(testdata, date, ntest, fpos) %>%
      tidyr::pivot_longer(-date, names_to='var') %>%
      mutate(method = 'raw count')

    effd <-
      dplyr::select(testdata, date, neff, fposeff) %>%
      dplyr::rename(ntest=neff, fpos=fposeff) %>%
      tidyr::pivot_longer(-date, names_to='var') %>%
      mutate(method = 'effective count')

    pltdata <- dplyr::bind_rows(rawd, effd)

    ntraw <- testdata$ntest
    fpraw <- testdata$fpos
    rawcor <- cor(ntraw, fpraw, method='kendall')

    nteff <- testdata$neff
    fpeff <- testdata$fposeff
    effcor <- cor(nteff, fpeff, method='kendall')

    message('Raw correlation: ', signif(rawcor, 2))
    message('Effective correlation: ', signif(effcor, 2))

    if(is.na(district)) {
      titlestr = 'Statewide'
    }
    else {
      titlestr = paste(district, 'district')
    }

    ggplot(pltdata, aes(x=date, y=value, color=method)) +
      facet_wrap(~var, ncol=1, scales='free_y') +
      geom_line(size=1.2) +
      ggtitle(titlestr) +
      ylab('') +
      scale_color_solarized() +
      theme_bw()
}

Statewide weekly positive test fraction

ptfstate <- dplyr::group_by(vaweeklytests, week, date) %>%
  summarise(ntest=sum(ntest), npos=sum(npos), neff=sum(neff), nposeff=sum(nposeff)) %>%
  mutate(fpos=npos/ntest, fposeff=nposeff/neff)

ggplot(ptfstate, aes(x=date)) + 
  geom_point(aes(y=fpos, color='nominal'), size=1.5) +
  geom_point(aes(y=fposeff, color='effective'), size=1.5, position=position_jitter(width=0, height=0.005)) +
  scale_color_solarized() + 
  ylab('Positive test fraction') +
  coord_cartesian(ylim=c(0,0.25)) + 
  labs(color='type', title='Commonwealth of Virginia') +
  theme_bw(14)

Positive test fractions for particular districts of interest

Thomas Jefferson District

plotdist('Thomas Jefferson')

Fairfax District

plotdist('Fairfax', c(0,0.4))

Portsmouth District

plotdist('Portsmouth')

Summary plot of all districts

ptfall <-
  group_by(vaweeklytests, week, date, HealthDistrict) %>%
  summarise(ntest=sum(ntest), npos=sum(npos), neff=sum(neff), nposeff=sum(nposeff)) %>%
  mutate(fpos=npos/ntest, fposeff=nposeff/neff)

ggplot(ptfall, aes(x=date)) + 
  geom_point(aes(y=fpos, color='nominal'), size=1.5) +
  geom_point(aes(y=fposeff, color='effective'), size=1.5, position=position_jitter(width=0, height=0.005)) +
  facet_wrap(~HealthDistrict, ncol=4, scales='free_y') +
  scale_color_solarized() + 
  ylab('Positive test fraction') +
  labs(color='type', title='Positive test fractions by district') +
  #coord_cartesian(ylim=c(0,0.4)) +
  theme_bw(14)

rplzzz/vdhcovid documentation built on July 2, 2021, 7:43 a.m.