Question

我非常感谢以下代码的一些帮助：

library(shiny)
library(rhandsontable)
library(tidyr)

dataa <- as.data.frame(cbind(rnorm(100, sd=2), rchisq(100, df = 0, ncp = 2.), rnorm(100)))
ldataa <- gather(dataa, key="variable", value = "value")
thresholds <- as.data.frame(cbind(1,1,1))

ui <- fluidPage(fluidRow(
  plotOutput(outputId = "plot", click="plot_click")),
  fluidRow(rHandsontableOutput("hot"))
  )

server <- function(input, output) {

  values <- reactiveValues(
    df=thresholds
  )

  observeEvent(input$plot_click, {
    values$trsh <- input$plot_click$x
  })

  observeEvent(input$hot_select, {
    values$trsh <- 1
  })

  output$hot = renderRHandsontable({
    rhandsontable(values$df, readOnly = F, selectCallback = TRUE)
  })

  output$plot <- renderPlot({
  if (!is.null(input$hot_select)) {
    x_val = colnames(dataa)[input$hot_select$select$c]

    dens.plot <- ggplot(ldataa) +
      geom_density(data=subset(ldataa,variable==x_val), aes(x=value), adjust=0.8) + 
      geom_rug(data=subset(ldataa,variable==x_val), aes(x=value)) +
      geom_vline(xintercept = 1, linetype="longdash", alpha=0.3) +
      geom_vline(xintercept = values$trsh) 

    dens.plot
  }
  })
}

shinyApp(ui = ui, server = server)

我在应用程序中有一个情节和一个双手对象。单击任何单元格加载相应的图表，并使用阈值。单击该图可更改其中一条垂直线的位置。

我希望通过将绘图单击到相应的单元格中来获取x值，并且我希望能够通过在单元格中键入值来设置垂直线的位置。

我目前对如何将值反馈到reactiveValue数据帧感到困惑。

非常感谢提前。

Answer 1

这正如我想象的那样：

（诀窍是用“input$plot_click$x填充”df“的右栏，用values$df[,input$hot_select$select$c]索引它们。）

library(shiny)
library(rhandsontable)
library(tidyr)

dataa <- as.data.frame(cbind(rnorm(100, sd=2), rchisq(100, df = 0, ncp = 2.), rnorm(100)))
ldataa <- gather(dataa, key="variable", value = "value")
thresholds <- as.data.frame(cbind(1,1,1))

ui <- fluidPage(fluidRow(
  plotOutput(outputId = "plot", click="plot_click")),
  fluidRow(rHandsontableOutput("hot"))
)

server <- function(input, output) {

  values <- reactiveValues(
    df=thresholds
  )

  observeEvent(input$plot_click, {
    values$df[,input$hot_select$select$c]  <- input$plot_click$x
  })

  output$hot = renderRHandsontable({
    rhandsontable(values$df, readOnly = F, selectCallback = TRUE)
  })

  output$plot <- renderPlot({
    if (!is.null(input$hot_select)) {
      x_val = colnames(dataa)[input$hot_select$select$c]

      dens.plot <- ggplot(ldataa) +
        geom_density(data=subset(ldataa,variable==x_val), aes(x=value), adjust=0.8) + 
        geom_rug(data=subset(ldataa,variable==x_val), aes(x=value)) +
        geom_vline(xintercept = 1, linetype="longdash", alpha=0.3) +
        geom_vline(xintercept = values$df[,input$hot_select$select$c]) 

      dens.plot
    }
  })
}

shinyApp(ui = ui, server = server)

Answer 2

从observeEvent内部更新您的reactiveValue数据框，您可以在其中查看任何有用的事件，即点击或其他事件。

observeEvent(input$someInput{
    values$df <- SOMECODE})

Shiny中的交互式情节与rhandsontable和reactiveValues

2 个答案: