Question

我有一个非常简单的闪亮应用

输入更改时，图形也会相应更改

在图形中选择一个点时，相应的模型显示在输入文本框的右侧

我希望看到所选内容显示在文本框中

有人可以指出正确的方向吗

感谢您的帮助

  require(ggplot2)
  require(dplyr)
  require(Cairo)   
  require(dplyr)
  
    
  mtcars2 <- datasets::mtcars %>% rownames_to_column(var = 'model') 
  
  
  ui <- fluidPage(
    
      fluidRow(
        column(width = 3,
               selectInput(inputId = '.model', label = 'input model', choices = mtcars2$model,  selected = NULL)),
        br(),br(),
        column(width = 3,
               textOutput('click_1A'), label = 'selected model')
            ),
      fluidRow(
        column(width = 8,
             plotOutput("plot1", height = 350, brush = "plot_brush", click = "plot_click")),
      )
    )
  
  server <- function(input, output) {
    
    
    
    global <- reactiveValues(.model = NULL) 
   
    
    # scatter plot
    output$plot1 <- renderPlot({
      selected_model <- input$.model
      ggplot(mtcars2, aes(x=mpg,y=disp), color = 'red') + 
        geom_point(size = 3, col = 'red') + 
        geom_point(data = filter(mtcars2, model == selected_model), col = 'blue', size = 5) + 
        theme_bw() +
        theme(legend.position = 'none') 
      
      
    })
    
    
    # MODEL name 
     output$click_1A <- renderText({
       
       near_out <- nearPoints(mtcars2, input$plot_click, addDist = TRUE)
       global$.model <- near_out %>% 
         pull(model) 
     })     
         
    }
  shinyApp(ui, server)

Answer 1

感谢@Ben

这是要实现的目标的简洁版本：

require(ggplot2)
require(tidyr)
require(tibble)
require(lubridate)
require(Cairo)
require(dplyr)
  
    
mtcars2 <- datasets::mtcars %>% rownames_to_column(var = 'model') 
  
  
  ui <- fluidPage(
    
      fluidRow(
        column(width = 3,
               selectInput(inputId = '.model', label = 'input model', choices = mtcars2$model,  selected = NULL)),
      ),
      fluidRow(
        column(width = 8,
             plotOutput("plot1", height = 350, brush = "plot_brush", click = "plot_click")),
      )
    )
  
  server <- function(input, output, session) {
    
    
    
    global <- reactiveValues(.model = NULL) 
   
    
    # scatter plot
    output$plot1 <- renderPlot({
      selected_model <- input$.model
      ggplot(mtcars2, aes(x=mpg,y=disp, label = model), color = 'red') + 
        geom_point(size = 3, col = 'red') + 
        geom_point(data = filter(mtcars2, model == selected_model), col = 'blue', size = 5) + 
        #geom_text() + 
        theme_bw() +
        theme(legend.position = 'none') 
      
      
    })
    
      observeEvent(
        eventExpr = input$plot_click, 
        handlerExpr = {
          selected_model <- nearPoints(mtcars2, input$plot_click, maxpoints = 1, addDist = F) %>% pull(model)
          updateSelectInput(session, inputId = ".model", choices = mtcars2$model, selected = selected_model)}
        ) 
    }
  shinyApp(ui, server)

闪亮单击情节更新输入

1 个答案: