SelectInput dependent of other selectInput and observe function

[Popsmelove]

Hi,

I'm trying to build my first Shiny app, then don't desperate if my questions are stupid .

I have a big dataframe with information about companies, their sector and their price historical.
I want to draw a price plot historical for the company choose by the user

My first Idea was to create a selectinput control with inputID ="SI_Stock" fed with all the possible companies and use the renderplot function to draw my plot. It's work fine but due to the number of companies the selectinput is not able to have them all.

Then I decide to create another selectInput with inputID = "SI_Sector" to filter the company list in "SI_Stock" on the sector select by user.

When I select a sector :
1 - The company list in "SI_Stock" is limited to stock in the corresponding sector
2 - My selectInput "SI_Stock" select automatically the first element of the list
3 - The plot is draw

When I select a company :
1 - The app draw the plot for the selected company
2 - Automatically the app select the first element of "SI_Stock" and then cancel the user selection

I understand that the second event reactive function observes and thus cancels the selection..How I can deal with that ?
I would like selectInput "SI_Stocks" to be updated only when there is an event on selectInput "SI_Sector" not for other reasons...

My Code (Sorry I do not see how to give a reproducible code because the dataframe is very big) :

library(shiny)
library(ggplot2)
library(stringr)
library(dplyr)
library(tidyr)
library(reshape2)

# Creation du dataframe

dtf # Dataframe with date, companies name, sector and price historical
names(dtf) <- c("Date", "Names", "Sector","Price")

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Price Historical"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "SI_Sector", 
                  label = "Sector:",
                  choices = sort(unique(dtf$Sector)), 
                  selected = sort(unique(dtf$Sector))[1]),
      
      selectInput(inputId = "SI_Stock", 
                  label = "Stock:",
                  choices ="",
                  selected =""),
      #choices = sort(unique((dtf %>%
      #                        filter(dtf$Sector==input$Sector))$Names)), 
      #selected = sort(unique((dtf %>%
      #filter(dtf$Sector==input$Sector))$Names))[1]),
      
      sliderInput("slider2", label = h3("Date Range"), min = min(dtf$Date), 
                  max = max(dtf$Date), value = c(min(dtf$Date), max(dtf$Date)))
      
    ),
    
    
    # Show a plot 
    mainPanel(
      plotOutput("Plot")
    )
  )
)


server <- function(input, output, session) {
  
  observe({
    
    c_Sector <- input$SI_Sector
    c_Stock <- input$SI_Stock
    
    updateSelectInput(session, "SI_Stock",
                      choice =sort(unique((dtf %>%
                                             filter(dtf$Sector==c_Sector))$Names))) 
    
    output$Plot <- renderPlot({
      dtf %>% 
        filter(dtf$Names==c_Stock) %>%
        gather(key,value, price) %>%
        ggplot(aes(x=Date, y=value, colour=key)) +
        geom_line()
      
    })
  }) 
}

# Run the application 
shinyApp(ui = ui, server = server)

Thanks for your help
Take care

[Popsmelove]

Hi,

I find a solution, perhaps not the better one but it's work !!

ui <- fluidPage(theme = shinytheme("slate"),
                
                # Application title
                titlePanel(tags$h2("STOCKS EPS HISTORICAL",style = "color:mediumturquoise")),
                
                # Sidebar with a slider input for number of bins 
                sidebarLayout(
                  
                  sidebarPanel(
                    selectInput(inputId = "SI_Sector", 
                                label = "Sector",
                                choices = sort(unique(dtf$Sector)), 
                                selected = ""),
                    
                    conditionalPanel(
                      condition = "false==true",
                      textInput("inText",  NULL, value = "")
                    ),
                    
                    selectInput(inputId = "SI_Stock", 
                                label = "List of stocks",
                                choices ="",
                                selected =""),
                    #choices = sort(unique((dtf %>%
                    #                        filter(dtf$Sector==input$Sector))$Names)), 
                    #selected = sort(unique((dtf %>%
                    #filter(dtf$Sector==input$Sector))$Names))[1]),
                    
                    dateRangeInput("date", strong("Date range"), start = min(dtf$Date), end = max(dtf$Date),
                                   min = min(dtf$Date), max = max(dtf$Date))
                    
                  ),
                  
                  
                  # Show a plot of the generated distribution
                  mainPanel(
                    
                    plotOutput("Plot",height = "600px")
                  )
                )
)


server <- function(input, output, session) {
  
  observe({
    c_Sector <- input$SI_Sector
    if (input$inText != c_Sector)
    {
      
      updateTextInput(session, "inText",
                      value = c_Sector)
      
      updateSelectInput(session, "SI_Stock",
                        choice =sort(unique((dtf %>%
                                               filter(dtf$Sector==c_Sector))$Names)))
    }
    c_stock <- input$SI_Stock
    if (c_stock !="")
    {
      c_daterange <- as.Date((dtf %>%
                                filter(dtf$Names==c_stock))$Date)
      
      updateDateRangeInput(session, "date", start = min(c_daterange),
                           end = max(c_daterange), min = min(c_daterange), max = max(c_daterange)) 
    }
  })
  
  Selected_Data <- reactive({
    req(input$date)
    validate(need(!is.na(input$date[1]) & !is.na(input$date[2]), "Error: Please provide both a start and an end date."))
    validate(need(input$date[1] < input$date[2], "Error: Start date should be earlier than end date."))
    data = NA
    if (input$SI_Stock!="")
    {
      data <- dtf %>%
        filter(
          Names==input$SI_Stock,
          Date > as.character(input$date[1]) & Date < as.character(input$date[2])
        )
    }
    return(data)
  })
  
  output$Plot <- renderPlot({
    data <- Selected_Data()
    if (length(data)>1)
    {
      datafin <- data %>% gather(key,value, epsntma, eps)
      datafin$key <- gsub("eps$","Reported EPS",datafin$key)
      datafin$key <- gsub("epsntma","EPS Ntma",datafin$key)
      datafin$key <- paste0(datafin$key,"\t\t\t\t")
      datafin %>%
        ggplot(aes(x=Date, y=value,colour=key)) + geom_line(size = 1) + 
        scale_color_manual(values=c("#48D1CC", "#F5F5F5")) + 
        labs(x = 'Date'
             , y = 'EPS'
             , title = input$SI_Stock) +
        theme_bw() +
        theme(text = element_text( color = "#FAFAFA")
              ,plot.background = element_rect(fill = '#272B30',colour = '#272B30')
              ,panel.background = element_rect(fill = '#272B30')
              ,panel.grid.minor = element_line(color = '#4d5566')
              ,panel.grid.major = element_line(color = '#4d5566')
              ,panel.border = element_rect(colour = "#4d5566", fill=NA, size=1)
              ,plot.title = element_text(size = 20)
              ,axis.title = element_text(size = 14)
              ,axis.title.y = element_text(vjust = 1, angle = 0)
              ,axis.title.x = element_text(hjust = 1, angle = 0)
              ,axis.text = element_text(color = "#FAFAFA")
              ,legend.position = "bottom"
              ,legend.title = element_blank()
              ,legend.background = element_rect(fill = '#272B30')
              ,legend.text =  element_text(size = 14)
              ,legend.key = element_rect(fill = '#272B30',color = '#272B30')
              ,legend.key.size = unit(50, 'points')
        ) 
    }          
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)