How to choose between histogram and nothing in sidebarPanel? - r

Let's consider my very basic application :
Created by code :
Server
library(shiny) # Load shiny package
start <- as.Date("2013-01-01")
end <- as.Date("2016-10-01")
#Apple stock
getSymbols("AAPL", src = "yahoo", from = start, to = end)
apple <- AAPL$AAPL.Close
#Gold
getSymbols('GOLD', src = 'yahoo', from = start, to = end)
gold <- GOLD$GOLD.Close
#S&P500
getSymbols('^GSPC', src = 'yahoo', from = start, to = end)
sp <- as.numeric(`GSPC`[,4])
#Microsoft
getSymbols('MSFT', src = 'yahoo', from = start, to = end)
msft <- MSFT$MSFT.Close
stock.frame <- data.frame(apple, gold, msft, sp)
colnames(stock.frame) <- c('apple', 'gold', 'msft', 'sp')
shinyServer(
function(input, output) {
output$myhist <- renderPlot({
colm <- as.numeric(input$var)
hist(stock.frame[, colm], col = input$colour, xlim = c(min(stock.frame[, colm]), max(stock.frame[, colm])), main = "Histogram of stock dataset", breaks = seq(min(stock.frame[, colm]), max(stock.frame[, colm]), l = input$bin + 1), xlab = names(stock.frame[colm]))
})
}
)
UI
library(shiny) # load the shiny package
# Define UI for application
shinyUI(fluidPage(
# Header or title Panel
titlePanel(h4('Demostration of the renderPlot() - A Histogram with stock dataset', align = "center")),
# Sidebar panel
sidebarPanel(
selectInput("var", label = "1. Select the quantitative Variable",
choices = c("Apple" = 1, "Gold" = 2, "S&P" = 3, "BTC"=4),
selected = 3),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=50, value=15),
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"),
plotOutput("myhist")
)
)
)
I want to have another sidebarPanel (analogous to '1. Select the quantitative Variable') in which I can specify if I want 'Histogram' or 'nothing'. If histogram was choosed then I should have same thing as above. When "nothing' was choosed I should see blank page. Do you know how it can be performed ?
EDIT
I added radiobutton as #r2evans suggested. It now look's in the way following :
shinyUI(fluidPage(
radioButtons("rb", "Plot type:", choiceNames = c("Histogram", "Nothing")),
# Header or title Panel
titlePanel(h4('Demostration of the renderPlot() - A Histogram with stock dataset', align = "center")),
# Sidebar panel
sidebarPanel(
selectInput("var", label = "1. Select the quantitative Variable",
choices = c("Apple" = 1, "Gold" = 2, "S&P" = 3, "BTC"=4),
selected = 3),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=50, value=15),
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"),
plotOutput("myhist")
)
)
)
However after running 'Run App' i see error :
Error in normalizeChoicesArgs: Please specify a non-empty vector for `choices` (or, alternatively, for both `choiceNames` AND `choiceValues`).
81: stop
80: normalizeChoicesArgs
79: radioButtons
Have I done something wrong ?

