I am trying to create a Shiny interactive web app but I have a rendering problem linked to a plot. My goal is to upload a csv file, have the possibility to select the column to plot (on y axis) and have the possibility to select the data range on which plot data. Here there is my code:
library(dplyr)
library(shiny)
library(networkD3)
library(igraph)
library(ggplot2)
db = as.data.frame(read.csv("./util_df.csv"))
EmotionalDB = as.data.frame(read.csv("./MainDB.csv"))
my_list = as.list(names(EmotionalDB))
my_list = my_list[c(2, 3, 4, 5, 6, 7, 8, 9, 10, 11)]
ui <- fluidPage(
column(12, wellPanel(
dateRangeInput('dateRangeEmotions',
label = 'Filter emotions by date',
start = as.Date('2019-05-20') ,
end = as.Date('2019-05-26')
)
)),
selectInput("data1",
label = "Choose an Emotion",
choices = my_list
),
plotOutput("Emotions")
)
server <- function(input, output, session) {
output$Emotions <- renderPlot({
x <- EmotionalDB$Date
y <- EmotionalDB$Anger
plot(main="Emotions", x, y, type="l", xlim=c(input$dateRangeEmotions[1],input$dateRangeEmotions[2]), xaxt = "n")
axis.Date(side = 1, at = x, format = "%Y-%m-%d")
})
}
shinyApp(ui = ui, server = server)
Unfortunately there is no output in the plot. Here an image:
Here an example of my dataset:
"Date","Anger","Anticipation","Disgust","Fear","Joy","Negative","Positive","Sadness","Surprise","Trust"
"2019-05-20",12521,14652,2687,5164,13085,18309,23214,12882,12091,18623
"2019-05-21",13073,14988,3170,5773,13191,18988,24747,12973,12005,19435
"2019-05-22",15085,18608,3428,6475,16354,22671,30028,15765,15347,23680
"2019-05-23",23586,32597,5092,10084,24827,34827,44475,24468,23021,35440
"2019-05-24",61955,74395,10963,19597,65097,88223,104236,67361,59611,86375
"2019-05-25",19017,23540,4170,8595,19640,29740,34746,21793,18817,27907
"2019-05-26",9379,11909,1849,4535,10046,14791,17525,10757,9306,14095
Can anyone help me?
A couple suggestions to try:
Make sure your Date variable in EmotionalDB is of Date type.
EmotionalDB$Date <- as.Date(EmotionalDB$Date)
Try using reactive to subset your data based on the input selections of emotion and the 2 dates.
server <- function(input, output, session) {
selectedData <- reactive({
subset(EmotionalDB[ , c("Date", input$data1)], Date >= input$dateRangeEmotions[1] & Date <= input$dateRangeEmotions[2])
})
output$Emotions <- renderPlot({
sd <- selectedData()
plot(sd, main="Emotions", type="l", xaxt = "n")
axis.Date(side = 1, at = sd$Date, format = "%Y-%m-%d")
})
}
Related
I am struggling to wrap my head around when to use reactiveValues and when I can used reactive. For example, I am wanting to create an app where I have a reactive value that is modified by a slider. Take this app:
library(shiny)
# Define UI
ui <- fluidPage(
sliderInput("multiplier", "Multiplier", min = 0, max = 10, value = 1, step = 0.1),
actionButton("update_button", "Add Rows"),
tableOutput("data_frame")
)
# Define server
server <- function(input, output) {
# Create reactiveValues object to store data
rv <- reactiveValues(data = data.frame(x = c(1, 2, 3), y = c(4, 5, 6)))
# Add rows to data frame when button is clicked
observeEvent(input$update_button, {
# Code to add rows to data frame goes here
new_rows <- data.frame(x = c(7, 8, 9), y = c(10, 11, 12))
rv$data <- rbind(rv$data, new_rows)
})
# Multiply values in data frame by the value of the slider
updated_data <- reactive({
rv$data * input$multiplier
})
# Display data frame
output$data_frame <- renderTable({
updated_data()
})
}
# Run the app
shinyApp(ui, server)
This works well but I want to understand reactiveValues. For example can anyone explain why if I make the reactive object first to do some multiplication I get an error. Can reactiveValues only take existing data?
library(shiny)
# Define UI
ui <- fluidPage(
sliderInput("multiplier", "Multiplier", min = 0, max = 10, value = 1, step = 0.1),
actionButton("update_button", "Add Rows"),
tableOutput("data_frame")
)
# Define server
server <- function(input, output) {
my_data <- reactive({
df <- data.frame(x = c(1, 2, 3), y = c(4, 5, 6))
df$x <- df$x * input$multiplier
df
})
# Create reactiveValues object to store data
val <- reactiveValues(rv = NULL)
val$rv = my_data()
# Add rows to data frame when button is clicked
observeEvent(input$update_button, {
# Code to add rows to data frame goes here
new_rows <- data.frame(x = c(7, 8, 9), y = c(10, 11, 12))
val$rv <- rbind(val$rv, new_rows)
})
# Display data frame
output$data_frame <- renderTable({
val()
})
}
# Run the app
shinyApp(ui, server)
I'm building a basic R Shiny app, and have a list that contains individual lists, each storing a dataframe and a value. I've included sample data to demonstrate my list of lists. Within my app I am trying to have one select option (a dropdown menu that says "List 1", List 2", etc) and then have the main panel in the app display a boxplot of the dataframe (x and y) and a text output of the value stored in the list that was selected.
I'm having trouble with the ability to make the outputs (both plot and text) reactive to the input and display data from the selected list.
I've put my code of what I have so far below.
## Example Data
list_a <- list(df = data.frame(x = rnorm(n = 10, mean = 5, sd = 2),
y = rnorm(n = 10, mean = 7, sd = 3)),
value = "a")
list_b <- list(df = data.frame(x = rnorm(n = 10, mean = 20, sd = 5),
y = rnorm(n = 10, mean = 13, sd = 7)),
value = "b")
list_c <- list(df = data.frame(x = rnorm(n = 10, mean = 12, sd = 4),
y = rnorm(n = 10, mean = 10, sd = 4)),
value = "c")
mylist <- list(list_a, list_b, list_c)
## Packages
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel('Data'),
sidebarPanel(
selectInput('data', 'Dataset',
choices = c("1" = list_a, "2" = list_b, "3" = list_c)),
),
mainPanel(
plotOutput('plot1'),
textOutput('text1')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
reactivedata <- boxplot(input$data)
boxplot(reactivedata$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
reactivetext <- print(input$data)
print(reactivetext$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Main issue with your code that you used your raw lists for the choices argument. Additionally I added a reactive to pick the right list according to the user's input:
set.seed(123)
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Shiny App"),
## Panel with selectInput dropdown and output options
pageWithSidebar(
headerPanel("Data"),
sidebarPanel(
selectInput("data", "Dataset",
choices = c("list_a" = 1, "list_b" = 2, "list_c" = 3)
),
),
mainPanel(
plotOutput("plot1"),
textOutput("text1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
reactivedata <- reactive({
mylist[[as.integer(input$data)]]
})
## Boxplot with 'DF' from selected list
output$plot1 <- renderPlot({
boxplot(reactivedata()$df)
})
## Text output from 'value' stored in list
output$text1 <- renderText({
print(reactivedata()$value)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4502
#> [1] "a"
I'm trying to create a shiny app that generates plots based on the user selection of a subset of a loaded dataframe. For example, I have the following dataset:
library(shiny)
library(data.table)
df <- rbind(
data.table( cat = rep('X', 40), grp = rep(LETTERS[1:4], each=10), x = rep(1:10, times=4), y = rnorm(40) ),
data.table( cat = rep('Y', 30), grp = rep(LETTERS[1:3], each=10), x = rep(1:10, times=3), y = rnorm(30) ),
data.table( cat = rep('Z', 20), grp = rep(LETTERS[4:6], each=10), x = rep(1:10, times=2), y = rnorm(20) )
)
Based on the value for cat that the user selects in the UI, I want shiny to produce charts for each value of grp. So, if the user selects 'X', then there will be 4 plots produced; if they select 'Y' there will be three, and if they select 'Z' there will be 3.
I also want to specify how each chart is generated based on the value of grp. So if grp is A,D or E I want it produce a line plot, otherwise it should produce a scatterplot (only if that grp has that value of course).
Below is the code for my (broken) shiny app:
server <- function(input, output) {
rv <- reactiveValues(
i = NULL,
df = NULL
)
observe({ rv$i <- input$i })
observe({ rv$df <- df[cat == rv$i] })
output$test <- renderUI({
plotList <- lapply( LETTERS[1:6], function(x) plotOutput(x) )
do.call( tagList, unlist(plotList, recursive=FALSE))
})
for(i in LETTERS[1:6]){
local({
my_i <- i
output[[my_i]] <- renderPlot({
if( my_i %in% c('A','D','E')) {
with(rv$df[grp == my_i], plot(x,y, type='l'))
} else {
with(rv$df[grp == my_i], plot(x,y))
}
})
})
}
}
ui <- fluidPage(
titlePanel('Title'),
sidebarLayout(
sidebarPanel(
helpText('Select the Category you would like to view.'),
selectInput('i', 'Category', c('X','Y','Z'), selectize=TRUE)
),
mainPanel(
uiOutput('test')
)
)
)
shinyApp(ui, server)
A reproducible example can be found at the bottom.
A few hints:
1) Using reactive contexts:
In your for Loop at the bottom of the Server Code you are using the reactive variable rv, so you will have to run the Code in a reactive Content. So wrap it in observe().
2) Create a list of Outputs:
If I am not mistaken you used some of the Code in this answer: dynamically add plots to web page using shiny.
It is a good starting Point. For the part of the taglist it might be easier to simplify to:
output$test <- renderUI({
lapply(unique(rv$df$grp), plotOutput)
})
You can also add tagList(), but it is not necessary here,...
3) Correcting the sample data:
You might want to update the df variable:
data.table(cat = rep('Z', 20), grp = rep(LETTERS[4:6], each=10),
x = rep(1:10, times=2), y = rnorm(20) )
Here your have three letters, so you might change it to LETTERS[5:6] or update the other numbers.
Full reproducible example:
library(shiny)
library(data.table)
df <- rbind(
data.table( cat = rep('X', 40), grp = rep(LETTERS[1:4], each=10), x = rep(1:10, times=4), y = rnorm(40) ),
data.table( cat = rep('Y', 30), grp = rep(LETTERS[1:3], each=10), x = rep(1:10, times=3), y = rnorm(30) ),
data.table( cat = rep('Z', 30), grp = rep(LETTERS[4:6], each=10), x = rep(1:10, times=3), y = rnorm(30) )
)
server <- function(input, output) {
rv <- reactiveValues(
i = NULL,
df = NULL
)
observe({ rv$i <- input$i })
observe({ rv$df <- df[cat == rv$i] })
observe({
for(letter in unique(rv$df$grp)){
local({
let <- letter
output[[let]] <- renderPlot({
if( let %in% c('A','D','E')) {
with(rv$df[grp == let], plot(x, y, type='l'))
} else {
with(rv$df[grp == let], plot(x,y))
}
})
})
}
})
output$test <- renderUI({
lapply(unique(rv$df$grp), plotOutput)
})
}
ui <- fluidPage(
titlePanel('Title'),
sidebarLayout(
sidebarPanel(
helpText('Select the Category you would like to view.'),
selectInput('i', 'Category', c('X','Y','Z'), selectize=TRUE)
),
mainPanel(
uiOutput('test')
)
)
)
shinyApp(ui, server)
I would like a user to be able to type in the name of a dataframe object and have that object rendered as a formatted data table in a Shiny application.
Here is a toy example. There are two dataframe objects available in the workspace: df1 and df2. When the user types in df1, I would like that dataframe to be rendered. Likewise for df2 or for any other dataframe they have in their workspace.
I suspect I have to do something with environments or scoping or evaluation but I am not sure what.
I have commented in the code where I can hardcode in the built-in mtcars dataset and have that rendered correctly. Now I just want to be able to do the same for any ad-hoc dataframe in a user's workspace.
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
# Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
textInput("dfInput", h5("Enter name of dataframe"),
value = "")),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
input$dfInput # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
We are going to get all the dataframes within the global enviriment first and then use get in order to access the object. I changed the textInput to selectInput so you dont need to type anything, potentially making a mistake. Moreover I added the data from datasets package however you should build more test cases to check if the data exists
library(shiny)
set.seed(1234)
x <- sample.int(n = 20)
y <- sample(x = LETTERS, size = 20)
a <- rnorm(n = 20)
b <- sample(x = letters, size = 20)
df1 <- data.frame(x = x, y = y)
df2 <- data.frame(a = a, b = b)
mydataframes <- names(which(unlist(eapply(.GlobalEnv,is.data.frame))))
OpenData <- data()$results[,3]
#Define UI ----
ui <- fluidPage(
titlePanel("Using text inputs to select dataframes"),
sidebarLayout(position = "left",
sidebarPanel(width = 5,
selectInput("dfInput","Select Dataframe",
#choices = mydataframes,
list("Your Datasets" = c(mydataframes),
"R Datasets" = c(OpenData),
selected=NULL))),
mainPanel(width = 6,
h4("Here's your data"),
textOutput("selected_df"),
dataTableOutput("view")
)
)
)
# Define server logic ----
server <- function(input, output, session) {
output$selected_df <- renderText({
paste("You have selected ", input$dfInput)
})
output$view <-
renderDataTable({
as.data.frame(get(input$dfInput)) # this should render the selected dataframe. If you replace this with mtcars then that dataset is correctly rendered.
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
I used shiny and created a app.R file to hope to build a bar chart with ggplot. I also used checkboxGroupInput to create a 2 check boxes to control the condition. While the total number of bars should be 28 after all boxes are checked, but the maximum seemed to allow only 17 bars for some reason. So some bars (row of data) are missing. The missing bars don't seems to have a pattern. Can someone please help ?
dataset:https://drive.google.com/open?id=1fUQk_vMJWPwWnIMbXvyd5ro_HBk-DBfc
my code:
midterm <- read.csv('midterm-results.csv')
library(dplyr)
library(tidyr)
# get column number for response time
k <- c(33:88)
v <- c()
for (i in k){
if (i%%2 == 1){
v <- c(v,i)
}
}
#average response time by question
time <- midterm[ , v]
new.col.name <- gsub('_.*', "", colnames(time))
colnames(time) <- new.col.name
avg.time <- data.frame(apply(time, 2, mean))
avg.time$question <- rownames(avg.time)
colnames(avg.time) <- c('response_time', 'question')
rownames(avg.time) <- NULL
avg.time$question <- factor(avg.time$question,
levels = c('Q1','Q2','Q3','Q4','Q5','Q6','Q7','Q8.9',
'Q10','Q11','Q12.13','Q14','Q15','Q16','Q17',
'Q18','Q19','Q20','Q21','Q22','Q23','Q24','Q25',
'Q26','Q27','Q28','Q29','Q30'))
avg.time$question_type <- c(1,0,1,0,1,0,1,1,1,1,1,0,1,1,1,1,0,1,1,1,0,0,0,0,1,1,0,0)
# I did this manually because the there when data was imported into the midterm.csv,
# q8 & 9, q12 &13 were accidentally merged (28 v.s 30 question)
avg.time$question_type <- ifelse(avg.time$question_type == 1,
'googleable', 'not googleable')
avg.time$question_type <- factor(avg.time$question_type,
levels = c('googleable', 'not googleable'))
library(shiny)
library(ggplot2)
ui <- fluidPage(
checkboxGroupInput(inputId = "type",
label = "select question type",
choices = levels(avg.time$question_type),
selected = TRUE),
plotOutput('bar')
)
server <- function(input, output) {
output$bar <- renderPlot({
ggplot(avg.time[avg.time$question_type==input$type, ],
aes(x=question, response_time)) +
geom_bar(aes(fill = question_type), stat='identity', width = 0.5)
}, height =500, width = 1000)
}
shinyApp(ui = ui, server = server)
library(shiny)
library(ggplot2)
ui <- fluidPage(
checkboxGroupInput(inputId = "type", label = "select question type",
choices = levels(avg.time$question_type), selected = TRUE),
plotOutput('bar')
)
server <- function(input, output) {
data <- reactive(avg.time[avg.time$question_type %in% input$type, ])
output$bar <- renderPlot({
ggplot(data(),
aes(x=question, response_time)) + geom_bar(stat='identity', width = 0.5,
aes(fill = question_type))
}, height =500, width = 1000)
}
shinyApp(ui = ui, server = server)
of course you can use avg.time[avg.time$question_type %in% input$type, ] inside ggplot2 but reactivity is better.