Interactively Change the Selectinput Choices

Interactively change the selectInput choices

You need to make the UI reactive. I haven't tested this (miss data for it too) but should work I think. In server.R add:

output$selectUI <- renderUI({ 
selectInput("partnerName", "Select your choice", searchResult()[,1] ),
})

And in ui.R replace the selectInput with:

htmlOutput("selectUI")

How to change the name of the choices in selectInput to avoid using URLs as the choice?

You can define a vector containing the plot names and a named vector which contains the urls like this:

plot_names <- c("Plot1", "Plot2")
## Month Dropdown ##
# Use the plot names here
selectInput("plot_name", label = "Visualization:",
choices = plot_names, selected = plot_names[1]))

And then to display the urls:

urls <- c(Plot1 = "url1", Plot2 = "url2") # vector to get the urls from the names
renderUI({
tags$iframe(style="height:600px; width:100%; scorlling=yes", src=urls[input$plot_name])
})

Hope this helps.

Vary the choices in selectinput based on other conditions in shiny R

I have tried to correct some of the issues in the server.R file. Note that I followed the following algorithm

  1. if file1 is uploaded first then choice is "Model"
  2. if file2 is uploaded subsequently then choices should be "Model", "Observation", "Both"
  3. if file2 is uploaded first the choice is "Observation"
  4. if file1 is uploaded subsequently then choices should be "Model", "Observation", "Both"

library(shiny) library(xlsx)

shinyServer(function(input, output) {

a <- reactive({
fileinput1 <- input$file1
if (is.null(fileinput1))
return(NULL)
#read.table(fileinput1$datapath, header = TRUE, col.names = c("Ei","Mi","hours","Nphy","Cphy","CHLphy","Nhet","Chet","Ndet","Cdet","DON","DOC","DIN","DIC","AT","dCCHO","TEPC","Ncocco","Ccocco","CHLcocco","PICcocco","par","Temp","Sal","co2atm","u10","dicfl","co2ppm","co2mol","pH"))

#Please change this part back to your code as I dont have your file based on the column names above
read.table(fileinput1$datapath, header= TRUE)
})

#Upload Observation Data

b <- reactive({
fileinput2 <- input$file2
if (is.null(fileinput2))
return(NULL)
#xlfile <- list.files(pattern = ".xlsx")
xlfile <- fileinput2$datapath
wb <- loadWorkbook(xlfile)
sheet_ct <- wb$getNumberOfSheets()
b <- rbind(list(lapply(1:sheet_ct, function(x) {
res <- read.xlsx(xlfile, x)
})))
b <- b [-c(1),]
print(b)
})

getModel <- reactive({
if(!is.null(a()) & !is.null(b()))
{
c("Model", "Observation", "Both")
}
else if(!is.null(a()))
{
"Model"
}
else if(!is.null(b()))
{
"Observation"
}

})
output$check <- renderUI({
selectInput("check", label = h4("Dataset Selection"), choices = as.list(getModel()), multiple = F )
})

})

Controlling choices for reactive selectinput with other Selectinput

You had a few typos and incorrect way to update selectInput. Try this

library(leaflet)
library(shiny)
library(shinydashboard)
library(dplyr)

#Data Sample

longN <- c(-96.72363, -96.72880, -96.72700)
latN <- c(17.06167, 17.06200, 17.06170 )
nameN <- c("jim", "grant", "pablo")
foodN <- c("tacos", "burger", "elote")

dfnight <- data.frame(long=longN, lat=latN, name = nameN, food=foodN)

longM <- c(-96.7261564, -96.7260505, -96.7259757)
latM <- c(17.0543072,17.0548387, 17.0553262)
nameM <- c("bob", "frank", "sue")
foodM <- c("memelas","tortas", "tacos")

dfmorn <- data.frame(long=longM, lat=latM, name = nameM, food=foodM)

puestocolorsN = c ("tacos" = 'green',
"burger" = 'orange',
"elote" = 'red'
)

colorsN = puestocolorsN[dfnight$food]

iconsN <- awesomeIcons(icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = unname(colorsN) )
puestocolorsM = c ("tacos" = 'green',
"memelas" = 'orange',
"tortas" = 'black')