Perhaps you are looking for a solution like this
library(shiny)
library(quantmod)
start <- as.Date("2013-01-01")
end <- as.Date("2016-10-01")
#Apple stock
getSymbols("AAPL", src = "yahoo", from = start, to = end)
apple <- AAPL$AAPL.Close
#Gold
getSymbols('GOLD', src = 'yahoo', from = start, to = end)
gold <- GOLD$GOLD.Close
#S&P500
getSymbols('^GSPC', src = 'yahoo', from = start, to = end)
sp <- as.numeric(`GSPC`[,4])
#Microsoft
getSymbols('MSFT', src = 'yahoo', from = start, to = end)
msft <- MSFT$MSFT.Close
stock.frame <- data.frame(apple, gold, msft, sp)
colnames(stock.frame) <- c('apple', 'gold', 'msft', 'sp')
cmat <- cor(stock.frame)
### plot_ly(z = cmat, type = "heatmap")
### Define UI for application
ui <- fluidPage(
# Header or title Panel
titlePanel(h4('Demostration of the renderPlot() - A Histogram with stock dataset', align = "center")),
# Sidebar panel
sidebarPanel(
selectInput("var", label = "1. Select the quantitative Variable",
choices = c("Apple" = 1, "Gold" = 2, "S&P" = 3, "BTC"=4),
selected = 3),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=50, value=15),
radioButtons("graphtype", label = "Select Type of Graph",
choices = c("Heatmap", "Histogram", "DataTable"), selected = "Heatmap"),
conditionalPanel(
condition = "input.graphtype == 'Histogram' ",
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"),
conditionalPanel(
condition = "input.graphtype == 'Heatmap' ", plotlyOutput("heatmap", width = "100%", height="600px")
),
conditionalPanel(
condition = "input.graphtype == 'Histogram' ", plotOutput("myhist")
),
conditionalPanel(
condition = "input.graphtype == 'DataTable' ", DTOutput("tb1")
)
)
)
server <- function(input, output) {
output$myhist <- renderPlot({
colm <- as.numeric(input$var)
hist(stock.frame[, colm], col = input$colour, xlim = c(min(stock.frame[, colm]), max(stock.frame[, colm])), main = "Histogram of stock dataset", breaks = seq(min(stock.frame[, colm]), max(stock.frame[, colm]), l = input$bin + 1), xlab = names(stock.frame[colm]))
})
output$heatmap <- renderPlotly({plot_ly(x = colnames(stock.frame), y = colnames(stock.frame), z = cmat, type = "heatmap") %>%
layout(
xaxis = list(title=colnames(stock.frame)),
yaxis = list(title="ts")
)
})
output$tb1 <- renderDT(stock.frame)
}
# Run the application
shinyApp(ui = ui, server = server)

Related

How to connect heatmap with histogram?

