I am an absolute beginner to Shiny, so I would appreciate your patience and any advice to my issue. Here's the server function that I'm using to output a ggplot, which works on its own, but doesn't change at all when I change the inputs:
server <- function(input, output) {
output$plooot<-renderPlot({
df = df %>%
group_by(input$Category,Type) %>%
summarise(Distribution=sum(Distribution))
ggplot(df,aes(input$Category,Distribution,fill=Type))+geom_bar(stat="identity",position="dodge")})
}
shinyApp(ui=ui,server=server)
Here's my ui function as well just for reference:
ui <- fluidPage(
titlePanel("chart"),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
selectInput("Category","Category:",choices=c("a","b","c","d","e","f")),
selectInput("a","a:", choices=unique(Table$a), selected="All"),
selectInput("b","b:", choices=unique(Table$b), selected="All"),
selectInput("c","c:", choices=unique(Table$c), selected="All"),
selectInput("d","d:", choices=unique(Table$d), selected="All"),
selectInput("e","e:", choices=unique(Table$e), selected="All"),
selectInput("f","f:", choices=unique(Table$f), selected="All")
),
# Create a spot for the barplot
mainPanel(
plotOutput("plooot")
)
)
)
Unfortunately, I can't post the data for legal reasons, but here are two plots of what I want vs. what I have:
This is probably a very rudimentary mistake, but I'm having trouble understanding what I'm doing wrong.
I agree with #AndS., re-assigning back to df = ... is not likely what you want/need but will almost certainly irreversibly reduce your data. Additionally, input$Category is a character and not a symbol that group_by is expecting. Try this:
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("chart"),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
selectInput("Category","Category:",choices=colnames(mtcars))
),
# Create a spot for the barplot
mainPanel(
plotOutput("plooot")
)
)
)
server <- function(input, output) {
output$plooot<-renderPlot({
req(input$Category)
icq <- sym(input$Category)
mtcars %>%
group_by(!!!icq, vs) %>%
summarise(disp=sum(disp)) %>%
ggplot(aes_string(input$Category, "disp", fill="vs")) +
geom_bar(stat="identity", position="dodge")
})
}
shinyApp(ui=ui,server=server)
Not knowing what your data looks like, see below. The best thing to do is for any data set that will be affected by a user input, is to put it in a reactive expression. Then use that reactive expression in your output plots. I also added an "ALL" to your choices and an if function in case you want to see them all together like you have in your picture.
ui <- fluidPage(
titlePanel("Chart"),
sidebarLayout(
sidebarPanel(
selectInput("Category","Category:",choices=c("All","a","b","c","d","e","f"))
),
mainPanel(
plotOutput("Plot")
)
)
)
server <- function(input, output) {
Distribution <- c(1,2,3,4,1,2,3,5,2,4)
Category <- c("a","b","c","e","f","a","b","c","e","f")
Type <- c("Blue","Blue","Blue","Blue","Blue","Red","Red","Red","Red","Red")
df <- data.frame(Distribution ,Category,Type)
df_subset <- reactive({
if (input$Category == "All") {df}
else{df[df$Category == input$Category,]}
})
output$Plot <- renderPlot({
dat <- df_subset()
dat <- dat %>%
group_by(Category,Type) %>%
summarise(Distribution=sum(Distribution))
plot <- ggplot(dat,aes(Category,Distribution,fill=Type))+geom_bar(stat="identity",position="dodge")
return(plot)
})
}
shinyApp(ui=ui,server=server)
Related
I have created a data table with DT in Shiny that looks like this:
I would like to select data with checkboxes on a side panel that satisfies certain attributes (e.g. Mfr=Mitsubish, Joint=1, etc.) and then updates a histogram of deg/s in real time to view.
I've read through the material I could find on the web, but I can't figure out how to do this. Does anyone have any hints?
#guero64 Here is an example I had that I believe has examples of what you're looking for. I hope this is helpful. It is based on the diamonds dataset and has a couple of checkbox filters you can apply to the data.
library(shiny)
library(DT)
library(tidyverse)
ui <- shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
checkboxInput("cb_cut", "Cut (Ideal)", FALSE),
checkboxInput("cb_color", "Color (I)", FALSE)
),
mainPanel(
DT::dataTableOutput("data_table"),
plotOutput("data_plot")
)
))
server <- shinyServer(function(input, output) {
filtered_data <- reactive({
dat <- diamonds
if (input$cb_cut) { dat <- dat %>% filter(dat$cut %in% "Ideal") }
if (input$cb_color) { dat <- dat %>% filter(dat$color %in% "I") }
dat
})
output$data_table <- DT::renderDataTable({
filtered_data()
})
output$data_plot <- renderPlot({
hist(filtered_data()$price, main = "Distribution of Price", ylab = "Price")
})
})
shinyApp(ui = ui, server = server)
This is my first Shiny app, and I just got the basics working to where it allows the user to select from a dropdown menu of clients, then a dropdown menu of test codes to receive a plot of the results for the selected test.
I'd like the second dropdown menu to be updated with the available test codes for that client (all are not present for each client). Also, I would like to be able to hover over the point in the plot and receive more information from the row in the original dataframe.
I've looked into tooltips and the nearPoints() function, but I'm not sure if these can be used on this data since it is manipulated. I'm not sure if at this point it would be easier to import the data in a different way (it will ultimately need to accept either excel files or .csv). Thanks for any help that you would be able to provide, please let me know if there is any other supporting info I can give.
Here is my code:
library(shiny)
library(scales)
library(ggplot2)
labData <-
read.table("MockNLData.csv",
header=TRUE, sep=",")
#convert '<10' and '<20' results
labData$ModResult <- labData$Result
levels(labData$ModResult)[levels(labData$ModResult)=="<10"]
<- "0"
levels(labData$ModResult)[levels(labData$ModResult)=="<20"]
<- "0"
#convert results to scientific notation
SciNotResult <-
formatC(as.numeric(as.character(labData$ModResult)),
format="e", digits=2)
ui <- fluidPage(
headerPanel("Dilution History"),
sidebarLayout(
sidebarPanel(
selectInput(inputId="client", label="Select Client
Name", choices=levels(labData$Client.Name)
),
selectInput(inputId="test", label="Select Test Code",
choices=levels(labData$Analysis))
),
mainPanel(
plotOutput("line", hover="plot_hov"),
verbatimTextOutput("info"))
)
)
server <- function(input, output) {
#selected client into data frame
selDF <- reactive({labData[labData[,1]==input$client,]
})
#selected test code into data frame
subsetDF <- reactive({selDF()[selDF()[,5]==input$test,]
})
#points to be plotted
points <-
reactive({as.numeric(levels(subsetDF()$ModResult))
[subsetDF()$ModResult]
})
#plot
output$line <- renderPlot({
qplot(seq_along(points()), points(), xlab ="Index",
ylab ="Result")
})
#hover information
output$info <- renderText({
paste0("x=", input$plot_hov$x, "\ny=",
input$plot_hov$y)
})
}
shinyApp(ui = ui, server = server)
Here is what the data looks like:
MockNLData.csv
EDIT: I figured out updating the menu with updateSelectInput()
In the future, make sure you share a reproducible example :)
Since your code is not reproducible please find below something you can understand and adapt to your case.
On your first question, if I understand correctly, you want to programatically generate a dropdown (selectInput) which is perfectly do-able. *Inputs are, in essence, just HTML content which you can dynamically generate, just like your plots. You do so with uiOutput (in your ui) and renderUI in your server.
library(shiny)
ui <- fluidPage(
selectInput("dataset", "Select a dataset", choices = c("cars", "mtcars")),
uiOutput("column"), # dynamic column selector
verbatimTextOutput("selected_column")
)
server <- function(input, output, session){
data <- reactive({
if(input$dataset == "cars")
return(cars)
else
return(mtcars)
})
output$column <- renderUI({
# build your selectInput as you normally would
selectInput("column_selector", "Select a column", choices = colnames(data()))
})
output$selected_column <- renderPrint({
# use input$column_selector!
print(input$column_selector)
})
}
shinyApp(ui, server)
On your second question, what you want is an interactive plot. There are numerous packages that will let you do that in R and Shiny. Below are some examples, by no means a comprehensive list:
plotly which will also let you make your ggplot2 charts interactive
highcharter another great, well tested library
echarts4r ECharts for R.
billboarder billboard.js for R and Shiny
Below is an example using highcharter. They all follow the same principle within Shiny, an *Output function coupled with a render* function.
library(shiny)
library(highcharter)
ui <- fluidPage(
highchartOutput("chart")
)
server <- function(input, output, session){
output$chart <- renderHighchart({
hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
})
}
shinyApp(ui, server)
EDIT
Following your question on the flashing error. You need to require (req) the required input. When launching the app below the error will flash, uncomment the req(input$y) line and it'll go away.
library(shiny)
ui <- fluidPage(
uiOutput("sel"),
plotOutput("plot")
)
server <- function(input, output){
output$sel <- renderUI({
numericInput("y", "N:", value = 200, min = 5, max = 1000, step = 100)
})
output$plot <- renderPlot({
# req(input$y)
hist(runif(input$y, 1, 10))
})
}
shinyApp(ui, server)
In essence, since your plot relies on a dynamically generating input for a fraction of second that input is not available as it is being rendered, using req prevents that.
What I understand from your problem above are:
You want to make next dropdown menu based on what the user have chosen from previous dropdown menu.
When the mouse over the point on the plot, it will show row value.
So, here i will give you reproducible example and i hope it is useful for you.
In this example I use Rabbit dataset from library MASS.
To filter data for next dropdown menu, I use filter from library
dplyr (See line 30).
I use reactive expression to manage next dropdown menu (See line
29).
I use nearPoints() to manage hover point (See line 55).
library(shiny)
library(MASS)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("Rabbit dataset from MASS library"),
fluidRow(
column(4, selectInput("var",
"Animal:",
unique(sort(Rabbit$Animal)))),
column(4, uiOutput("selected_var")),
column(4, uiOutput("selected_var1")),
column(12, plotOutput("selected_var2", hover = "plot_hover")),
column(12, verbatimTextOutput("info"))
)
)
server <- function(input, output) {
###FILTER NEXT DROPDOWN MENU BASED ON PREVIOUS SELECTED BY USER
dataset3 <- reactive({
unique(Rabbit %>% filter(Animal == input$var) %>% select(Treatment))
})
output$selected_var <- renderUI({
selectInput("var1", "Treatment:", c(dataset3()))
})
dataset4 <- reactive({
Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% select(Run)
})
output$selected_var1 <- renderUI({
selectInput("var2", "Run:", c(dataset4()))
})
####
output$selected_var2 <- renderPlot({
ggplot(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), aes(x = BPchange, y = Dose)) + geom_point()
})
###HOVER POINT USING nearPoints()
output$info <- renderPrint({
nearPoints(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), input$plot_hover)
})
}
shinyApp(ui = ui, server = server)
I am building an RShiny-app where I am creating a plot based on a data table which I can edit and another data table which I cannot. I eventually want to save all data points on the plot in a data table which I can display and export.
I have seen many ways to do this using ggplot (ie layer_data, ggplot_build), but no efficient ways when just using plot and lines. My plots will be getting quite complicated so it would be really helpful to find an easy way to do this rather than hardcoding everything in.
A very simple example of my code is below (Note: plots will be getting much more complicated than this. They will be line graphs, but I will just need the y values at each x value marked with a number on the x axis):
x <- data.frame('col_1' = c(1,2,3,4,5), 'col_2' = c(4,5,6,7,8))
y <- data.frame('col_1' = c(5,4,3,6,7), 'col_2' = c(1,2,3,4,5))
#import necessary libraries
library(shiny)
library(DT)
library(shinythemes)
library(rhandsontable)
#ui
ui <- fluidPage(theme = shinytheme("flatly"),
titlePanel("Test"),
sidebarLayout(
sidebarPanel(
#display data
rHandsontableOutput('contents'),
#update plot button
actionButton("go", "Plot Update"),
width=4
),
mainPanel(
tabsetPanel(
#plot
tabPanel("Plot", plotOutput("plot_1")) )
))
)
#server
server <- function(input, output, session) {
#data table
output$table_b <- renderTable(x)
indat <- reactiveValues(data=y)
observe({
if(!is.null(input$contents))
indat$data <- hot_to_r(input$contents)
})
output$contents <- renderRHandsontable({
rhandsontable(indat$data)
})
#save updated data
test <- eventReactive(input$go, {
live_data = hot_to_r(input$contents)
return(live_data)
})
#plot
output$plot_1 <- renderPlot({
plot(x[,1],x[,2],col='red',type = 'l')
lines(test()[,1],x[,2], col='black', type='l')
# need a way to grab data from plot a create a table
})
}
shinyApp(ui, server)
I can't seem to get my plot to come up for this shiny app of the Lahman data. Any help would be greatly appreciated.
ui.R
library(shiny)
library(ggplot2)
shinyUI(fluidPage(
fluidRow(
sidebarLayout(
sidebarPanel(
selectInput("team","Select Team",choices=levels(teamID)),
sliderInput("year","Include Years in Range",min=1871,max=2014,value=c(1871,2014), sep="")
),
mainPanel(
plotOutput("pitchingplot")
)
)
)
))
server.R
library(dplyr)
library(ggplot2)
library(shiny)
shinyServer(function(input, output) {
Pitching%>%
group_by(input$teamID,yearID)%>%
filter(teamID=input$team,yearID>=input$year[1]& yearID<=input$year[2])
summarise(TotER=sum(ER))
output$pitchingplot<-renderPlot({
g<-ggplot(data=Pitching,aes(x=yearID,y=TotER)) + geom_point(aes(color=input$team))
g
})
})
You didn't exactly specify what do you want so it is difficult to help. All I could do was to make the code working - added reactive dataset data and changed few things.
library(shiny)
library(ggplot2)
library(dplyr)
library(Lahman)
data("LahmanData")
ui <- shinyUI(fluidPage(
fluidRow(
sidebarLayout(
sidebarPanel( # added Pithing$
selectInput("team","Select Team", choices=levels(Pitching$teamID)),
sliderInput("year","Include Years in Range",min=1871,max=2014,value=c(1871,2014), sep="")
),
mainPanel(
plotOutput("pitchingplot")
)
)
)
))
server <- shinyServer(function(input, output) {
# create a reactive dataset which is passed to ggplot object
data <- reactive({
Pitching%>%
group_by(teamID == input$team, yearID)%>% # changed to teamID == input$team
filter(yearID >= input$year[1] & yearID <= input$year[2]) %>%
summarise(TotER=sum(ER))
})
output$pitchingplot<-renderPlot({
# changed to data() # use aes_string if the variable is passed as a string
g<-ggplot(data=data(),aes(x=yearID,y=TotER)) + geom_point()
g
})
})
shinyApp(ui = ui, server)
Simple example of a Shiny app using ggvis. Trying to use a pulldown to filter a variable. So here I'm trying to filter by mtcars' gear (either 3, 4, or 5), then plotting x and y of mpg and hp for each of the unique values of gear.
I get the initial plot drawn with a default of '3' selected, but if I change the value via the pulldown nothing happens. I think I know where things are going wrong (commented in the code), but I've tried just about everything I can think of and have no idea what the actual mistake I'm making is.
Thanks
ui.R
# ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Car Thing"),
sidebarLayout(
sidebarPanel(
uiOutput("choose_gear")
),
mainPanel(
ggvisOutput("ggvis")
)
)
))
server.R
#server.R
library(shiny)
library(ggvis)
library(dplyr)
gear_nos <- sort(unique(mtcars$gear))
shinyServer(function(input, output, session) {
output$choose_gear <- renderUI({
selectInput("gears", "Choose Gear", gear_nos, selected="3")
})
# I'm pretty sure this is where I'm messing something up
pickedGear <- reactive({
mtcars %>% filter(gear == input$gears)
})
if(is.null(dim(pickedGear))){
pickedGear <- mtcars[mtcars$gear == 3,]
}
pickedGear %>% ggvis(~mpg, ~hp) %>% layer_points(fill := "green") %>% bind_shiny("ggvis")
})
I think this might be what you want.
Note that it took me quite awhile to figure out the validate piece that eliminates an extraneous error message (incorrect string: length(0) 32 expected) on startup initialization of the shinyServer code, but I will remember it for the future now I guess.
library(shiny)
library(ggvis)
library(dplyr)
# library(googleVis) # used observe instead now
u <- shinyUI(fluidPage(
titlePanel("Car Thing"),
sidebarLayout(
sidebarPanel(
uiOutput("choose_gear")
),
mainPanel(
ggvisOutput("ggvis")
)
)
))
gear_nos <- sort(unique(mtcars$gear))
s <- shinyServer(function(input, output, session) {
output$choose_gear <- renderUI({
selectInput("gears", "Choose Gear", gear_nos, selected="3")
})
pickedGear <- reactive({
shiny::validate(need(input$gears, message=FALSE))
mtcars %>% filter(gear == input$gears)
})
# could also replace "observe" with this from googlevis : "output$ggvis <- renderGvis({"
observe({
pickedGear() %>% ggvis(~mpg,~hp) %>% layer_points(fill:="green") %>% bind_shiny("ggvis")
})
})
shinyApp(u,s)
Yielding: