1

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

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 数据帧。

提前谢谢了。

4

2 回答 2

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)
于 2017-03-23T17:55:32.680 回答
0

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

observeEvent(input$someInput{
    values$df <- SOMECODE})
于 2017-03-13T11:42:08.710 回答