Thank you in advance for the help. I am trying to reference a reactive dataframe in renderplot and then eventually I would also like to reference the same dataframe in a rendertable. the plot keeps showing up blank with no data. Any thoughts on what I am doing wrong? I am fairly new to shiny still, so sorry if its a beginner no brainer question.
ui <- fluidPage(
titlePanel("Moving Average Backtest"),
sidebarLayout(
sidebarPanel(
dateRangeInput("DateRange","Select Dates"),
numericInput("SDRoll","Select rolling Vol", value = 255)
),
mainPanel(
plotOutput("Chart"),
tableOutput("Risk_Return")
)
)
)
server <- function(input, output) {
dateTriggerBegin<- reactive({input$DateRange[1]})
dateTriggerEnd<- reactive({input$DateRange[2]})
library(dplyr)
library(tidyr)
library(ggplot2)
library(zoo)
library(PerformanceAnalytics)
library(quantmod)
#setwd("P:/Anthony/R/Moving Average")
Main_DF <- reactive({
Roll_Avg3 <- group_by(Roll_Avg2, Date)%>%
summarize(Total_weighted_return = sum(TotalReturn)+1)%>%
filter(row_number() > 255)%>%
filter(Date >= dateTriggerBegin() & Date <= dateTriggerEnd())%>%
mutate(Total_Cum_Return = cumprod(Total_weighted_return))%>%
mutate(Total_Cum_DollarRet = Total_Cum_Return*1000000)
})
output$Chart <- renderPlot({
Roll_Avg4 <- Main_DF()$Roll_Avg3
ggplot(Roll_Avg4, aes(x = Roll_Avg4$Date, y = Roll_Avg4$Total_Cum_DollarRet )+geom_line()
})
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)
I have a bar graph which is part of a shiny app. I have created it with plotly. I would like the user to be able to select a part of the graph (click) and on clicking a datatable would show all rows corresponding to the values given in the hover text from that part of the chart.
So far I am able to show the output from event.data which isnt very interesting. How can I show the relevant rows from the original table?
library(plotly)
library(shiny)
ui <- fluidPage(
uiOutput("ChooserDropdown"),
plotlyOutput("plot2"),
DT::dataTableOutput("tblpolypDetail2")
)
server <- function(input, output, session) {
output$plot2 <- renderPlotly({
# use the key aesthetic/argument to help uniquely identify selected observations
#key <- row.names(mtcars)
browser()
p <- ggplot(iris,aes_string(iris$Species,input$Chooser)) + geom_col()
ggplotly(p,source = "subset") %>% layout(dragmode = "select")
})
output$tblpolypDetail2 <- renderDataTable({
event.data <- event_data("plotly_click", source = "subset")
print(event.data)
})
output$ChooserDropdown<-renderUI({
selectInput("Chooser", label = h4("Choose the endoscopic documentation column"),
choices = colnames(iris) ,selected = 1
)
})
}
shinyApp(ui, server)
I created a small demo where you can highlight rows in datatable by clicking the plotly graph.
You need to do it in two steps:
Map pointNumber of a click to rows in datatable(), you can create an external table for it.
You need to create a dataTableProxy where you can update a datatable
library(plotly)
library(DT)
library(shiny)
library(dplyr)
data <- as_tibble(iris) %>%
group_by(Species) %>%
summarise(avg = mean(Sepal.Width)) %>%
mutate(Species = as.character(Species))
species_mapping <- data.frame(
Species = data$Species,
row_id = 1:length(data$Species),
stringsAsFactors = FALSE
)
ui <- fluidPage(
DT::dataTableOutput("table"),
plotlyOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- data %>%
ggplot() +
geom_col(aes(x = Species, y = avg))
# register this plotly object
plotly_object <- ggplotly(p,source = "source1")
event_register(plotly_object,event = "plotly_click")
plotly_object
})
output$table <- DT::renderDataTable(data)
# create a proxy where we can update datatable
proxy <- DT::dataTableProxy("table")
observe({
s <- event_data("plotly_click",source = "source1")
req(!is.null(s))
# map point number to Species
row_clicked <- species_mapping[s$pointNumber + 1,"row_id"]
proxy %>%
selectRows(NULL) %>%
selectRows(row_clicked)
})
}
shinyApp(ui, server)
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)
I have a problem with my code. Every time I click a button my plot (built with ggvis) is showing up but vanishes immediately. Since my code is very long, the following code reproduces my problem. I want to reuse the reactive data frame test0 in my render function and I guess this is exactly what causes my problem. But this is essential to me. The three steps (reactive, observe, render) are the same than in my code. I would very much appreciate your help!
server.R
library(shiny)
library(ggvis)
library(dplyr)
data(mtcars)
shinyServer(function(input, output) {
test0 <- reactive({
df <- mtcars %>% select(mpg, wt)
(input$NextCounter + 1)*df
})
observe({
df <- test0()
if (!is.null(df)) {
ggvis(df, x = ~wt, y = ~mpg) %>% bind_shiny("plotggvis")
}
})
output$test1 <- renderUI({
df <- test0()
ggvisOutput("plotggvis")
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
uiOutput("test1")
)
)
))
this one working for me
library(shiny)
library(ggvis)
library(dplyr)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
ggvisOutput("plotggvis")
)
)
))
server <- shinyServer(function(input, output) {
data(mtcars)
test0 <- reactive({
df <- mtcars %>% select(mpg, wt)
(input$NextCounter + 1)*df
})
my_graph <- reactive({
df <- test0()
ggvis(df, x = ~wt, y = ~mpg)
})
my_graph %>% bind_shiny("plotggvis")
})
})
shinyApp(ui = ui, server = server)
You don't need to have a ggvisOutput in the UI to solve your problem. Actually the problem in your code is having the bind_shiny function inside an observer that will be executed again every time your test0 data changes. It is expected to bind your ggvis only once, otherwise it will have that behavior of showing up and vanishes immediately. Also, one great feature of ggvis is having a nice transitions when data is changing, so you don't need to create a ggvis object every time your data changes, just make sure that you only bind that ggvis object once in your UI.
Below is a modified version of your code to solve your problem and show the animated transition of data.
library(shiny)
library(ggvis)
library(dplyr)
data(mtcars)
ui <- fluidPage(fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("NextCounter", "Next")
),
mainPanel(
uiOutput("test1")
)
)
))
server <- function(input, output) {
test0 <- reactive({
input$NextCounter
df <- mtcars %>% select(mpg, wt)
df[sample(nrow(df),nrow(df)/2), ]
})
output$test1 <- renderUI({
# bind the ggvis only once
test0 %>% ggvis(x = ~wt, y = ~mpg) %>% bind_shiny("plotggvis")
ggvisOutput("plotggvis")
})
}
shinyApp(ui, server)
You can also modify some ggvis parameters using input widgets by putting the ggvis inside of a reactive expression.
I am having issues displaying ggplot (or any form of charts like hist()). I have tried looking through Stack Overflow but the solutions provided were not useful for this instance. I have not been able to display any of the graphs successfully.
I am using R studio with 3.2.0 build, deploying on Shinyapps.io and viewing via Chrome. I am able to display the graph within R but unable to display it when running with shiny.
Is this a code issue or something I had missed out from my packages? (Note: I have reduced my code trying to troubleshoot, so the variables from ui.R are not used in server.R.)
ui.R
library(shiny)
library(ggplot2)
dataset <- diamonds
diamondcolours <- unique( dataset["color"], incomparables = FALSE)
diamondcolours <- lapply(diamondcolours, as.character)
diamondcuts <- unique( dataset["cut"], incomparables = FALSE)
diamondcuts <- lapply(diamondcuts, as.character)
diamondclarity <- unique( dataset["clarity"], incomparables = FALSE)
diamondclarity <- lapply(diamondclarity, as.character)
carat <- dataset["carat"]
mincarat <- min(carat[ carat != min(carat) ])
# mincarat
maxcarat <- max(carat[ carat != max(carat) ])
# maxcarat
fluidPage(
titlePanel("Diamonds"),
sidebarPanel(
sliderInput('carat', 'Carat', min=mincarat, max=maxcarat,
value=mincarat, step=0.01, round=0),
selectInput('cut', 'Cut', diamondcuts$cut),
selectInput('color', 'Color', diamondcolours$color),
selectInput('clarity', 'Clarity', diamondclarity$clarity)
),
mainPanel(
plotOutput(outputId = 'mainplot')
)
)
server.R
library(shiny)
library(ggplot2)
dataset <- diamonds()
shinyServer(function(input, output, session) {
values <- reactiveValues()
testset <- dataset[ which(dataset$color == values$dcolor & dataset$carat > values$dcarat & dataset$clarity == values$dclarity & dataset$cut== values$dcut ), ]
output$mainplot <- renderPlot({
p <- ggplot(dataset[dataset$price <= 326,], aes(x = carat, y = color))
p <- p + geom_point()
print(p)
} )
Some of the more important problems: (1) data should be reactive to user input, (2) the variable names referring to input are incorrect, (3) all of the code in UI should be in server or, if it's not meant to be reactive, in the global environment. Here is a simplified version that runs,
library(shiny)
library(ggplot2)
dataset(diamonds)
## ** From UI: variables defined here can be seen in the whole app
mincarat <- min(diamonds$carat)
maxcarat <- max(diamonds$carat)
shinyApp(
shinyUI(
fluidPage(
titlePanel("Diamonds"),
sidebarPanel(
sliderInput('dcarat', 'Carat', min=mincarat, max=maxcarat,
value=mincarat, step=0.01, round=0),
selectInput('dcut', 'Cut', levels(diamonds$cut)),
selectInput('dcolor', 'Color', levels(diamonds$color)),
selectInput('dclarity', 'Clarity', levels(diamonds$clarity))
),
mainPanel(
plotOutput('mainplot')
)
)
),
shinyServer(function(input, output) {
## values <- reactiveValues() # unused
## Your data should be reactive - and reference `input`
## to get user-entered values
rxData <- reactive({
dat <- with(diamonds,
diamonds[color == input$dcolor &
carat > input$dcarat &
clarity == input$dclarity &
cut == input$dcut, ])
dat
})
output$mainplot <- renderPlot({
dataset <- rxData() # this is the subsetted data
p <- ggplot(dataset, aes(x = carat, y = price))
p <- p + geom_point()
print(p)
})
})
)
There are number of errors in that code:
You are missing to brackets at the end of the server.R
You are not reading your data correctly
Amended file:
library(shiny)
library(ggplot2)
shinyServer(function(input, output, session) {
data("diamonds")
dataset <- diamonds
rm(diamonds)
values <- reactiveValues()
testset <- dataset[ which(dataset$color == values$dcolor & dataset$carat > values$dcarat & dataset$clarity == values$dclarity & dataset$cut== values$dcut ), ]
output$mainplot <- renderPlot({
p <- ggplot(dataset[dataset$price <= 326,], aes(x = carat, y = color))
p <- p + geom_point()
print(p)
})
})
The ui.R is also wrong. You should put that stuff at the beginning in global.R as per guidelines on scoping rules in Shiny.