I'm creating a shiny app, and I want one of my tabs to be a 13 question quiz/game. However, I don't want all 13 questions displayed at once. I want to include an action button that when the user presses, the next question is displayed. Currently, both questions are displayed. Also, will I need to create separate action buttons for each question?
Problem 2: Questions 1-5 use the same plot. Questions 6-13 will use a different plot, and I will want both the question and the plot to be changed after question 5. I've provided 2 questions as an example.
In my UI script I have:
navbarPage(
"NEO Guess Who", position = "fixed-top",
tabPanel("Quiz",
fluidPage(
titlePanel(h1("Do you even know us?")),
sidebarLayout(
sidebarPanel(
radioButtons("q1", "Whose personality is plotted as the purple line?",
choices = list("Amy" = "Amy",
"Claire" = "Claire",
"Olivia" = "Olivia",
"Shae" = "Shae",
"Sharon" = "Sharon"),
selected = character(0)),
textOutput("q1text"),
actionButton("q1action", "Next", class = "btn-success"),
radioButtons("q2", "Whose personality is plotted as the blue line?",
choices = list("Amy" = "Amy",
"Claire" = "Claire",
"Olivia" = "Olivia",
"Shae" = "Shae",
"Sharon" = "Sharon"),
selected = character(0))),
mainPanel(
plotOutput("plot7"))
)))
)
within the server script, I have:
output$q1text <- renderText({
q1 <- switch (input$q1,
Amy = paste("Oops, the correct answer is Sharon"),
Claire = paste("Oops, the correct answer is Sharon"),
Olivia = paste("Oops, the correct answer is Sharon"),
Shae = paste("Oops, the correct answer is Sharon"),
Sharon = paste("Correct!"),
)
})
observeEvent(input$q1action, {
updateRadioButtons(session, "q1", choices = c("Amy", "Claire", "Olivia", "Shae", "Sharon"), selected = 0)
updateRadioButtons(session, "q2", choices = c("Amy", "Claire", "Olivia", "Shae", "Sharon"), selected = 0)
})
# both questions are still displayed
# no legend
output$plot7 <- renderPlot({
{neo_simple <- read.csv("neo_simple.csv", header = T, sep = ",")}
{neo_simple$domain <- factor(neo_simple$domain, levels = c("neuroticism", "extraversion", "openness", "agree", "conscient"))}
{neoColors <-
setNames( c('#a6cee3', '#b2df8a', '#fb9a99', '#fdbf6f', '#cab2d6'),
levels(neo_simple$id) )}
neo_simple %>%
ggplot(aes(x = domain, y=tscore, group = id, color = id)) +
geom_point(size = 1.75) +
scale_color_manual(values = neoColors) +
geom_line(size = 1.25) +
theme_bw() +
ggtitle("NEO Domain Scores") +
theme(plot.title = element_text(hjust = 0.5, size = 15)) +
theme(text = element_text(size=rel(4.5))) +
theme(legend.position = "none") +
theme(plot.caption = element_text(hjust = 0, size = 14))
})
Perhaps the 'slickR' package is a possible way:
library(shiny)
library(slickR)
ui <- fluidPage(
slickROutput("questions", width = "50%")
)
server <- function(input, output, session){
output[["questions"]] <- renderSlickR({
slickR(
slick_list(
radioButtons(
"q1",
"First question",
choices = c("Yes", "No")
),
radioButtons(
"q2",
"Second question",
choices = c("True", "False")
)
)
)
})
}
shinyApp(ui, server)
Related
I try to display interactive plots by using R shiny. I can successfully make the GUI and published, but the plots in tabPanel shows nothing, just like the picture shows below. There is the data I used (have been downloaded into my laptop).
I think problem may caused by the way how I preprocessing my data in server.R, but whatever I tried, it still display nothing. No Error shows when I run the app.
enter image description here
My code in ui.R:
library(shiny)
shinyUI(fluidPage(
titlePanel("Data Viz Lab"),
sidebarLayout(
sidebarPanel(
## Add X-Variable select element
selectInput(inputId = "var_x",
label = h5("X-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Land.Value"),
## Add Fill Color select element
selectInput(inputId = "color",
label = h5("Fill Color"),
choices = c("brown", "yellow", "green", "blue", "red"),
selected = "brown"),
## Add log-scale check box
checkboxInput(inputId = "log",
label = "log-sclae for X-variable in Scatterplot?",
value = FALSE),
## Add Y-Variable select element
selectInput(inputId = "var_y",
label = h5("Y-Variable"),
choices = c("Structure.Cost", "Land.Value", "Home.Value", "Home.Price.index"),
selected = "Structure.Cost"),
## Add Circle-Size side bar
sliderInput(inputId = "size",
label = h5("Circle-Size"),
min = 1,
max = 10,
value = 3),
## Add Outlier color select element
selectInput(inputId = "color_out",
label = h5("Outlier Color"),
choices = c("white", "yellow", "green", "blue", "red"),
selected = "white")
),
mainPanel(
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
value = plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
value = plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
)
)
))
My code in server.R:
library(shiny)
library(ggplot2)
library(sp)
library(dplyr)
# setwd()
landdata = read.csv("landdata.csv")
options(scipen = 999)
shinyServer(function(input, output) {
## Plotting Histogram
output$hist = renderPlot({
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color)
}else{
ggplot(landdata, aes_string(x = input$var_x)) +
geom_histogram(color = input$color) +
scale_x_log10(input$var_x)
}
})
## Plotting Scatter plot
output$scatter = renderPlot({
# Data pre-processing
p = ggplot(data = landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point() +
stat_ellipse(type = "norm", level = 0.95, color = "black")
build = ggplot_build(p)$data
pts = build[[1]]
elli = build[[2]]
Outlier = point.in.polygon(pts$x, pts$y, elli$x, elli$y)
landdata = cbind(landdata, Outlier)
landdata$Outlier = ifelse(landdata$Outlier == 0, yes = "Y", no = "N") %>% factor(level = c("Y", "N"))
# Plotting
if (input$log == FALSE){
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out))
}else{
ggplot(landdata, aes_string(x = input$var_x, y = input$var_y)) +
geom_point(aes(color = Outlier), size = input$size) +
scale_color_manual(values = c(input$color, input$color_out)) +
scale_x_log10(input$var_x)
}
})
})
The mistake lies in the tabPanel setup. value is not the correct argument for the plot. value is "the value that should be sent when tabsetPanel reports that this tab is selected" (taken from the manual). That means, value has the role of an id (like id argument of tabsetPanel or outputId of plotOutput).
Remove value = to make it work (the code snippet below gave me an output on my system).
tabsetPanel( # Establish tabset panel
tabPanel(
# Tab1
title = "Histogram",
plotOutput(outputId = "hist") # Add an figure in tab1
),
tabPanel(
# Tab2
title = "Scatterplot",
plotOutput(outputId = "scatter") # Add an figure in tab2
)
)
Hello I'm doing this Shiny app for a class project and I was wondering why my graph isn't appearing at all. It runs without giving me an error and shows the side panels, but the graph is appearing blank. I've attached the code below. I've seen other posts on here that deal with us and I've tried them out, but nothing has been giving me the results I need. I just need this to show up by Tuesday, so I can present it on Thursday morning. Thank you!
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
# Load Libraries
library(shiny)
library(tidyverse)
library(ggrepel)
library(dplyr)
library(magrittr)
library(quantmod)
# Load and Merge Data
wordbank = read_csv("/Users/Dohyun/Desktop/school stuff/year3/stat41/final project/administration_data.csv")
wordbank
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Word Bank"),
# Sidebar layout with a input and output definitions
sidebarLayout(
# Inputs: Select variables to plot
sidebarPanel(
selectInput(inputId = "x",
label = "X-axis:",
choices = c("Age" = "age")),
selectInput(inputId = "y",
label = "Y-axis:",
choices = c("Word Size" = "comprehension")),
selectInput(inputId = 'language', 'Language: ',
choices = c("English (American)", "English (British)", "English (Australian)",
"American Sign Language","British Sign Language",
"Cantonese","Croatian","Czech", "Danish", "French (French)",
"French (Quebecois)", "German", "Greek (Cypriot)", "Hebrew",
"Italian", "Kigiriama", "Kiswahili", "Korean", "Latvian",
"Mandarin (Beijing)", "Mandarin (Taiwanese", "Norwegian",
"Portugeuse (European)", "Russian", "Slovak", "Spanish (European)",
"Spanish (Mexican)", "Swedish", "Turkish")),
sliderInput(inputId = "alpha",
label = "Alpha:",
min = 0, max = 1,
value = 0.5)
),
#Output
mainPanel(
plotOutput(outputId = "scatterplot"),
plotOutput(outputId = "boxplot"),
br(), # a little bit of visual separation
)
)
)
# Define server function --------------------------------------------
server <- function(input, output) {
lang_data <- reactive({
wordbank %>%
filter(language %in% input$language)
})
# Create scatterplot object the plotOutput function is expecting
output$lang_plot <- renderPlot({
# Creates base plot
p1 <-
ggplot(lang_data(), aes(x = input$x, y = input$y, fill = as.factor(age))) +
geom_boxplot(alpha = .6, outlier.shape = NA) +
geom_jitter(size = 0.2, alpha = input$alpha, width = 0.3, aes(color = as.factor(age))) +
scale_fill_viridis_d(end = .75, option = "D", guide=FALSE) +
scale_color_viridis_d(end = .75, option = "D", guide=FALSE) +
labs(x = str_to_title(str_replace_all(input$x, "_", " ")),
y = str_to_title(str_replace_all(input$y, "_", " "))) +
scale_x_continuous(breaks = seq(from = 16, to = 30, by = 2))
theme(panel.background = element_blank())
print(p1)
})
}
# Create the Shiny app object ---------------------------------------
shinyApp(ui, server)
So I'm trying to create a shiny app to visualize some probability functions. I've got an old version (which works) with some very heavy code and now I want to update it using the switch functions. But my plot does not seem to respond very well to that.
I've tried to use the req() function to force the update of the data. But then I thought that maybe the problem was I just can't use the same name for the plot in two panels.
ui <- dashboardPage(
dashboardHeader(title = "probability laws"),
dashboardSidebar(
sidebarMenu(id='menus',
menuItem(text = "Plotting some densities" , icon = icon("atlas"),tabName = "density"),
menuItem(text = "repartition functions", icon = icon("cog", lib = 'glyphicon'),tabName = "repartition")
)
),
dashboardBody(
tabItems(
tabItem("density",
fluidRow(
tabsetPanel(id = 'tabs',
tabPanel(title='uniforme',value='unif',fluidRow(
column(8, plotOutput('graphe')),
column(3,wellPanel(
sliderInput(inputId = "inf",label = "borne inf",min = -10,max = 10,value = 0,step = 0.2),br(),
sliderInput(inputId = "sup",label = "borne sup",min = -10,max = 10,value = 1,step = 0.2),br())
))),
tabPanel(title='normale',value='norm',fluidRow(
column(8, plotOutput('graphe')),
column(3,wellPanel(
sliderInput(inputId = "mu",label = "mean",min = -10,max = 10,value = 0,step = 0.2),br(),
sliderInput(inputId = "var",label = "variance",min = 0,max = 10,value = 1,step = 0.2),br())
)))
)
)))))
And in the server:
server <- function(input, output,session) {
x <- reactive({switch (input$tabs,
'unif' = seq(-10,10,0.1),
'norm' = seq(-10,10,0.1)
)})
data <- reactive({switch(input$tabs,
'unif' = dunif(x(),0,1),
'norm' = dnorm(x(),0,1)
)})
data2 <- reactive({switch(input$tabs,
'unif' = dunif(x(),min(input$inf, input$sup),max(input$inf,input$sup)),
'norm' = dnorm(x(), input$mu, sqrt(input$var))
)})
output$graphe <- renderPlot({df <- melt(data.frame(x(),data(),data2()), id='x..')
ggplot(data=df, aes(x=x.., y=value, colour=variable)) + geom_line() + xlim(-10,10) + ylim(0,1) + theme(legend.position = 'none')
})
}
The thing is R doesn't find any error, and if I just keep the unif part it works. But when I add the normal distribution panel I'm left with a blank space.
Any help is greatly appreciated.
So with some research I solved this by using graphe1 and graph2 like :
output$graphe1 <- output$graphe2 <- renderPlot(...)
Thank you #Stéphane_Laurent for pointing out where the mistake was.
This question already has answers here:
Sort (order) data frame rows by multiple columns
(19 answers)
Closed 4 years ago.
I created a shiny app and need some help with the subset of my data. I insert a dateRangeInput where the client can filter between a start and end date. This filter is included into my ggplot code, so that the plot always automatically changes when a different date is selected. My problem is it does not filter based on the selected date, the data of partC. The problem is this line of code: geom_line(aes(x = Date, y = OLS.Data[partC]), color="red"). partC is a variable that connects to selectinputs to have access to my dataframe. Example: Client selects input1 = Informed and input2 = Full, partC makes InformedFull (which is the name of one column of my dataset) and so on. So partC is just a a connector of the two inputs, and this is my problem. If I put into my geom_line this code e.g geom_line(aes(x = Date, y = InformedFull), color="red"), instead the above everything works perfect, but I need it with partC.
Here is my ui.R code (only necessary part):
box(
title = "Controls-0",
status = "primary",
solidHeader = TRUE,
width = 3,
height = 142,
dateRangeInput("daterange", "SELECT DATE:", start = min(OLS.Data$Date), end = max(OLS.Data$Date))
),
box(
title = "Investor Control",
status = "primary",
solidHeader = TRUE,
width = 3,
selectInput("investor", label="Select Investor", choices = list("Informed" = "Informed", "Noise" = "Noise"), selected = "Informed")
),
box(
title = "Category Control",
status = "primary",
solidHeader = TRUE,
width = 3,
selectInput("category", label="Select Category", choices = list("Full" = "Full", "Fact" = "Fact", "Fact Positive" = "Fact.Pos", "Fact Negative" = "Fact.Neg", "Emotions" = "Emotions", "Emotions Fact" = "EmotionsFact"), selected = "Full")
),
Update server.R with ggplot:
server <- function(input, output) {
partC = NULL
makeReactiveBinding("partC")
observeEvent(input$investor, {
partA<<-input$investor
partA<<-as.character(partA)
})
observeEvent(input$category, {
partB<<-input$category
partB<<-as.character(partB)
})
OLS.Data$InformedEmotionsFact <- as.numeric(as.character(OLS.Data$InformedEmotionsFact))
OLS.Data$NoiseEmotionsFact <- as.numeric(as.character(OLS.Data$NoiseEmotionsFact))
output$myPlotVisu <- renderPlot({
partC<-as.character(paste(partA,partB,sep=""))
OLS.Data %>%
select(partC, NYSE,Date,Sector) %>%
filter(Date >= input$daterange[1], Date <= input$daterange[2]) %>%
ggplot(aes(x = Date, y = NYSE)) +
geom_line() +
ggtitle(paste(input$investor,input$category,sep = "")) +
theme(plot.title = element_text(hjust = 0.5,face="bold")) +
labs(x="Time",y="Return S&P500") +
geom_line(aes(x = Date, y = OLS.Data[partC]), color="red")
})
I dont know why you assign partA/partB to the global environment, and even twice. You dont need to do that. I created an reactiveValues object instead, where you store the values (partA, partB and partC). Then you can use them wherever you want in your app.
Maybe the following example will help you with your code. I created some dummy data for it.
library(shiny)
library(shinydashboard)
library(ggplot2)
## DATA #######################
DateSeq = seq(as.Date("1910/1/1"), as.Date("1911/1/1"), "days")
OLS.Data = data.frame(
ID = 1:length(DateSeq),
Date = DateSeq,
NoiseEmotionsFact = sample(1:100,length(DateSeq), T),
InformedEmotionsFact = sample(100:1000,length(DateSeq), T),
InformedFull = sample(10:1000,length(DateSeq), T),
NoiseFull = sample(50:5000,length(DateSeq), T),
NoiseFact = sample(1:15,length(DateSeq), T),
NoiseFact.Pos = sample(100:110,length(DateSeq), T),
NoiseFact.Pos = sample(10:200,length(DateSeq), T)
)
## UI #######################
ui <- {dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
plotOutput("myPlot"),
box(
title = "Controls-0",
status = "primary",
solidHeader = TRUE,
width = 3,
height = 142,
dateRangeInput("daterange", "SELECT DATE:", start = min(OLS.Data$Date), end = max(OLS.Data$Date))
),
box(
title = "Alpha",
sliderInput("alphaVisu", label = "Alpha :", min = 0, max = 1, value = 0.4, step = 0.1)
),
box(
title = "Investor Control",
status = "primary",
solidHeader = TRUE,
width = 3,
selectInput("investor", label="Select Investor",
choices = list("Informed" = "Informed", "Noise" = "Noise"), selected = "Informed")
),
box(
title = "Category Control",
status = "primary",
solidHeader = TRUE,
width = 3,
selectInput("category", label="Select Category",
choices = list("Full" = "Full", "Fact" = "Fact", "Fact Positive" = "Fact.Pos",
"Fact Negative" = "Fact.Neg", "Emotions" = "Emotions",
"Emotions Fact" = "EmotionsFact"), selected = "Full")
)
)
)}
## SERVER #######################
server <- function(input, output) {
## Reactive Values ############
parts <- reactiveValues(partA=NULL, partB=NULL, partC=NULL)
## Observe Events ############
observeEvent(input$investor, {
parts$partA <- as.character(input$investor)
})
observeEvent(input$category, {
parts$partB <- as.character(input$category)
})
## Plot ############
output$myPlot <- renderPlot({
parts$partC <- as.character(paste(parts$partA, parts$partB,sep=""))
OLS.Data.filtered <- OLS.Data %>%
filter(Date >= input$daterange[1], Date <= input$daterange[2])
req(OLS.Data.filtered)
OLS.Data.filtered %>%
ggplot(aes(x = Date, y = ID)) +
geom_line() +
ggtitle(paste("input$investor","input$category",sep = "")) +
theme(plot.title = element_text(hjust = 0.5,face="bold")) +
labs(x="Time",y="Return S&P500") +
geom_line(aes(x = Date, y = OLS.Data.filtered[parts$partC]), color="red",
alpha = rep(as.numeric(input$alphaVisu), nrow(OLS.Data.filtered[parts$partC])))
})
}
shinyApp(ui, server)
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()