i've been trying to interactively zoom in certain parts of a chartSeries with zoomChart and shiny, but can't find the right solution. I would use dateRangeInput or a slider, but i'm not sure how to connect the zoomChart-option from quantmod with shiny. As you might have already assumed, I'm relatively new to shiny and very thankful for your advices!
edit: Data is in the xts-format.
MyCode:
library(quantmod)
library(shiny)
date_range <- as.POSIXct(index(data))
if (interactive()) {
options(device.ask.default = FALSE)
ui <- fluidPage(
titlePanel("Select Range to zoom-in:"),
sidebarLayout(
sidebarPanel(
dateRangeInput("Range", "Choose Date Range:", min=first(date_range),
max=last(date_range), format = "dd-mm-yyyy")
),
mainPanel(
plotOutput("Plot")
)
)
)
server <- function(input, output) {
output$Plot <- renderPlot({
chartSeries(data, type = c("auto", "candlesticks", "matchsticks", "bars","line"),
theme=chartTheme("white"), name=paste(start(data), end(data),sep = " "))
zoomChart(dateRangeInput)
})
}
shinyApp(ui, server)
}
Actually, you were very close. Note the changes in dateRangeInput(): The start and end argument are used instead of min, max. And then you can use the input on the server-side to use zoom-chart.
library(quantmod)
library(shiny)
getSymbols("YHOO")
data <- YHOO
date_range <- index(data)
if (interactive()) {
options(device.ask.default = FALSE)
ui <- fluidPage(
titlePanel("Select Range to zoom-in:"),
sidebarLayout(
sidebarPanel(
dateRangeInput("Range", "Choose Date Range:", start=first(date_range),
end=last(date_range), format = "yyyy-mm-dd")
),
mainPanel(
plotOutput("Plot")
)
)
)
server <- function(input, output) {
output$Plot <- renderPlot({
chartSeries(data, type = c("auto", "candlesticks", "matchsticks", "bars","line"),
theme=chartTheme("white"), name=paste(start(data), end(data),sep = " "))
zoomChart(paste(input$Range, collapse = "::"))
})
observe({
print(input$Range)
})
}
shinyApp(ui, server)
}
As #drmariod indicated It would be beneficial to have a fully reproducible exmaple, which was easy to get in this case via getSymbols().
Related
I'm trying to show a table with Shiny, but I have a problem showing dates in the right format. Here is an example of what I'm dealing with:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("myfirstinput", "text1"),
textInput("mysecondinput", "text2"),
actionButton("button", "An action button")
),
mainPanel(
tableOutput("table1")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
selected <- as.Date('2000-01-01', "%Y-%m-%d")
selected <- as.list(selected)
output$table1 <- renderTable(selected)
}
# Run the application
shinyApp(ui = ui, server = server)
This works as well :)
selected <- as.character(as.Date('2000-01-01', "%Y-%m-%d"))
Enjoy and Keep Posting!
It seems to work if you change the line:
selected <- as.Date('2000-01-01', "%Y-%m-%d")
to:
selected <- format(as.Date('2000-01-01'), "%Y-%m-%d")
I found that you need to format the date at the last step when the output is computed. Mutating to date earlier on did not solve the issue.
library(shiny)
library(dplyr)
ui <- fluidPage(
fileInput("upload", "Upload CSV", accept = c(".csv", ".tsv")),
numericInput("n", "Rows", value = 5, min = 1, step = 1),
tableOutput("head")
)
server <- function(input, output, session) {
data <- reactive({
req(input$upload)
readr::read_csv(input$upload$datapath)
})
output$head <- renderTable({
data() %>%
group_by(condition, metric) %>%
filter(agg_date == min(agg_date)) %>%
arrange(condition) %>%
mutate(agg_date = format(agg_date, "%Y-%m-%d"))
})
}
shinyApp(ui, server)
I am struggling in writing this shinyApp. It's main aim is to investigate on the variables of a dataset. First it produces the summary statistics on the selected variable.
In the second part; I want this app to give me the pairplot of the varibles that I have selected in the checkbox in the UI. I have used the dataset IRIS which is available to everyone, but I need the code to be adaptable to other datasets.
Can someone please help me?
library(shiny)
library(plotly)
data(iris)
ui<-fluidPage(
titlePanel("Iris"),
sidebarLayout(
sidebarPanel(
selectInput("var",label="Choose a variable",
choice=list("Sepal.Length"=1, "Sepal.Width"=2, "Petal.Length"=3, "Petal.Width"=4, "Species"=5), selectize=FALSE),
checkboxGroupInput(inputId ="independent",label = "Select independent variables", choices = names(iris)),
mainPanel(
verbatimTextOutput("sum"),
plotlyOutput('plot_id_in_ui ', height = "900px")
)
))
)
server<-function(input,output){
output$sum <- renderPrint({
summary(iris[, as.numeric(input$var)])
})
output$plot_id_in_ui <- renderplot( { "DON'T KNOW HOW TO WRITE THIS PART"
pairplot(iris, varnames, type = "both", penalty.par.val = "lambda.1se",
nvals = c(20, 20), pred.type = "response") } )
})
shinyApp(ui, server)
Maybe this little example can help you. It illustrates how to plot a normal R-Plot and a Plotly-Plot in a ShinyApp:
library(shiny)
library(plotly)
ui <- fluidPage(
titlePanel("Iris"),
sidebarLayout(
sidebarPanel(
selectInput("var",label="Choose a variable",
choice=list("Sepal.Length"=1, "Sepal.Width"=2, "Petal.Length"=3, "Petal.Width"=4, "Species"=5), selectize=FALSE),
checkboxGroupInput(inputId ="independent",label = "Select independent variables", choices = names(iris))
),
mainPanel(
verbatimTextOutput("sum"),
plotOutput("plot"),
plotlyOutput("plotly")
)
)
)
server <- function(input,output) {
output$sum <- renderPrint({
summary(iris[, as.numeric(input$var)])
})
output$plot <- renderPlot({
plot(iris)
})
output$plotly <- renderPlotly({
plot_ly(iris) %>%
add_trace(x=iris$Sepal.Length, y=iris$Sepal.Width, type="scatter", mode="markers")
})
}
shinyApp(ui, server)
I'm trying to create the scenario whereby using conditionalpanel, I am able to have an user input of checked boxes to display either 1 or 2 plots, one after another.
My reproducible code can be found below, however, I am unable to display the plots.
Could someone please share with me where did I make a mistake?
library(shiny)
ui = fluidPage(
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot1'",
plotOutput("plot1")
),
conditionalPanel(
condition = "input.my_choices == 'Plot2'",
plotOutput("plot2")
),
conditionalPanel(
condition = "input.my_choices.includes('Plot1', 'Plot2')",
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
}
shinyApp(ui, server)
Update:
I've got what I wanted but without using ConditionalPanel function. Here's the code below:
Would appreciate if someone can share with me the proper way of using ConditionalPanel Function! (:
library(shiny)
#data
df <- iris
#ui
ui <- fluidPage(
sidebarPanel(
checkboxGroupInput(inputId = "Question",
label = "Choose the plots",
choices = c("Plot1", "Plot2", "Plot3"),
selected = "")),
mainPanel(
uiOutput('ui_plot')
)
)
#server
server <- function(input, output)
{
# gen plot containers
output$ui_plot <- renderUI({
out <- list()
if (length(input$Question)==0){return(NULL)}
for (i in 1:length(input$Question)){
out[[i]] <- plotOutput(outputId = paste0("plot",i))
}
return(out)
})
# render plots
observe({
for (i in 1:3){
local({ #because expressions are evaluated at app init
ii <- i
output[[paste0('plot',ii)]] <- renderPlot({
if ( length(input$Question) > ii-1 ){
return(plot(runif(100)))
}
NULL
})
})
}
})
}
shinyApp(ui, server)
I would give you an alternative as you will need to create new plots with different id in order for that to work. The simplest one I can think of is using shinyjs package and its hide and show functions. You can also do this via renderUI but you shouldn't give unnecessary work to your server only if you're showing and hiding the elements
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(),
titlePanel("Plot1 or Plot2?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Plot1 or Plot2",choices = c("Plot1", "Plot2"), selected = "Plot1"),width=2),
mainPanel(
plotOutput("plot1"),
plotOutput("plot2")
)
)
)
server = function(input, output,session) {
# hide plots on start
hide("plot1");hide("plot2")
output$plot1 <- renderPlot({plot(iris)})
output$plot2 <- renderPlot({plot(mtcars)})
observeEvent(input$my_choices,{
if(is.null(input$my_choices)){
hide("plot1"); hide("plot2")
}
else if(length(input$my_choices) == 1){
if(input$my_choices == "Plot1"){
show("plot1");hide("plot2")
}
if(input$my_choices == "Plot2"){
hide("plot1");show("plot2")
}
}
else{
if(all(c("Plot1","Plot2") %in% input$my_choices)){
show("plot1");show("plot2")
}
}
},ignoreNULL = F)
}
shinyApp(ui, server)
I want to print data set values in R shiny web app. But below code is printing the name of dataset in UI output. How can I print values of dataset?
library(MASS)
library(shinythemes)
library(shiny)
library(ggplot2)
mass.tmp <- data(package = "MASS")[3]
mass.datasets <- as.vector(mass.tmp$results[,3])
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Linear Regression Modelling"),
sidebarLayout(
sidebarPanel(
selectInput("dsname", "Dataset:",choices = c(mass.datasets))
,
uiOutput("x_axis")
,
tableOutput("tab")
),
mainPanel(
tags$br(),
tags$br()
)
)
)
server <- function(input, output) {
num_ds <- function(ds)
{
nums <- sapply(ds,is.numeric)
num_ds <- ds[,nums]
return(num_ds)
}
ds_ext <- reactive({ num_ds(input$dsname) })
output$tab <- renderTable({ eval(input$dsname) })
# output$x_axis <- renderUI({
# col_opts <- get(ds_ext())
# selectInput("x_axis2", "Independent Variable:", choices = names(col_opts))
# })
}
shinyApp(ui = ui, server = server)
This is full code. I am trying to display data set from MASS package as you see in the code above.
I am pretty new to Shiny and dealing with the following problem, upon pressing an actionButton in shiny, I want it to do multiple calculations. I use the handler of observeEvent.
An example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(`
actionButton("calc","calculate stuff")),
mainPanel(
textOutput("result")
)
)
)
server <- function(input,output){
observeEvent(input$calc, {output$result <- renderText({"only this is not enough"}) })
}
shinyApp(ui,server')`
Now what I would want is where the output$result is made in the server-observeEvent, I would like to perform additional tasks, say assign a variable a <- 12, calculate B4 <- input$ID1*inputID2 etc.
This can not be hard I imagine.. but I am just not getting there.
kind regards,
Pieter
You can use isolate, see this example:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput(inputId = 'x', label = 'Select a value for x', value = 1),
actionButton( "calc", "calculate stuff" )
),
mainPanel(
textOutput("result")
)
)
)
server <- function(input, output) {
output$result <- renderText({
input$calc
isolate({
y<- input$x *2
paste("The result is:", y)
})
})
}
shinyApp(ui, server)