Let's consider my heatmap shiny code :
library(shiny)
library(plotly)
library(quantmod)
#Data
start <- as.Date("2013-01-01")
end <- as.Date("2016-10-01")
#Apple stock
getSymbols("AAPL", src = "yahoo", from = start, to = end)
apple <- AAPL$AAPL.Close
#Gold
getSymbols('GOLD', src = 'yahoo', from = start, to = end)
gold <- GOLD$GOLD.Close
#S&P
getSymbols('^GSPC', src = 'yahoo', from = start, to = end)
sp <- as.numeric(`GSPC`[,4])
#Microsoft
getSymbols('MSFT', src = 'yahoo', from = start, to = end)
msft <- MSFT$MSFT.Close
stock.frame <- data.frame(apple, gold, msft, sp)
colnames(stock.frame) <- c('apple', 'gold', 'msft', 'sp')
cmat <- cor(stock.frame)
plot_ly(z = cmat, type = "heatmap")
ui <- fluidPage(
mainPanel(
plotlyOutput("heatmap", width = "100%", height="600px")
)
)
## server.R
server <- function(input, output) {
output$heatmap <- renderPlotly({plot_ly(x = colnames(stock.frame), y = colnames(stock.frame), z = cmat, type = "heatmap") %>%
layout(
xaxis = list(title=colnames(stock.frame)),
yaxis = list(title="ts")
)
})
}
shinyApp(ui,server)
And my histogram :
UI
library(shiny) # load the shiny package
# Define UI for application
shinyUI(fluidPage(
# Header or title Panel
titlePanel(h4('Demostration of the renderPlot() - A Histogram with stock dataset', align = "center")),
# Sidebar panel
sidebarPanel(
selectInput("var", label = "1. Select the quantitative Variable",
choices = c("Apple" = 1, "Gold" = 2, "S&P" = 3, "BTC"=4),
selected = 3),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=50, value=15),
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"),
plotOutput("myhist")
)
)
)
Sever
library(shiny) # Load shiny package
start <- as.Date("2013-01-01")
end <- as.Date("2016-10-01")
#Apple stock
getSymbols("AAPL", src = "yahoo", from = start, to = end)
apple <- AAPL$AAPL.Close
#Gold
getSymbols('GOLD', src = 'yahoo', from = start, to = end)
gold <- GOLD$GOLD.Close
#S&P500
getSymbols('^GSPC', src = 'yahoo', from = start, to = end)
sp <- as.numeric(`GSPC`[,4])
#Microsoft
getSymbols('MSFT', src = 'yahoo', from = start, to = end)
msft <- MSFT$MSFT.Close
stock.frame <- data.frame(apple, gold, msft, sp)
colnames(stock.frame) <- c('apple', 'gold', 'msft', 'sp')
shinyServer(
function(input, output) {
output$myhist <- renderPlot({
colm <- as.numeric(input$var)
hist(stock.frame[, colm], col = input$colour, xlim = c(min(stock.frame[, colm]), max(stock.frame[, colm])), main = "Histogram of stock dataset", breaks = seq(min(stock.frame[, colm]), max(stock.frame[, colm]), l = input$bin + 1), xlab = names(stock.frame[colm]))
})
}
)
What I want to have is a special list in which I can choose if I want to have heatmap or histogram. So speaking as simply as possible I want possibility to switch between heatmap or histogram in one app (because now I have two seperate apps). Do you any idea how it can be performed ?
One way to achieve this is to use conditionalPanel as shown below.
library(shiny)
library(quantmod)
start <- as.Date("2013-01-01")
end <- as.Date("2016-10-01")
#Apple stock
getSymbols("AAPL", src = "yahoo", from = start, to = end)
apple <- AAPL$AAPL.Close
#Gold
getSymbols('GOLD', src = 'yahoo', from = start, to = end)
gold <- GOLD$GOLD.Close
#S&P500
getSymbols('^GSPC', src = 'yahoo', from = start, to = end)
sp <- as.numeric(`GSPC`[,4])
#Microsoft
getSymbols('MSFT', src = 'yahoo', from = start, to = end)
msft <- MSFT$MSFT.Close
stock.frame <- data.frame(apple, gold, msft, sp)
colnames(stock.frame) <- c('apple', 'gold', 'msft', 'sp')
cmat <- cor(stock.frame)
### plot_ly(z = cmat, type = "heatmap")
### Define UI for application
ui <- fluidPage(
# Header or title Panel
titlePanel(h4('Demostration of the renderPlot() - A Histogram with stock dataset', align = "center")),
# Sidebar panel
sidebarPanel(
selectInput("var", label = "1. Select the quantitative Variable",
choices = c("Apple" = 1, "Gold" = 2, "S&P" = 3, "BTC"=4),
selected = 3),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=50, value=15),
radioButtons("graphtype", label = "Select Type of Graph",
choices = c("Heatmap", "Histogram"), selected = "Heatmap"),
conditionalPanel(
condition = "input.graphtype == 'Histogram' ",
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"),
conditionalPanel(
condition = "input.graphtype == 'Heatmap' ", plotlyOutput("heatmap", width = "100%", height="600px")
),
conditionalPanel(
condition = "input.graphtype == 'Histogram' ", plotOutput("myhist")
)
)
)
server <- function(input, output) {
output$myhist <- renderPlot({
colm <- as.numeric(input$var)
hist(stock.frame[, colm], col = input$colour, xlim = c(min(stock.frame[, colm]), max(stock.frame[, colm])), main = "Histogram of stock dataset", breaks = seq(min(stock.frame[, colm]), max(stock.frame[, colm]), l = input$bin + 1), xlab = names(stock.frame[colm]))
})
output$heatmap <- renderPlotly({plot_ly(x = colnames(stock.frame), y = colnames(stock.frame), z = cmat, type = "heatmap") %>%
layout(
xaxis = list(title=colnames(stock.frame)),
yaxis = list(title="ts")
)
})
}
# Run the application
shinyApp(ui = ui, server = server)

r shiny selectInput - selectable classes in only one column

