Rhandsontable & Shiny: сделать условный график в зависимости от добавленных столбцов - PullRequest
0 голосов
/ 31 мая 2018

Я хотел бы сделать график (ggplot) после обновления таблицы в блестящем, но я не могу заставить его работать - график не появляется.Сюжет должен появиться только после того, как столбцы созданы для x и y.В идеале, точки отображаются в виде значений, которые редактируются в таблице.Ниже приведен некоторый воспроизводимый код ( отсюда ), который я расширил.

library(rhandsontable)
library(tidyverse)

ui <- fluidPage(
  h2("The mtcars data"),
  rHandsontableOutput("mytable"),
  textInput('NewCol', 'Enter new column name'),
  radioButtons("type", "Column type:",
               c("Integer" = "integer",
                 "Floating point" = "numeric",
                 "Text" = "character")),
  actionButton("goButton", "Update Table"),
  plotOutput("plot")
)

server <- function(input, output) {

  # g <- reactiveValues(d=NULL) #define it ouside

  mydata <- mtcars[1:5,]
  output$mytable = renderRHandsontable(df())
  df <- eventReactive(input$goButton, {
    if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
      if (input$type == "integer") v1 <- integer(NROW(mydata))
      if (input$type == "numeric") v1 <- numeric(NROW(mydata))
      if (input$type == "character") v1 <- character(NROW(mydata))
      newcol <- data.frame(v1)
      names(newcol) <- input$NewCol
      mydata <<- cbind(mydata, newcol)
    }
    rhandsontable(mydata, stretchH = "all")
  }, ignoreNULL = FALSE)
  observe(if (!is.null(input$mytable)) mydata <<- hot_to_r(input$mytable))

  output$plot <- renderPlot({
    if (req(mydata$x) >= 0 & req(mydata$y) >= 0) 
      ggplot(mydata, aes(x=mydata$x,y=mydata$y)) +
        geom_point()
    # else if (req(mydata$x) = 0 & req(mydata$y) = 0) {
    #   print("empty")
    # }
  })  
}

shinyApp(ui,server)

1 Ответ

0 голосов
/ 31 мая 2018

Я не знаю точно, как работают эти функции (rhandsontable и hot_to_r), но то, что вы хотите сделать, кажется совместимым с классической структурой reactiveValues, например, в коде вашего сервера:

r = reactiveValues(mydata=mtcars[1:5,])
  output$mytable = renderRHandsontable(df())
  df <- eventReactive(input$goButton, {
    if(input$NewCol!="" && !is.null(input$NewCol) && input$goButton>0){
      if (input$type == "integer") v1 <- integer(NROW(r$mydata))
      if (input$type == "numeric") v1 <- numeric(NROW(r$mydata))
      if (input$type == "character") v1 <- character(NROW(r$mydata))
      newcol <- data.frame(v1)
      names(newcol) <- input$NewCol
      r$mydata <- cbind(r$mydata, newcol)
    }
    rhandsontable(r$mydata, stretchH = "all")
  }, ignoreNULL = FALSE)
  observe({if (!is.null(input$mytable)) r$mydata <- hot_to_r(input$mytable)})
  output$plot <- renderPlot({
    if(is.null(r$mydata$x) | is.null(r$mydata$y)) {return(NULL)}
      ggplot(r$mydata, aes(x=x,y=y)) +
      geom_point()})  }

Думаю, это безопаснее, чем выполнять глобальные назначения, что вообще не рекомендуется

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