cloudspotter86
10/5/2018 - 10:55 PM

gender_age_year table

make_table = function(dataframe, var1, var2, measure) {

  counts = dataframe %>% 
    group_by_(var1,var2) %>%
    summarise(Count = n())  %>%
    ungroup() %>%
    as.data.frame()
  
  if (measure == "Count"){
    tab <-  counts
    tab = tab %>% select(var1, var2, measure) %>% spread(var2, measure) ; tab[is.na(tab)] = 0
    
    regulartable(tab) %>% 
      bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
      fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
      set_formatter( `2008` = function(x) sprintf("%0.0f", x),
                     `2009` = function(x) sprintf("%0.0f", x),
                     `2010` = function(x) sprintf("%0.0f", x),
                     `2011` = function(x) sprintf("%0.0f", x), 
                     `2012` = function(x) sprintf("%0.0f", x), 
                     `2013` = function(x) sprintf("%0.0f", x),
                     `2014` = function(x) sprintf("%0.0f", x),
                     `2015` = function(x) sprintf("%0.0f", x), 
                     `2016` = function(x) sprintf("%0.0f", x), 
                     `2017` = function(x) sprintf("%0.0f", x))
    
  } else if (measure == "Rate"){
    denoms <- denominators10 %>%
      filter(HA == "BC")  %>% 
      gather(key = !!var1, value = "Population", c("All", "Female", "Male")) %>%
      group_by_(var1, var2) %>%
      summarise(Population = sum(Population))

     if (var1 == "Gender"){
      denoms = denoms %>% filter(Gender != "All")
      counts = counts %>% filter(!(Gender %in% c("Transgender", "Unknown")))
     }
      
      tab = full_join(counts, denoms, by = c(var1, var2))
      tab$Rate = round(tab$Count/tab$Population*100000,1)
      tab <-  tab %>% select(var1, var2, Rate) %>% 
        spread(var2, Rate)
      
      regulartable(tab) %>% 
        bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
        fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
        set_formatter( `2008` = function(x) sprintf("%0.1f", x),
                       `2009` = function(x) sprintf("%0.1f", x),
                       `2010` = function(x) sprintf("%0.1f", x),
                       `2011` = function(x) sprintf("%0.1f", x), 
                       `2012` = function(x) sprintf("%0.1f", x), 
                       `2013` = function(x) sprintf("%0.1f", x),
                       `2014` = function(x) sprintf("%0.1f", x),
                       `2015` = function(x) sprintf("%0.1f", x), 
                       `2016` = function(x) sprintf("%0.1f", x), 
                       `2017` = function(x) sprintf("%0.1f", x))
      

    }  else if (measure == "Proportion"){
      tab = counts %>% 
        group_by_(var2) %>% 
        mutate(Proportion = round(100*Count/sum(Count),1)) %>% 
        select(var1, var2, Proportion) %>%
        spread(var2, Proportion) ; tab[is.na(tab)] = 0
        
        regulartable(tab) %>% 
          bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
          fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
          set_formatter( `2008` = function(x) sprintf("%0.1f", x),
                         `2009` = function(x) sprintf("%0.1f", x),
                         `2010` = function(x) sprintf("%0.1f", x),
                         `2011` = function(x) sprintf("%0.1f", x), 
                         `2012` = function(x) sprintf("%0.1f", x), 
                         `2013` = function(x) sprintf("%0.1f", x),
                         `2014` = function(x) sprintf("%0.1f", x),
                         `2015` = function(x) sprintf("%0.1f", x), 
                         `2016` = function(x) sprintf("%0.1f", x), 
                         `2017` = function(x) sprintf("%0.1f", x))
      }

}


# working on a version where ha_surveillance is an optional var
###########################