I'm new to R and shiny. I have a problem that I could not solve.
I have a histogram where I want to make the classes separately selectable.
The classes are all in one column. To make them separately selectable, I did not succeed.
How do I get it to work?
Thanks a lot
## app.R ##
set.seed(24)
df <- data.frame(Class = sample(LETTERS[1:5], 30, replace = TRUE),
Amount = sample(5:20, 30, replace = TRUE),
stringsAsFactors= FALSE, check.names = FALSE)
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
output$sum = renderPrint({
summary(df)
})
output$str = renderPrint({
str(df)
})
output$data = renderTable({
colm = as.numeric(input$var)
df[colm]
head(df)
})
output$myhist <- renderPlot({
colm = as.numeric(input$var)
hist(df$Amount, col =input$colour, xlim = c(0, max(df$Amount)), main = "Histogram", breaks = seq(0, max(df$Amount),l=input$bin+1),
xlab = names(df$Amount)
)}
)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("var", label = "1. Select Class",
choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5),
selected = 2),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=25, value=15),
radioButtons("colour", label = "3. Select the color of histogram",
choices = c("Green", "Red",
"Blue"), selected = "Green")
),
mainPanel(
tabsetPanel(type="tab",
tabPanel("Plot", plotOutput("myhist")),
tabPanel("Summary", verbatimTextOutput("sum")),
tabPanel("Structure", verbatimTextOutput("str")),
tabPanel("Data", tableOutput("data"))
)
)
)
)
shinyApp(ui = ui, server = server)
I appreciate your help.
You have a few options:
Allow the selectInput to have multiple selections, by adding multiple = TRUE:
selectInput("var", label = "1. Select Class", choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5), multiple = TRUE)
Use a checkbox group:
checkboxGroupInput('var', label = "1. Select Class", choices = c("A" = 1, "B" = 2, "C" = 3, "D"= 4, "E" = 5))
I recommend the 2nd option, using a checkbox group, as I believe they are easy for users to understand.
EDIT
As requested here is the full code, with the checkbox group linked to the chart:
## app.R ##
library(shiny)
set.seed(24)
df <- data.frame(Class = sample(LETTERS[1:5], 30, replace = TRUE),
Amount = sample(5:20, 30, replace = TRUE),
stringsAsFactors= FALSE, check.names = FALSE)
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs), col = 'darkgray', border = 'white')
})
output$sum = renderPrint({
summary(df)
})
output$str = renderPrint({
str(df)
})
output$data = renderTable({
colm = as.numeric(input$var)
df[colm]
head(df)
})
output$myhist <- renderPlot({
df_plot <- df[df$Class %in% input$var, ]
hist(df_plot$Amount, col = input$colour, xlim = c(0, max(df_plot$Amount)), main = "Histogram", breaks = seq(0, max(df_plot$Amount),l=input$bin+1),
xlab = names(df_plot$Amount)
)}
)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput('var', label = "1. Select Class", choices = c("A", "B", "C", "D", "E"), selected = "B"),
sliderInput("bin", "2. Select the number of histogram BINs by using the slider below", min=5, max=25, value=15),
radioButtons("colour", label = "3. Select the color of histogram",
choices = c("Green", "Red",
"Blue"), selected = "Green")
),
mainPanel(
tabsetPanel(type="tab",
tabPanel("Plot", plotOutput("myhist")),
tabPanel("Summary", verbatimTextOutput("sum")),
tabPanel("Structure", verbatimTextOutput("str")),
tabPanel("Data", tableOutput("data"))
)
)
)
)
shinyApp(ui = ui, server = server)

elements in ui not reactive

