I have data to be plotted as series which is uploded by user. However, the data is for one year and I would like to display 2 months for instance, january and february when the user needs to analyze the pattern of these months. That's why i thought that dateRangeInput can be useful but i dont know how can i bind with plot?
for data: http://www.filedropper.com/quo
EDITED: I used the reactive argument in order get the inputs. However, it shows another error: Error in charToDate(x) :
character string is not in a standard unambiguous format.
library(shiny)
shinyUI(fluidPage(
titlePanel("Time Series Study"),
sidebarLayout(
sidebarPanel(
fileInput('file2', 'Choose Quotation File:', accept=c('text/csv', 'text/comma-separated-values,text/plain', '.csv'), multiple = FALSE),
dateRangeInput("range",
"Date Range:",
start = "start",
end = "end",
min = "2012.01.01",
max = "2012.01.31")
),
mainPanel(
plotOutput("distPlot") ) ) ))
#server.r
library(shiny)
library(ggplot2)
shinyServer(function(input, output) {
dataInput <- reactive({
`uploadedsamplefile` <- read.csv(input$file2$datapath, sep=";",check.names = FALSE)
uploadedsamplefile1 <- uploadedsamplefile
xx<-cbind(`uploadedsamplefile1`[1:4])
xx$`Datee` <- as.Date( xx$`Datee`, '%d.%m.%Y')
xx$`Datee` <- subset( xx$`Datee`, as.Date("input$start") <= xx$`Datee` && xx$`Datee` <= as.Date("input$end"))
})
output$distPlot <- renderPlot({
y <- ggplot(xx, aes(x=`Datee`)) + geom_line(aes(y=(`A`), colour = "A")) + geom_line(size=1,aes(y=(`B`), colour = "B")) +
geom_line(size=1,aes(y=(`C`), colour = "C"))
y }) })
To access the start and end dates in your example use input$range[1] for the start date and input$range[2] to access the end date.
Related
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 have the following dataset
Date, IMEI
22-7-2017, I
23-7-2017, I
24-7-2017, I
25-7-2017, I
26-7-2017, C
27-7-2017, C
28-7-2017, C
29-7-2017, C
30-7-2017, C
31-7-2017, A
01-8-2017, A
02-8-2017, A
03-8-2017, A
04-8-2017, I
05-8-2017, C
06-8-2017, A
07-8-2017, A
07-8-2017, A
08-8-2017, I
09-8-2017, I
09-8-2017, A
09-8-2017, C
and i want to create an interactive plot to visualize it using plotly to allow the user set the date range manually in "R Shiny" using a dateRangeInput function in r shiny, I've tried the following but still getting wrong plot
ui = fluidpage(
sidebarPanel(
dateRangeInput(inputId="myDateRange", label="", start = NULL, end = NULL, min = NULL, max = NULL),
))
mainPanel(
plotlyOutput("")
)
server = function(input, output, session) {
output$age <- renderPlotly({
plot_ly(a1, x= a1$Date, y = a1$IMEI)
})
Here is a reproducible example.
First, make sure your Date column in your data is a Date object.
Your ui needed minor edits, including capital "P" in fluidPage and adjustment of parentheses. Your plotlyOutput needed an "InputId" - looks like you want to use age based on server.
Next, in server you can subset your data based on the dateRangeInput. There are 2 values input$myDateRange[1] and input$myDateRange[2] - corresponding to the lower and higher limits of the input chosen. You can subset your data and include rows of data where Date is between those values.
Otherwise, I selected some example settings for plot_ly to use.
df$Date <- as.Date(df$Date, format = "%d-%m-%Y")
library(shiny)
library(plotly)
ui = fluidPage(
sidebarPanel(
dateRangeInput(inputId="myDateRange", label="", start = NULL, end = NULL, min = NULL, max = NULL),
),
mainPanel(
plotlyOutput("age")
)
)
server = function(input, output, session) {
output$age <- renderPlotly({
plot_ly(
data = subset(df, Date > input$myDateRange[1] & Date < input$myDateRange[2]),
x = ~Date,
y = ~IMEI,
type = "scatter",
mode = "markers")
})
}
shinyApp(ui, server)
I am trying to run an interactive rshiny plot. I have this output:
I want to be able to subset and plot by country, by scenario, by variable, by year (4 selections). I also want to be able to add value points by year and not have the whole plot by year done immediately.
I am only able to subset by country. My scenario and variable dropdowns are not reactive. And it plots all variables with all scenarios although I want one variable plot by one scenario and one country
How can I make my graph interactive?
library(reshape2)
library(lattice)
library(plyr)
library(shiny)
library(dplyr)
library(abind)
library(ggplot2)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices=unique(dmiubf$country), selected = ""),
selectInput("Senario","Show senario:", choices = unique(dmiubf$scn)),
selectInput("var","Show senario:", choices = unique(dmiubf$var)),
selectInput("year","Show vertical line in year(s):", choices = unique(dmiubf$year),multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a = dmiubf[dmiubf$var==input$var, dmiubf$scn==input$senario]<-dmiubf[dmiubf[,"country"]=="Costa Rica",input$senario]<-"base"
dmiubf
})
output$chart <- renderPlot({
req(input$radio)
if (input$radio==c("Costa Rica")) {
plot0<-ggplot(data=cr()) + geom_point(aes(x=year,y=pcn, fill=scn),
size = 6)
print(plot0)
}
})
}
shinyApp(ui = ui, server = server)
I tried fixing your app, but without knowing how the input data looks like, its a bit hard. So i created a random dummy dataset. Therefore it is not always showing a plot, as no data is left after the filtering process.
But as a starting point I think this should help you:
library(shiny)
library(dplyr)
library(ggplot2)
dmiubf <- data.frame(
country=c(rep("Costa Rica",8), rep("England",8), rep("Austria",8), rep("Latvia",8)),
scn = rep(c("base","high","low","extra"),8),
year = sample(c(1998, 1999, 2000, 2001), 32, replace = T),
var = sample(c(1,2,3,4), 32, replace = T),
pcn = sample(c(10,20,30,40), 32, replace = T)
)
ui <- fluidPage(
titlePanel("Comparing Trend and PP policies by MDGs and funding"),
sidebarLayout(
sidebarPanel(
radioButtons("radio", label = h3("Country"),choices= as.character(unique(dmiubf$country)), selected = ""),
selectInput("Senario","Show senario:", choices = as.character(unique(dmiubf$scn))),
selectInput("var","Show senario:", choices = sort(unique(dmiubf$var))),
selectInput("year","Show vertical line in year(s):", choices = sort(unique(dmiubf$year)), multiple=TRUE)
),
mainPanel(
plotOutput("chart")
)
)
)
server <- function(input, output) {
cr <- reactive({
a <- dmiubf[as.character(dmiubf$country)==input$radio &
dmiubf$var %in% as.numeric(input$var) &
dmiubf$year %in% as.numeric(input$year) &
as.character(dmiubf$scn)==input$Senario
,]
a
})
output$chart <- renderPlot({
validate(
need(nrow(cr())!=0, "No Data to plot")
)
ggplot(data=cr()) + geom_point(aes(x=year, y=pcn, fill=scn), size = 6)
})
}
shinyApp(ui = ui, server = server)
I am trying to subset a data set using a few input parameters and then plot the output. I am able to plot various stats over time for various teams, but I am unable to figure out how to subset my data for an input date range. Attached is my server and ui.
Server:
library(shiny)
season = read.csv("2016_Season.csv")
season$date = as.POSIXct(season$date)
function(input, output) {
adjust <- function() {
data = season
#data = data[data$date >= input$dates[1],]
#data = data[data$date <= input$dates[2],]
if (input$Team != "All"){
data <- data[data$Team == input$Team,]
}
data = data[,c('date',input$Stat)]
}
output$distPlot <- renderPlot({
plot(adjust())
})
}
UI:
library(shiny)
season = read.csv("2016_Season.csv")
season$date = as.POSIXct(season$date)
shinyUI(fluidPage(
titlePanel("Time Plot"),
sidebarPanel(
fluidRow(
div(class="span4",
selectInput('Team',
'Team:',
c('All',unique(as.character(season$Team)))))
),
fluidRow(
div(class="span4",
selectInput("Stat",
"Stat:",
c('PTS','TRB','AST')))
),
dateRangeInput("dates",
"Date range",
start = min(season$date),
end = max(season$date))
),
mainPanel(
plotOutput("distPlot")
)
))
The code works fine when the these two lines are commented out in the server, though obviously the date filters dont work:
#data = data[data$date >= input$dates[1],]
#data = data[data$date <= input$dates[2],]
but I remove the comments i get the error 'need finite 'xlim' values' and I am not sure how to fix it.
I am trying to program a shiny dashboard with a histogram that allows you to subset the input data according to dates.
I have the date input bar functioning, but it only provides data for a single point in time, not a range. Can someone point out where I went wrong in the code?
I will provide my server.r and ui.r code, as well as reproducible data.
SERVER.R
library(reshape)
library(shiny)
library(ggplot2)
# GEN DATA -----------------------------------------------
dates = c("2014-01-01", "2014-02-01", "2014-03-01", "2014-04-01", "2014-01- 01", "2014-02-01", "2014-03-01", "2014-04-01", "2014-01-01", "2014-02-01")
value = c ("3.2", "4.1", "3.8", "5.6", "2.1", "2.0", "1.0" , "4.5", "1.6", "2.9")
dataset = cbind(dates, value)
dataframe = data.frame(dataset)
dataframe$dates <- as.Date(dataframe$dates, format = "20%y-%m-%d")
dataframe$value <- as.numeric(dataframe$value)
# SERVER -----------------------------------------------
shinyServer(function (input, output) {
# DATA
data.r = reactive({
a = subset(dataframe, dates %in% input$daterange)
return(a)
})
# GGPLOT
mycolorgenerator = colorRampPalette(c('sienna','light grey'))
output$myplot = renderPlot({
dd<-data.r()
# ggplot with proper reference to reactive function <<data.r()>>
s = ggplot(data=subset(dataframe, dates %in% input$daterange ), aes (x=value)) + geom_histogram(data=subset(dd, dates%in% input$daterange ) , aes(x=value))
print(s)
})
})
ui.R
# INPUT PART
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("My App"),
sidebarPanel(
dateRangeInput("daterange", "Date range:",
start = "2014-01-01",
end = "2014-03-31",
min = "2014-01-01",
max = "2014-03-31",
format = "yyyy/mm/dd",
separator = "-"),
submitButton(text="Update!")
),
# -----------------------------------------------
# OUTPUT PART
mainPanel(
tabsetPanel(
tabPanel("Tab 1", h4("Head 1"),plotOutput("myplot"))
)
)
))
You are doing string matching here not date interval checking. For what you have to work the daterange would need to contain the exact same values as your data and return more than two dates which that UI control isn't setup to do.
I think something like this might work for you.
# inside interval
start <- ymd("2014-01-01")
end <- ymd("2014-02-01")
my.interval <- interval(start, end)
ymd("2014-01-05") %within% my.interval
[1] TRUE
# outside interval
start <- ymd("2014-01-01")
end <- ymd("2014-02-01")
my.interval <- interval(start, end)
ymd("2014-03-21") %within% my.interval
[1] FALSE
You don't have to use lubridate you can manage this with the base Date packages but it would require some work.
Another work around would be to use a different control with all the date hardcoded and enable a multiselect on the input. Such as selectizeInput(...).
Modify your code like the following, your subsetting was not correct:
server <- shinyServer(function (input, output) {
# DATA
data.r = reactive({
a = subset(dataframe, dates >= input$daterange[1] &
dates <= input$daterange[2]) # add some validation code here
# to validate that input$daterange[2] >= input$daterange[1]
return(a)
})
# GGPLOT
mycolorgenerator = colorRampPalette(c('sienna','light grey'))
output$myplot = renderPlot({
dd<-data.r()
# ggplot with proper reference to reactive function <<data.r()>>
print(ggplot(dd, aes(x=value)) + geom_histogram())
})
})
# INPUT PART
library(shiny)
ui <- shinyUI(pageWithSidebar(
# Application title
headerPanel("My App"),
sidebarPanel(
dateRangeInput("daterange", "Date range:",
start = "2014-01-01",
end = "2014-03-31",
min = "2014-01-01",
max = "2014-03-31",
format = "yyyy/mm/dd",
separator = "-"),
submitButton(text="Update!")
),
# OUTPUT PART
mainPanel(
tabsetPanel(
tabPanel("Tab 1", h4("Head 1"),plotOutput("myplot"))
)
)
))
shinyApp(ui = ui, server = server)