I'm sorry my code is too complex to create a MRE. I am currently trying to dynamically output n numbers of plots & inputSliders based on the number of calculation columns inputted. I have looked almost everywhere, however I can not seem to find a previously posted question that connects dynamically produced plots & sliders.
Goals: Upload n plots & inputSlider based up a file upload. Two reactive vertical lines on top of the plot that move based on the respective inputSlider range.
What actually happens: The correct number of plots & sliderInputs output, however the inputSliders aren't reactive to the created plots AND the vertical line doesn't appear.
I don't receive any error messages, however I am almost certain that the issues lies in that my inputSlider information returns NULL.
I've tried to change the possible inputs for the ggplot code to hopefully show the respective plots by doing:
...+geom_vline(xintercept = input$plotSlider[1])+ geom_vline(xintercept = input$plotSlider[2])
...+geom_vline(xintercept = output$plotSlider[1])+geom_vline(xintercept = output$plotSlider[2])
..+geom_vline(xintercept = plotSlider[1]) +geom_vline(xintercept = plotSlider[2])
I also have tried rendering the sliders before the plots, since the input variable wouldn't have been created yet.
This here is a sample csv file:
structure(list(X10.9 = c(11.1, 11.6, 12, 12.5, 13, 13.4), X = c(NA,
NA, NA, NA, NA, NA), X.0.095 = c(-0.0911, -0.07, -0.0891, -0.1021,
-0.1019, -0.1019), X.1 = c(NA, NA, NA, NA, NA, NA), X1.4241 = c(1.4396,
1.4439, 1.4454, 1.4498, 1.4513, 1.4513), X.2 = c(NA, NA, NA,
NA, NA, NA), X1.4353 = c(1.4498, 1.4648, 1.474, 1.4819, 1.485,
1.4866), X.3 = c(NA, NA, NA, NA, NA, NA), X0.6736 = c(0.6943,
0.7066, 0.7141, 0.7179, 0.7193, 0.7182)), row.names = c(NA, 6L
), class = "data.frame")
My Code so far:
library(shiny)
library(dplyr, warn.conflicts = FALSE)
library(ggplot2)
#library(MeltR)
library(shiny)
library(glue)
# Define UI ----
ui <- navbarPage(title = "MeltShiny",
id = "navbar",
navbarMenu("File",
tabPanel("Add Data",
fluidPage(
sidebarLayout(
sidebarPanel(
textInput(label="Enter the Pathlength for each Absorbance Reading(separated by commas)",
placeholder = "E.g: 2,5,3,2,...",
inputId = "pathlengths"),
fileInput(label = "Add Data",
inputId = "inputFile",
multiple = FALSE,
accept = ".csv")
),
mainPanel(
tableOutput("contents")
)
)
)
)
),tabPanel(
value = "vizPanel",
title = "Data Visualization",
uiOutput("sliders"),
uiOutput("plots")
)
)
server <- function(input,output){
#Reactive list variable
values <- reactiveValues(masterFrame=NULL,up=NULL,loaded=NULL)
plots <- reactiveValues()
#Upload Project File
upload <- observeEvent(eventExpr =input$inputFile,
handlerExpr = {
req(input$inputFile)
#Declaring variables
pathlengths <- c(unlist(strsplit(input$pathlengths,",")))
req(input$inputFile)
fileName = input$inputFile$datapath
cd <- read.csv(file = fileName,header=FALSE)
df <- cd %>% select_if(~ !any(is.na(.)))
#Creating temporary frame to store sample data
columns <- c("Sample", "Pathlength", "Temperature", "Absorbance")
tempFrame <- data.frame(matrix(nrow = 0, ncol = 4))
colnames(tempFrame) <- columns
readings <- ncol(df)
#Loop that appends sample data
counter <- 1
for (x in 2:readings){
col <- df[x]
sample<-rep(c(counter),times=nrow(df[x]))
pathlength<-rep(c(pathlengths[counter]),times=nrow(df[x]))
col <- df[x]
t <- data.frame(sample,pathlength,df[1],df[x])
names(t) <- names(tempFrame)
tempFrame <- rbind(tempFrame, t)
counter <- counter + 1
}
values$numReadings <- counter-1
values$masterFrame <- tempFrame
values$up <- 1
}
)
output$contents <- renderTable({
return(values$masterFrame)})
observeEvent(eventExpr = input$navbar == "vizPanel",
handlerExpr = {
req(input$inputFile)
print("Observe Triggered")
for(i in 1:values$numReadings){
local({
myI <- i
plotName = paste0("plot",myI)
plotSlider = paste0("plotSlider",myI)
output[[plotName]] <- renderPlot({
data = values$masterFrame[values$masterFrame$Sample == myI,]
ggplot(data, aes(x = Temperature,
y = Absorbance,
color = factor(Sample))) +geom_point() +theme_classic()+geom_vline(xintercept = input$plotSlider[1]) +geom_vline(xintercept = input$plotSlider[2])
})
})
values$loaded <- 1
}
}
)
output$plots <- renderUI({
req(values$loaded)
plot_output_list <- lapply(1:values$numReadings, function(i){
plotName <- paste0("plot",i)
plotOutput(plotName,height=280,width=250)
})
do.call(tagList,plot_output_list)
})
output$sliders <- renderUI({
req(input$inputFile)
print("slider")
slider_output_list <- lapply(1:values$numReadings, function(i){
plotSlider <- paste0("plotSlider",i)
data = values$masterFrame[values$masterFrame$Sample == i,]
xmin = min(data$Temperature)
xmax = max(data$Temperature)
sliderInput(plotSlider,"Range of values",min=xmin,max=xmax,value=c(xmin,xmax))
})
do.call(tagList,slider_output_list)
})
}
# Run the app
shinyApp(ui = ui, server = server)
Any suggestions would be greatly appreciated!
Appropriate syntax for input$plotSlider will make it work. Try this
library(shiny)
library(dplyr, warn.conflicts = FALSE)
library(ggplot2)
#library(MeltR)
library(shiny)
library(glue)
# Define UI ----
ui <- navbarPage(title = "MeltShiny",
id = "navbar",
navbarMenu("File",
tabPanel("Add Data",
fluidPage(
sidebarLayout(
sidebarPanel(
textInput(label="Enter the Pathlength for each Absorbance Reading(separated by commas)",
placeholder = "E.g: 2,5,3,2,...",
inputId = "pathlengths"),
fileInput(label = "Add Data",
inputId = "inputFile",
multiple = FALSE,
accept = ".csv")
),
mainPanel(
tableOutput("contents")
)
)
)
)
),tabPanel(
value = "vizPanel",
title = "Data Visualization",
uiOutput("sliders"),
uiOutput("plots")
)
)
server <- function(input,output){
#Reactive list variable
values <- reactiveValues(masterFrame=NULL,up=NULL,loaded=NULL)
plots <- reactiveValues()
#Upload Project File
upload <- observeEvent(eventExpr =input$inputFile,
handlerExpr = {
req(input$inputFile)
#Declaring variables
pathlengths <- c(unlist(strsplit(input$pathlengths,",")))
req(input$inputFile)
fileName = input$inputFile$datapath
cd <- read.csv(file = fileName,header=TRUE)
df <- cd %>% select_if(~ !any(is.na(.)))
#Creating temporary frame to store sample data
columns <- c("Sample", "Pathlength", "Temperature", "Absorbance")
tempFrame <- data.frame(matrix(nrow = 0, ncol = 4))
colnames(tempFrame) <- columns
readings <- ncol(df)
#Loop that appends sample data
counter <- 1
for (x in 2:readings){
# local({
# x <- x
col <- df[x]
sample<-rep(c(counter),times=nrow(df[x]))
pathlength<-rep(c(pathlengths[counter]),times=nrow(df[x]))
col <- df[x]
t <- data.frame(sample,pathlength,df[1],df[x])
names(t) <- names(tempFrame)
tempFrame <- rbind(tempFrame, t)
counter <- counter + 1
#})
}
values$numReadings <- counter-1
values$masterFrame <- tempFrame
values$up <- 1
}
)
output$contents <- renderTable({
return(values$masterFrame)})
# observeEvent(eventExpr = input$navbar == "vizPanel",
# handlerExpr = {
observe({
req(input$inputFile)
#print(input[[paste0("plotSlider1")]])
print("Observe Triggered")
for(i in 1:values$numReadings){
local({
myI <- i
plotName = paste0("plot",myI)
plotSlider = paste0("plotSlider",myI)
output[[plotName]] <- renderPlot({
data = values$masterFrame[values$masterFrame$Sample == myI,]
ggplot(data, aes(x = Temperature,
y = Absorbance,
color = factor(Sample))) +
geom_point() + theme_classic()+
geom_vline(xintercept = input[[paste0("plotSlider",myI)]][1]) +
geom_vline(xintercept = input[[paste0("plotSlider",myI)]][2])
})
})
values$loaded <- 1
}
})
output$plots <- renderUI({
req(values$loaded)
plot_output_list <- lapply(1:values$numReadings, function(i){
plotName <- paste0("plot",i)
plotOutput(plotName,height=280,width=250)
})
do.call(tagList,plot_output_list)
})
output$sliders <- renderUI({
req(input$inputFile)
slider_output_list <- lapply(1:values$numReadings, function(i){
plotSlider <- paste0("plotSlider",i)
data = values$masterFrame[values$masterFrame$Sample == i,]
xmin = min(data$Temperature)
xmax = max(data$Temperature)
sliderInput(plotSlider,"Range of values",min=xmin,max=xmax,value=c(xmin,xmax))
})
do.call(tagList,slider_output_list)
})
}
# Run the app
shinyApp(ui = ui, server = server)
I have this sample app:
User should pick a numer of row from which a random value will be generated and output is a plot of values.
I would like to compare input with the row number but I get this error:
Warning: Error in <=: comparison (4) is possible only for atomic and list types
48: ifelse
library(shiny)
ui <- fluidPage(
titlePanel("Random numbers"),
sidebarLayout(
sidebarPanel(
sliderInput("row",
"Row number:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("rowPlot")
)
)
)
server <- function(input, output) {
rowTable <- data.frame(rowNumber = as.integer(), value = as.integer())
rowTable[1:50, ] <- NA
rowTable[["rowNumber"]] <- 1:50
rowTable[["value"]] <- ifelse(rowTable[["rowNumber"]] <= reactive({input$row}), 0, rnorm(50))
output$rowPlot <- renderPlot({
plot(rowTable[["rowNumber"]], rowTable[["value"]])
})
}
shinyApp(ui = ui, server = server)
Create the data.frame inside the reactive
server <- function(input, output) {
dat <- reactive({
rowTable <- data.frame(rowNumber = as.integer(), value = as.integer())
rowTable[1:50, ] <- NA
rowTable[["rowNumber"]] <- 1:50
rowTable[["value"]] <- ifelse(rowTable[["rowNumber"]] <= as.numeric(input$row), 0, rnorm(50))
rowTable
})
output$rowPlot <- renderPlot({
tmp <- dat()
plot(tmp[["rowNumber"]], tmp[["value"]], xlab = "rowNumber", ylab = "value")
})
})
}
-testing
shinyApp(ui = ui, server = server)
-output
I want to get the following simple R function running in Shiny.
It works fine in R.
LifeExpectancy <- function(Age){
X <- which(lifeExpCH$Alter == Age)
LifeE <- lifeExpCH$`2018`[X:100]
Y <- seq(Age, 99, 1)
df1 <- data.frame(LifeE, Y)
ggplot(df1, aes(Y, LifeE)) +
geom_line() +
labs(x = “Age”, y = “Years Expected to Live”, title = “Life Expectancy Switzerland 2018”)
}
What I wrote in Shiny and is not working.
Would very be very happy for some help, thank you.
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = "Age", label = "Enter your age", value = 30, min = 0, max = 99)
),
mainPanel(
plotOutput(outputID = "LifeExp_plot")
)
)
)
LifeExpectancy <- function(Age){
X <- which(lifeExpCH$Alter == Age)
LifeE <- lifeExpCH$`2018`[X:100]
Y <- seq(Age, 99, 1)
df1 <- data.frame(LifeE, Y)
return(df1)
}
server <- function(input, output){
LifeExpectancy <- reactive ({
LifeExpectancy(input$Age)
})
output$LifeExp_plot <- renderPlot({
ggplot(LifeExpectancy, aes(Y, LifeE) ) +
geom_line()
})
}
shinyApp(ui = ui, server = server)
#Martin - I hope this may be helpful. I am not able to run as I don't have lifeExpCH available.
Note I renamed your calculation function as LifeExpectancyFromAge to distinguish from your reactive function. And when you call your reactive function, make sure to use parentheses.
library(shiny)
library(ggplot2)
LifeExpectancyFromAge <- function(Age){
X <- which(lifeExpCH$Alter == Age)
LifeE <- lifeExpCH$`2018`[X:100]
Y <- seq(Age, 99, 1)
df1 <- data.frame(LifeE, Y)
return(df1)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = "Age", label = "Enter your age", value = 30, min = 0, max = 99)
),
mainPanel(
plotOutput(outputId = "LifeExp_plot")
)
)
)
server <- function(input, output){
LifeExpectancy <- reactive ({
LifeExpectancyFromAge(input$Age)
})
output$LifeExp_plot <- renderPlot({
ggplot(LifeExpectancy(), aes(Y, LifeE)) +
geom_line() +
labs(x = "Age", y = "Years Expected to Live", title = "Life Expectancy Switzerland 2018")
})
}
shinyApp(ui = ui, server = server)
I have a rather simple problem but can not figure out why it is not working
library(shiny)
library(leaflet)
pts <- data.frame(
id = letters[seq(from = 1, to = 10)],
x = rnorm(10, mean = -93.625),
y = rnorm(10, mean = 42.0285),
stringsAsFactors = F
)
# Define UI
ui <- fluidPage(uiOutput('Select'))
server <- function(input, output, session) {
pts
output$Select <- renderUI({
Range <- sort(unique(pts$id))
selectInput("dataselect",
"select",
choices = Range,
selected = 'a')
})
mydata <- reactive({
if (input$dataselect != 'a') {
data <- pts[pts$id == input$dataselect,]
}
else
{
data <- pts
}
})
observe(print(mydata()))
}
shinyApp(ui = ui, server = server)
I basically try to subset my data set if anything else than 'a' is selected with the selected value. If 'a' is selected I want the whole df returned.
Just run into
Warning: Error in if: argument is of length zero [No stack trace
available]
You need to to not run mydata() if input$dataselect is not available, that can be done by inserting: req(input$dataselect)
As shown below:
library(shiny)
library(leaflet)
pts <- data.frame(
id = letters[seq(from = 1, to = 10)],
x = rnorm(10, mean = -93.625),
y = rnorm(10, mean = 42.0285),
stringsAsFactors = F
)
# Define UI
ui <- fluidPage(uiOutput('Select'))
server <- function(input, output, session) {
output$Select <- renderUI({
Range <- sort(unique(pts$id))
selectInput("dataselect",
"select",
choices = Range,
selected = 'a')
})
mydata <- reactive({
req(input$dataselect)
if (input$dataselect != 'a') {
data <- pts[pts$id == input$dataselect,]
}
else
{
data <- pts
}
})
observe(print(mydata()))
}
shinyApp(ui = ui, server = server)
The community helped me in developing this code
library(shiny)
server <- shinyServer(function(input, output, session) {
values <- reactiveValues()
values$df <- data.frame(N = numeric(0), A = numeric(0), C = numeric(0))
newEntry <- observeEvent(input$update,{
gr <- 10 + input$n
newLine <- isolate(c(input$n, input$nr1, gr))
values$df[nrow(values$df) + 1,] <- c(input$n, input$nr1, gr)
})
output$table1 <- renderTable({values$df})
})
ui <- shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("nr1", "Give a number: ", min = 0, max = 100, value = 0, step = 2),
sliderInput("n", "N:", min = 10, max = 1000, value = 200, step = 10),
actionButton("update", "Update Table"))),
column(6, tableOutput("table1"))
)
))
shinyApp(ui, server)
And I come to a new problem with that.
Now, I'd like that the app do like this: on click on the update, the variable A should always add a 5 i.e. if I have starting value of 5 than on the next click it should be 10 than 15, 20 etc?
Now when I click update the same number appears continously
Is this what you want? Also you dont need the isolate in there.
rm(list = ls())
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
sliderInput("nr1", "Give a number:", min = 1, max = 100, value = 1, step = 1),
sliderInput("n", "N:", min = 10, max = 1000, value = 200, step = 10),
actionButton("update", "Update Table"))),
column(6, tableOutput("table1"))
)
))
server <- shinyServer(function(input, output, session) {
values <- reactiveValues()
values$df <- data.frame(N = numeric(0), A = numeric(0), C = numeric(0))
newEntry <- observeEvent(input$update,{
if(!is.null(input$nr1) & is.null(values$A)){
values$A <- input$nr1
}
if(nrow(values$df) > 0){
values$A <- values$A + 5
}
gr <- 10 + input$n
values$df[nrow(values$df) + 1,] <- c(input$n, values$A, gr)
})
output$table1 <- renderTable({values$df})
})
shinyApp(ui, server)