在RShiny中的反應事件中觀察事件刷子

我正在顯示在我的初始表中選擇的每一行的選項卡式圖形。我希望這些圖表具有發現的畫筆/縮放功能here。在RShiny中的反應事件中觀察事件刷子

這是我的代碼：

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')

來源

2017-06-27 Chapo

您需要在plotOutput通話

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

現在觀察員觸發正確分配「雙擊ID」和「刷身份證」，併發出正確的信息。還有與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)

來源

2017-06-27 09:23:35

美麗。謝謝。 – Chapo

在RShiny中的反應事件中觀察事件刷子

回答

相關問題