I've written some Shiny code which connects three rhandsontables with different date aggregations. There are three tables: day, week and month. If you add/edit values into the day table, the values are aggregated and pushed into the other two tables. If you add/edit values into the week table, the values are aggregated and pushed into the month table or evenly distributed across the day table so it maintains it's shape. Finally if you add/edit values into the month table, the values are evenly distributed across the week and day tables so the shape of the data doesn't change.
The code works fine, although I'm sure it could be done in a neater/more efficient way, however when entering values into the rhandsontables if I do it too quickly the dashboard breaks and the new values get stuck in a loop rendering the dashboard unusable. I'd really like to continue making progress with this dashboard/exercise so any help would be greatly appreciated! My code is below:
library(shiny)
library(rhandsontable)
library(lubridate)
library(plyr)
library(ggplot2)
library(reshape2)
install.packages()
nextmon <- function(x) 7 * ceiling(as.numeric(x-1+4)/7) + as.Date(1-4, origin="1970-01-01")
is.nan.data.frame <- function(x)
do.call(cbind, lapply(x, is.nan))
na.zero <- function(x) {
x[is.na(x)] <- 0
x
}
channel <- c("TV","Radio","Digital")
start.date <- as.Date("2017-01-01")
start.date <- nextmon(start.date)
end.date <- as.Date("2017-01-31")
date.range <- as.Date((seq(start.date,end.date,by="day")), origin = "1970-01-01")
date.range <- as.data.frame(date.range)
colnames(date.range) <- c("date")
date.range$week <- week(date.range$date)
date.range$month <- month(date.range$date)
date.range[channel] <- 0
#aggregate table
tableM <- date.range
tabled <- tableM[c("date",channel)]
tablew <- tableM[c("week",channel)]
tablew <- aggregate( .~week, data = tablew, FUN = sum)
tablem <- tableM[c("month",channel)]
tablem <- aggregate( .~month, data = tablem, FUN = sum)
ui <- fluidPage(
br(),
fluidRow(
column(4,
dateInput("start.date","start.date","2017-01-01"),
dateInput("end.date","end.date","2017-01-31"),
actionButton("reset","reset"))
),
br(),
fluidRow(
column(4,
h3("Daily"),
rHandsontableOutput("table1output")),
column(4,
h3("Weekly"),
rHandsontableOutput("table2output")),
column(4,
h3("Monthly"),
rHandsontableOutput("table3output"))
),
br(),
fluidRow(
column(12, plotOutput("plot1"))
)
)
server <- function(input,output,session){
table <- reactiveValues()
#set defaults for day, week, month.
table$tabled <- tabled
table$tablew <- tablew
table$tablem <- tablem
#reset tables for day, week, month.
observeEvent(input$reset,{
start.date <- input$start.date
start.date <- as.Date(start.date)
start.date <- nextmon(start.date)
end.date <- input$end.date
end.date <- as.Date(end.date)
date.range <- as.Date((seq(start.date,end.date,by="day")), origin = "1970-01-01")
date.range <- as.data.frame(date.range)
colnames(date.range) <- c("date")
date.range$week <- week(date.range$date)
date.range$month <- month(date.range$date)
date.range[channel] <- 0
tableM <- date.range
tabled <- tableM[c("date",channel)]
tablew <- tableM[c("week",channel)]
tablew <- aggregate( .~week, data = tablew, FUN = sum)
tablem <- tableM[c("month",channel)]
tablem <- aggregate( .~month, data = tablem, FUN = sum)
table$tabled <- tabled
table$tablew <- tablew
table$tablem <- tablem
})
#rhandsontable outputs
output$table1output <- renderRHandsontable({rhandsontable(table$tabled)})
output$table2output <- renderRHandsontable({rhandsontable(table$tablew)})
output$table3output <- renderRHandsontable({rhandsontable(table$tablem)})
#if a user updates tabled, tablew and tablem should also update.
observeEvent(input$table1output,{
tabled <- hot_to_r(input$table1output)
tabled <- as.data.frame(tabled)
tablew <- tabled
tablem <- tabled
tablew$week <- week(tabled$date)
tablew <- tablew[c("week",channel)]
tablew <- aggregate( .~week, data = tablew, FUN = sum)
tablem$month <- month(tabled$date)
tablem <- tablem[c("month",channel)]
tablem <- aggregate( .~month, data = tablem, FUN = sum)
table$tabled <- tabled
table$tablew <- tablew
table$tablem <- tablem
})
#if a user updates tablew, tabled and tablem should also update.
observeEvent(input$table2output,{
tabled <- table$tabled
tabled$week <- week(tabled$date)
table1 <- split(tabled, as.factor(tabled$week))
for(i in 1:length(table1)){
for(j in channel){
if(sum(table1[[i]][j]) == 0){
table1[[i]][j] <- 1
}
}
}
table1 <- ldply(table1, as.data.frame)
tabled <- table1
tablewtemp <- tabled[c("week",channel)]
tablewtemp <- aggregate(.~week, data = tablewtemp, FUN = sum)
tabletemp <- merge(tabled, tablewtemp, by = "week")
tabletemp[,grep(".x",names(tabletemp))] <- tabletemp[,grep(".x",names(tabletemp))]/tabletemp[,grep(".y",names(tabletemp))]
tabletemp <- cbind(tabletemp[,which(names(tabletemp) %in% c("date","week"))],tabletemp[,grep(".x",names(tabletemp))])
names(tabletemp) <- gsub(".x","",names(tabletemp))
tabletemp[is.nan.data.frame(tabletemp)] <- 0
tablew <- hot_to_r(input$table2output)
tablew <- as.data.frame(tablew)
tabletemp <- merge(tabletemp,tablew, by= "week")
tabletemp <- cbind("date" = tabletemp$date, tabletemp[,grep(".x",names(tabletemp))]*tabletemp[,grep(".y",names(tabletemp))])
names(tabletemp) <- gsub(".x","",names(tabletemp))
tabled <- tabletemp
table$tabled <- tabled
table$tablew <- tablew
})
#if a user updates tablem, tabled and tablew should also update.
observeEvent(input$table3output,{
tabled <- table$tabled
tabled$month <- month(tabled$date)
table1 <- split(tabled, as.factor(tabled$month))
for(i in 1:length(table1)){
for(j in channel){
if(sum(table1[[i]][j]) == 0){
table1[[i]][j] <- 1
}
}
}
table1 <- ldply(table1, as.data.frame)
tabled <- table1
tablemtemp <- tabled[c("month",channel)]
tablemtemp <- aggregate(.~month, data = tablemtemp, FUN = sum)
tabletemp <- merge(tabled, tablemtemp, by = "month")
tabletemp[,grep(".x",names(tabletemp))] <- tabletemp[,grep(".x",names(tabletemp))]/tabletemp[,grep(".y",names(tabletemp))]
tabletemp <- cbind(tabletemp[,which(names(tabletemp) %in% c("date","month"))],tabletemp[,grep(".x",names(tabletemp))])
names(tabletemp) <- gsub(".x","",names(tabletemp))
tabletemp[is.nan.data.frame(tabletemp)] <- 0
tablem <- hot_to_r(input$table3output)
tablem <- as.data.frame(tablem)
tabletemp <- merge(tabletemp,tablem, by= "month")
tabletemp <- cbind("date" = tabletemp$date, tabletemp[,grep(".x",names(tabletemp))]*tabletemp[,grep(".y",names(tabletemp))])
names(tabletemp) <- gsub(".x","",names(tabletemp))
tabled <- tabletemp
table$tabled <- tabled
table$tablem <- tablem
})
output$plot1 <- renderPlot({
tabled <- table$tabled
tabled <- melt(tabled, id.vars = "date", variable.name = "channel", value.name = "spend")
g <- ggplot(data = tabled, aes(x = date, y = spend, fill = channel)) + geom_bar(stat = "identity")
g
})
}
shinyApp(ui = ui, server = server)
