I am using shiny package in R to take input from user and plot the X and Y variable against each other as line plot.There is no error displayed.Everything is displayed except for the graph.Please can someone help why the graph is not displayed .Here is the ui.r file
library(shiny) # load the shiny package
setwd("C:/indiahacks2")
dat<-read.csv("final.csv")
# Define UI for application
shinyUI(fluidPage(
# Header or title Panel
titlePanel(h4('Impulse Response on VAR MODEL', align = "center")),
# Sidebar panel
sidebarPanel(
selectInput("Impulse", label = "1. Select the Impulse Variable",
choices = names(dat)),
selectInput("Response", label = "1. Select the Response Variable",
choices = names(dat)),
sliderInput("Lag", "2. Select the number of histogram BINs by using the slider below", min=0, max=25, value=10),
radioButtons("colour", label = "3. Select the color of histogram",
choices = c("Green", "Red",
"Yellow"), selected = "Green")
),
# Main Panel
mainPanel(
textOutput("text1"),
textOutput("text2"),
textOutput("text3"),
textOutput("text3"),
plotOutput("myhist")
)
)
)
Server.r
library(shiny) # Load shiny package
dat<-read.csv("final.csv")
shinyServer(
function(input, output) {
output$text1 <- renderText({
colm = as.numeric(input$Impulse)
paste("Impulse Variable is", names(dat[colm]))
})
output$text2 <- renderText({
paste("Color of plot is", input$radio)
})
output$text3 <- renderText({
paste("Number of Lags is", input$Lag)
})
output$text4 <- renderText({
colm = as.numeric(input$Response)
paste("Response Variable is", names(dat[colm]))
})
output$myhist <- renderPlot(
{
colm = as.numeric(input$Impulse)
colm1 = as.numeric(input$Response)
plot(dat[,colm],dat[,colm1])})
})
So there a couple of things wrong with your script, upon further inspection:
1) colm cannot be referenced by output$text4. This is because of scoping...
2) When you comment-out the output$text4 code I now receive an undefined column error in the plot call. This is because forcing your column choices to numeric returns NA.
Below should do what you are looking for.
Here is the server.R code:
library(shiny) # Load shiny package
dat<-read.csv("final.csv")
shinyServer(
function(input, output) {
output$text1 <- renderText({
colm = as.numeric(input$Impulse)
paste("Impulse Variable is", columns()[2])
})
output$text2 <- renderText({
paste("Color of plot is", input$radio)
})
output$text3 <- renderText({
paste("Number of Lags is", input$Lag)
})
output$text4 <- renderText({
colm = as.numeric(input$Response)
paste("Response Variable is", columns()[2])
})
columns<-reactive({
colm = as.character(input$Impulse)
colm1 = as.character(input$Response)
return(c(colm, colm1) )
})
output$myhist <- renderPlot(
{
plot(dat[,columns()[1]],dat[,columns()[2]],type="b")})
})
*Ui.R
# Define UI for application
library(shiny)
shinyUI(fluidPage(
# Header or title Panel
titlePanel(h4('Impulse Response on VAR MODEL', align = "center")),
# Sidebar panel
sidebarPanel(
selectInput("Impulse", label = "1. Select the Impulse Variable",
choices = names(dat)),
selectInput("Response", label = "1. Select the Response Variable",
choices = names(dat)),
sliderInput("Lag", "2. Select the number of histogram BINs by using the slider below", min=0, max=25, value=10),
radioButtons("colour", label = "3. Select the color of histogram",
choices = c("Green", "Red",
"Yellow"), selected = "Green")
),
# Main Panel
mainPanel(
textOutput("text1"),
textOutput("text2"),
textOutput("text3"),
textOutput("text4"),
plotOutput("myhist")
)
)
Related
I am trying to reference the values of a reactive variable. I have included the code I have so far below. I am referring to "output$var1" below. This app selects the dataset and based on that dataset produces another selectInput to select a variable.
I am able to render the text if I directly type dataset$area (the first variable of the rock dataset). I would like to render something like "dataset$selvar". Is there a way to do this?
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("dataset", label = "Dataset", choices =c("rock","pressure","cars")),
numericInput(inputId = "obs",
label = "Number of observations to view:",
value=10)
),
mainPanel(
verbatimTextOutput("summary"),
tableOutput("table"),
selectInput("inSelect","Select variable", c("Item A", "Item B")),
textOutput("var1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
datasetInput<-reactive({
switch(input$dataset,
"rock"=rock,
"pressure"=pressure,
"cars"=cars
)
})
output$summary<- renderPrint({
dataset<- datasetInput()
summary(dataset)
})
output$table<- renderTable({
head(datasetInput(), n=input$obs)
})
observe({
dataset<- datasetInput()
varlist<-colnames(dataset)
updateSelectInput(session,"inSelect",
label="Select variable",
choices=varlist,
selected=head(varlist,1)
)
selvar<-updateSelectInput(session,"inSelect",
label="Select variable",
choices=varlist,
selected=head(varlist,1)
)
output$var1<-renderText({
dataset$area
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
When I try dataset$selvar I get "error i ncat: argument 1 (type 'environment') cannot be bandled by 'cat'
Remove the second updateSelectInput from your observer, move your renderText outside of the observer. and inside the renderText use datasetInput()[[input$inSelect]] to display the select column from the selected dataset.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("dataset", label = "Dataset", choices = c("rock", "pressure", "cars")),
numericInput(
inputId = "obs",
label = "Number of observations to view:",
value = 10
)
),
mainPanel(
verbatimTextOutput("summary"),
tableOutput("table"),
selectInput("inSelect", "Select variable", c("Item A", "Item B")),
textOutput("var1")
)
)
)
server <- function(input, output, session) {
datasetInput <- reactive({
switch(input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars
)
})
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
output$table <- renderTable({
head(datasetInput(), n = input$obs)
})
observe({
dataset <- datasetInput()
varlist <- colnames(dataset)
updateSelectInput(session, "inSelect",
label = "Select variable",
choices = varlist,
selected = varlist[[1]]
)
})
output$var1 <- renderText({
datasetInput()[[input$inSelect]]
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:5275
I am creating a Shiny app and I have started using the Waiter package.
When I load the app, before doing anything, we cannot see anything (at it is expected). When I generate the plot, the loading bar appears but when it finishes, it doesn't disappear. It stays a white box that it still can be seen.
Loading....
It has finished.
Does anyone know how to remove it?
Thanks in advance!
Code:
library(shiny)
library(magrittr)
library(DT)
library(ggplot2)
library(waiter)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("My shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
useWaitress(),
actionButton(inputId = "drawplot", label = "Show the plot")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("plot"),
)
)
)
server <- function(input, output, session) {
waitress <- Waitress$new(theme = "overlay-percent", min = 0, max = 10)
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
# use notification
waitress$notify()
for(i in 1:10){
waitress$inc(1) # increase by 10%
Sys.sleep(.3)
}
v$plot <- ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
waitress$close() # hide when done
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)
Feels like a bug to me. You may file an issue to the waiter github repository and ask them to fix it. Meanwhile, a workaround we can do is to manually show and hide the bar by ourselves.
library(shiny)
library(magrittr)
library(DT)
library(ggplot2)
library(waiter)
library(shinyjs)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("My shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
useWaitress(),
useShinyjs(),
actionButton(inputId = "drawplot", label = "Show the plot")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
waitress <- Waitress$new(theme = "overlay-percent", min = 0, max = 10)
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
# use notification
show(selector = '.waitress-notification.notifications')
waitress$notify()
for(i in 1:10){
waitress$inc(1) # increase by 10%
Sys.sleep(.3)
}
v$plot <- ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
waitress$close()
hide(selector = '.waitress-notification.notifications')
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)
I am creating a shiny app with some tabs and I am using the shinycssloaders package in order to show a spinner AFTER pressing the actionButton. I saw this post because I was having the same problem... I followed the solution that it was given to the post, but as I my app is different (it has tabPanels, it doesn't work properly, the spinner still apears).
For example, if you click on "Show the plot" in the first tab (selection) and then you want to want to do the log2 transformation o calculate the square root (3rd tab, calculations), before clicking the actionButton the spinner appears and the plot updates. It happens the same when you want to change the titles (2nd tab).
Does anyone know how to fix it?
Thanks very much in advance
The code:
library(shiny)
library(magrittr)
library(DT)
library(ggplot2)
library(shinycssloaders)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("My shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
# Show a plot of the generated distribution
mainPanel(
# plotOutput("plot")
uiOutput("spinner"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
observeEvent(input$drawplot, {
output$spinner <- renderUI({
withSpinner(plotOutput("plot"), color="black")
})
output$plot <- renderPlot({
Sys.sleep(3)
ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
})
})
}
shinyApp(ui, server)
Is it OK like this? I'm not sure to understand all your requirements. To avoid the spinner at the start-up, I use a conditionalPanel. In the server code, I did some changes. It is not recommended to define some output inside an observer.
library(shiny)
library(magrittr)
library(ggplot2)
library(shinycssloaders)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("My shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel(
"Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel(
"Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel(
"Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
# Show a plot of the generated distribution
mainPanel(
conditionalPanel(
condition = "input.drawplot > 0",
style = "display: none;",
withSpinner(plotOutput("plot"))
)
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
gg <- reactive({
ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)
}) %>%
bindEvent(input$drawplot)
output$plot <- renderPlot({
Sys.sleep(3)
gg()
})
}
shinyApp(ui, server)
You need to isolate the expressions that you don't want to trigger the rendering event inside renderPlot
library(shiny)
library(magrittr)
library(DT)
library(ggplot2)
library(shinycssloaders)
new_choices <- setNames(names(mtcars), names(mtcars))
ui <- fluidPage(
# Application title
titlePanel("My shiny app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),
selectInput("y_axis", "Choose y axis",
choices = new_choices),
hr(),
),
tabPanel("Titles",
hr(),
textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),
),
tabPanel("Calculations",
hr(),
checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),
)
),
actionButton(inputId = "drawplot", label = "Show the plot")
),
# Show a plot of the generated distribution
mainPanel(
# plotOutput("plot")
uiOutput("spinner"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data+1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
observeEvent(input$drawplot, {
output$spinner <- renderUI({
withSpinner(plotOutput("plot"), color="black")
})
output$plot <- renderPlot({
Sys.sleep(3)
ggplot() +
geom_point(data = isolate(filtered_data()),
aes_string(x = isolate(input$x_axis), y = isolate(input$y_axis))) +
xlab(isolate(input$xlab)) +
ylab(isolate(input$ylab)) +
ggtitle(isolate(input$title))
})
})
}
shinyApp(ui, server)
Read more about shiny reactivity and isolation: https://shiny.rstudio.com/articles/isolation.html
I am new to Shiny and learning it's features. Using the mtcars data, I am trying to create a plot whose axis will alter upon user input. When I run the app, I am getting error telling me the "x and y lengths are not the same", so it appears that "data" specified in the plot function is not receiving the mtcars dataframe columns. The plot works property if I replace "data" with any of the columns listed in the server function.
shinyUI(navbarPage("My Application",
tabPanel("Component 1"),
tabPanel("Component 2"),
tabPanel("Component 3",
fluidPage(
fluidRow(
column(4,
"Sidebar",
helpText("This is my longer help text help text."),
selectInput("var",
label = "Choose a variable to display",
choices = c("mpg", "disp", "hp", "qsec"),
selected = "A")
),
column(8,
#style = "background-color:#4d3a7d;",
"Main",
textOutput("selected_var"),
plotOutput("plot1")
)
)
)
),
navbarMenu("More",
tabPanel("Sub-Component A"),
tabPanel("Sub-Component B"))
))
shinyServer(function(input, output) {
data <- reactive({
if("mpg" %in% input$var) return(mtcars$mpg)
if("disp" %in% input$var) return(mtcars$disp)
if("hp" %in% input$var) return(mtcars$hp)
if("qsec" %in% input$var) return(mtcars$qsec)
})
output$selected_var <- renderText({
paste("you have selected", input$var)
})
output$plot1 <- renderPlot({
plot(mtcars$wt, data)
})
})
I figured it out - "data" should have been "data()".
We could also use switch instead of if. Also, in the selected in selectInput, it could be one of the choices. Not sure where "A" is defined
library(shiny)
-ui
ui <- navbarPage("My Application",
tabPanel("Component 1"),
tabPanel("Component 2"),
tabPanel("Component 3",
fluidPage(
fluidRow(
column(4,
"Sidebar",
helpText("This is my longer help text help text."),
selectInput("var",
label = "Choose a variable to display",
choices = c("mpg", "disp", "hp", "qsec"),
selected = "mpg")
),
column(8,
#style = "background-color:#4d3a7d;",
"Main",
textOutput("selected_var"),
plotOutput("plot1")
)
)
)
),
navbarMenu("More",
tabPanel("Sub-Component A"),
tabPanel("Sub-Component B"))
)
-server
server <- function(input, output) {
data <- reactive({
switch(input$var,
mpg = mtcars$mpg,
dist = mtcars$disp,
hp = mtcars$hp,
qsec = mtcars$qsec
)
})
output$selected_var <- renderText({
paste("you have selected", input$var)
})
output$plot1 <- renderPlot({
plot(mtcars$wt, data(), xlab = "wt", ylab = input$var)
})
}
shinyApp(ui = ui, server = server)
-output
I have been working with the Shiny package, there is one function, which the user is able to select from a list of choices, based on the choice, the plot will update. however, right now the app does not update when the selection changes.
server.R
----------
library(shiny)
library(quantmod)
library(TTR)
shinyServer(function(input, output, session) {
selectedsymbol <- reactive({
symbol <- input$selectstock
})
output$stockplotoverview <- renderPlot({
symbolinput <- selectedsymbol()
getSymbols(symbolinput)
chartSeries(get(symbolinput))
addMACD()
addBBands()
})
output$candlechart <- renderPlot({
symbolinput <- input$selectstock
getSymbols(symbolinput)
candleChart(get(symbolinput),multi.col=TRUE,theme="white")
})
output$barchart <- renderPlot({
symbolinput <- input$selectstock
getSymbols(symbolinput)
barChart(get(symbolinput))
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
titlePanel("Hello Shiny!"),
# Sidebar component
sidebarLayout(
sidebarPanel(
selectInput("selectstockset", label = h3("Select the stock set"), choices = list("My Stock set" = 1,
"Good Stock Set" = 2,
"Customize" = 3), selected = 1),
selectInput("selectalgo", label = h3("Select the algorithm"), choices = list("Worst Increment" = 1,
"PAMR" = 2,
"SMA" = 3), selected = 1),
dateRangeInput("daterange", label = h3("Date Range")),
submitButton("Simulate")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Stock Set",
helpText("Select a stock to examine.
Information will be collected from yahoo finance."),
textInput("stocksetname", label = h4("Stock Set Name"),
value = "Enter text...") ,
# uiOutput("selectstock"),
selectInput("selectstock", label = h4("Select the stock"), choices = list("AAPL" = "AAPL",
"SBUX" = "SBUX",
"GS" = "GS")),
tabsetPanel(
tabPanel("Overview",
plotOutput("stockplotoverview")
),
tabPanel("Candle Chart",
plotOutput("candlechart")
),
tabPanel("Bar Chart",
plotOutput("barchart"))
),
hr(),
fluidRow(
column(3,
actionButton("addtostockset","Add to stock set"),
tags$style(type='text/css', "#addtostockset { align: right;}")
),
column(3,
actionButton("confirm","Confirm stock set"),
tags$style(type='text/css', "#confirm { align: right; }")
)
)),
tabPanel("Simulation Window"),
tabPanel("Statistical Result")
)
)
)))
Nothing is returned by your reactive conductor:
selectedsymbol <- reactive({
symbol <- input$selectstock
})
Use
selectedsymbol <- reactive({
symbol <- input$selectstock
return(symbol)
})