I am trying to make reactive elements in my shiny app using RStudio. I want the radio buttons to appear or disappear depending upon a checkbox. Then I am gathering the inputs from the elements displayed to generate two graphs. The problem is that the elements in UI are not reactive. Below is the coding I used.
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
tags$div(id = 'placeholder'),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg"),
uiOutput(outputId = "facet")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
observeEvent(input$checkbox_facet, { if (input$checkbox_facet == TRUE) { # radio buttons for facet options show, and graph be made accordingly.
output$facet <- eventReactive(input$checkbox_facet, { insertUI( selector = "#placeholder",
ui = radioButtons("radio_facet", label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"), selected = "owner")
) })
output$exp <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
facet_wrap(~get(input$radio_facet), labeller = label_both) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
)
})
})
output$reg <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
facet_wrap(~get(input$radio_facet), labeller = label_both) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
)
})
})
}
else { # radio buttons disappear and graph is without facets
output$facet <- eventReactive(input$checkbox_facet, { removeUI(selector = 'div:has(> #radio_facet)', immediate = TRUE) })
output$exp <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
)
})
})
output$reg <- eventReactive(input$select_x, { renderPlotly({
ggplotly(
ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) + geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
)
})
})
}
}) # end observeEvent for graphs
}
shinyApp(ui, server)
You're just overcomplicating things.
In your code, you have reactive expressions, that reactively assign other reactive expressions. So you always fight with a double layer of reactivity.
I don't know if you noticed, but you also delete the placeholder div the first time the checkbox is unchecked. You maybe did this on purpose, because otherwise the radio buttons will always be there. Because overwriting the output$facet will not delete any reacting expressions. And your reactive logic itself does not contain the state of input$checkbox_facet. So you are always fighting with reactive expressions, that you reassign and where you have no control over how they are executed.
What I recommend is, to clean up your code. Pick each output element by itself and define what reactions you really want to happen. And then define a fixed behaviour, that reflects that.
Also, be aware that render functions are reactive environments by default.
Below is a refactoring that works:
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
uiOutput("facets"),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
output$facets <- renderUI({
if (input$checkbox_facet) {
radioButtons("radio_facet",
label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"),
selected = "owner"
)
}
})
output$exp <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
output$reg <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
}
shinyApp(ui, server)
To address the comment from Gregor de Cillia about conditional panels: You might not want to recreate the radio buttons every time the checkbox changes, since the options are in fact always the same. (And you might want to keep the state, i.e. which item was selected previously.) A conditionalPanel just hides the radio buttons and therefore cleans up your server code even more.
Example below:
library(shiny)
library(AER)
library(ggplot2)
library(plotly)
CreditCard <- read.csv("https://gist.githubusercontent.com/anonymous/3ffc253260bae6894c00edb2062729d6/raw/6c08d02eaba4b1691212fd518f2079ef2c112a20/Credit_Card.csv")
key <- read.csv("https://gist.githubusercontent.com/anonymous/9a8c05eb2202d79b03b187117e6fe709/raw/beddca49b669fe5ff27ce7dd1c7bcbe1c4660327/key.csv")
df_cc = CreditCard[sample(nrow(CreditCard), 500), ]
ui <- fluidPage(
title = "Final Project",
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.tabs === "Graphs"',
checkboxInput("checkbox_facet", label = "Show Facet", value = TRUE),
conditionalPanel('input.checkbox_facet',
radioButtons("radio_facet",
label = h4("Choose Facet Variable"),
choices = list("Card" = "card", "Reports" = "reports", "Owner" = "owner", "SelfEmployed" = "selfemp", "Dependents" = "dependents"),
selected = "owner"
)
),
selectInput("select_y", label = h4("Select Y-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "active"),
selectInput("select_x", label = h4("Select X-Axis"),
choices = list("Age" = "age", "Income" = "income", "Share" = "share", "Expenditure" = "expenditure", "Months" = "months", "MajorCards" = "majorcards", "Active" = "active"), selected = "income")
) # end conditionalPanel for graphs
), #end sidebarPanel
mainPanel(
tabsetPanel(
id = 'tabs',
tabPanel("Graphs",
plotlyOutput(outputId = "exp"),
plotlyOutput(outputId = "reg")
) #Graphs
) # end tabsetPanel
) # end mainPanel
) # end sidebarLayout
) # end fluid page
server <- function(input, output) {
output$exp <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
labs(title = "Exploratory Plot", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
output$reg <- renderPlotly({
g <- ggplot(df_cc, aes(x=get(input$select_x), y=get(input$select_y))) +
geom_point(shape=1) +
geom_smooth(method = "glm", family = "poisson", se = FALSE) +
labs(title = "Poisson Regression", x = input$select_x, y = input$select_y)
if (input$checkbox_facet) {
g <- g + facet_wrap(~get(input$radio_facet), labeller = label_both)
}
ggplotly(g)
})
}
shinyApp(ui, server)

r shiny code - selectInput with factor variables

I am building a shiny app. In the drop down menu I have the categories of a factor variable. I think the problem is in the server but I dont know how to fix it.
Also, I would like that to add a vertical in the histograms at 15 when the colour chosen is yellow, and a vertical line at 20 when the colour chose in the histogram is Red. Can you please help me with my code?
Thanks
library(shiny)
# Creating a fake data frame
categories <- c("A", "B", "c")
values <- c(12, 15, 20)
data <- merge(categories, values)
# Define UI for application
ui <- shinyUI(fluidPage(
# Title panel
titlePanel(title = h1("Title", align = "center")),
sidebarLayout(
# Sidebar panel
sidebarPanel(
# Options
selectInput(inputId = "xcol", label = "Select", choices = levels(data$x)),
br(),
#Colours histogram
radioButtons(inputId = "colour", label = strong("Select the colour of
histogram"), choices = c("Yellow", "Red"), selected = "Yellow"),
br(),
#Bins for histogram
sliderInput(inputId = "bins", label = "Select the number of Bins for the
histogram", min=5, max = 25, value = 15),
br(),
#Density curve
checkboxInput(inputId = "density", label = strong("Show Density Curve"),
value = FALSE),
# Display this only if the density is shown
conditionalPanel(condition = "input.density ==true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth adjustment:",
min = 0.2, max = 3, value = 1, step = 0.2))
),
# Main Panel
mainPanel(
#plot histogram
plotOutput("plot"),
# Output: Verbatim text for data summary
verbatimTextOutput("summary"))
)))
# Define server logic
server <- shinyServer(function(input, output) {
output$plot <-renderPlot({
hist(data[input$xcol, data$x], breaks = seq(0, max(data[input$xcol,
data$x]), l= input$bins+1), col = "lightblue",
probability = TRUE, xlab = "Values", main = "")
abline(v = mean(data[input$xcol, data$x]), col = "red", lty = 2)
title(main = levels(data$x[input$xcol]))
if (input$density) {
dens <- density(data[input$xcol, data$x], adjust = input$bw_adjust)
lines(dens, col = "blue", lwd = 1)
}
# Generate the summary
output$summary <- renderPrint({
xcol <- xcolInput()
summary(xcol)
})
})
})
# Run the application
shinyApp(ui = ui, server = server)
It looks like you were subsetting data incorrectly. I created a reactive expression for the data subset: data2(), and used that to make the plot outputs. I also added the vertical lines you mention with an if(){...}else{...} statement.
library(shiny)
# Creating a fake data frame
categories <- c("A", "B", "c")
values <- c(12, 15, 20)
data <- merge(categories, values)
# Define UI for application
ui <- shinyUI(fluidPage(
# Title panel
titlePanel(title = h1("Title", align = "center")),
sidebarLayout(
# Sidebar panel
sidebarPanel(
# Options
selectInput(inputId = "xcol", label = "Select", choices = levels(data$x)),
br(),
#Colours histogram
radioButtons(inputId = "colour", label = strong("Select the colour of
histogram"), choices = c("Yellow", "Red"), selected = "Yellow"),
br(),
#Bins for histogram
sliderInput(inputId = "bins", label = "Select the number of Bins for the
histogram", min=5, max = 25, value = 15),
br(),
#Density curve
checkboxInput(inputId = "density", label = strong("Show Density Curve"),
value = FALSE),
# Display this only if the density is shown
conditionalPanel(condition = "input.density ==true",
sliderInput(inputId = "bw_adjust",
label = "Bandwidth adjustment:",
min = 0.2, max = 3, value = 1, step = 0.2))
),
# Main Panel
mainPanel(
#plot histogram
plotOutput("plot"),
# Output: Verbatim text for data summary
verbatimTextOutput("summary"))
)))
# Define server logic
server <- shinyServer(function(input, output) {
data2 <- reactive({data[as.character(data$x)==input$xcol, "y"]})
output$plot <-renderPlot({
hist(data2(), breaks = seq(0, max(c(1, data2()), na.rm=TRUE), l= input$bins+1), col = input$colour,
probability = TRUE, xlab = "Values", main = "")
abline(v = mean(data2()), col = "red", lty = 2)
title(main = input$xcol)
if (input$density) {
dens <- density(data2(), adjust = input$bw_adjust)
lines(dens, col = "blue", lwd = 1)
}
if(input$colour=="Red"){
abline(v=20)}else{abline(v=15)}
# Generate the summary
output$summary <- renderPrint({
#xcol <- xcolInput()
summary(data2())
})
})
})
# Run the application
shinyApp(ui = ui, server = server)

Basic shiny not rendering plot

I have this shiny code and the plot is not showing for some reason. Can you please extend me a hand?
Is a basic shiny plot to render in the Main Panel. Checked loads of times and still not plotting.
library(shiny)
library(plotly)
library(ggplot2)
ui <- fluidPage(
(titlePanel("APP & MEP | Size (m2) ~ Hours", windowTitle = "app")),
sidebarLayout(
sidebarPanel(
checkboxGroupInput(inputId = "checkgroup",
label = "Select Deparments",
choices = c("All", "ELE", "HVAC", "MAN", "PH", "LV"),
selected = "All", inline = F),
radioButtons(inputId = "radio",
label = "ADD Stat_Smooth?",
choices = c("YES","NO"),
inline = T),
sliderInput(inputId = "slider",
label = "SPAN Setting",
min = 0.2, max = 2, value = 1,
ticks = T)
),
mainPanel(plotOutput(outputId = "plot33"))
)
)
server <- function(input, output){
output$plot33 <- renderPlotly({
gg <- ggplot(sizedf, aes(SIZE, Hours)) + geom_point(aes(color = Department)) + ggtitle("Size(m2) vs Hours per department")
p <- ggplotly(gg)
p
})
}
shinyApp(ui = ui, server = server)
I have seen this same mistake a few time already.
plotlyOutput() should be used, not plotOutput()

Resources