hot_to_r: сбой / значения застряли в цикле

Question

Я написал некоторый блестящий код, который связывает три rhandsontable с различными агрегатами дат. Есть три таблицы: день, неделя и месяц. Если вы добавляете / редактируете значения в таблице дней, значения агрегируются и помещаются в две другие таблицы. Если вы добавляете / редактируете значения в таблицу недель, они объединяются и помещаются в таблицу месяцев или равномерно распределяются по таблице дней, чтобы она сохраняла свою форму. Наконец, если вы добавите / отредактируете значения в таблицу месяцев, значения будут равномерно распределены по таблицам недели и дня, поэтому форма данных не изменится.

Код работает нормально, хотя я уверен, что это можно сделать аккуратнее / эффективнее, однако при вводе значений в rhandsontables, если я делаю это слишком быстро, панель инструментов разрывается, и новые значения зацикливаются на цикле, отображающем панель инструментов. непригодным для использования. Мне бы очень хотелось продолжить работу с этой приборной панелью / упражнением, поэтому любая помощь будет принята с благодарностью! Мой код ниже:

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)