I have an AWS bucket with a bunch of dynamically generated JSON files. When a file is generated it gets a "slug".
I'd like to be able to copy that slug (from an outside website) and enter it in a Shiny textInput box, then add the rest of the URL to the slug, and download the designated file as an R object. (I use jsonlite::fromJSON here).
The code below works, and it generates the correct string and puts it into a box in the ui side. But I can't figure out how to use that output variable on the server side. It is hard-coding the "slug". I want to use the slug from the ui textInput.
library(tidyverse)
library(igraph)
library(jsonlite)
library(circlize)
library(chorddiag)
library(plotly)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(
textInput("slug","Discovery ID",placeholder = "N79og8K"),
fluidRow(box(textOutput("URL")))
)
)
server <- function(input, output) {
# raw_data_URL <- "https://XXX.s3.us-west-1.amazonaws.com"
# raw_data_suffix <- ".json"
#
# full_URL <- eventReactive(input$submit, {
# paste0(raw_data_URL,"/",input$slug,raw_data_suffix)
# })
# output$URL <- renderPrint(full_URL())
data <- fromJSON(paste0(raw_data_URL,"/","N79og8K",raw_data_suffix))
)
}
I've tried all sorts of things with reactive objects, and haven't gotten anything to work.
Also, the commented out text does work too: it populates the box with the right string on "submit". But I can't get the server to go to the resulting file URL.
Can I use the output variable in my server app?
The following app will prepare the URL, fetch it, and then modify it in the server. It will print the output at each step.
library(tidyverse)
library(shiny)
library(jsonlite)
ui <- fluidPage(
textInput("slug","Type in Name",value = "charlie"),
actionButton("submit", "Submit"),
textOutput("URL"),
textOutput("raw_JSON"),
textOutput("modified_JSON")
)
server <- function(input, output) {
raw_data_URL <- "https://api.genderize.io/?name="
full_URL <- eventReactive(input$submit, {
paste0(raw_data_URL,input$slug)
})
output$URL <- renderPrint(full_URL())
full_JSON <- reactive({
fromJSON(full_URL())
})
output$raw_JSON <- renderPrint(full_JSON())
JSON <- reactive({
full_JSON()$probability
})
output$modified_JSON <- renderPrint(JSON())
}
shinyApp(ui = ui, server = server)
I removed the shinydashboard package to make the solution more minimal. Not every Shiny developer has or knows it.
The key point is that when you want to use something reactive, you have to treat it like a function and put () after it, like I did for full_URL(), full_JSON() and JSON() above. Also, you can only use reactive objects inside of other reactives like reactive() and renderPrint().
Here's a minimal reprex of what actually ended up working
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)
library(jsonlite)
library(igraph)
library(plotly)
library(chorddiag)
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(fluidRow(textInput("slug", "Discovery ID",value = "VJPEqQB")),
actionButton("submit", "Submit")),
dashboardBody()
),
server = function(input, output, session) {
raw_data_URL <- "https://XXX-bucket.s3.us-west-1.amazonaws.com"
raw_data_suffix <- "_graph.json"
saveData <- function(data) {
set.seed(1)
data <- fromJSON(data)
}
# Construct the URL
getURL <- reactive({
data <- paste0(raw_data_URL,"/",input$slug,raw_data_suffix)
data
})
# When the Submit button is clicked:
observeEvent(input$submit, {
saveData(getURL())
})
# Show Outputs (omitted from MRE)
# Not Used:
output$graph <- renderPlot({
input$submit
plot(net) # net is a graph object derived from `data`
})
}
)
Related
I would like to run a function that has a shiny app inside, but I can't.
Running this example separately, I first remove column one from my input data frame; then I run shiny to change whatever is necessary in the data frame and, when I close the window, a new object is saved with the changes; and finally I create a new column in the data frame.
This is an example script, but I would like that, when executing the function, the shiny window opens and some things are changed in the data frame for the user interactively. Could someone help?
library(shiny)
library(rhandsontable)
my_function <- function(x){
select <- x[,-1]
ui <- fluidPage(
fluidRow(
column(
width = 12,
rHandsontableOutput("myTable")
)))
server <- function(input, output, session) {
# dummy dataframe
df = select
# convert it to a "rhansontable" object
output$myTable <- renderRHandsontable({rhandsontable(df)
})
observeEvent(input$myTable, {
test_df = hot_to_r(input$myTable)
assign('my_data_frame',test_df,envir=.GlobalEnv)
# browser() # uncomment for debugging
})
}
shinyApp(ui, server)
my_data_frame2 <- my_data_frame %>%
mutate(new_column_test = "hello")
return(my_data_frame2)
}
my_function(mtcars)
Hi you almost made it you don't want to return anything but add the data simply using assign
library(shiny)
library(rhandsontable)
myapp_function <- function(data) {
ui <- basicPage(
actionButton("quit", label = "Close"),
actionButton("create", label = "Create copy"),
textInput("name","Set dataframe name", value = "my_data_frame"),
rHandsontableOutput("myTable")
)
server <- function(input, output, session) {
output$myTable <- renderRHandsontable({
rhandsontable(data)
})
observeEvent(input$create, {
assign( input$name, hot_to_r(input$myTable), envir=.GlobalEnv)
})
observeEvent(input$quit,{
stopApp()
})
}
## launch app
shinyApp(ui, server,options=c(shiny.launch.browser = .rs.invokeShinyPaneViewer))
}
## test
myapp_function(iris)
myapp_function(mtcars)
myapp_function(PlantGrowth)
I would suggest to create the ui and server outside of the myapp_function - otherwise it will become a very large function...also creating a function inside another function is not the best practise.
I'm new to shiny, so don't mind me if my question is simple.
I want to take a path as an input from the user and generate the data frame. I've done this so far:
library(shiny)
ui <- fluidPage(
textInput("data_path", "Please enter the path of your data: ")
tableOutput("data_glimpse")
)
server <- function(input, output){
data <- read.csv(input$data_path)
output$data_glimpse <- renderTable({
glimpse(data)
})
}
shinyApp(ui = ui, server = server)
But it's not working right. I don't get any pages to enter my path!
Any help?
I think it is easier to upload the file directly. But if you want to keep this structure, you can try the following. To make it work you have to add to your path the name of the file plus .csv, e.g. /sample.csv
library(shiny)
ui <- fluidPage(
textInput("data_path", "Please enter the path of your data: "),
tableOutput("data_glimpse")
)
server <- function(input, output){
dataTable <- reactive({
data <- read.csv(input$data_path)
})
output$data_glimpse <- renderTable({
dplyr::glimpse(dataTable())
})
}
shinyApp(ui = ui, server = server)
I have an app where a large dataset is read in before the app starts. The app has separate ui and server files. So the UI is visible straightaway and the div for output plot remains empty. It sort of hangs for about 2-3 seconds as the data is read in. And then the plot is displayed. The rest of the app is fast enough and requires no progress bars. I would like to show some progress/indication that the data is being read in rather than just "freezing" for few seconds.
Here is a dummy example. The data is only read in once before the app loads. The data is used in ui as well as server.
library(shiny)
# read big file
#saveRDS(diamonds,"diamonds.Rds")
x <- readRDS("diamonds.Rds")
ui = fluidPage(
titlePanel("Progress bar test"),
selectInput("in_opts","Select",choices=colnames(x),selected=1),
verbatimTextOutput("out_txt")
)
server=function(input,output,session) {
output$out_txt <- renderPrint({
Sys.sleep(3)
head(x)
})
}
shinyApp(ui,server)
I have tried using shinycssloaders. It generally works. It works well in this dummy example. But, it doesn't work for the "reading in file" part since that is outside the withSpinner() function.
library(shiny)
library(shinycssloaders)
# read big file
#saveRDS(diamonds,"diamonds.Rds")
x <- readRDS("diamonds.Rds")
ui = fluidPage(
titlePanel("Progress bar test"),
selectInput("in_opts","Select",choices=colnames(x),selected=1),
shinycssloaders::withSpinner(verbatimTextOutput("out_txt"))
)
server=function(input,output,session) {
output$out_txt <- renderPrint({
Sys.sleep(3)
head(x)
})
}
shinyApp(ui,server)
Is there a way to display progress/indicator for the readRDS() step?
As mentioned in the comments we can run the long computation in a separate process. This can e.g. be done via library(future).
Once the future_promise returns its result, it is assigned to a global reactiveVal - therefore all shiny sessions started later don't have to wait.
library(shiny)
library(promises)
library(future)
library(datasets)
library(shinycssloaders)
plan(multisession)
globalrv <- reactiveVal(NULL)
future_promise({
Sys.sleep(10) # your long running function
iris
}) %...>%
globalrv() %...!% # assign result to globalrv
(function(e) {
globalrv(NULL) # error handling needed?
warning(e)
})
ui = fluidPage(
titlePanel("Progress bar test"),
conditionalPanel("output.trigger == null", shinycssloaders::withSpinner(uiOutput("dummy"))),
conditionalPanel("output.trigger != null", verbatimTextOutput("out_txt"))
)
server = function(input, output, session) {
output$trigger <- eventReactive(globalrv(), {globalrv()})
outputOptions(output, "trigger", suspendWhenHidden = FALSE)
output$out_txt <- renderPrint({
req(globalrv())
head(globalrv())
})
}
shinyApp(ui,server)
Using renderUI instead:
library(shiny)
library(promises)
library(future)
library(datasets)
library(shinycssloaders)
plan(multisession)
globalrv <- reactiveVal(NULL)
future_promise({
Sys.sleep(10) # your long running function
iris
}) %...>%
globalrv() %...!% # assign result to globalrv
(function(e) {
globalrv(NULL) # error handling needed?
warning(e)
})
ui = fluidPage(
titlePanel("Progress bar test"),
uiOutput("spinner"),
verbatimTextOutput("out_txt")
)
server = function(input, output, session) {
output$spinner <- renderUI({
if(is.null(globalrv())){
shinycssloaders::withSpinner(uiOutput("dummy"))
} else {
NULL
}
})
output$out_txt <- renderPrint({
req(globalrv())
head(globalrv())
})
}
shinyApp(ui,server)
I am trying to split a dataframe based on a grouping variable and then display each group as a table in a separate box in a shiny dashboard app.
However, I keep getting the same group in all the tables. The title for each box is shown correctly though and if I introduce some print statements I can also see that the correct data seems to be handled.
Below is an example that reproduces the problem:
library(tidyverse)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("tables"))
)
server <- function(input, output) {
output$tables <- renderUI({
df <- iris %>%
group_by(Species) %>%
group_split()
ui <- tagList()
for(df.split in df) {
id <- paste0("tbl_", df.split[1, "Species"])
output[[id]] <- renderTable(head(df.split, 3))
ui <- append(
ui,
box(
title = df.split[1, "Species"],
tableOutput(id)
)
)
}
return(ui)
})
}
shinyApp(ui = ui, server = server)
It is an interesting case. I think this should work, tell me if it is not :
library(tidyverse)
library(shiny)
library(shinydashboard)
multiple_dt <- function(output,id,table_list){
ns <- NS(id)
ui <- tagList(lapply(table_list,function(df.split){
box(
title = as.character(df.split[1, "Species"]),
tableOutput(ns(as.character(df.split[1,"Species"]))),
output[[ns(df.split[1,"Species"])]] <- renderTable(head(df.split, 3))
)
}))
ui
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("tables"))
)
server <- function(input, output) {
output$tables <- renderUI({
df <- iris %>%
group_by(Species) %>%
group_split()
multiple_dt(output,"tables",df)
})
}
shinyApp(ui = ui, server = server)
I think there are multiple errors in your code. First of all, I think that your appending is not working correctly because the tables to be rendered are not well stored in the list (they are just successively stored while there should be a hierarchical dimension, which is made in the function multiple_dt with the lapply).
Moreover, when you create complicated shiny objects like this one, you should create a new function to render it, like I did with a structured code having an NS id, etc.
I would like to use a Shiny interface to collect data from user inputs, such as in this Medium Article
The article is written for the googlesheets package, but we now need to use googlesheets4.
I think my code will not work due to may lay of understanding of reactive elements.
#load libraries
library(shiny)
library(shinydashboard)
library(googlesheets4)
library(DT)
ui <- fluidPage(
# Define UI
ui <- fluidPage(
# App title ----
titlePanel("Seflie Feedback"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar to demonstrate various slider options ----
sidebarPanel(
# Input: Overall Rating
sliderInput(inputId = "helpful",
label = "I think this app is helpful",
min = 1,
max = 7,
value = 3),
actionButton("submit", "Submit")
),
mainPanel(
))
)
)
server <- function(input, output, session) {
# Reactive expression to create data frame of all input values ----
sliderValues <- reactive({
usefulRating <- input$helpful
Data <- data.frame(
Value = as.character(usefulRating),
stringsAsFactors = FALSE)
})
#This will add the new row at the bottom of the dataset in Google Sheets.
observeEvent(input$submit, {
MySheet <- gs4_find() #Obtain the id for the target Sheet
MySheet <- gs4_get('https://docs.google.com/spreadsheets/d/162KTHgd3GngqjTm7Ya9AYz4_r3cyntDc7AtfhPCNHVE/edit?usp=sharing')
sheet_append(MySheet , data = Data)
})
}
shinyApp(ui = ui, server = server)
I replaced the gs4_get() with the link rather than the ID to support you in helping me. If you are not able to access the link, you can replace the link with a google sheet ID from your own sheets temporarily.
When I run the code, I see the following: Warning: Error in is.data.frame: object 'Data' not found.
When I replace the usefulRating <- input$helpful with usefulRating <- 4 or usefulRating <- 5 or some other value, the data writes to the Sheet.
Thanks for any insights :)
#load libraries
library(shiny)
library(shinydashboard)
library(googlesheets4)
library(DT)
ui <- fluidPage(
titlePanel("Seflie Feedback"),
sidebarLayout(
sidebarPanel(
#This is where a user could type feedback
textInput("feedback", "Plesae submit your feedback"),
),
#This for a user to submit the feeback they have typed
actionButton("submit", "Submit")),
mainPanel())
server <- function(input, output, session) {
textB <- reactive({
as.data.frame(input$feedback)
})
observeEvent(input$submit, {
Selfie <- gs4_get('https://docs.google.com/spreadsheets/d/162KTHgd3GngqjTm7Ya9AYz4_r3cyntDc7AtfhPCNHVE/edit?usp=sharing')
sheet_append(Selfie, data = textB())
})
}
shinyApp(ui = ui, server = server)