Home > Enterprise >  How to replace a rendered plot with its own plot_click info in R Shiny?
How to replace a rendered plot with its own plot_click info in R Shiny?

Time：07-22

My app is supposed to load certain data as input file (in this post i will give a part of it written in form of data frame so you can use to run my example). and then plot three plots . i want that when the user click oh the plot at the top of page , a first new plot will be displayed based on the click info and when the new plot will be displayed then i want to plot a second new plot based on the click info of the first new plot.

library(dplyr)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(ggplot2)
library(gridExtra)
library(scales)
library(grid)
library(RColorBrewer)
library(officer)
library(svglite)
library(rvg)
library(readxl)
library(tools)
library(rsvg)


body <- dashboardBody(
  fluidRow(
    tabBox(
      
      # The id lets us use input$tabset1 on the server to find the current tab
      id = "tabset1",height = 750,width=20,
      tabPanel("Summary",dataTableOutput(outputId = "table")),
      tabPanel("Visualization",sliderInput("scalegvt","Scale  Data by:",  min = 0, max = 100, value = c(70,100)),plotOutput("p1", height = 1000,click = "plot_click")
      )
    )
  )
)
  side<- dashboardSidebar(  
    width = 290,
    sidebarMenu(
      menuItem("Summary",tabName = "Summary") ,  
      uiOutput('choose_Da'),
      
      selectizeGroupUI(
        id = "m",
        inline = FALSE,
        params = list(
       Lot = list(inputId = "Lot", title = "Lot"),
          wafer = list(inputId = "wafer", title = "wafer"),
         M_datum = list(inputId = "M_Datum", title = "M_Datum"),
          Yield = list(inputId = "Yield", title = "Yield")
          
          
        )
      ),inline=FALSE,
      menuItem("Visualization",tabName = "Visualization")
      
    ))
  ui <- function(request) {
    
    dashboardPage(
      
      dashboardHeader(title = "Yield Report",titleWidth = 290),
      side,
      body
      
    )
  }
  
  server = function(input, output,session) { 
    
    
    
    newscale <- reactive({
      req(input$scalegvt)
    })
    
    mydt<-data.frame(Lot=c(rep("A",4),rep("b",5),rep("n",3),rep("x",2)),M_Datum=as.Date(c("2012-06-05","2012-06-15","2012-06-10","2014-11-17","2014-03-18","2014-06-15","2014-06-10","2014-06-17","2015-11-27","2016-08-15","2016-09-10","2016-10-27","2017-09-10","2017-10-12")),wafer=(c(rep(5,14) 1:14)),Yield=c(rep(10,14) 57))
  
  
dz<-reactive({
 req(res_mod())
  dat<-res_mod() 
  dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
  
  
  dt[,2]<-as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
  
  req(dt$M_Datum,dt$Yield)
  dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
  
  req(dr$M_Datum,dr$Yield)
  dx<-aggregate(Yield~M_Datum,dr,mean)
  req(dx$M_Datum,dx$Yield)
  dx$M_Datum<-format(dx$M_Datum, "%b %Y")
  
  return(data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield))
  })


#observeEvent(input$plot_click,

#{ a<- reactive(nearPoints(dz(),  input$plot_click, threshold = 10, maxpoints = 1,
            # addDist = F))
# b<-reactive(match(substr(a()$M_Datum,1,3),month.abb))


# req(res_mod())
 #dat<-res_mod() 
 #dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
 #dt<-dt[substr(dt$M_Datum,6,7)==as.character(b()),]
 
 
 
 
 #req(dt$Lot,dt$Yield)
 #dr<-data.frame("Lot"=dt$Lot,"Yield"=dt$Yield)
 
# req(dr$Lot,dr$Yield)
# dx<-aggregate(Yield~Lot,dr,mean)
# req(dx$Lot,dx$Yield)
 
# dza<-data.frame("Lot"=dx$Lot,"Yield"=dx$Yield)
# output$p2 <- renderPlot({  ggplot(dza, aes(x = Lot,y = Yield,group = 1))  
 #  geom_point()})

 
