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)
Related
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)
I have a table, in which the user will give as input some groups. As a result, I want another column to automatically update and show the frequency (or replicate) of each group:
This code creates this app:
library(shiny)
library(rhandsontable)
library(tidyverse)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Automatic data rhandsontable"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
rhandsontable::rHandsontableOutput('ed_out'),
shiny::actionButton('start_input', 'save final table')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# This has to be reactive
data <- reactive({
df <- data.frame(Animal = c('Dog', 'Cat', 'Mouse', 'Elephant', 'Tiger'),
Group = ' ',
replicate = as.numeric(' '))
})
output$ed_out <- rhandsontable::renderRHandsontable({
df <- data()
rhandsontable(
df,
height = 500,
width = 600) %>%
hot_col('replicate', format = '0a', readOnly = TRUE) %>%
hot_col('Animal', readOnly = TRUE)
})
# This is just to save the table when the user has finished, can be ignored
group_finals <- reactiveValues()
observeEvent(input$start_input, {
group_finals$data <- rhandsontable::hot_to_r(input$ed_out)
print(group_finals$data)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
So the idea is that the user, inputs the groups and the replicate is automatically updated: (here the user gives as input B, B, A, A, B.
I am able to count the replicates of each group, but I'm not sure how where to implement this part to calculate them and display them at the same time after the user inputs each group.
df <- df %>%
group_by(Group) %>%
mutate(replicate = 1:n())
Not sure if this is the best approach, I tried a bit with the hot_to_col renderer to use javascript but I'm unfamiliar with that language.
Sorry but I'm not familiar with the tidyverse - so I switched to data.table.
hot_to_r is the right way to go:
library(shiny)
library(rhandsontable)
library(data.table)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Automatic data rhandsontable"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
rhandsontable::rHandsontableOutput('ed_out'),
shiny::actionButton('start_input', 'save final table')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# This has to be reactive
data <- reactive({
data.frame(Animal = c('Dog', 'Cat', 'Mouse', 'Elephant', 'Tiger'),
Group = '',
replicate = NA_integer_)
})
myData <- reactiveVal()
observeEvent(data(),{
myData(data())
})
output$ed_out <- rhandsontable::renderRHandsontable({
rhandsontable(
myData(),
height = 500,
width = 600) %>%
hot_col('replicate', format = '0a', readOnly = TRUE) %>%
hot_col('Animal', readOnly = TRUE)
})
observeEvent(input$ed_out, {
userDT <- rhandsontable::hot_to_r(input$ed_out)
setDT(userDT)
userDT[, replicate := seq_len(.N), by = Group][is.na(Group) | Group == "", replicate := NA_integer_]
myData(userDT)
})
# This is just to save the table when the user has finished, can be ignored
group_finals <- reactiveValues()
observeEvent(input$start_input, {
group_finals$myData <- rhandsontable::hot_to_r(input$ed_out)
print(group_finals$myData)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm new to Shiny. I'm trying to use sliderInput for dates with ggplot and shiny. I could use dygraphs and it worked. But I'm hoping to stick with ggplot for data visualisation. R script below may be a mess. I just can't get the sliderInput to work on shiny app using ggplot.
The data set is here.
library(shiny)
library(scales)
library(ggplot2)
library(reshape2)
# Set system language as Japanese
Sys.setlocale(category = "LC_ALL", locale = "Japanese")
# Load data ---- the dataset is available at the link above.
df <-read.csv("data.csv", encoding="UTF-8", stringsAsFactors=FALSE, check.names = F)
colnames(df)[1]<-"取引オープン日" ##If the first column had extra string.
##Formating date
df$取引クローズ日edit<-gsub("/","-",df$取引クローズ日)
df$取引クローズ日edit<-as.POSIXct(df$取引クローズ日edit, format="%m-%d-%Y %H:%M")
##Pick 5 columns
df_5col<-df[,c("ロット","総ピップス","総収益","ドローダウン（差額）","取引クローズ日edit")]
##Stack dataset
stacked<-melt(df_5col,id.vars="取引クローズ日edit",variable.name="USD/pips",value.name="USD/pips(値)")
stacked$取引クローズ日edit<-as.POSIXct(stacked$取引クローズ日edit, format="%Y-%m-%d %H:%M") ##%m-%d-%Y
# User interface ----
ui <- fluidPage(
titlePanel("Autobot1"),
sidebarLayout(
sidebarPanel(
helpText("FX autobot"),
checkboxGroupInput("checkGroup", label = "Choose a variable to display",
choices = c("総収益" = "総収益", "ドローダウン（差額）" = "ドローダウン", "総ピップス" = "総ピップス", "ロット" = "ロット"),
selected = "総収益"),
sliderInput("sliderdate",
label = "可視化する期間:",
min = as.POSIXct("2020-03-24 10:23", "%Y-%m-%d %H:%M"),
max = as.POSIXct("2020-12-30 10:23", "%Y-%m-%d %H:%M"),
value=c(as.POSIXct("2020-03-24 10:23"),
as.POSIXct("2020-12-30 10:23")),
timeFormat="%Y-%m-%d %H:%M")
),
mainPanel(plotOutput("plot1"))
)
)
# Server logic
server <- function(input, output) {
output$plot1 <- renderPlot({
##filter data
df_5col%>%
filter(取引クローズ日edit == input$sliderdate) %>%
#data manipulation
data1=reactive({
return(stacked[stacked$USD/pips%in%input$checkGroup,])
})
ggplot(data=data1) +geom_line(aes(x=取引クローズ日edit, y= 総収益, colour="総収益"))+geom_line(aes(x=取引クローズ日edit, y=総ピップス, colour="総ピップス"))+geom_line(aes(x=取引クローズ日edit, y= ロット, colour="ロット"))+scale_x_datetime(labels = date_format("%Y-%m-%d %H:%M"),date_breaks = "2 months")
})
}
# Run the app
shinyApp(ui, server)
Thanks in advance
It's solved. The script below works.
library(shiny)
library(scales)
library(ggplot2)
library(reshape2)
# Set system language as Japanese
Sys.setlocale(category = "LC_ALL", locale = "Japanese")
# Load data ----
df <-read.csv("data.csv", encoding="UTF-8", stringsAsFactors=FALSE, check.names = F)
colnames(df)[1]<-"取引オープン日" ##If the first column had extra string.
##Formating date
df$取引クローズ日edit<-gsub("/","-",df$取引クローズ日)
df$取引クローズ日edit<-as.POSIXct(df$取引クローズ日edit, format="%m-%d-%Y %H:%M")
##Pick 5 columns
df_5col<-df[,c("ロット","総ピップス","総収益","ドローダウン（差額）","取引クローズ日edit")]
##Stack dataset
stacked<-melt(df_5col,id.vars="取引クローズ日edit",variable.name="USD/pips",value.name="USD/pips(値)")
stacked$取引クローズ日edit<-as.POSIXct(stacked$取引クローズ日edit, format="%m-%d-%Y %H:%M")
# User interface ----
ui <- fluidPage(
titlePanel("title"),
sidebarLayout(
sidebarPanel(
helpText("Times-series data of FX autobot"),
checkboxGroupInput("checkGroup", label = "Choose a variable to display",
choices = c("総収益" = "総収益", "ドローダウン（差額）" = "ドローダウン（差額）", "総ピップス" = "総ピップス", "ロット" = "ロット"),
selected = "総収益"),
sliderInput("sliderdate",
label = "可視化する期間:",
min = as.POSIXct("2020-03-24 10:23"),
max = as.POSIXct(Sys.Date()),
value=c(as.POSIXct("2020-03-24 10:23"),
as.POSIXct("2020-12-30 10:23")),
timeFormat="%m-%d-%Y %H:%M")
),
mainPanel(plotOutput("plot1"))
)
)
# Server logic
server <- function(input, output) {
output$plot1 <- renderPlot({
##create the data
date1<-as.POSIXct(input$sliderdate, timeFormat="%m-%d-%Y %H:%M")
sub_data <- subset(stacked, 取引クローズ日edit >= date1[1] & 取引クローズ日edit <= date1[2])
sub_data2<-sub_data[sub_data[,2]%in%input$checkGroup,]
ggplot(data=sub_data2) +geom_line(aes(x=取引クローズ日edit, y= sub_data2[,3], color=sub_data2[,2]))+ylab("USD/pips")+xlab("取引クローズ日")+scale_x_datetime(labels = date_format("%m-%d-%Y"),date_breaks = "1 month")
})
}
# Run the app
shinyApp(ui, server)
I'm trying to let the choropleth map to react while user change inputs using slider. I'm using sqldf library to query the result and plot it in the map. However, currently, I'm getting the result of "Error in result_create: near "&": syntax error". Not sure how to fix it or maybe I was wrong from the beginning.
library(magrittr)
library(shiny)
library(shinythemes)
library(dplyr)
library(readr)
library(ggplot2)
library(leaflet)
library(evaluate)
library(ggmap)
library(rgdal)
library(tmap)
library(tmaptools)
library(sf)
library(geojsonio)
library(sqldf)
library(DBI)
library(gsubfn)
library(RH2)
library(RSQLite)
library(rJava)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- dashboardPage(
# Application title
dashboardHeader(title="Vic Car Accidents"),
dashboardSidebar(
sliderInput("range", "Year:",
min = 2013, max = 2018,
value = c(2013,2018))),
dashboardBody(
box(title = "Choropleth Map",width = 12, status = "primary",leafletOutput("young_driver",width = "100%", height = 400)
),
box(tableOutput("values"))
))
# Define server logic required to draw a histogram
options(scipen = 999)
#read LGA geojson file from local file
LGA<-st_read("Data/LGA.geojson",stringsAsFactors = FALSE)
#read car crashes data from local file
carCrashes<- read_csv("Data/Car.csv")
server <- shinyServer(function(input, output, session) {
sliderValues <- reactive({
data.frame(name = "range", value= (paste(input$range[1],input$range[2])))})
output$values <- renderTable({
sliderValues()
})
temp <- observe({
year_1 <- input$range[1]
year_2 <- input$range[2]
#data.frame(name = "range", value= (paste(input$range[1],input$range[2])))})
read.csv.sql(
"Data/Car.csv",
sql = ("select distinct LGA_NAME, count(LGA_NAME) as 'number of young driver'
from file
where driver_type = 'young driver' and
year_period >= year_1 && year_period <= year_2
group by LGA_NAME; ")
)
sub_and_car <- left_join(LGA,temp,by = c("VIC_LGA__3" = "LGA_NAME"))
output$young_driver<-renderLeaflet({
tm<-tm_shape(sub_and_car)+tm_polygons(col="number of young driver", border.col="grey")
tmap_leaflet(tm)
})
# output$young_driver<-renderLeaflet({
# tm<-tm_shape(sub_and_car)+tm_polygons(col="number of young driver", border.col="grey")
#tmap_leaflet(tm)
})
})
# Run the application
shinyApp(ui = ui, server = server)
Ok I got it... you made multiple mistakes in your code:
observeEvent should only be used for check for sideeffekts never to create a data.frame. Always use eventReactive to do that. There were many bugs I could not figure out in your sqldf code. I anyway recommend learning dplyr,it´s the standard others programmers also use.
Seperate creating data.frames from rendering Widgets. Since the Map takes long time to render, I used shinycssloaders to show the user some feedback. Otherwise he or she may just close the App.
Here is the Code, just change the paths:
library(magrittr)
library(shiny)
library(shinythemes)
library(dplyr)
library(readr)
library(ggplot2)
library(leaflet)
library(evaluate)
library(ggmap)
library(rgdal)
library(tmap)
library(tmaptools)
library(sf)
library(geojsonio)
library(sqldf)
library(DBI)
library(gsubfn)
library(RH2)
library(RSQLite)
library(rJava)
library(shinydashboard)
library(shinycssloaders)
# Define UI for application that draws a histogram
ui <- dashboardPage(
# Application title
dashboardHeader(title="Vic Car Accidents"),
dashboardSidebar(
sliderInput("range", "Year:",
min = 2013, max = 2018,
value = c(2013,2018)),
actionButton("change", "Change")),
dashboardBody(
box(title = "Choropleth Map",width = 12, status = "primary",withSpinner(leafletOutput("young_driver",width = "100%", height = 400))
),
box(tableOutput("values"))
))
# Define server logic required to draw a histogram
options(scipen = 999)
#read LGA geojson file from local file
LGA<-st_read("C:/Users/User/Downloads/R-project-master/R-project-master/LGA.geojson",stringsAsFactors = FALSE)
#read car crashes data from local file
carCrashes<- read_csv("C:/Users/User/Downloads/R-project-master/R-project-master/Car.csv")
server <- shinyServer(function(input, output, session) {
sliderValues <- reactive({
data.frame(name = "range", value= (paste(input$range[1],input$range[2])))})
output$values <- renderTable({
sliderValues()
})
cmap <- eventReactive(input$change,{
range_1 <- as.numeric(input$range[1])
range_2 <- as.numeric(input$range[2])
temp <- carCrashes %>%
filter(driver_type == 'young driver' & year_period >= range_1 & year_period <= range_2) %>%
group_by(LGA_NAME) %>%
mutate(`Number of young drivers` = n())
# temp<- sqldf(
# "C:/Users/User/Downloads/R-project-master/R-project-master/Car.csv",
# sql = paste("select distinct LGA_NAME, count(LGA_NAME) as 'number of young driver'
# from file
# where driver_type = 'young driver' and
# year_period between range_1 and range_2
# group by LGA_NAME; ")
sub_and_car <- left_join(LGA,temp,by = c("VIC_LGA__3" = "LGA_NAME"))
})
output$young_driver <- renderLeaflet({
tm <- tm_shape(cmap())+tm_polygons(col="Number of young drivers", border.col="grey")
tmap_leaflet(tm)
})
})
# Run the application
shinyApp(ui = ui, server = server)
I want to use the data.table package in a Shiny App to improve speed.
However, it's not clear to me how to select the right columns based on the user input.
The following example works for the case when the data is in the data.frame format but not when it is in data.table format.
# load packages
library(data.table)
# global ----------------------------------------
library(shiny)
# use cars dataset
data(cars)
# create datatable from cars data
cars <- as.data.table(cars)
# user interface ---------------------------------
ui <- fluidPage(
sidebarLayout(
selectInput(inputId = 'col', label = 'column', choices = names(cars)),
numericInput(inputId = 'filter',label = 'filter', value = 5)
),
mainPanel(plotOutput("plot"))
)
# server ----------------------------------------
server <- function(input, output) {
output$plot <- renderPlot({
# filter example
d1 <- cars[speed>input$filter,]
x <- d1[[input$col]]
hist(x)
})
}
# run app --------------------------------------
shinyApp(ui = ui, server = server)