Как я могу получить rhandsontable, чтобы реагировать на изменения во входных значениях и на изменения в себе? - PullRequest
0 голосов
/ 25 января 2020

Поэтому я хочу иметь таблицу значений в rHOT, которая обновляется всякий раз, когда 1) базовые данные обновляются через реактивный ввод И 2) всякий раз, когда вы обновляете значения в таблице rHOT.

Код ниже удается обновить sh реальную таблицу avgs / cums, когда ввод $ изменяется. Затем я могу ввести новые значения в таблицу rHOT 'avgs, и константы будут обновлены.

Но я хочу переосмыслить sh значения таблицы rHOT заново, когда вы снова измените ввод $, и все равно восприимчив к изменениям в своем собственном среднем ряду.


library(dplyr)
library(shiny)
library(shinydashboard)
library(rhandsontable)

accdntprd<-1:5
StatData<-as.data.frame(matrix(c(100, 150, 175, 180, 200, 110, 
                                 168, 192, 205, 210, 115, 169,
                                 202, 200, 100, 125, 185, 100, 
                                 120, 130, 150, 180, 190, 200, 210), 
                               nrow = 5, byrow = TRUE))
StatData<-as.data.frame(cbind(accdntprd,StatData[1:5,]))


ui <- dashboardPage(
  dashboardHeader(title="Shiny"),
  dashboardSidebar(
    sidebarMenu(id="tabs", menuItem("Blocks", tabName = "Blocks"))),
  dashboardBody(tabItems(

    tabItem("Blocks",
            fluidRow(box(width=12
                         ,div(tableOutput("DFs"))
                         ,div(rHandsontableOutput("rTable"))      
            )),
            fluidRow(width=12,
                     box(radioButtons("SelAvgMeth", "averaging", choices= c("straight", "trim"), selected = "straight"))     
            )
    )
  ))
)

server<-function(input, output) {

  observeEvent(
    input$SelAvgMeth, {

      rTable_content <<- reactive({

        t<-ifelse(input$SelAvgMeth=="trim",1, 0)
        Avgs<-t(sapply((2:5),function(i){mean(StatData[, i+1]/StatData[, i], trim = t/4)}))

        Avgs<-rev(Avgs)
        Cums<-cumprod(Avgs)
        DF<-t(as.data.frame(cbind(rev(Avgs), rev(Cums))))
        DF<-data.frame(DF)
        rownames(DF)<-c("Avgs", "Cums")
        return(DF)

      })

      output$DFs<-renderTable({
        rTable_content()
      }, digits = 3, spacing = "xs", rownames = TRUE)

    })   


  MyChanges <- reactive({

    if(is.null(input$rTable)|(identical(rTable_content(),input$rTable))){
      return(rTable_content())
    } else {
      selDF<- as.data.frame(hot_to_r(input$rTable)) 
      selDF[2,]<-rev(cumprod(rev(as.numeric(selDF[1,]))))
      rownames(selDF)<-c("Avgs", "Cums")
      return(selDF)
    } 
  })
  output$rTable <- renderRHandsontable({
    rhandsontable(MyChanges())%>% hot_cols(format = "0.000")
  })



}

shinyApp(ui, server)


Я знаю, что событие наблюдения не является действительно необходимым, но давайте оставим его там на случай, если я захочу контролировать другие входы.

Простите, если я спросил это неправильно. Код воспроизводим.

Как это должно работать на фотографиях:

  1. По умолчанию
  2. Выбрать обрезку

    3. Принять изменения rHOT в верхней строке и автоматически рассчитать нижнюю строку. Нет изменений в StatData

1 Ответ

0 голосов
/ 26 января 2020

Спасибо за дополнительные подробности.

Я мог бы создать отдельную reactiveValues для хранения ваших таблиц и придания вам большей гибкости.

Часть, по которой я до сих пор не понимаю, - что должно произойти, если переключатель выбран после rHOT стол изменился. Сейчас он просто устанавливает обе таблицы обратно на основе исходных данных.

Посмотрите, имеет ли это поведение, которое вы искали.

server<-function(input, output) {

  rv <- reactiveValues(table1 = NULL,
                       table2 = NULL)

  observeEvent(input$SelAvgMeth,{
    t <- ifelse(input$SelAvgMeth == "trim", 1, 0)
    Avgs<-t(sapply((2:5),function(i){mean(StatData[, i+1]/StatData[, i], trim = t/4)}))
    Avgs<-rev(Avgs)
    Cums<-cumprod(Avgs)
    DF<-t(as.data.frame(cbind(rev(Avgs), rev(Cums))))
    DF<-data.frame(DF)
    rownames(DF)<-c("Avgs", "Cums")
    rv$table1<-rv$table2<-DF
  })

  output$DFs<-renderTable({
    rv$table1
  }, digits = 3, spacing = "xs", rownames = TRUE)

  observe({
    if (!is.null(input$rTable)){
      selDF<- as.data.frame(hot_to_r(input$rTable)) 
      selDF[2,]<-rev(cumprod(rev(as.numeric(selDF[1,]))))
      rownames(selDF)<-c("Avgs", "Cums")
      rv$table2 <- selDF
    } 
  })

  output$rTable <- renderRHandsontable({
    rhandsontable(rv$table2) %>%
      hot_cols(format = "0.000")
  })

}
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...