#})
  
  
  
  
  
  
  
  
  
  

    

  
  
  
  
  output$choose_Da <- renderUI({
    dateRangeInput('dateRange',
                   label = 'Filter  by date',
                   start = min(mydt$M_Datum) , end = max(mydt$M_Datum),min=min(mydt$M_Datum),max=max(mydt$M_Datum)
    )
  })
  

 res_mod <- callModule(
    module = selectizeGroupServer,
    id = "m",
   data =  mydt,
    vars = c("Lot","M_Datum","Yield","wafer"),
   inline=FALSE
    
  )
  
  output$table <- renderDataTable({
    
    
   dato<-res_mod() 
    
    return(dato[dato$M_Datum >= input$dateRange[1] & dato$M_Datum <=  input$dateRange[2],]) },
    options = list(scrollX = TRUE))
  
  
  
  
  
  
  
  
  
  filtredplot<-reactive({
    
    req(res_mod())
    dat<-res_mod() 
    dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
    
    
    dt[,2]<-as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
    
    req(dt$M_Datum,dt$Yield)
    dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
    
    req(dr$M_Datum,dr$Yield)
    dx<-aggregate(Yield~M_Datum,dr,mean)
    req(dx$M_Datum,dx$Yield)
    
    dz<-data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield)
    dz$M_Datum<-factor(format(dz$M_Datum, "%b %Y"), levels=format(sort(unique(dz$M_Datum)),"%b %Y"))
    hline_data <- data.frame(y = c(mean(dz$Yield)-sd(dz$Yield),mean(dz$Yield), mean(dz$Yield) sd(dz$Yield)), type = factor(c(2, 1, 2)), 
                             stringsAsFactors = FALSE)
    ggplot(dz, aes(x=M_Datum, y=Yield,group = 1))  
      geom_point(size=7,colour="#007A9D",shape=4)  
                                                                                     
                                                                                     
                                                                                     
                                                                                     
                                                                                     theme(axis.text.x = element_text(angle = 0, vjust = 0.5, hjust=1)) 
                                                                                       
                                                                                       
                                                                                       
                                                                                       theme(legend.direction = "horizontal", legend.position = "top", legend.key = element_blank(), 
                                                                                             legend.background = element_rect(fill = "white", colour = "white"),
                                                                                             
                                                                                             axis.text.y.left = element_text(color = "#007A9D"),
                                                                                             axis.title.y.left  = element_text(color = "#007A9D"),
                                                                                             plot.title = element_text(color="#007A9D")
                                                                                       ) 
                                                                                       
                                                                                       ylab("Mean Yield") 
                                                                                       xlab("") 
                                                                                       ggtitle(paste0("FCM-Yield Trend :","  ",paste0(c(input[["m-Customer_Name"]],input[["m-Local_Process_Id"]],input[["m-Process_Family"]],input[["m-MEMS_flag"]],input[["m-Device"]]),collapse = ","))) 
                                                                                       ylim(newscale()) 
                                                                                       
                                                                                       
                                                                                       geom_hline(data = hline_data, 
                                                                                                  aes(yintercept = y, linetype = type, colour = type))  
                                                                                       scale_colour_manual(values = c("#007A9D", "#EF783D"), 
                                                                                                           labels = c("Mean", "Mean -sd"),
                                                                                                           name = "Key:")  
                                                                                       scale_linetype_manual(values = 1:2, 
                                                                                                             labels = c("Mean", "Mean -sd"),
                                                                                                             name = "Key:")
                                                                                     
                                                                                     
                                                                                     
                                                                                     
                                                                                     
                                                                                     
                                                                                     
                                                                                     
  })
  
  
  output$p1<-renderPlot({
    
    
    filtredplot()                })
  }
  shinyApp(ui,server)

in that part of code turned to comment i have tried using the clik info to transform that month name to number to use it in order to filter data that means i want to plot the lot (x axis ) vs Yield ( as y axis in form of mean(avarage) ) so i can get average of yield pro lot in that month and then when i click again i want to get a second plot showing yield ( y axis not aggregated as mean this time) vs wafer (x axis) and of course only for that lot chosen by clickíng the first new plot.

CodePudding user response：

The code posted is not a minimal reproducible example MRE. I did not go through it. But here is an MRE to achieve the task you have described: to output a second plot (p2) based on the plot_click of a first plot (p1) using nearPoints() shiny function.

library(shiny)
library(ggplot2)

data <- mpg  

ui <- basicPage(
  plotOutput("p1", click = "plot_click"),
  plotOutput("p2")
)

