This is causing me a lot of pain.
I would like to simlpy have a sliderInput that takes a Date (preferably stepping by month) and changes a simple ggplot_bar as a result. Although I can show everything there seems to be no response to the changing of the slider:
Here is my code:
ui.r
library(shiny)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("St Thomas' Physiology Data Console"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("DatesMerge",
"Dates:",
min = as.Date("2006-01-01","%Y-%m-%d"),
max = as.Date("2016-12-01","%Y-%m-%d"),
value=as.Date("2016-12-01"),timeFormat="%Y-%m-%d")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Breath Tests",plotOutput("distPlotLactul")),
)
)
))
server.r
library(shiny)
source("S:\\Usage.R")
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
output$distPlotLactul <- renderPlot({
#Create the data
DatesMerge<-input$DatesMerge
# draw the histogram with the specified number of bins
ggplot(TotsLactul)+
geom_bar(aes(DatesMerge,fill=year))+
labs(title=paste("Num")) +
xlab("Time") +
ylab("NumP") +
theme(axis.text.x=element_text(angle=-90)) +
theme(legend.position="top")+
theme(axis.text=element_text(size=6))
})
})
I wasn't totally sure of your ggplot code, so I had to rejig into something I understood.
I also created my own data to make it reproducible.
Here is the data I made
# Generate random variates
TotsLactul <- rep(ymd("2016-01-01"),10000)
randomMonths <- round(runif(n = 10000,min = 0,max = 11),0)
randomDays <- round(runif(n = 10000,min = 0,max = 28),0)
# Increments days
month(TotsLactul) <- month(TotsLactul) + randomMonths
day(TotsLactul) <- day(TotsLactul) + randomDays
# Make it a DT
TotsLactul <- data.table(x=TotsLactul)
This is just random dates throughout the year.
UI
ui <- shinyUI(fluidPage(
# Application title
titlePanel("St Thomas' Physiology Data Console"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("DatesMerge",
"Dates:",
min = as.Date("2016-01-01","%Y-%m-%d"),
max = as.Date("2016-12-01","%Y-%m-%d"),
value=as.Date("2016-12-01"),
timeFormat="%Y-%m-%d")
),
mainPanel(
plotOutput("distPlotLactul"))
)
))
I amended the slider to only take 2016 values, to match my generated data
Server
server <- shinyServer(function(input, output) {
output$distPlotLactul <- renderPlot({
#Create the data
DatesMerge<-input$DatesMerge
# draw the histogram with the specified number of bins
ggplot(TotsLactul[month(x) == month(DatesMerge)],mapping=aes(x=x))+
geom_histogram(bins=100)+
labs(title=paste("Num")) +
xlab("Time") +
ylab("NumP") +
theme(axis.text.x=element_text(angle=-90)) +
theme(legend.position="top")+
theme(axis.text=element_text(size=6))
})
})
I'll be honest, I have never used ggplot like you have (just dropped in a table in a geom etc.), so I can't comment on if any of it was right / wrong. Hopefully you can follow my changes.
Changed geom_bar to geom_hist (to match my data)
The filtering happens in the data included in the plot, not within the geom.
This seems to work fine, let me know how you get on.
Related
Not sure why my code shows all the countries' plots at the same time, I want to make it display only the country that's selected by the user. Does anyone know what went wrong with the code?
library(shiny)
require(readr)
countries <- read.csv("~/Desktop/share-deaths-suicide.csv")
# Define UI for application that draws a scatterplot
ui <- fluidPage(
# Application title
titlePanel("Country Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Entity",
"countries",
paste(countries$Entity),
selected = "China", multiple = FALSE)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("countryPlot")
)
)
)
# Define server logic required to draw a scatterplot
server <- function(input, output) {
output$countryPlot <- renderPlot({
country = input$Entity
plot(countries$Year, countries$`Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent`, col=ifelse(countries$Entity==country, "red","black"),
main = "Sucide Rate of Countries", xlab = "Year", ylab = "Sucide rate",log="xy")
options(scipen=999)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The issue is that you do not filter your data for the selected country. According to your code only the color is changed for the selected country.
To fix you issue you have to filter your data before passing it to plot. To this end you could add a reactive which filters the data. The filtered data could then be used via countries_filtered() where the parantheses are important. Additionally I have fixed an issue with your selectInput. Instead of passing the vector of entities use only the unique values for the choices argument.
As you provided no example data (to this end I would suggest to have a look at how to provide provide a minimal reproducible example) I use the gapminder dataset as example data:
library(shiny)
# Example data
library(gapminder)
countries <- gapminder
names(countries)[c(1, 3, 4)] <- c("Entity", "Year", "Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent")
# Define UI for application that draws a scatterplot
ui <- fluidPage(
# Application title
titlePanel("Country Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Entity",
"countries",
choices = unique(countries$Entity),
selected = "China", multiple = FALSE)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("countryPlot")
)
)
)
# Define server logic required to draw a scatterplot
server <- function(input, output) {
countries_filtered <- reactive({
req(input$Entity)
countries[countries$Entity == input$Entity, ]
})
output$countryPlot <- renderPlot({
country = input$Entity
plot(countries_filtered()$Year, countries_filtered()$`Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent`,
col=ifelse(countries$Entity==country, "red","black"),
main = "Sucide Rate of Countries", xlab = "Year", ylab = "Sucide rate",log="xy")
options(scipen=999)
})
}
# Run the application
shinyApp(ui = ui, server = server)
#>
#> Listening on http://127.0.0.1:4061
1: You need to filter the dataset for the input country
And I will demonstrate this using ggplot:
output$countryPlot <- renderPlot({
countries %>%
filter(country == input$Entity) %>%
plot(aes(Year, countries$`Deaths...Self.harm...Sex..Both...Age..All.Ages..Percent`, color= Entity)) +
geom_point() +
labs(main = paste("Sucide Rate of", input$Entity), xlab = "Year", ylab = "Sucide rate") +
scale_y_log10() +
scale_x_log10() +
scale_fill_manual(values=c("red", "black"))
options(scipen=999)
})
I am not exactly sure why you wanted to color the points of the scatter plot based on "entity" as it seems that entity is the country input and the original plot would change the color of the points based on the user selection. In my above code, it would change the entire plot to only show the selected country, and changes the title based on the country selected as well.
I am currently working on a Shiny dashboard that has a slider that outputs the optimal portfolio weights of stocks, gold and silver for a given volatility value using the slider input. I have been able to output the values with a dynamic text output given the slider input, but I cannot figure out how to turn these values into a graph as the text output in Shiny seems to require a function. How can I add a pie chart to this code using the values I get from slidervalues()? It outputs a list of 5 numerical values, now I want to chart the first 3 of them in a pie chart:
library(shiny)
shinyUI(fluidPage(
headerPanel(title = "Volatility Slider"),
sidebarLayout(
sidebarPanel(
sliderInput("Risk","Volatility", 0, 0.24, 0.12)
),
mainPanel(
textOutput("Output")
)
)
))
server <- function(input, output) {
sliderValues <- reactive({
#This part finds the optimal portfolio using CAPM(which is found in a different script).
custom <- three_assets %>%
filter(sd_p > input$Risk,
sd_p < input$Risk+0.0001)
max_er_custom <- custom[custom$er_p == max(custom$er_p)]
toString(max_er_custom)
})
output$Output <- renderText({
sliderValues()
})
}
Here is a screenshot of the dashboard. The first three values are the weights of the three assets, the forth value is the expected return of that portfolio and the last value is the volatility of that portfolio all using historical data.
Not sure how to replicate your logic without your files, but here's an example where the input slider determines the values in the sliderValues data frame, which are in turn used to create a bar chart.
library(shiny); library(ggplot2)
ui <- fluidPage(
headerPanel(title = "Volatility Slider"),
sidebarLayout(
sidebarPanel(
sliderInput("Risk","Volatility", 0, 0.24, 0.12)
),
mainPanel(
plotOutput("Output")
)
)
)
server <- function(input, output) {
sliderValues <- reactive({
data.frame(values = c(input$Risk, 0.7 * (1 - input$Risk), 0.3 * (1-input$Risk)),
categories = c("A", "B", "C"))
})
output$Output <- renderPlot(
ggplot(sliderValues(), aes(1, values, fill = categories)) +
geom_col() +
coord_polar(theta = "y")
)}
shinyApp(ui = ui, server = server)
The object is gettig parameters from users to make them understand the forecasting techniques. Therefore, i would like to begin with moving average. Eventhough the work is quite simple, i couldnt manage and i have some issues.
One error occurs: ERROR: missing value where TRUE/FALSE needed.
I do not understand why do I get this?
I want to show forecasted values for next period. But with this ready formula does not provide that?
`
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Forecasting Methods"),
sidebarPanel(
h3(strong("Moving Average",style = "color:black")),
br(),
sliderInput("ord","Order Size:",min = 1, max = 100, step= 1, value = 15),
),
mainPanel(
plotOutput(outputId = "ma1", width = "700px",height = "400px"))
))
library(shiny)
library(ggplot2)
library(forecast)
library(TTR)
shinyServer(function(input, output){
output$ma1 <- renderPlot(
tmp <- data.frame(time = 1:100, sales = round(runif(100, 150, 879))),
sm <- SMA(tmp[,"sales"],order=input$ord),
y <-ggplot(tmp, aes(time, sales)) + geom_line() + geom_line(aes(time,sm),color="red") + xlab("Days") + ylab("Sales Quantity")+ ggtitle("Moving Average"),
y
)
})
How is this:
library(shiny)
library(ggplot2)
library(forecast)
library(TTR)
ui <- pageWithSidebar(
headerPanel("Forecasting Methods"),
sidebarPanel(
h3(strong("Moving Average",style = "color:black")),
br(),
sliderInput("ord","Order Size:",min = 1, max = 100, step= 1, value = 15)
),
mainPanel(
plotOutput(outputId = "ma1", width = "700px",height = "400px"))
)
server <- function(input, output){
n <- 0
output$ma1 <- renderPlot({
input$ord
tmp <- data.frame(time = 1:100, sales = round(runif(100, 150, 879)) )
sm <- SMA(tmp[,"sales"],order=input$ord)
title <- sprintf("Moving Average (%d)",n)
n <<- n+1
y <-ggplot(tmp, aes(time, sales)) +
geom_line() +
geom_line(aes(time,sm),color="red") +
xlab("Days") + ylab("Sales Quantity")+ ggtitle(title)
y
})
}
shinyApp(ui, server)
Yielding:
As to your program - I could not reproduce your errors exactly:
1 - the program as posted would not run. The server function code block was not enclosed in curly brackets ({}), but was structured like the ui function code (comma separated statements). This is wrong. The ui function code not a function like the server code, rather it series of function calls that output html/css/javascript. Try them from the R-console to see what I mean.
2 - the UI function had at least one extraneous comma that I had to get rid of in order for it to work.
3 - using input$ord in the output$ma1 code that initializes the sm dataframe was not enough to cause the function to be reactive, and be triggered on every update of the slider. Not sure why that was not enough, but when I added another instance of input$ord to the front of the function it worked.
4- I also put a counter in the title of the output$ma1 to help me debug the above-debugged lack of reactivity.
5 - I also combined both the shiny ui.R and server.R files into one file as this example is small and makes it easy to see everything at once. Note that it can be hard matching ui.R and server.R code with the Rstudio tabbed editor - it is worth getting another editor (like Atom or Notepad++) to help code if you need more than one file.
I am new to shiny and have a problem about the slider input, it works well for the dataset but not working for my histogram, could you please help me to look at it, thanks.
Overview
I am trying to build a shiny application to display the attitude{datasets}, the first tab just displays the data, the slider works pretty well, but in the second tab the slider input not works for my histogram. I don't know why, I tried rChart before it also works. Please ignore the about.md file, it's just description.
Code
ui.r
library(shiny)
require(markdown)
library(ggplot2)
# Define UI for application that draws a histogram
shinyUI(
navbarPage("Employee attitude survey",
# multi-page user-interface that includes a navigation bar.
tabPanel("Explore the Data",
sidebarPanel(
sliderInput("rating",
"Employee rating filter:",
min = 1,
max = 100,
value = c(10,50))
),
# Show a plot of the generated distribution
# mytable1: dataset
# distPlot: histogram
mainPanel(
tabsetPanel(
tabPanel(p(icon("table"), "Dataset"),
dataTableOutput("mytable1")),
tabPanel(p(icon("search"), "Visualize the Data"),
plotOutput("distPlot"))
)
)
),
tabPanel("About",
mainPanel(
includeMarkdown("about.md")
)
) # end of "About" tab panel
)
)
server.R
library(shiny)
library(ggplot2)
# Define server logic required to draw a histogram and a table
shinyServer(function(input, output) {
# table to display the attitude, slider works
output$mytable1 = renderDataTable({
attitude[which(attitude$rating <= input$rating[2] & attitude$rating >= input$rating[1]), ]
})
# histogram of rating, but slider not works
output$distPlot <- renderPlot({
df <- attitude[which(attitude$rating <= input$rating[2] & attitude$rating >= input$rating[1]), ]
p1 <- ggplot() + aes(df[,"rating"])
p1 <- p1 + geom_histogram(binwidth=2, col="skyblue", aes(fill=..count..), alpha=0.6)
p1
})
})
My Question
Why the slider not working for my ggplot histogram. But works for the dataset ?Thanks a lot.
Try this
# histogram of rating, but slider not works
output$distPlot <- renderPlot({
df <- attitude[which(attitude$rating <= input$rating[2] & attitude$rating >= input$rating[1]), ]
test <<- (df[,"rating"])
p1 <- ggplot() + aes(test)
p1 <- p1 + geom_histogram(binwidth=2, col="skyblue", aes(fill=..count..), alpha=0.6)
p1
})
Given the following ui.R and server.R and circuit.csv; I can produce a simple plot which reacts to the user input (power in this case).
However, not all values for power are returned. For example, .5 produces a plot whereas .6 does not, so on and so forth at random occurrence throughout the power range.
If i plot as a table instead, to check my work, same thing, certain power inputs work as expected and others produce no table, and also no plot when asking to plot.
ui.R
library(shiny)
library(ggplot2)
shinyUI(fluidPage(
hr(),
sidebarLayout(
sidebarPanel(
sliderInput("power",label = "Power",
min = 0, max = 5, value = .5, step = .1)
),
mainPanel(
p("Lum vs Distance by Power"),
plotOutput('plot1')
)
)
))
server.R
library(shiny)
library(ggplot2)
df <- read.table(file = "circuit.csv", sep=",", header = TRUE)
shinyServer(function(input, output) {
output$plot1 <- renderPlot({
df2 <- subset(df,df$pow==input$power)
p <- ggplot(df2)+
geom_point(aes(x=dist, y=lum))
print(p)
})
})
Link to github (for csv data)
I would post images but am not allowed to do so at this time.