I would like to create a dashboard in shiny. The purpose of the dashboard is to show KPI for several mobile app in several platforms. I would like to create a template and just give filtered data to this template and observe my KPI for this app on this platform.
The data are on sql, so instead of maintaining a connection between shiny and the sql server, I prefer to create a function that extract the data once on the time range selected by the user and collect it. I want this function to extract again only if date range change and the user validate by clicking on an action button.
This a very simple toy example to illustrate my goal
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(sidebarMenu( dateRangeInput("daterange", "Date Range"), actionButton("do", "Do it !", width="100%"))),
dashboardBody(fluidPage(plotlyOutput("plot")))
)
data = function(start, end)
{
return(data.frame(x = c(start, end), y = runif(2)))
}
outputTemplate = function(input, output, data, instanceName)
{
output[[instanceName]] = renderPlotly({
plot_ly(data = data) %>% add_bars(x~x, y~y)
})
}
server = function(input, output){
dt = eventReactive(input$do,{
return(data(input$daterange[1], input$daterange[2]))
})
outputTemplate(input, output, dt(), "plot")
}
shinyApp(ui, server)
So, when I click the "Do it !" button, I load data base on the dateRange input, and then use this Data in one Template.
The first time I click on the button, the plot appear but then when I change the date and click again the plot is never updated.
What I have missed about reactive in shiny ?
EDIT 1 :
If I replace by
output[["plot"]] = renderPlot({
plot(dt()$x, dt()$y, type = "b")
})
instead of the outputTemplate function it works perfectly
I found the problem but I don't understand why.
If you do not put the parenthesis on dt it works.
The solution is
outputTemplate(input, output, dt, "plot")
outputTemplate = function(input, output, data, instanceName)
{
output[[instanceName]] = renderPlotly({
plot_ly(data = data()) %>% add_bars(x~x, y~y)
})
}
Related
I am working on a shiny app where users can upload their own data and get some plots and statistics back. However, I also want to include an example dataset that gets used instead if the user presses a specific button. Importantly, the plots should be reactive so that users get updated plots whenever they click on the "use example data instead" button or upload a new file. I tried to recreate my current approach of overwriting the data object as best as I could here, but simply defining the data object twice doesn't overwrite the data in the way I hoped it would. Any suggestions are appreciated.
library(shiny)
# UI
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput("Upload", "Upload your own Data"),
actionButton("Example", "Use Example Data instead")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("hist")
)
)
)
# Server Logic
server <- function(input, output) {
data <- eventReactive(input$Upload,{input$Upload})
data <- eventReactive(input$Example, {faithful$eruptions})
output$hist <- renderPlot({hist(data())})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use a reactiveVal like this:
server <- function(input, output) {
my_data <- reactiveVal()
observeEvent(input$Upload, {
tmp <- read.csv(input$Upload$datapath)
## do whatever is needed to parse the data
my_data(tmp)
})
observeEvent(input$Example, {
my_data(faithful)
})
output$hist <- renderPlot({
dat <- as.data.frame(req(my_data()))
dat <- dat[, sapply(dat, is.numeric), drop = FALSE]
validate(need(NCOL(dat) > 1, "No numeric columns found in provided data"))
hist(dat[,1])
})
}
Depending on upload or button click, you store your data in my_data which is a reactive value. Whenever this value changes, the renderPlot function fires and uses the correct data.
You can use a reactive value to access whether the user has chosen to use an example dataset or use their own dataset. The user can choose to switch between the active dataset using an input from your UI.
Here's the official explanation on reactive values from RStudio: link
This would go in your ui.R:
radioButtons("sample_or_real",
label = h4("User data or sample data?"),
choices = list(
"Sample Data" = "sample",
"Upload from user data" = "user",
),
selected = "user"
)
This would go in your server.R:
data_active <- reactive({
# if user switches to internal data, switch in-app data
observeEvent(input$sample_or_real_button, {
if(input$sample_or_real == "sample"){
data_internal <- sample_data_object
} else {
data_internal <- uploaded_data_object
}
})
Note, that when using a reactive value in your server.R file, it must have parentheses () at the end of the object name. So, you call the data_internal object as data_internal().
Good morning everyone,
I have a Shiny application that collects 5 inputs from the users and stores them into variables.
Then, I would be able to use another R script that would run based on the information provided by the user.
Here is a sample of my Shiny App :
jscode <- "shinyjs.closeWindow = function() { window.close(); }"
#Define UI for application
ui <- pageWithSidebar(
#App title
headerPanel("Filters applied for Powerpoints"),
#Panel to display the filters
sidebarPanel(
#Select dates
dateInput(inputId = "startDate", label = "Start date : ", value = "2018-12-01", format = "yyyy/mm/dd"),
dateInput(inputId = "endDate", label = "End date : ", value = "2018-12-31", format = "yyyy/mm/dd"),
#Select brand template
selectInput("Brand", label = "Select brand : ", choices = list("Carat" = "Carat", "Amplifi" = "Amplifi", "iProspect" = "iProspect", "Isobar" = "Isobar")),
#Select medium type
selectInput("Medium", label = "Select medium type : ", choices = list("Social Post" = "Social Post", "Display" = "Display", "Programmatic" = "Programmatic", "SEA" = "SEA")),
#Enter the plan ID of your campaign
textInput("Camp", label = "Enter the plan ID of your campaign : ", value = ""),
#Button to close the window, then run script
useShinyjs(),
extendShinyjs(text = jscode, functions = c("closeWindow")),
actionButton("close", "Close and run")
),
mainPanel()
)
#Define server logic
server <- function(input, output, session){
observe({
startDate <<- input$startDate
endDate <<- input$endDate
brand <<- input$Brand
medium <<- input$Medium
campaign <<- input$Camp
})
observeEvent(input$close, {
js$closeWindow()
stopApp()
})
source("C:/Users/RPeete01/Desktop/Automated powerpoints/Datorama R/Datorama reporting R/DatoramaSocial.R")
}
#Run the application
shinyApp(ui = ui, server = server)
I've used the source function but it doesn't work.
If someone has an idea, please let me know.
Thanks a lot,
Rémi
You should take advantage of built in onStop functions in shiny to execute some functions before the stopApp() call
library(shiny)
if (interactive()) {
# Open this application in multiple browsers, then close the browsers.
shinyApp(
ui = basicPage("onStop demo",actionButton("close", "Close and run")),
server = function(input, output, session) {
onStop(function() cat("Session stopped\n"))
observeEvent(input$close, {
stopApp()
})
},
onStart = function() {
cat("Doing application setup\n")
onStop(function() {
cat("Doing application cleanup, your functions go here\n")
})
}
)
}
Instead of creating a function to replace your script, you can source your script by supplying an environment to the local option. This environment must contain the objects needed by your script. Something like that:
mylist <- reactiveVal() # we will store the inputs in a reactive list
observe({ # create the list
mylist(list(
startDate = input$startDate,
endDate = input$endDate,
brand = input$Brand,
medium = input$Medium,
campaign = input$Camp))
})
observeEvent(input$runScript, { # "runScript" is an action button
source("myscript.R", local = list2env(mylist()))
})
EDIT
Here is a full example.
library(shiny)
ui <- fluidPage(
textInput("text", "Enter text", value = "test"),
actionButton("runScript", "Run")
)
server <- function(input, output, session) {
mylist <- reactiveVal() # we will store the inputs in a reactive list
observe({ # create the list
mylist(list(
text = input$text))
})
observeEvent(input$runScript, { # "runScript" is an action button
source("myscript.R", local = list2env(mylist()))
})
}
shinyApp(ui, server)
File myscript.R:
writeLines(text, "output.txt")
When I run the app and click on the button, the file output.txt is correctly created (i.e. the script is correctly sourced).
Your script DatoramaSocial.R should be formulated as a function that takes your 5 input values as arguments. As to the return value, well you haven't told us what you want to do with it. By formulating it as a function I mean wrap everything in DatoramaSocial.R in a function (or several subfunctions). The code for that function can easily reside in the external script file or be pasted before the ui and server statements in your shiny app. If the former, simply include the definitions by calling source('DatoramaSocial.R') before your ui and server statements.
Now, in your server function, you can simply call it as a reaction to changes in the input:
observe({
DatoramaSocial(input$startDate, input$endDate, input$Brand, input$Medium, input$Camp)
})
Although in this case, I recommend inserting an actionbuttonInput and having the user click that when they have selected all their inputs. In which case, update to:
observeEvent(input$actionbutton, ignoreInit=TRUE, {
DatoramaSocial(input$startDate, input$endDate, input$Brand, input$Medium, input$Camp)
})
where actionbutton is the actionbutton's inputId.
My users would like to run some R scripts using the objects that my Shiny App creates. E.g. if my app creates a new data frame, they would like to run their own analysis using the new data frame.
Is there a way to do that?
Maybe some console-like (interactive) feature in R Shiny?
I found this Access/use R console when running a shiny app, but wondering if there is any other way to do it besides building your own server.
Any input is great appreciated. Thank you!
Here is an example of a very basic console on Shiny. It is based on Dean Attali's code here. The idea is to execute arbitrary code from a textInput with the eval function using the same environment that shiny is using. To test the idea, the variable myDat was created inside the server function and can be used by the user. It should also work with other objects created later. I also enabled the "Enter" key to press the [Run] button using JavaScript, so you don't need click on the button.
It is recommended to enable this console only to trusted users, it is a complete open access to any R command and can be potentially a serious security issue.
library(shiny)
ui <- fluidPage(
# enable the <enter> key to press the [Run] button
tags$script(HTML(
'$(document).keyup(function(event) {
if (event.keyCode == 13) {
$("#run").click();
}
});'
)),
textInput("expr", label = "Enter an R expression",
value = "myDat"),
actionButton("run", "Run", class = "btn-success"),
div( style = "margin-top: 2em;",
uiOutput('result')
)
)
server <- function(input, output, session) {
shinyEnv <- environment()
myDat <- head(iris)
r <- reactiveValues(done = 0, ok = TRUE, output = "")
observeEvent(input$run, {
shinyjs::hide("error")
r$ok <- FALSE
tryCatch(
{
r$output <- isolate(
paste(
capture.output(
eval(parse(text = input$expr), envir = shinyEnv)
),
collapse = '\n'
)
)
r$ok <- TRUE
}
,
error = function(err) {
r$output <- err$message
}
)
r$done <- r$done + 1
})
output$result <- renderUI({
if (r$done > 0 ) {
content <- paste(paste(">", isolate(input$expr)), r$output, sep = '\n')
if (r$ok) {
pre(content)
} else {
pre( style = "color: red; font-weight: bold;", content)
}
}
})
}
shinyApp(ui = ui, server = server)
If you want to make a data frame available to the user in the global environment after running the app, you can use assign(). The following example uses the logic of a shiny widget that can be added as an add-in to RStudio:
shinyApp(
ui = fluidPage(
textInput("name","Name of data set"),
numericInput("n","Number observations", value = 10),
actionButton("done","Done")
),
server = function(input, output, session){
thedata <- reactive({
data.frame(V1 = rnorm(input$n),
V2 = rep("A",input$n))
})
observeEvent(input$done,{
assign(input$name, thedata(), .GlobalEnv)
stopApp()
})
}
)
Keep in mind though that your R thread is continuously executing when a shiny app is running, so you only get access to the global environment after the app stopped running. This is how packages with a shiny interface deal with it.
If you want users to be able to use that data frame while the app is running, you can add a code editor using eg shinyAce. A short example of a shiny App using shinyAce to execute arbitrary code:
library(shinyAce)
shinyApp(
ui = fluidPage(
numericInput("n","Number observations", value = 10),
aceEditor("code","# Example Code.\n str(thedata())\n#Use reactive expr!"),
actionButton("eval","Evaluate code"),
verbatimTextOutput("output")
),
server = function(input, output, session){
thedata <- reactive({
data.frame(V1 = rnorm(input$n),
V2 = rep("A",input$n))
})
output$output <- renderPrint({
input$eval
return(isolate(eval(parse(text=input$code))))
})
}
)
But the package comes with some nice examples, so take a look at those as well.
Dear R Shiny community,
I am trying to create a bookmarking state for Shiny app where I render table with DT package. For example, in the app pasted below I want to type some text in the search field which subsets data and bookmark that state, i.e. get a URL that I can share. Another user can use the URL and see the same subset of the table without a need to type the text again into the search field. With the code below I was expecting to see the "Bookmark" button with the option 1 code or a dynamic URL with option 2, but unfortunately it does not work as expected. Does anyone know how to make a bookmarking state when rendering a table with DT?
Here is the reproducible code:
Option 1
library(shiny)
ui <- function(request) {
fluidPage(DT::dataTableOutput('tbl'))
}
server = function(input, output) {
output$tbl = DT::renderDataTable(
iris, options = list(lengthChange = FALSE)
)
}
shinyApp(ui, server, enableBookmarking = "url")
Option 2
library(shiny)
ui <- function(request) {
fluidPage(DT::dataTableOutput('tbl'))
}
server = function(input, output) {
observe({
output$tbl = DT::renderDataTable(
iris, options = list(lengthChange = FALSE)
)
})
onBookmarked(function(url) {
updateQueryString(url)
})
}
shinyApp(ui, server, enableBookmarking = "url")
Thank you so much for your time and help!
Based on the following discussion https://groups.google.com/forum/#!topic/shiny-discuss/DvWhqwZ8OKw I was able to find an answer.
I was able to modify the option 1 and here is the minimal reproducible app that works. Just type a string in a global search field, click on the bookmark button on the bottom, copy the url and share.
library(DT)
library(shiny)
ui <- function(request) {
fluidPage(
DT::dataTableOutput('tbl')
, bookmarkButton(label = "Bookmark", title = "Link to this view")
)
}
server = function(input, output) {
# exclude some values query variables from url
setBookmarkExclude(names = c("resTable_rows_all",
"resTable_cell_clicked"))
# proxy for table manipulations
tbl_proxy <- dataTableProxy("tbl")
# restore table selection and search
onRestored(function(state) {
# req(state$input$resTable_search)
DT::updateSearch(tbl_proxy,
keywords = list(global = state$input$tbl_search))
})
output$tbl <- renderDataTable(iris)
}
shinyApp(ui, server, enableBookmarking = "url")
In my Shiny App, there are a few numericInput and selectInput.
Shiny updates outputs during typing, especially when users type is slower in the numericInput.
sumbitButton could you be used to stop automatically updading. But I prefer to not to use it.
How could I let Shiny waits for a longer time for numericInput?
Thanks for any suggestion. Let me know if my question is not clear.
You can use debounce on the reactive function that uses your Inputs.
Setting it to 2000 milliseconds felt OK to me.
If you use the input directly in a render function you might need to create the data to use in your render function in a reactive function.
An example is here: https://shiny.rstudio.com/reference/shiny/latest/debounce.html
## Only run examples in interactive R sessions
if (interactive()) {
options(device.ask.default = FALSE)
library(shiny)
library(magrittr)
ui <- fluidPage(
plotOutput("plot", click = clickOpts("hover")),
helpText("Quickly click on the plot above, while watching the result table below:"),
tableOutput("result")
)
server <- function(input, output, session) {
hover <- reactive({
if (is.null(input$hover))
list(x = NA, y = NA)
else
input$hover
})
hover_d <- hover %>% debounce(1000)
hover_t <- hover %>% throttle(1000)
output$plot <- renderPlot({
plot(cars)
})
output$result <- renderTable({
data.frame(
mode = c("raw", "throttle", "debounce"),
x = c(hover()$x, hover_t()$x, hover_d()$x),
y = c(hover()$y, hover_t()$y, hover_d()$y)
)
})
}
shinyApp(ui, server)
}