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))
}
}
}