shiny 点击 plot 更新输入

Question

I have this very simple shiny app

When input changes, the graph changes accordingly

When a point is selected within the graph the corresponding model is displayed on the right of the input text box

I would like to see the selection to be displayed inside the text box

Can anyone please point me in the right direction

Thanks for any help

  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

Thanks @Ben

Here is the clean version of what was trying to achieve:

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)