I am trying to implement something like the following post:
How to set daterangepicker to ONLY YEARS
I would like my dataRangeInput() to only accept values of years.
Currently the dataRangeInput() displays years but then goes on to ask for the month and day. I would like to avoid this since I am using yearly data and not daily/monthly.
Code:
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
dateRangeInput(
inputId = "myInputID",
label = h4("Year"),
start = as.Date("1990-01-04"),
end = as.Date("2005-10-23"),
# min = as.Date("1990-01-04"),
# max = as.Date("2022-10-23"),
startview = "year",
language = "es",
format = "yyyy",
separator = " - "
#startview = "decade"
),
actionButton(inputId = "apply_analysis", label = "Aplicar", icon = icon("play")),
plotOutput("out")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
out = eventReactive(input$apply_analysis, {
managers %>%
data.frame() %>%
rownames_to_column("Date") %>%
mutate(year = lubridate::year(Date)) %>%
filter(year > input$myInputID)
})
output$myPlot = renderPlot({
out() %>%
ggplot(aes(x = year, y = HAM1)) +
geom_line() +
theme_bw()
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
I am trying to create a shiny App which stores plotly objects in a list and I want the user to select from the dropdown X number of stocks they want to perform some analysis to. Then I use some function to split the time series into training and testing data.
What I want to do is update the UI so that the user has the option to select a symbol from a new dropdown (next to the plot area) and then it will generate this new plot. (i.e. by filtering the list of plots by the input$symbol2 name.
I am stuck on the plotsList at the very end of the code.
Code and App:
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(tidyverse)
library(tidyquant)
library(tidymodels)
library(timetk)
library(plotly)
# library(shiny)
# library(shinyWidgets)
# library(shinyjs)
#
# library(tidyverse)
# library(tidyquant)
# library(Deloitte)
# library(gtExtras)
# library(gt)
# library(htmltools)
#
# library(modeltime)
# library(tidymodels)
# library(timetk)
# library(lubridate)
# library(parsnip)
FANG
uniqueSymbols = unique(FANG$symbol)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("List error"),
shinyWidgets::pickerInput(
inputId = "var_to_forecast_CF1",
label = h4("Variable To Predict"),
choices = c("open", "high"),
selected = "open"
),
verbatimTextOutput("formula_to_estimate_1"),
airYearpickerInput(
inputId = "yearly_range",
label = "Select range of years:",
range = TRUE, value = c(Sys.Date()-365*10, Sys.Date())
),
shinyWidgets::pickerInput(
inputId = "symbol",
label = h4("Select symbol"),
choices = uniqueSymbols,
selected = "Total",
multiple = TRUE,
options = list(
size = 3
)
),
actionButton(inputId = "apply", label = "Aplicar", icon = icon("play")),
plotlyOutput("plot")
)
# Define server logic required to draw a histogram
server <- function(input, output) {
formula_to_estimate = reactive({
#formula(paste0(input$var_to_forecast_CF1, "~Periodo", sep = ""))
paste0(input$var_to_forecast_CF1, "~", "close") %>%
as.formula()
})
output$formula_to_estimate_1 = renderText({
deparse(as.formula(formula_to_estimate()))
})
# Compute Assessment period
# compute the "assess" part of the "time_series_split" function:
assessmentDuration = reactive({
(year(input$yearly_range[2]) - year(input$yearly_range[1])) * 12
})
# A list of 2:
data_to_model = eventReactive(input$apply, {
FANG %>%
filter(symbol %in% input$symbol) %>%
split(., .$symbol)
})
splits = eventReactive(input$apply, {
data_to_model() %>%
map(., ~.x %>%
time_series_split(
assess = assessmentDuration(),
#assess = "18 months",
cumulative = TRUE
)
)
})
plotsList = eventReactive({
splits() %>%
map(., ~.x %>%
ggplot(aes(x = Periodo, y = diff_from_base_year), color = "#041e42") +
geom_line(size = 1) +
#facet_wrap(~input$symbol, ncol = 1) +
labs(
x = "Date", y = "r",
title = "my title"
) +
theme_momura() %>%
ggplotly()
)
})
# How can update the UI and filter a single stock to plot?
output$plot = renderPlotly({
plotsList[[!!sym(input$symbol2)]] # STUCK HERE...........
})
}
# Run the application
shinyApp(ui = ui, server = server)
My normal Shiny date widget offers date selection by year-month-day. REPREX:
# Load library
library(shiny)
library(dplyr)
# Load data & prepare data
data(economics)
dat <- economics %>% filter(date > '2014-01-01')
# Define UI
ui <- fluidPage(
dateRangeInput(
inputId = 'enter_dt',
label = 'select timeframe:',
start = max(dat$date),
end = min(dat$date) ,
)
)
# Define server
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Above code gives me this:
I am trying to get a widget which only offers year-month like this:
Please advise.
We could use airDatepickerInput from shinyWidgets:
library(shiny)
library(dplyr)
library(shinyWidgets)
# Load data & prepare data
data(economics)
dat <- economics %>% filter(date > '2014-01-01')
# Define UI
ui <- fluidPage(
airDatepickerInput("input_var_name",
label = "Start month",
value = "2022-10-01",
maxDate = "2022-12-01",
minDate = "2022-01-01",
view = "months",
minView = "months",
dateFormat = "yyyy-mm"
)
)
# Define server
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
I am currently having issues with my R.Shiny app which I have designed. The UI has a drop down menu which selects a variable "returnvar", one of the columns in my dataframe source_file. However, upon running the code below I receive an error message stating:
Warning: Unknown or uninitialised column: 'returnvar'.
Warning: Error in : geom_line requires the following missing aesthetics: y
Does anyone know how I can reference an input into my source file? (Something to fix the error from the line source_file_filtered$returnvar) Would greatly appreciate all the help I can get for this, thanks!
App.R
# Defining UI
ui <- fluidPage(theme = shinytheme("darkly"),
navbarPage(
"App", #Title of app
tabPanel("Weekly Cumulative Returns",
sidebarPanel(
tags$h3("Input:"),
dateRangeInput("daterange", "Date range",
start = "2016-01-01",
end = "2021-04-02",
min = "2016-01-01",
max = "2021-04-02",
format = "yyyy/mm/dd",
separator = "to"),
selectInput("returnvar", "Index",
choices= names(source_file[2:(length(source_file)-1)])),
), #sidebarpanel
mainPanel(
# Output: Correlation Plot ----
plotOutput(outputId = "plot2"),
), #mainPanel
) #tabpanel
) #navbarPage
) #fluidPage
# Defining Server
server <- function(input, output) {
#plot for Weekly Cumulative Returns tab
output$plot2 <- renderPlot({
returncolumn(returnvar = input$returnvar,
daterange = input$daterange)
})
}
# Create Shiny Object
shinyApp(ui = ui, server = server)
Global.R
#choose source file to work with
file_name = file.choose()
source_file = read_csv(file_name)
source_file$Date = as.Date(source_file$Date)
#defining returncolumn as a function to return of selected variable over the selected date range in shiny
returncolumn = function(returnvar, daterange)
{
source_file_filtered <- source_file %>%
filter(Date >= daterange[1] & Date <= daterange[2])
g = ggplot(data = source_file_filtered, mapping = aes(x=Date, y=source_file_filtered$returnvar)) + geom_line(color="blue")
print(g)
}
Without the data its hard to test, but changing source_file_filtered$returnvar to source_file_filtered[[returnvar]] should make it work.
returncolumn = function(returnvar, daterange)
{
source_file_filtered <- source_file %>%
filter(Date >= daterange[1] & Date <= daterange[2])
g = ggplot(data = source_file_filtered,
mapping = aes(x = Date,
y = source_file_filtered[[returnvar]])) +
geom_line(color="blue")
print(g)
}
I am trying to make my line graph change based on the users input in the dateRangeInput widget in Rshiny. I have a column named SampleTime that has dates but every time I run the app I cannot seem to get the plot to change. I am obviously not linking this together correctly. Can anyone provide any input to this problem? Below is my code in app code in R.
library(tidyverse)
library(shiny)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("TPO Data Over Time by Valve ID and Product Type"),
# Sidebar
sidebarLayout(
position = "left",
sidebarPanel(
selectInput(inputId = "valves",
label = strong("Valve ID"),
choices = unique(cTPO$ValveID),
selected = "1"),
selectInput(inputId = "products",
label = strong("Product Type"),
choices = unique(cTPO$Product),
selected = "12OZ CAN"),
dateRangeInput(inputId = "calendar",
label = 'Date range input: mm-dd-yyyy',
format = "mm-dd-yyyy",
start = NULL, end = NULL)),
mainPanel(
plotOutput("TPOPlot"))))
# Define server logic required to draw a line plot
server <- function(input, output) {
output$TPOPlot <- renderPlot({
## Read cTPO.csv and assign
cTPO <- read_csv("cTPO.csv")
## Get date from data
cTPO$SampleTime <- as.Date(cTPO$SampleTime, "%m/%d/%Y")
## Create point plot of TPO by valve number and product type
cTPO %>%
select(
ValveID,
BrandName,
Product,
TPOvalue,
CO2value,
LogIDKey,
SampleTime) %>%
filter_all(all_vars(!is.na(.)))
## Create line plot of TPO data
cTPO %>%
filter (ValveID == input$valves, Product == input$products) %>%
ggplot(aes (x = SampleTime, y = TPOvalue)) +
geom_line() +
labs (x = "Sample Date", y ="TPO Value") +
theme_bw()
})
}
The below shiny app fails to render the Network graph. Whereas with an Rmd file I do get the graphic. Below an reproducible example. Keen to know where the error is if any.
library(shiny)
library(shinythemes)
library(networkD3)
library(data.tree)
library(tidyr)
# Define UI for application that draws a network graph
ui <- fluidPage(theme = shinytheme("slate"),
sliderInput("number",
"Random Numbers:",
min = 1,
max = 100,
value = 20),
# Show a plot of the generated distribution
radialNetworkOutput("radial")
)
# Define server logic required to draw a network graph
server <- function(input, output) {
Data_tree <- reactive({
data.frame(Start="Class",
Asset = sample(c("FI","Equity","Currency"),input$number,replace = TRUE),
Sub_Asset = sample(c("Asia","Europe","USA"),input$number,replace = TRUE),
Ticker = replicate(input$number,paste0(sample(LETTERS,3),collapse=""))) %>%
unite(col="pathString",Start,Asset,Sub_Asset,Ticker,sep="-",remove=FALSE) %>%
select(-Start) %>% as.Node(pathDelimiter = "-")
})
output$radial <- renderRadialNetwork({
# draw the radialNetwork with the specified size
ToListExplicit(Data_tree(), unname = TRUE )
})
}
# Run the application
shinyApp(ui = ui, server = server)
The graphic should look like below:
Just discovered the short coming in the code. Within the renderRadialNetwork function needed to add radialNetwork()
Here is the working final code.
library(shiny)
library(shinythemes)
library(networkD3)
library(data.tree)
library(tidyr)
# Define UI for application that draws a network graph
ui <- fluidPage(theme = shinytheme("slate"),
sliderInput("number",
"Random Numbers:",
min = 1,
max = 100,
value = 20),
# Show a plot of the generated distribution
radialNetworkOutput("radial")
)
# Define server logic required to draw a network graph
server <- function(input, output) {
Data_tree <- reactive({
data.frame(Start="Class",
Asset = sample(c("FI","Equity","Currency"),input$number,replace = TRUE),
Sub_Asset = sample(c("Asia","Europe","USA"),input$number,replace = TRUE),
Ticker = replicate(input$number,paste0(sample(LETTERS,3),collapse=""))) %>%
unite(col="pathString",Start,Asset,Sub_Asset,Ticker,sep="-",remove=FALSE) %>%
select(-Start) %>% as.Node(pathDelimiter = "-")
})
output$radial <- renderRadialNetwork({
# draw the radialNetwork with the specified size
radialNetwork(ToListExplicit(Data_tree(), unname = TRUE ), linkColour = "#ccc",nodeColour = "#fff",
nodeStroke = "orange",textColour = "#cccccc")
})
}
# Run the application
shinyApp(ui = ui, server = server)