make_gender_table = function(dataframe, var1, var2, measure) {  # can I add an optional var3 for nested tables?? ? 
  
    if (dataframe$disease[1] %in%  c("Gonorrhea", "Chlamydia")){
    dataframe = dataframe %>% filter(Site == "Genital")
  } else if (dataframe$disease[1] == "Syphilis") {
    dataframe = dataframe %>% filter(surveillance_condition == "Syphilis (infectious)")
  }
  
  if (var2 == "Age_group_10"){
    counts = dataframe %>% 
      group_by_(var1,var2) %>%
      summarise(Count = n())  %>%
      ungroup() %>%
      as.data.frame()
    
    if (measure == "Count"){
      tab <-  counts
      tab = tab %>% select(var1, var2, measure) %>% spread(var2, measure) %>%
        rename(Unknown = `Age Cannot Be Calculated`); tab[is.na(tab)] = 0
      
      regulartable(tab) %>% 
        bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
        fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
        set_formatter( `<1 Year` = function(x) sprintf("%0.0f", x),
                       `1-4 Years` = function(x) sprintf("%0.0f", x),
                       `5-9 Years` = function(x) sprintf("%0.0f", x),
                       `10-14 Years` = function(x) sprintf("%0.0f", x),
                       `15-19 Years` = function(x) sprintf("%0.0f", x), 
                       `20-24 Years` = function(x) sprintf("%0.0f", x), 
                       `25-29 Years` = function(x) sprintf("%0.0f", x),
                       `30-39 Years` = function(x) sprintf("%0.0f", x),
                       `40-59 Years` = function(x) sprintf("%0.0f", x), 
                       `60+ Years` = function(x) sprintf("%0.0f", x), 
                       `Unknown` = function(x) sprintf("%0.0f", x)) 
      
    } else if (measure == "Rate"){
      denoms <- denominators10 %>%
        filter(HA == "BC")  %>% 
        gather(key = !!var1, value = "Population", c("All", "Female", "Male")) %>%
        group_by_(var1, var2) %>%
        summarise(Population = sum(Population))
      
      if (var1 == "Gender"){
        denoms <- denominators10 %>%
          filter(HA == "BC")  %>% 
          gather(key = !!var1, value = "Population", c("All", "Female", "Male")) %>%
          group_by_(var1, var2) %>%
          summarise(Population = sum(Population))
        
         denoms = denoms %>% filter(Gender != "All")
        counts = counts %>% filter(!(Gender %in% c("Transgender", "Unknown")))
      } else if (var1 == "ha_surveillance"){
        denoms <- denominators10 %>%
          filter(HA == "BC")  %>% 
          gather(key = !!var1, value = "Population", c("All", "Female", "Male")) %>%
          group_by_(var1, var2) %>%
          summarise(Population = sum(Population))
        
      }
        
      
      tab = full_join(counts, denoms, by = c(var1, var2))
      tab$Rate = round(tab$Count/tab$Population*100000,1)
      tab <-  tab %>% select(var1, var2, Rate) %>% 
        spread(var2, Rate)
      
      regulartable(tab) %>% 
        bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
        fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
        set_formatter( `2008` = function(x) sprintf("%0.1f", x),
                       `2009` = function(x) sprintf("%0.1f", x),
                       `2010` = function(x) sprintf("%0.1f", x),
                       `2011` = function(x) sprintf("%0.1f", x), 
                       `2012` = function(x) sprintf("%0.1f", x), 
                       `2013` = function(x) sprintf("%0.1f", x),
                       `2014` = function(x) sprintf("%0.1f", x),
                       `2015` = function(x) sprintf("%0.1f", x), 
                       `2016` = function(x) sprintf("%0.1f", x), 
                       `2017` = function(x) sprintf("%0.1f", x))
      
      
    }  else if (measure == "Proportion"){
      tab = counts %>% 
        group_by_(var2) %>% 
        mutate(Proportion = round(100*Count/sum(Count),1)) %>% 
        select(var1, var2, Proportion) %>%
        spread(var2, Proportion) ; tab[is.na(tab)] = 0
        
        regulartable(tab) %>% 
          bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
          fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
          set_formatter( `2008` = function(x) sprintf("%0.1f", x),
                         `2009` = function(x) sprintf("%0.1f", x),
                         `2010` = function(x) sprintf("%0.1f", x),
                         `2011` = function(x) sprintf("%0.1f", x), 
                         `2012` = function(x) sprintf("%0.1f", x), 
                         `2013` = function(x) sprintf("%0.1f", x),
                         `2014` = function(x) sprintf("%0.1f", x),
                         `2015` = function(x) sprintf("%0.1f", x), 
                         `2016` = function(x) sprintf("%0.1f", x), 
                         `2017` = function(x) sprintf("%0.1f", x))
    }
    
    
  } else if (var2 == "Year"){
  
  counts = dataframe %>% 
    group_by_(var1,var2) %>%
    summarise(Count = n())  %>%
    ungroup() %>%
    as.data.frame()
  
  if (measure == "Count"){
    tab <-  counts
    tab = tab %>% select(var1, var2, measure) %>% spread(var2, measure) ; tab[is.na(tab)] = 0
    
    regulartable(tab) %>% 
      bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
      fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
      set_formatter( `2008` = function(x) sprintf("%0.0f", x),
                     `2009` = function(x) sprintf("%0.0f", x),
                     `2010` = function(x) sprintf("%0.0f", x),
                     `2011` = function(x) sprintf("%0.0f", x), 
                     `2012` = function(x) sprintf("%0.0f", x), 
                     `2013` = function(x) sprintf("%0.0f", x),
                     `2014` = function(x) sprintf("%0.0f", x),
                     `2015` = function(x) sprintf("%0.0f", x), 
                     `2016` = function(x) sprintf("%0.0f", x), 
                     `2017` = function(x) sprintf("%0.0f", x))
    
  } else if (measure == "Rate"){
    denoms <- denominators10 %>%
      filter(HA == "BC")  %>% 
      gather(key = !!var1, value = "Population", c("All", "Female", "Male")) %>%
      group_by_(var1, var2) %>%
      summarise(Population = sum(Population))
    
    if (var1 == "Gender"){
      denoms = denoms %>% filter(Gender != "All")
      counts = counts %>% filter(!(Gender %in% c("Transgender", "Unknown")))
    }
    
    tab = full_join(counts, denoms, by = c(var1, var2))
    tab$Rate = round(tab$Count/tab$Population*100000,1)
    tab <-  tab %>% select(var1, var2, Rate) %>% 
      spread(var2, Rate)
    
    regulartable(tab) %>% 
      bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
      fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
      set_formatter( `2008` = function(x) sprintf("%0.1f", x),
                     `2009` = function(x) sprintf("%0.1f", x),
                     `2010` = function(x) sprintf("%0.1f", x),
                     `2011` = function(x) sprintf("%0.1f", x), 
                     `2012` = function(x) sprintf("%0.1f", x), 
                     `2013` = function(x) sprintf("%0.1f", x),
                     `2014` = function(x) sprintf("%0.1f", x),
                     `2015` = function(x) sprintf("%0.1f", x), 
                     `2016` = function(x) sprintf("%0.1f", x), 
                     `2017` = function(x) sprintf("%0.1f", x))
    
    
  }  else if (measure == "Proportion"){
    tab = counts %>% 
      group_by_(var2) %>% 
      mutate(Proportion = round(100*Count/sum(Count),1)) %>% 
      select(var1, var2, Proportion) %>%
      spread(var2, Proportion) ; tab[is.na(tab)] = 0
      
      regulartable(tab) %>% 
        bg(bg = "#E6E6E6", part = "header") %>% bold(part = "header") %>% 
        fontsize(size = 10, part = "all") %>% font(part = "all", fontname = "Arial") %>%
        set_formatter( `2008` = function(x) sprintf("%0.1f", x),
                       `2009` = function(x) sprintf("%0.1f", x),
                       `2010` = function(x) sprintf("%0.1f", x),
                       `2011` = function(x) sprintf("%0.1f", x), 
                       `2012` = function(x) sprintf("%0.1f", x), 
                       `2013` = function(x) sprintf("%0.1f", x),
                       `2014` = function(x) sprintf("%0.1f", x),
                       `2015` = function(x) sprintf("%0.1f", x), 
                       `2016` = function(x) sprintf("%0.1f", x), 
                       `2017` = function(x) sprintf("%0.1f", x))
  }
  } 
}