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
- if file1 is uploaded first then choice is "Model"
- if file2 is uploaded subsequently then choices should be "Model", "Observation", "Both"
- if file2 is uploaded first the choice is "Observation"
- 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
Time-Series - Data Splitting and Model Evaluation
Combination Boxplot and Histogram Using Ggplot2
Change Color of Only One Bar in Ggplot
Texture in Barplot for 7 Bars in R
Differencebetween a List and a Pairlist in R
Filter One Selectinput Based on Selection from Another Selectinput
R Table Function: How to Sum Instead of Counting
Automatic Adjustment of Margins in Horizontal Bar Chart
How to Extend '==' Behavior to Vectors That Include Nas
How to Specify "Does Not Contain" in Dplyr Filter
Add Dynamic Subtitle Using Ggplot
How to Fill Nas with Locf by Factors in Data Frame, Split by Country
Sort a Factor Based on Value in One or More Other Columns
Arrange Plots in a Layout Which Cannot Be Achieved by 'Par(Mfrow ='