Good Evening,
the code i m using is very simple
UI:
selectInput("var", label = h4("choose a place"), choices = c("",as.character(Places$Adr)), selected = "", width = "90%")),
mainPanel(leafletOutput("mymap"),tableOutput("table"))
Server:
output$mymap <- renderLeaflet({
leaflet() %>% addTiles() %>%
#addCircles(lng = as.numeric(Places$Long), lat = as.numeric(Places$Lat), weight = 1) }
but when i choose an element from the liste the output (mymap) does'nt change !!
shall i use an obsereEvent ?
Your UI widget is not being used by your server.
In UI you named your selectInput with the name "var". To use the value from this widget you need to refer to input$var in your server.
Related
Is there any reason this wouldn't work? I simply want to see which terms are found in the two selected columns. I figured intersect would do the job, but I'm not seeing results. If this looks alright, perhaps I have some other syntax error along the way? Do the inputs need to be in different sidebar panels?
selectInput("data1", "Choose you Input:", choices = colnames(data), selected = "PD.Risk.Factor"),
selectInput("data2", "Choose you Input:", choices = colnames(data), selected = "AD.Risk.Factor")),
Output:
p2 = intersect(x = input$data1, y = input$data2)
print(p2)
Welcome to SO! Please provide a reprex the next time - this will help to get help.
For our problem. What your snippet does is to compare not the columns of your data frame but the the strings as returned by selectInput. What you want to do is to use these strings to retrieve the corresponding columns in the data.
library(shiny)
sample_dat <- data.frame(x = 1:10, y = 5:14, z = 9:18)
ui <- fluidPage(selectInput("col1", "Column 1:", names(sample_dat), "x"),
selectInput("col2", "Column 1:", names(sample_dat), "y"),
verbatimTextOutput("result"))
server <- function(input, output, session) {
output$result <- renderPrint({
list(on_strings = list(col1 = input$col1,
col2 = input$col2,
intersect = intersect(input$col1, input$col2)),
on_cols = list(col1 = input$col1,
col2 = input$col2,
intersect = intersect(sample_dat[[input$col1]],
sample_dat[[input$col2]])))
})
}
shinyApp(ui, server)
I'm using leaflet and shiny. I would like to color my markers based on a column that can be changed via input. It's almost the same as Modifying Existing Maps with leafletProxy. In this example, the user can change the color palette. In my example, I would like to change the column that the palette is applied on.
I'm trying to use something like:
fillColor = ~pal(!!sym(input$col_to_apply)) # input$col_to_apply is a column name (string) I want to use
However, this doesn't work. I'm also not sure if I have to use reactive() in this case.
Sure. My suggestion would be to do it before the palette is created. Palettes are tricky enough as it is. See the below minimal example:
library(leaflet)
library(maps)
library(shiny)
ui <- fluidPage(
leafletOutput("map_1"),
selectInput(inputId = "input_species", label = "Species Selection", choices = c("Species_1", "Species_2", "Species_3"))
)
server <- function(input, output, session) {
#Load a map of the US from the 'map' package (runs once when apps starts)
shp_map = map("state", fill = TRUE, plot = FALSE)
#Make up a dataframe with some data for three species for each state (runs once when apps starts)
df_data <- data.frame(state = unique(shp_map$names), Species_1 = sample(100:199, 63), Species_2 = sample(200:299, 63), Species_3 = sample(300:399, 63))
#Create map
output$map_1 <- renderLeaflet({
df_map <- df_data
#Create a column called species selected based on which is selected in the dropdown box
df_map$Species_Selected <- df_map[, paste(input$input_species)]
#Create a palette function
palette <- colorNumeric(palette = "Blues", domain = df_map$Species_Selected)
#Use the palette function created above to add the appropriate RGB value to our dataframe
df_map$color <- palette(df_map$Species_Selected)
#Create map
map_1 <- leaflet(data = shp_map) %>%
addPolygons(fillColor = df_map$color, fillOpacity = 1, weight = 1, color = "#000000", popup = paste(sep = "", "<b>", paste(shp_map$names), " ", "</b><br>", df_map$Species_Selected))
map_1
})
}
shinyApp(ui, server)
I am currently using the waiter package for my initial loading screen. It works great except that is displays my dashboard after the code is processed but before my plots render.
This behavior is expected due to where the waiter code is placed and how shiny renders plots but I am wondering if there is any way to keep the waiter screen 'alive' until all plots are rendered.
Example below:
library (shiny)
library (waiter)
library (shinydashboard)
library (shinycssloaders)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
use_waiter(include_js = TRUE), # do not include js
show_waiter_on_load(html = tagList(spin_orbiter(),span("Loading Dash...", style="color:white;")), color = "#3A3F44"), # place at the bottom
plotOutput(outputId = "distPlot") %>% withSpinner(color="#E4551F")
)
ui <- ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
Sys.sleep(2)
update_waiter(html = tagList(spin_orbiter(),span("Grabbing a cup of coffee...", style="color:white;")))
output$distPlot <- renderPlot({
Sys.sleep(5)
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = 30 + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
Sys.sleep(2)
update_waiter(html = tagList(spin_orbiter(),span("Getting back to work...", style="color:white;")))
Sys.sleep(2)
hide_waiter()
}
shinyApp(ui, server)
I get an error while using shiny dq_render_handsontable which I guess it's a bug of the dq_shiny package. I would appreciate if anyone could know any work around.
I am trying to interactively update a table via an action button ("Generate" in the code below). The tables which I am trying to switch among, have different number of columns. All works up to the display of the new table, i.e., once I click on "Generate" I can see the new table with additional columns. BUT the problem is that once I try to edit the cells of the data frame with a more columns after editting the first one with less columns, the following error appear:
Warning: Error in [<-.data.frame: new columns would leave holes after existing columns
I guess that is certainly a bug of dq_render_handsontable that doesn't recognize the new columns added to handsontable. Anyone knows a workaround? Maybe refreshing the table before showing a new data frame with more columns?
I attach the peice of the code to reproduce the error:
library(shiny)
library(rhandsontable)
library(dqshiny)
library(rlang)
ui = fluidPage(
dq_handsontable_output("InputTable", 9)
,
# actionButton("render", "Render HoT"),
actionButton("simulationInput_2", "Generate"),
fluidRow(id="bigRow", class="hidden",
style="height:100vh;background:#ff8f00;")
)
server = function(input, output) {
hw <- c("Hello", "my", "funny", "world!")
data1 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
A2=hw, B2=hw[c(2,3,4,1)], C2=1:4, D2=Sys.Date() - 1:4,
stringsAsFactors = FALSE)
hw <- c("Hello", "my", "funny", "world!")
data2 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
# A2=NA, B2=NA, C2=NA, D2=NA,
stringsAsFactors = FALSE)
cont = 0
observeEvent(input$simulationInput_2, {
cont <<- cont+1
print(cont)
if(mod(cont,2)==0){
data <- data2
}else{
data <- data1
}
renderInputTable(data)
render_hot("InputTable")
})
renderInputTable <- function(data){
dq_render_handsontable(
"InputTable",
data, #"rand",
# filters = F, #c("S", "T", "R", "R"),
filters = rep(NA, ncol(data)),
table_param = list(rowHeaders = NULL, selectCallback = TRUE))
}
observeEvent(input$random_select, toggle("bigRow"))
observeEvent(input$render, render_hot("InputTable"))
}
shinyApp(ui, server)
I could overcome the problem by a trick which is renaming the dq_shiny table ID which is actually a bug of dq_render_handsontable:
library(shiny)
library(rhandsontable)
library(dqshiny)
library(rlang)
library(magrittr)
library(data.table)
ui = fluidPage(
tags$div(id="simulationInputTable_divOutside", style="padding:0px;margin:0px",
tags$div(id="simulationInputTable_divInside1", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable1", 9)),
tags$div(id="simulationInputTable_divInside2", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable2", 9)),
tags$div(id="simulationInputTable_divInside3", style="padding:0px;margin:0px",
dq_handsontable_output("InputTable3", 9))
)
,
# actionButton("render", "Render HoT"),
actionButton("simulationInput_2", "Generate"),
fluidRow(id="bigRow", class="hidden",
style="height:100vh;background:#ff8f00;")
)
server = function(input, output) {
columns <- c(1,2,3,4)
hw <- c("Hello", "my", "funny", "world!")
cont = 0
observeEvent(input$simulationInput_2, {
cont <<- cont+1
data1 <- data.frame(A=hw, B=hw[c(2,3,4,1)], C=1:4, D=Sys.Date() - 0:3,
A2=hw, B2=hw[c(2,3,4,1)], C2=1:4, D2=Sys.Date() - 1:4,
stringsAsFactors = FALSE)
name = paste0("InputTable",cont)
divName = paste0("simulationInputTable_divInside",cont-1)
hide(divName)
dq_render_handsontable(
name,
data1, #"rand",
# filters = F, #c("S", "T", "R", "R"),
filters = rep(NA, ncol(data1)),
table_param = list(rowHeaders = NULL, selectCallback = TRUE))
})
observeEvent(input$random_select, toggle("bigRow"))
observeEvent(input$render, render_hot("InputTable"))
}
shinyApp(ui, server)
I am having trouble creating an interactive column chart in R using highcharter. Here is the code that I am trying to work with:
library(highcharter)
library(shiny)
library(shinydashboard)
library(extrafontdb)
testdata<-read.table("Matrix_Mean_sym.txt", header=TRUE)
testdata2<-t(testdata)
testdatase<-read.table("Matrix_SE_sym.txt", header=TRUE)
testdatase2<-t(testdatase)
ui<-dashboardPage(...
tabItem(tabName = "graph",
fluidRow(
box(title= "Gene Selection",
selectizeInput(inputId = "gene", "Gene Symbol:",
choices = colnames(testdata2),
selected="CD8A",
options = NULL,
multiple = FALSE)),
box(title= "Graph of Gene Expression",
highchartOutput("genePlot"))
))
server<- function(input, output) {
output$genePlot <- {
renderHighchart({
require(input$gene)
highchart() %>%
hc_add_series(data = list(testdata2[, input$gene]), type="column") %>%
hc_xAxis(categories = c('CD14+',
'CD19+',
'CD4+',
'CD56+',
'CD8+',
'Neutrophils',
'nRBCs',
'WB')) %>%
hc_title(text= "Graph of Gene Expression")
})}
I know I do not provide a working dataset, but this is from a 140904 element matrix. The error that shows up every time I run this code is:
Warning in if (!loaded) { :
the condition has length > 1 and only the first element will be used
c("Loading required package: $", "Loading required package: input", "Loading required package: gene")
Failed with error: ‘'package' must be of length 1’
Input to asJSON(keep_vec_names=TRUE) is a named vector. In a future version of jsonlite, this option will not be supported, and named vectors will be translated into arrays instead of objects. If you want JSON object output, please use a named list instead. See ?toJSON.
Any help would be appreciated. Thanks!