server <- function(input, output) {
  output$p1 <- renderPlot({    
    ggplot(data, aes(x = displ, y = cty))   
      geom_point()
  })
  
  observeEvent(input$plot_click,{ 
    a <- nearPoints(data,  
                    input$plot_click, 
                    threshold = 10, 
                    maxpoints = 1,
                    addDist = F)$model

    if (length(a) > 0) {
      df <- data[data$model == a, ]  
      output$p2 <- renderPlot({
        ggplot(df, aes(x = model, y = displ, group = 1))  
          geom_point()
      })
    }
     
  })
  
}

shinyApp(ui, server)

EDITED here is the above solution using your code. A click on p1 outputs a second plot p2, and a click on p2 outputs a third plot p3. I made the plots smaller because I'm working on a laptop. Note that because your sample data is small, not all datapoints result in a valid click. But there are enough "good" points to test out the solution.

library(dplyr)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(ggplot2)

body <- dashboardBody(
  fluidRow(
    tabBox(
      
      # The id lets us use input$tabset1 on the server to find the current tab
      id = "tabset1",height = 750,width=20,
      tabPanel("Summary",dataTableOutput(outputId = "table")),
      tabPanel("Visualization",
               sliderInput("scalegvt","Scale  Data by:",  min = 0, max = 100, value = c(70,100)),
               plotOutput("p1", height = 300, width = 300, click = "plot_click_p1"),
               plotOutput("p2", height = 300, width = 300, click = "plot_click_p2"),
               plotOutput("p3", height = 300, width = 300,)
      )
    )
  )
)
side <- dashboardSidebar(  
  width = 290,
  sidebarMenu(
    menuItem("Summary",tabName = "Summary") ,  
    uiOutput('choose_Da'),
    
    selectizeGroupUI(
      id = "m",
      inline = FALSE,
      params = list(
        Lot = list(inputId = "Lot", title = "Lot"),
        wafer = list(inputId = "wafer", title = "wafer"),
        M_datum = list(inputId = "M_Datum", title = "M_Datum"),
        Yield = list(inputId = "Yield", title = "Yield")
        
        
      )
    ),inline=FALSE,
    menuItem("Visualization",tabName = "Visualization")
    
  ))
ui <- function(request) {
  
  dashboardPage(
    
    dashboardHeader(title = "Yield Report",titleWidth = 290),
    side,
    body
    
  )
}

