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)
Related
I am using the mtcars dataset and have created another column that is a random number(x) * 2. I have then used the renderDataTable in r shiny to print it. I now want to use renderPlot({}) on the new_col column and any other column. How would I go about calling that new column?
library(shiny)
library(ggplot2)
df<- mtcars
ui<- fluidPage(
titlePanel("Mtcars"),
sidebarLayout(
sidebarPanel(
selectInput(inputID = 'test', label = "TEST", choices = c(1,2,3,4), selected = 3)
mainPanel(
DT::dataTableOutput('table1')
plotOutput('basicplot')
))
server <- function(input, output) {
func<-function(x){
df%>%
mutate(new_col = x*2)
output$table1 <- renderTable({
func(2)
})
output$basicplot <-renderPlot({
plot(* $new_col, *$mpg) #what do i call the new dataframe with the new_col
})
)
shinyApp(ui = ui, server = server)
You had numerous syntax errors. Please check it before posting a question in the future. Try this
library(shiny)
library(ggplot2)
df<- mtcars
ui<- fluidPage(
titlePanel("Mtcars"),
sidebarLayout(
sidebarPanel(
selectInput('test', label = "TEST", choices = names(df)[-1] )
),
mainPanel(
DTOutput('table1'),
plotOutput('basicplot')
)
)
)
server <- function(input, output) {
mydata <- reactive({
df %>%
mutate(new_col = as.numeric(df[[input$test]])*2)
})
output$table1 <- renderDT({
mydata()
})
output$basicplot <-renderPlot({
req(mydata())
df <- data.frame(mydata()$new_col,mydata()$mpg)
plot(df)
})
}
shinyApp(ui = ui, server = server)
I'm trying to get the label output in shiny using textOutput function with var_label from the labelled package. I tried a couple of things but I'm not able to view the label in the output. The error I'm getting is Error in var_label.data.frame: object 'var1' not found.
Code:
library(shiny)
library(labelled)
library(haven)
dat <- read_spss("http://staff.bath.ac.uk/pssiw/stats2/SAQ.sav")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("var1", "Frequency Table", choices = names(dat), selected = NULL)
),
mainPanel(
verbatimTextOutput("name"),
textOutput("label")
)
)
)
server <- function(input, output) {
output$name <- renderPrint({
input$var1
})
output$label <- renderText({
var_label(input$var1)
})
}
shinyApp(ui = ui, server = server)
The issue is that input$var1 is the name of the variable. It does not contain any information about the variable in your dataset. To get the label associated with the variable called input$var1 use var_label(dat[[input$var1]]).
I'm trying to pass the node value of a simple network as an argument to a function in Shiny R. However, I'm getting this error:
Error in rsqlite_send_query: no such column: input$id
Can anyone help with this issue? Thanks.
library(shiny)
library(networkD3)
ui <- shinyUI(fluidPage(
fluidRow(
column(4, simpleNetworkOutput("simple")),
column(4, DT::dataTableOutput("table"))
)
))
server <- shinyServer(function(input, output, session) {
session$onSessionEnded(stopApp)
output$simple <- renderSimpleNetwork({
sn<-simpleNetwork(df)
sn$x$options$clickAction = 'Shiny.onInputChange("id",d.name)'
sn
})
output$table <- DT::renderDataTable(DT::datatable(get(funct(input$id))))
})
shinyApp(ui = ui, server = server)
take out the deparse and substitute from your sprintf command, and add single quotes around the value you want to match in the SQL statement you're generating
get rid of the get function because you're not trying to "get" an object
for example....
library(shiny)
library(networkD3)
library(DT)
library(sqldf)
df <- read.csv(header = T, text = '
source,name,age,hair
dad,Jon X,18,brown
dad,Jon Y,22,blonde
')
funct <-
function (n) {
isp <- sprintf("Select df.age From df Where df.name='%s';", n)
isd <- sqldf::sqldf(isp)
return(isd)
}
ui <- shinyUI(fluidPage(
fluidRow(
column(4, simpleNetworkOutput("simple")),
column(4, DT::dataTableOutput("table"))
)
))
server <- shinyServer(function(input, output, session) {
session$onSessionEnded(stopApp)
output$simple <- renderSimpleNetwork({
sn<-simpleNetwork(df)
sn$x$options$clickAction = 'Shiny.onInputChange("id",d.name)'
sn
})
output$table <- DT::renderDataTable(DT::datatable(funct(input$id)))
})
shinyApp(ui = ui, server = server)
however, if all you want is to display a value associated with a given selection, I highly suggest drastically reducing the complexity to something like this
library(shiny)
library(networkD3)
df <- read.csv(header = T, text = '
source,name,age,hair
dad,Jon X,18,brown
dad,Jon Y,22,blonde
')
ui <- shinyUI(fluidPage(
fluidRow(
column(4, simpleNetworkOutput("simple")),
column(4, textOutput("text"))
)
))
server <- shinyServer(function(input, output, session) {
session$onSessionEnded(stopApp)
output$simple <- renderSimpleNetwork({
sn <- simpleNetwork(df)
sn$x$options$clickAction <- 'Shiny.onInputChange("id", d.name)'
sn
})
output$text <- renderPrint({ df$age[df$name == input$id] })
})
shinyApp(ui = ui, server = server)
I would like to understand why I get different behaviors than I expect when using eventReactive instead of reactive together with an actionButton to refresh the page.
For example, this simple Shiny dashboard behaves as I expect: upon loading the plot is displayed and I can modify the filter and refresh the plot when clicking on the refresh button.
# app1.R
library(shiny)
library(dplyr)
library(ggplot2)
species <- levels(iris$Species)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("species", "Select Iris Species",
choices = species, selected=species, multiple = TRUE),
actionButton("refresh", "Refresh")
),
mainPanel(plotOutput("scatterplot"))
)
)
server <- function(input, output) {
selected_data <- reactive({
input$refresh
isolate({
iris %>% filter(Species %in% input$species)
})
})
output$scatterplot <- renderPlot({
plot(selected_data())
})
}
shinyApp(ui = ui, server = server)
Based on my understanding of actionButton and eventReactive I though I could replace the code for selected_data with
selected_data <- eventReactive( input$refresh, {
iris %>% filter(Species %in% input$species)
})
this way I make explicit that selected_data only depends on input$refresh.
However the app doesn't behave as I expect: upon loading no plot is shown and I have to explicitely click on "Refresh" to get the plot displayed. After that everything works as intended.
Here is the full code for the second version of the app:
# app2.R
library(shiny)
library(dplyr)
library(ggplot2)
species <- levels(iris$Species)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("species", "Select Iris Species",
choices = species, selected=species, multiple = TRUE),
actionButton("refresh", "Refresh")
),
mainPanel(plotOutput("scatterplot"))
)
)
server <- function(input, output) {
selected_data <- eventReactive( input$refresh, {
iris %>% filter(Species %in% input$species)
})
output$scatterplot <- renderPlot({
plot(selected_data())
})
}
shinyApp(ui = ui, server = server)
According to the documentation, when the Shiny app is executed input$refresh should have changed value from NULL to 0, which in turns triggers the evaluation of selected_data and showing the plot.
Can you explain me why in app1.R the plot is shown when the app is loaded and in app2.R you have to force the refresh manually?
Is there any (clean) way I can make app2.R show the plot when the app is loaded?
There is an argument within eventReactive which is ignoreNULL and it is set to TRUE by default, if you change that to FALSE it will trigger. For more info please refer to ?eventReactive
library(shiny)
library(dplyr)
library(ggplot2)
species <- levels(iris$Species)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("species", "Select Iris Species",
choices = species, selected=species, multiple = TRUE),
actionButton("refresh", "Refresh")
),
mainPanel(plotOutput("scatterplot"))
)
)
server <- function(input, output) {
selected_data <- eventReactive( input$refresh, {
iris %>% filter(Species %in% input$species)
},ignoreNULL = F)
output$scatterplot <- renderPlot({
plot(selected_data())
})
}
shinyApp(ui = ui, server = server)
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().