The following minimal Shiny app fails to display when I launch the app. The sidebar shows up but not the main panel. I get no error messages or warnings. The app just hangs there.
The ggplot works in the console.
This must be an environmental parameter controlling the interface between Shiny & ggplot2. But what is it. Have tried setting dev.off() to no avail. Does anyone have any suggestions?
ui <- fluidPage(
sidebarPanel(
# client logo
# select trade
selectInput(inputId = "trade",
label = "Trade",
choices = trades,
selected = defaultTrade
)
),
mainPanel(
# performance time series plots
plotOutput(outputId = "tsPlotRev", height = "195px")
)
)
server <- function(input, output) {(
output$tsPlotVol <- renderPlot(
ggplot(data.frame(tsData), aes(x = as.Date(weekDate), y = as.numeric(revenue) / 1000000, color = as.factor(isHist))) +
geom_line() + scale_x_date(date_breaks = "4 week", date_labels = "%y-%W") +
theme(axis.text.x = element_text(angle = 45, hjust = 0.75), legend.position = "none") +
labs(x = NULL, y = "revenue (million USD)")
)
)}
shinyApp(ui = ui, server = server)
Related
This is my first shiny, and i'm trying to use ggplot to plot a graph. It's working on a normal R code but it's not showing anything on the UI when the app is running.
I want to plot the graph for a specific user, the first column of my dataset is named "User" and Users$User (yeah not a good name but since it's working i kept it for the moment) is a dataframe with every "user" choosable.
Since the ggplot function is used correctly (working in R), i think that the mistake is somewhere else, but i don't know where !
Here's what i currently have :
Server
library(shiny)
library(tidyverse)
library(dplyr)
library(ggplot2)
Total_Hit <- reactive({
Global_Perf_Data |> filter(User == input$boxer) |> filter(sequenceOutput!="Touché") |>
group_by(User, sequenceOutput)|> summarise(TotalDef=(n()*100)/180)
})
shinyServer(function(input, output) {
output$Performance_Globale <- renderPlot({
ggplot(Total_Hit, aes(fill=sequenceOutput, y=User, x= TotalDef, label=round(TotalDef))) + geom_bar(position="stack", stat="identity")+
geom_col() + labs(x = "Défense réussie en %", y = "") +
scale_x_continuous(labels = scales::percent_format(scale=1), breaks =breaks_width(10, 10), limits = c(0, 100))+
scale_fill_manual(name = "Type de défense", values = c("#4682B4", "#2F4F4F"))+
geom_text(size = 3, position = position_stack(vjust = 0.5), colour="white")
})
})
UI
library(shiny)
library(rAmCharts)
# Define UI for application that draws a histogram
shinyUI(
# navbarPage
navbarPage("REVEA",
# First tab individuel
tabPanel("Individuel",
fluidRow(
column(width = 3, wellPanel(
# selection of the boxer
radioButtons(inputId = "boxer", label = "Boxeur : ", choices = Users$User)
)),
# Show a plot of what the coach/Annabelle asked above here
column(width = 9,
tabsetPanel(
tabPanel('Performance globale',
plotOutput("Performance_Globale"),
div(textOutput("Résultat du pourcentage de réussite globale de défense réussie (esquive + esquive contre attaque)."), align = "center")
),
)
))
)
)
)
The data is from here. I selected the "Get table as CSV (for Excel)" option from "Share & Export". I highlighted all the resulting table text, and copied to excel. I then did "Text to columns" and split the data by the comma delimiters. I then saved the file as a .csv extension. My goal is to create an app with sliders for minutes and games played with a check box for teams. I want plotly graphs with pop ups. My code is below.
library(shiny)
library(ggplot2)
library(dplyr)
library(plotly)
library(tidyverse)
Player_Stats<-read.csv("2021-2022 Indiv Per Game Stats.csv")
colnames(Player_Stats)[11]<-"FG%"
colnames(Player_Stats)[14]<-"ThreeP%"
colnames(Player_Stats)[17]<-"TwoP%"
colnames(Player_Stats)[18]<-"eFG%"
colnames(Player_Stats)[21]<-"FT%"
colnames(Player_Stats)
ui<-fluidPage(
titlePanel("Player Stats"),
sidebarLayout(
sidebarPanel(
sliderInput("input1",
"Minutes",
min=0,
max = max(MP),
value = 0),
sliderInput("Input2",
"Games Played",
min = 0,
max = 82,
value = 0),
checkboxGroupInput(inputId = "tm_input",
label = "Team",
choices = unique(Player_Stats$Tm),
selected = unique(Player_Stats$Tm))
),
mainPanel(
plotOutput("plot1"),
plotOutput("plot2"),
dataTableOutput("Player_StatsTable")
)
)
)
server<-function(input, output){
output$plot1<-renderPlotly({
Player_Stats.subset() %>% ggplotly(
ggplot(aes(x=PTS, y=`ThreeP%`,color=Tm,
text=paste("Player:",Player, "PPG:",PTS, "3P%:", `ThreeP%`*100, "Team:",Tm)))+
geom_point()+
geom_smooth()+
xlab("Points per Game")+
ylab("Three Point %")+
ggtitle("PPG and 3P% by Player")+
theme(plot.title = element_text(hjust = 0.5))
)
})
output$plot2<-renderPlotly({
Player_Stats.subset() %>% ggplotly(
ggplot(aes(x=PTS, y=`TwoP%`,color=Tm,
text=paste("Player:",Player, "PPG:",PTS, "2P%:", `2P%`*100, "Team:",Tm)))+
geom_point()+
geom_smooth()+
xlab("Points per Game")+
ylab("Two Point %")+
ggtitle("PPG and 2P% by Player")+
theme(plot.title = element_text(hjust = 0.5))
)
})
Player_Stats.subset=reactive({
Player_Stats %>%
dplyr::filter(Tm %in% input$Tm_,.preserve = TRUE) %>%
dplyr::filter(MP>=input$input1) %>%
dplyr::filter(G>=input$input2)
})
output$Player_StatsTable<-renderDataTable({
Player_Stats.subset
})
}
shinyApp(ui=ui,server=server)
I am able to take input dates from the user and but can't make it wait to execute after entering the dates.
library(shiny)
library(ggplot2)
library(quantmod)
# Define UI for application that draws a bar graph
ui <- fluidPage(
# Application title
titlePanel("My Plot"),
sidebarLayout(
sidebarPanel(
textInput("text", "Enter company name:", width = NULL,
placeholder = "comp.name"),
dateRangeInput("dates", h3(strong("Date Range")),
start = "2001-01-01", end = Sys.Date(),
min = "0000-01-01", max = Sys.Date(),
format = "dd-mm-yy", separator = strong("to"),
autoclose = TRUE),
submitButton(text = "submit")),
# Show a plot
mainPanel( h1(strong(textOutput("Company"))),
tableOutput("MRF"),
plotOutput("finally")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$MRF <- renderTable({
tyu2 <- getSymbols(input$text , src = "yahoo", verbose = TRUE,
from = min(input$date) , to = max(input$date), auto.assign = FALSE)})
output$finally <- renderPlot({ggplot(data = tyu2 , aes(x= x ,y=tyu))+
geom_bar(stat = "identity", fill = "blue")+
theme(axis.text.x = element_text(angle = 90)) +
xlab("Dates")+ ylab(comp.name)})
}
# Run the application
shinyApp(ui = ui, server = server)
The dates must be going in as infinity which is the default case when the dates are not being read. I am not understanding what is wrong. Could anybody help me out. Thank you
Issue:
I'm interested in displaying three graphs in a shiny web app. I have written three functions to graph each type of plot for a specified range. The function's parameter takes a input parameter, region, and subsets the larger data.frame for that specified region and subsequently graphs it.
I'm having difficulty passing this function into an r-shiny reactive element.
Here is my function:
plot_30cumulative <- function(enter_region) {
subset <<- HPF[HPF$region == enter_region, ]
thirty_year_cumulative <<- ggplot(subset, aes(x=subset$date)) +
geom_line(aes(y = subset$BaseCumulative, color = "Base"), color = "green") +
geom_line(aes(y = subset$StressCumulative, color = "Adjusted"), color = "red", linetype = "dashed") +
theme_bw() +
scale_x_date(name = "",
date_labels = "%Y-%m-%d",
limits = as.Date(c("2014-02-15", "2044-02-15")),
breaks = seq(as.Date("2014-02-15"), as.Date("2044-02-15"), by = "1 year")) +
scale_y_continuous(name = "Cumulative Growth Rates",
breaks = seq(min(subset$StressCumulative),max(subset$BaseCumulative), .25),
limits = c(NA, 4), # Temporarily hard-coded for better visability.
labels = percent) +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
ggtitle("Cumulative 30-Year Growth Rates")
What I Want in Shiny:
library(shiny)
#Define UI for dataset
ui <- fluidPage(
#App title ----
titlePanel("Home Price Forecasting under Stress Scenarios"),
sidebarLayout(
sidebarPanel(
#Input: Stress Path Function Parameters ----
#Input: Numeric entry for region to plot ----
numericInput(inputId = "region",
label = "Enter Region Number:",
value = "1",
min = 1,
max = 110)
),
# Main panel for displaying outputs ----
mainPanel(plotOutput(outputId = "ThYrC"),
plotOutput(outputId = "FiYrC"),
plotOutput(outputId = "FoYrQtr")
)
)
)
#Define server logic to summarize and view selected dataset ----
server <- function(input, output){
output$ThYrC <- renderPlot({reactive(plot_30cumulative(enter_region == input$region)}))
}
# Run the application ----
shinyApp(ui = ui, server = server)
Problem:
I can't seem to pass the function parameter, enter_region, to the reactive element by input$region == enter_region.
Any insight into this issue would be much appreciated!
My ggplotly plot (see Tab 3 in server.R) does not work when used in my Shiny app. However, when I generate the plot by itself in RStudio, it works fine.
This is the bit of code that does not render a plot correctly.
output$facetmap=renderPlotly({
ggplotly(
ggplot(ranksvf(),aes(Rank,input$parameterchoice,fill=Location))+
ggtitle("") +
theme(axis.title.y=element_blank())+
geom_bar(position="dodge",stat="identity")+
facet_wrap(~Tran.Hour.2h.Slot,nrow=2)
)
})
When I say it doesn't render a plot correctly, I mean two things:
1) When I use input$parameterchoice in ggplot, the graph comes out weird. It looks like this. Incorrect Plot
2) When I use the actual name of the input in ggplot instead of input$parameterchoice, the plot comes out fine. However when I mouseover the plot, the values do not show as they should (it is a plotly graph so it should show).
What I find strange is that I use a ggplotly in Tab 2 of my application as well, and it works fine (the mouseover works too).
I feel the problem has something to do with the way I used my reactive functions, though I'm not sure. I've tried to debug for a while, but no luck so far.
This is what my app looks like.
####
#UI#
####
ui=fluidPage(theme = shinytheme("paper"),
titlePanel("Visualising Site-Specific Indicators: XYZ University"),
#img(src='xyz.jpg', align = "left"),
tabsetPanel(
#TAB 1
tabPanel(type="pills","Macro-View of Locations",
fluidRow(
column(width = 4,
wellPanel(
selectInput("size",
label="Select Parameter for Rectangle Size",
choices=names(details)[2:5],selected = "Average Daily Transactions"))),
column(width = 4,
wellPanel(
selectInput("color",
label="Select Parameter for Rectangle Color",
choices=names(details)[2:5],selected = "Unique Products Sold"))
)#Close column
), #Close fluidRow
fluidRow(
plotOutput("plot")),
fluidRow(
dataTableOutput("tab"))
),#Close tabPanel macroview
#TAB 2
tabPanel("Transaction Overiew by Location",
fluidRow(
column(width = 4,
wellPanel(
selectInput("sitechoice",
label="Select a Site",
choices=unique(heatmap_mean$Location),selected = "Horton 1"))
)#Close column
), #Close fluidRow
fluidRow(
plotlyOutput("heatmap")),
fluidRow(
dataTableOutput("tab2"))
),#Close tabPanel transactionoverview
#TAB 3
tabPanel("Parameter Ranking",
fluidRow(
column(width = 4,
wellPanel(
selectInput("parameterchoice",
label="Rank By",
choices=unique(c(names(rankdf_avgtran),names(rankdf_ticket)))[3:4],selected = "Average Transaction Value (USD)"))
),#Close column
column(width=6,
wellPanel(
sliderInput("rankchoice",
label="Number of Ranks Desired",
min=1,
max=10,
value=5))
)#Close column
), #Close fluidRow
fluidRow(
plotlyOutput("facetmap")),
fluidRow(
dataTableOutput("tab3"))
)#Close tabPanel transactionoverview
) #Close tabsetpanel
) #Close UI
########
#SERVER#
########
server=function(input, output,session) {
# TAB 1
sortTable <- reactive({
details[do.call(order, -details[as.character(input$size)]),]
})
output$plot= renderPlot ({
treemap(details,
index=c("Site"),
vSize=input$size,
vColor=input$color,
title="XYZ University: Overview of Site Data",
fontsize.title = 20,
#sortID = paste("-",input$sort,sep=""),
type="value")
})
output$tab <- renderDataTable({
sortTable()
})
#TAB 2
test=reactive({
heatmap_mean %>% filter(Location==input$sitechoice)
})
output$heatmap=renderPlotly({
ggplotly(
ggplot(test(), aes(Day, `Time Slot`)) +
geom_tile(aes(fill = `Average Number of Transactions`),color = "white") +
scale_fill_gradient(low = "lightblue", high = "darkblue") +
ylab("") +
xlab("") +
theme(legend.title = element_text(size = 8),
panel.background = element_blank(),
legend.text = element_text(size = 8),
plot.title = element_text(size=18),
axis.title=element_text(size=22,face="bold"),
axis.text.x = element_text(angle = 90, hjust = 1)) +
labs(fill = ""))
})
output$tab2 <- renderDataTable({
test()
})
#TAB 3
ranks_pen <- reactive({
if(input$parameterchoice=="Average Number of Transactions")
{
showdata=rankdf_avgtran %>%
group_by(Tran.Hour.2h.Slot) %>%
top_n(n = input$rankchoice, wt = `Average Number of Transactions`) %>% #For each time slot, cut off top n values.
mutate(Rank = rank(-`Average Number of Transactions`, ties.method = "first")) #And rank for each of the 'n' sites for each time slot
return(showdata)
}
else
if(input$parameterchoice=="Average Transaction Value (USD)")
{
showdata=rankdf_ticket %>%
group_by(Tran.Hour.2h.Slot) %>%
top_n(n = input$rankchoice, wt = `Average Transaction Value (USD)`) %>% #For each time slot, cut off top 'n' values.
mutate(Rank = rank(-`Average Transaction Value (USD)`, ties.method = "first")) #And rank the 'n' sites for each time slot
return(showdata)
}
})
ranksvf<- reactive({
ranks_pen() %>%
group_by(Tran.Hour.2h.Slot) %>% #Group the columns
arrange(Rank) #Arrange rank from 1 to 'n'
})
output$facetmap=renderPlotly({
ggplotly(
ggplot(ranksvf(),aes(Rank,input$parameterchoice,fill=Location))+
ggtitle("") +
theme(axis.title.y=element_blank())+
geom_bar(position="dodge",stat="identity")+
facet_wrap(~Tran.Hour.2h.Slot,nrow=2)
)
})
output$tab3 <- renderDataTable({
ranksvf()
})
}#Close server
#RUN APP
shinyApp(ui,server)
input$parameterchoice returns a quoted string, however aes only accepts unquoted strings as arguments. Using aes_ instead should resolve the issue
output$facetmap=renderPlotly({
pc <- input$parameterchoice
ggplotly(
ggplot(ranksvf(),aes_(quote(Rank),as.name(pc),fill=quote(Location)))+
ggtitle("") +
theme(axis.title.y=element_blank())+
geom_bar(position="dodge",stat="identity")+
facet_wrap(~Tran.Hour.2h.Slot,nrow=2)
)
})
Try it:
selectInput("parameterchoice",
label="Rank By",
choices=as.list(unique(c(names(rankdf_avgtran),names(rankdf_ticket)))[3:4]),
selected = "Average Transaction Value (USD)")