server = function(input, output,session) { 
  
  
  
  newscale <- reactive({
    req(input$scalegvt)
  })
  
  mydt<-data.frame(Lot=c(rep("A",4),rep("b",5),rep("n",3),rep("x",2)),M_Datum=as.Date(c("2012-06-05","2012-06-15","2012-06-10","2014-11-17","2014-03-18","2014-06-15","2014-06-10","2014-06-17","2015-11-27","2016-08-15","2016-09-10","2016-10-27","2017-09-10","2017-10-12")),wafer=(c(rep(5,14) 1:14)),Yield=c(rep(10,14) 57))
  
  
  dz<-reactive({
    req(res_mod())
    dat<-res_mod() 
    dt<-dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
    
    
    dt[,2]<-as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
    
    req(dt$M_Datum,dt$Yield)
    dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
    
    req(dr$M_Datum,dr$Yield)
    dx<-aggregate(Yield~M_Datum,dr,mean)
    req(dx$M_Datum,dx$Yield)
    dx$M_Datum<-format(dx$M_Datum, "%b %Y")
    
    return(data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield))
  })
  
  
  observeEvent(input$plot_click_p1, { 
    a <- nearPoints(dz(),  
                    input$plot_click_p1, 
                    threshold = 10, 
                    maxpoints = 1,
                    addDist = F)
    
    b <- match(substr(a$M_Datum,1,3),month.abb)
    
    req(res_mod())
    dat <- res_mod() 
    dt  <- dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
    dt  <- dt[substr(dt$M_Datum,6,7)==as.character(b),]
    
    req(dt$Lot, dt$Yield)
    dr <- data.frame("Lot"=dt$Lot,"Yield"=dt$Yield)
  
    req(dr$Lot, dr$Yield)
    dx <- aggregate(Yield~Lot,dr,mean)
    
    req(dx$Lot,dx$Yield)
    dza <- data.frame("Lot"=dx$Lot,"Yield"=dx$Yield)
    
    output$p2 <- renderPlot({  
      ggplot(dza, aes(x = Lot,y = Yield,group = 1))  
      geom_point()
    })
  
  })
  
  observeEvent(input$plot_click_p2, {
    output$p3 <- renderPlot({
      
      
      test <- nearPoints(mydt,  
                 input$plot_click_p2, 
                 threshold = 10, 
                 maxpoints = 1,
                 addDist = F)
      
      str(test)
      ggplot(test, aes(x = Lot, y = Yield))  
        geom_point()
    })
  })

  output$choose_Da <- renderUI({
    dateRangeInput('dateRange',
                   label = 'Filter  by date',
                   start = min(mydt$M_Datum) , end = max(mydt$M_Datum),min=min(mydt$M_Datum),max=max(mydt$M_Datum)
    )
  })
  
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "m",
    data =  mydt,
    vars = c("Lot","M_Datum","Yield","wafer"),
    inline=FALSE
    
  )
  
  output$table <- renderDataTable({
    
    dato <- res_mod() 
    return(dato[dato$M_Datum >= input$dateRange[1] & dato$M_Datum <=  input$dateRange[2],]) 
    
  },options = list(scrollX = TRUE))

  filtredplot <- reactive({
    
    req(res_mod())
    dat <- res_mod() 
    dt <- dat[dat$M_Datum >=input$dateRange[1] & dat$M_Datum <= input$dateRange[2],]
    
    
    dt[,2] <- as.Date(format(as.Date(dt[,2]), "%Y-%m-01"))
    
    req(dt$M_Datum,dt$Yield)
    dr<-data.frame("M_Datum"=dt$M_Datum,"Yield"=dt$Yield)
    
    req(dr$M_Datum,dr$Yield)
    dx<-aggregate(Yield~M_Datum,dr,mean)
    req(dx$M_Datum,dx$Yield)
    
    dz<-data.frame("M_Datum"=dx$M_Datum,"Yield"=dx$Yield)
    dz$M_Datum<-factor(format(dz$M_Datum, "%b %Y"), levels=format(sort(unique(dz$M_Datum)),"%b %Y"))
    hline_data <- data.frame(y = c(mean(dz$Yield)-sd(dz$Yield),mean(dz$Yield), mean(dz$Yield) sd(dz$Yield)), type = factor(c(2, 1, 2)), 
                             stringsAsFactors = FALSE)
    ggplot(dz, aes(x=M_Datum, y=Yield,group = 1))  
      geom_point(size=7,colour="#007A9D",shape=4)  
      theme(axis.text.x = element_text(angle = 0, vjust = 0.5, hjust=1)) 
      theme(legend.direction = "horizontal", legend.position = "top", legend.key = element_blank(), 
            legend.background = element_rect(fill = "white", colour = "white"),
            axis.text.y.left = element_text(color = "#007A9D"),
            axis.title.y.left  = element_text(color = "#007A9D"),
            plot.title = element_text(color="#007A9D")
      )  
      ylab("Mean Yield") 
      xlab("") 
      ggtitle(paste0("FCM-Yield Trend :","  ",paste0(c(input[["m-Customer_Name"]],input[["m-Local_Process_Id"]],input[["m-Process_Family"]],input[["m-MEMS_flag"]],input[["m-Device"]]),collapse = ","))) 
      ylim(newscale()) 
      geom_hline(data = hline_data, 
                 aes(yintercept = y, linetype = type, colour = type))  
      scale_colour_manual(values = c("#007A9D", "#EF783D"), 
                          labels = c("Mean", "Mean -sd"),
                          name = "Key:")  
      scale_linetype_manual(values = 1:2, 
                            labels = c("Mean", "Mean -sd"),
                            name = "Key:")
  })
  
  output$p1 <- renderPlot({
    filtredplot()                
  })
}

shinyApp(ui,server)

Page link：https//www.codepudding.com/Enterprise/483957.html

Prev:geom_line() error geom_path: Each group consists of only one observation. Do you need to adjust the
Next:ggplot: geom_text over geom_bar
  • Related

About Us:  Contact Us      Terms of Service       Privacy Policy

Copyright © 2010-2023，Powered By CodePudding