r - hot_to_r: グリッチ/値がループにスタック

Question

3 つの rhandsontables を異なる日付集計に接続する Shiny コードをいくつか作成しました。日、週、月の 3 つのテーブルがあります。日テーブルに値を追加/編集すると、値が集計され、他の 2 つのテーブルにプッシュされます。値を週テーブルに追加/編集すると、値が集計されて月テーブルにプッシュされるか、日テーブル全体に均等に分散されるため、形状が維持されます。最後に、月のテーブルに値を追加/編集すると、値は週と日のテーブルに均等に分散されるため、データの形状は変わりません。

コードは正常に動作しますが、よりきちんとした/より効率的な方法で実行できると確信していますが、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)