colorsM = puestocolorsM[dfmorn$food]

iconsM <- awesomeIcons(icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = unname(colorsM) )

#ui
ui <- fluidPage(
titlePanel(title = "Street Food Oaxaca"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "time",
label = "Select Time",
choices = c("Day", "Night"),
selected = "Day"
),
# uiOutput("conditionalUI")
selectInput(
inputId = "food",
label = "Type of Food",
choices = unique(dfmorn$food),
selected = dfmorn$food[1:5],
multiple = TRUE)),
mainPanel(h3("Map"), leafletOutput("map", width = "800", height = "600")))
)

#server
server <- function(input, output, session){

observeEvent(input$time, {

if(input$time == "Day") choices <- unique(dfmorn$food)
else choices <- unique(dfnight$food)

updateSelectInput(
inputId = "food",
label = "Type of Food",
choices = choices,
select=choices[1:3]
)
})

dfmrn <- eventReactive(input$food, {
if(input$time == "Day") df <- dfmorn
else df <- dfnight
df %>% dplyr::filter(food %in% input$food)
})

observe({print(dfmrn())})

output$map = renderLeaflet({
req(dfmrn())
leaflet(data = dfmrn()) %>%
setView(lng = -96.725, lat = 17.0618, zoom =14)%>%
addTiles()
})

observeEvent(input$food, {
if(input$time == "Day") icons <- iconsM
else icons <- iconsN
popup <- paste( "<b>Name:</b>", dfmrn()$name, "<br>", "<b>Type of food:</b>", dfmrn()$food)
leafletProxy("map", session) %>%
clearShapes() %>%
clearMarkers() %>%
addAwesomeMarkers(
data = dfmrn(),
lng = ~long,
lat = ~lat,
icon = icons, popup = popup,
label = ~as.character(name)
)
})

}

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

add CSS style to selectInput choices programatically

You can make a dynamic CSS style with renderUI:

library(shiny)

names <- c("A", "B", "C")
options <- data.frame(names)

cssTemplate <- function(color){
sprintf(
".selectize-dropdown-content > .option,
.selectize-input > .item
{
color: %s;
}",
color
)
}

ui <- fluidPage(
tags$head(
uiOutput("css")
),
selectInput("apkgs", "Select a package", choices = options$names),
)

server <- function(input, output, session) {

output[["css"]] <- renderUI({
color <- ifelse(input$apkgs == "A", "green", "red")
tags$style(HTML(cssTemplate(color)))
})

}

shinyApp(ui, server)


EDIT by the OP

library(shiny)

names <- c("A", "B", "C")
installed <- c(TRUE, FALSE, FALSE)
options <- data.frame(names, installed)

ui <- fluidPage(
tags$head(
uiOutput("css")
),

div(id="algo",
selectInput("apkgs", "Select a package", choices = options$names)
)
)

server <- function(input, output, session) {
output$css <- renderUI({
tags$style(
HTML(unlist(
lapply(names, function(x){
if(options[options$names==x,]$installed) {
sprintf("#algo .selectize-dropdown-content > .option[data-value='%s'] { color: green; }", x)
} else {
sprintf("#algo .selectize-dropdown-content > .option[data-value='%s'] { color: red; }", x)
}
})
)
)
)
})
}

shinyApp(ui, server)

change selectizeInput choices - wrong values in menu

I think you are not getting indices, but rather the integer representation of a factor. Check the class of partners[,1]. Try

output$selectUI <- renderUI({ 
selectizeInput("partnerName", "Click in and select",
choices=as.character(searchResult()[,1]), multiple=TRUE )
})

You could possibly add the stringsAsFactors=FALSE option when you read the data as well.

How to assign value to choices in selectInput

You can also try switch. Also try to use actionButton instead of submitButton as recommended here.

server <- function(input, output) { 

data <- reactive({
switch(input$age,
"--" = c(NA,NA),
"age1" = c(1.00,1.00),
"age2" = c(11.11,0.75),
"age3" = c(3.39, 0.45),
"age4" = c(1.35, 0.09)
)
})

output$result <- renderPrint ({if(input$gender == "gender1") {
print(log10(data()[1]))
}})}


Related Topics



Leave a reply



Submit