Question

我正在显示在我的初始表中选择的每一行的选项卡图。我希望这些图表能够找到刷子/缩放功能here。

这是我的代码：

library(shiny)
library(DT)
library(ggplot2)
library(scales)
library(reshape2)

首先ui：下面带有选项卡式UI的主表是为了响应主表中的行选择而生成的

ui <- fluidPage(
  mainPanel(
    fluidRow(
      column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
    ),
    fluidRow(
      uiOutput("selectedTabs")
    )
  )
)

然后server函数：为了示例，主表值是随机生成的。 brush功能直接从提供的链接中解除。我怀疑我的问题与反应函数中的反应函数有关，但我很乐意让专家决定。

server <- function(input,output){

  output$tableCurrencies <- DT::renderDataTable({datatable(data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10)))})

  origTable_selected <- reactive({
    ids <- input$tableCurrencies_rows_selected
    return(ids)
  })

  rangeRates <- reactiveValues(xRate = NULL, yRate = NULL)

  output$selectedTabs <- renderUI({
    myTabs <- lapply(origTable_selected(),function(i) {


      tabName <- paste0("test",i)

      a <- renderPlot({
        hist(rnorm(50))
      })
      output[[paste0(tabName,"rates")]] <- a
      #plot of realized vol and implied vols over 5 years

      observeEvent(input[[paste0(tabName,"rates_dblclick")]], {
        brush <- input[[paste0(tabName,"rates_brush")]]
        if (!is.null(brush)) {
          rangeRates$xRate <- c(brush$xmin, brush$xmax)
          rangeRates$yRate <- c(brush$ymin, brush$ymax)

        } else {
          rangeRates$xRate <- NULL
          rangeRates$yRate <- NULL
        }
      })

      return(tabPanel(
        tabName,
        fluidRow(
          column(6,plotOutput(paste0(tabName,"rates")))
        )
      ))
    })
    return(do.call(tabsetPanel,myTabs))
  })
}
app = shinyApp(ui,server)
runApp(app,port=3250,host='0.0.0.0')

Answer 1

您需要指定＆＃34;双击ID＆＃34;和＃34;刷ID＆＃34;在plotOutput电话

中

column(6, plotOutput(paste0(tabName, "rates"),
                     dblclick = paste0(tabName, "rates_dblclick"),
                     brush = brushOpts(
                       id = paste0(tabName, "rates_brush"),
                       resetOnNew = TRUE
                    )))

现在观察者正确触发并发送正确的信息。还有第二个问题rangeRates对图表没有任何影响，可以通过以下方式解决

a <- renderPlot({
  if (!is.null(rangeRates$xRate))
    hist(rnorm(50), xlim = rangeRates$xRate,
         ylim = rangeRates$yRate)
  else
    hist(rnorm(50))
})

这是完整的工作版

library(shiny)
library(DT)

ui <- fluidPage(
  mainPanel(
    fluidRow(column(12, DT::dataTableOutput(outputId = 'tableCurrencies'))),
    fluidRow(uiOutput("selectedTabs"))
  )
)

server <- function(input, output){      
  output$tableCurrencies <- DT::renderDataTable({
    data.frame(a = rnorm(10), b = rnorm(10), c = rnorm(10))
  })

  origTable_selected <- reactive({
    ids <- input$tableCurrencies_rows_selected
    return(ids)
  })

  rangeRates <- reactiveValues(xRate = NULL, yRate = NULL)

  output$selectedTabs <- renderUI({
    myTabs <- lapply(
      origTable_selected(), 
      function(i) {       
        tabName <- paste0("test", i)

        output[[paste0(tabName, "rates")]] <- renderPlot({
          if( !is.null(rangeRates$xRate) )
            hist(rnorm(50), xlim = rangeRates$xRate,
                 ylim = rangeRates$yRate)
          else
            hist(rnorm(50))
        })

        observeEvent(input[[paste0(tabName, "rates_dblclick")]], {
          brush <- input[[paste0(tabName, "rates_brush")]]
          if (!is.null(brush)) {
            rangeRates$xRate <- c(brush$xmin, brush$xmax)
            rangeRates$yRate <- c(brush$ymin, brush$ymax)              
          } else {
            rangeRates$xRate <- NULL
            rangeRates$yRate <- NULL
          }
        })

        tabPanel(
          tabName,
          fluidRow(column(6, plotOutput(
            paste0(tabName, "rates"),
            dblclick = paste0(tabName, "rates_dblclick"),
            brush = brushOpts(
              id = paste0(tabName, "rates_brush"),
              resetOnNew = TRUE)
          )))
        )
      })
    return(do.call(tabsetPanel, myTabs))
  })
}

shinyApp(ui, server)

observeEvent在RShiny

1 个答案: