knitr::opts_chunk$set(fig.width = 12)
mytheme <- gridExtra::ttheme_default( core = list(fg_params=list(cex = .5)), colhead = list(fg_params=list(cex = .5)), rowhead = list(fg_params=list(cex = .5)) ) get_row_bg <- function(df) { rowtotal <- 'Total' %in% names(df) if (rowtotal) x <- df %>% dplyr::select(-Total) mask <- vapply(x, is.numeric, logical(1)) cols <- t(scale(t(as.matrix(x[mask])))) %>% apply(., 1, function(x) dplyr::case_when( x < -2 ~ '#198c19', dplyr::between(x, -2, -1.5) ~ '#4ca64c', dplyr::between(x, -1.5, -1) ~ '#7fbf7f', dplyr::between(x, -1, -.5) ~ '#b2d8b2', dplyr::between(x, -.5, 0) ~ '#e5f2e5', dplyr::between(x, 0, .5) ~ '#ffe5e5', dplyr::between(x, .5, 1) ~ '#ffb2b2', dplyr::between(x, 1, 1.5) ~ '#ff7f7f', dplyr::between(x, 1.5, 2) ~ '#ff4c4c', x > 2 ~ '#ff1919', TRUE ~ 'black' )) %>% t() %>% cbind(matrix(rep('grey', sum(!mask) * nrow(.)), ncol = sum(!mask)), .) if (rowtotal) { cols %<>% cbind(matrix(rep('grey', nrow(.)), ncol = 1)) } return(cols) } row_heat_table <- . %>% tableGrob( row = NULL, theme = ttheme_default( core = list(fg_params = list(cex = .5), bg_params = list(fill = get_row_bg(.))), colhead = list(fg_params = list(cex = .5)), rowhead = list(fg_params = list(cex = .5))) ) grob_binder <- function(ggrob, tgrob) { tgrob$heights <- unit.pmax(tgrob$heights)#, unit(2, 'lines')) tgrob$widths <- unit(rep(1/ncol(tgrob), ncol(tgrob)), 'npc') ggrob %<>% gtable_add_rows(., sum(tgrob$heights)) ggrob %<>% gtable_add_grob(., grobs = tgrob, t = nrow(ggrob), l = 4, b = nrow(ggrob), r = 4) grid.draw(ggrob) invisible(ggrob) } ggpareto <- function( df, filter, title ) { df %<>% df_checker() %>% dplyr::filter_( filter ) xlabel <- 'Call Area' ylabel <- 'Count of Complaints' x <- na.omit(df[, 'Call_Area']) %>% dplyr::rename(modality = Call_Area) Df <- x %>% dplyr::group_by( modality ) %>% dplyr::summarise( frequency = n() ) %>% dplyr::arrange( -frequency ) Df$modality <- ordered( Df$modality, levels = unlist(Df$modality, use.names = FALSE) ) Df %<>% dplyr::mutate( modality_int = as.integer(modality), cumfreq = cumsum(frequency), cumperc = cumfreq / nrow(x) * 100 ) nr <- nrow(Df) N <- sum(Df$frequency) Df_ticks <- data.frame(xtick0 = rep(nr +.55, 11), xtick1 = rep(nr +.59, 11), ytick = seq(0, N, N/10)) y2 <- c(' 0%', ' 10%', ' 20%', ' 30%', ' 40%', ' 50%', ' 60%', ' 70%', ' 80%', ' 90%', ' 100%') g <- ggplot( Df, aes(x = modality, y = frequency) ) + geom_bar( stat='identity', aes(fill='red') ) + geom_text( aes(x= modality, y = 0, label = frequency, vjust = -1), size = 2.5 ) + geom_line( aes(x = modality_int, y = cumfreq) ) + geom_point( aes(x = modality_int, y = cumfreq), pch = 19 ) + geom_text( aes( x = modality_int, y = cumfreq, label = paste0(round(cumperc, digits = 1), '%') ), vjust = -1, size = 2.5 ) + scale_y_continuous( breaks = seq(0, N, N/10), limits = c(-.02 * N, N * 1.02), labels = round(seq(0, N, N/10)) ) + scale_x_discrete( breaks = Df$modality ) + guides( fill = FALSE, color = FALSE ) + annotate( "rect", xmin = nr + .55, xmax = nr + 1, ymin = -.02 * N, ymax = N * 1.02, fill = 'white' ) + annotate( "text", x = nr + .8, y = seq(0, N, N/10), label = y2, size = 1.5 ) + geom_segment( x = nr + .55, xend = nr + .55, y = -.02 * N, yend = N * 1.02, color = 'grey50' ) + geom_segment( data = Df_ticks, aes(x = xtick0, y = ytick, xend = xtick1, yend = ytick) ) + geom_segment( aes( x = .5, xend = nr+.5, y = seq(0, N, N/10)[9], yend = seq(0, N, N/10)[9], color = 'red' ) ) + labs( title = paste0('Pareto Chart of ', title), y = ylabel, x = xlabel ) + theme_bw() + theme( axis.text.x = element_text(angle = 90, size = 7, vjust = .5, hjust = 1), axis.text.y = element_text(size = 7), title = element_text(size = 7) ) return(list(data = Df, plot = g)) }
path <- file.path('~', 'reporting', 'monthly', 'EFS', lubridate::year(last_month()), strftime(last_month(), format = '%m-%b')) file <- dir(path) %>% .[grepl('raw', tolower(.))] df <- readxl::read_excel(file.path('~', 'reporting', 'monthly', 'EFS', lubridate::year(last_month()), strftime(last_month(), format = '%m-%b'), file)) %>% df_checker() %>% dplyr::mutate(YYYYMM = as.character(YYYYMM))
ggrob <- ggplotGrob( ggplot(df %>% dplyr::count(YYYYMM), aes(x = YYYYMM, y = n)) + geom_point() + geom_text_repel(aes(label = n)) + geom_line(group = 1) + ylab('Complaints') + xlab('Month') + ggtitle('Complaints per Month') ) tgrob <- df %>% dplyr::count(Call_Subject, Call_Subject_Desc, YYYYMM) %>% tidyr::spread(YYYYMM, n, fill = 0) %>% setNames(c('Call Subject', 'Call Subject Desc', strftime(as.Date(paste0(sort(unique(df$YYYYMM)), '01'), format = '%Y%m%d'), format = '%b-%Y'))) %>% add_margins() %>% row_heat_table() supptab <- data.frame( Info = c('3 Month Average', '2017 Total'), Complaints = c(mean(df %>% dplyr::count(YYYYMM) %>% .$n %>% tail(3)), sum(df %>% dplyr::count(year) %>% dplyr::filter(year == lubridate::year(last_month())) %>% .$n)), stringsAsFactors = FALSE) tgrob %<>% combine(., supptab %>% tableGrob(row = NULL, theme = mytheme), along = 1) tgrob$heights <- unit.pmax(tgrob$heights) ggrob %<>% gtable_add_rows(., sum(tgrob$heights)) ggrob %<>% gtable_add_grob(., grobs = tgrob, t = nrow(ggrob), l = 4, b = nrow(ggrob), r = 4) grid.draw(ggrob)
countries <- srms::srms_table('country_codes') df %>% dplyr::count(Country_Code, YYYYMM) %>% dplyr::ungroup() %>% tidyr::spread(YYYYMM, n, fill = 0) %>% dplyr::left_join(y = countries %>% dplyr::select(-Region), by = 'Country_Code') %>% dplyr::select(-Country_Code) %>% dplyr::select(colNums = c(ncol(.), 1:(ncol(.) - 1))) %>% setNames(c('Country', strftime(as.Date(paste0(sort(unique(df$YYYYMM)), '01'), format = '%Y%m%d'), format = '%b-%Y'))) %>% add_margins() %>% row_heat_table() %>% combine(., tail(supptab, 1) %>% tableGrob(row = NULL, theme = mytheme), along = 1) %>% grid.draw()
tables <- df %>% dplyr::filter(YYYYMM == max(YYYYMM)) %>% dplyr::count(Call_Subject, Call_Subject_Desc, Call_Area) %>% dplyr::rename(Complaints = n) %>% split(.$Call_Subject_Desc) raw_dfs <- df %>% dplyr::filter(YYYYMM == max(YYYYMM)) %>% split(.$Call_Subject_Desc) out <- NULL for (csd in names(tables)) { out <- c( out, knitr::knit_expand( text = paste0( '\n{{csd}} {data-navmenu=\'Call Subject\'}', '\n=====================================', '\n```r}, fig.width = 10}', '\npareto <- ggpareto(df = raw_dfs[[\'{{csd}}\']], filter = \'TRUE\', title = \'{{csd}}\')', '\ngrob_binder(ggrob = ggplotGrob(pareto$plot), tgrob = tables[[\'{{csd}}\']] %>% tableGrob(row = NULL, theme = mytheme))', '\n```' ), count = match(csd, names(tables)), csd = csd ) ) }
r knitr::knit(text = out)
table <- df %>% dplyr::count(YYYYMM, Resolution) %>% tidyr::spread(YYYYMM, n, fill = 0) %>% tidyr::gather(YYYYMM, n, -Resolution) ggrob <- ggplotGrob( ggplot(table, aes(x = YYYYMM, y = n, fill = Resolution)) + geom_col(color = 'black') + xlab('Month') + ylab('Complaints') + ggtitle('Resolutions by Month') ) tgrob <- table %>% tidyr::spread(YYYYMM, n, fill = 0) %>% setNames(c('Resolution', strftime(as.Date(paste0(sort(unique(df$YYYYMM)), '01'), format = '%Y%m%d'), format = '%b-%Y'))) %>% add_margins() %>% row_heat_table() %>% combine(., tail(supptab, 1) %>% tableGrob(row = NULL, theme = mytheme), along = 1) grid.draw(ggrob)
grid.draw(tgrob)
r paste0('Resolutions in ', strftime(last_month(), format = '%B - %Y'))
{data-navmenu='Resolutions'}df %>% dplyr::filter(YYYYMM == max(YYYYMM)) %>% dplyr::count(Resolution) %>% dplyr::filter(n > 0) %>% dplyr::mutate(Resolution = replace(Resolution, is.na(Resolution), 'NA')) %>% ggplot(aes(x = reorder(Resolution, -n), y = n)) + geom_col(fill = 'white', color = 'black') + geom_text(aes(label = n), vjust = 1) + xlab('Resolution') + ylab('Complaints') + ggtitle(paste0('Complaints by Resolution in ', strftime(last_month(), format = '%B-%Y')))
df %>% dplyr::filter(YYYYMM == max(YYYYMM)) %>% dplyr::count(Lot_Serial_Number) %>% dplyr::filter(n > 0) %>% ggplot(aes(x = reorder(Lot_Serial_Number, -n), y = n)) + geom_col(fill = 'white', color = 'black') + geom_text(aes(label = n), vjust = 1) + xlab('Lot Number') + ylab('Complaints') + ggtitle(paste0('Complaints by Lot Number in ', strftime(last_month(), format = '%B-%Y')))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.