I have this Shiny script:
library(shiny)
source("oss_datamanip.R")
# Define UI ----
ui <- fluidPage(
titlePanel("Prime Awards Analysis for the OSS Team"),
sidebarPanel(fluidRow(
column(12, textInput("text", h4("Please enter a DUNS number: "),
value = "Enter text...")),
column(12, textInput("text", h4("Please enter the file path where you would like your output to be saved: "),
value = "Enter text...")))),
mainPanel(textOutput("duns"),
textOutput("file_path")),
actionButton("script", "Run the Script")
)
# Define server logic ----
server <- function(input, output, session){
observe({
user.input <<- input$duns
output.dir <<- input$file_path
})
source("oss_datamanip.R")
}
# Run the app ----
shinyApp(ui = ui, server = server)
and I want to have the user input from the Shiny app update the R script before it runs. Is this possible? How would I go about doing this?
Related
i've built an app that allow users to paste a folder path so that files inside that folder can be listed and selected. The app works when i set the path globally but i really need users to be able to stipulate their path. The path needs to be a network path as we use Azure/Databricks...
library(dplyr)
library(shinyWidgets)
library(shinythemes)
library(DT)
fpath <- '/dbfs/dbfs/Analytics/ShinyApp' #example path
# Define UI
ui <- fluidPage(
theme = shinytheme("spacelab"),
navbarPage(
"App",
tabPanel(
"Setup Project",
sidebarPanel(
textInput("v_inpath", "Specify File Path:", ""),
actionButton("Setpath", "Set Path"),
selectInput("selectfile", "Select File to Analyse",choice = list.files("ppath", pattern = ".csv")) #list of files should show up here
), # sidebarPanel
mainPanel(verbatimTextOutput("ppath")) # mainPanel
) #tabPanel
) # navbarPage
) # fluidPage
# Define server function
server <- function(input, output, session) {
observeEvent(input$Setpath,{
output$ppath <-reactive({paste0(input$v_inpath)})
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
In the mainPanel, i can see the path being pasted correctly as text (as you can see i'm using verbatimTextOutput("ppath")). The list of files contained in the specified folder should show up but it does not work as no list is available... Thank you in advance for your help
You need renderUI
You should avoid to put an output element inside an observer
You could use the shinyFiles package or the jsTreeR package to select the path
Code:
library(shiny)
# Define UI
ui <- fluidPage(
navbarPage(
"App",
tabPanel(
"Setup Project",
sidebarPanel(
textInput("v_inpath", "Specify File Path:", ""),
actionButton("Setpath", "Set Path"),
uiOutput("selectfileUI")
), # sidebarPanel
mainPanel(verbatimTextOutput("ppath")) # mainPanel
) #tabPanel
) # navbarPage
) # fluidPage
# Define server function
server <- function(input, output, session) {
output[["selectfileUI"]] <- renderUI({
req(input[["Setpath"]])
files <- list.files(input[["v_inpath"]], pattern = ".csv")
selectInput("selectfile", "Select File to Analyse", choices = files)
})
output[["ppath"]] <- renderPrint({
input[["v_inpath"]]
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
EDIT: feedback
Also, you can use the shinyFeedback package to print a message when the path is not valid:
library(shiny)
library(shinyFeedback)
# Define UI
ui <- fluidPage(
useShinyFeedback(), # don't forget this line
navbarPage(
"App",
tabPanel(
"Setup Project",
sidebarPanel(
textInput("v_inpath", "Specify File Path:", ""),
actionButton("Setpath", "Set Path"),
uiOutput("selectfileUI")
), # sidebarPanel
mainPanel(verbatimTextOutput("ppath")) # mainPanel
) #tabPanel
) # navbarPage
) # fluidPage
# Define server function
server <- function(input, output, session) {
Check <- eventReactive(input[["Setpath"]], {
dir.exists(input[["v_inpath"]])
})
Files <- reactive({
req(Check())
list.files(input[["v_inpath"]], pattern = ".csv")
})
observeEvent(input[["Setpath"]], {
hideFeedback("v_inpath")
show <- !Check() || length(Files()) == 0
if(show) {
if(Check()) {
text <- "No CSV file in this folder"
} else {
text <- "Invalid path"
}
showFeedbackWarning("v_inpath", text)
} else {
hideFeedback("v_inpath")
}
})
output[["selectfileUI"]] <- renderUI({
req(Files())
selectInput("selectfile", "Select File to Analyse", choices = Files())
})
output[["ppath"]] <- renderPrint({
input[["v_inpath"]]
})
} # server
# Create Shiny object
shinyApp(ui = ui, server = server)
I am trying to create a dynamic Shiny app that uses the yacas Computer Algebra System to process entered functions. As a first step, I want the UI to confirm what it understands has been typed in.
However, the following Shiny code is not displaying the entered function in Latex format.
library(shiny)
library(Ryacas) # for the TeXForm command
library(Ryacas0)
library(mathjaxr) # for rendering Latex expressions in Shiny
ui <- fluidPage(
sidebarPanel(
textInput(
inputId = "ui_function",
label = 'f(x) = ',
value = "x^2",
placeholder = "Enter function here"),
),
mainPanel(
uiOutput("entered")
)
)
server <- function(input, output) {
output$entered = renderUI({
withMathJax(
helpText(yac_str(paste0("TeXForm(",
input$ui_function,
")")
)
)
)
})
} # end server function
shinyApp(ui = ui, server = server)
When I remove the 'withMathJax' commands from the above code, it behaves exactly the same way, so it's as if the 'withMathJax' command is not having any effect on the output.
By way of a simple example, I'm looking for the user to enter 'x^2' and it should displays
x²
I welcome any help that anyone can offer.
I'm running this on latest RStudio 2022.02.1 Build 461, with R4.1.3, Shiny 1.7.1 and MathJax 1.6-0
You can do as follows:
library(shiny)
library(Ryacas) # for the TeXForm command
ui <- fluidPage(
sidebarPanel(
textInput(
inputId = "ui_function",
label = 'f(x) = ',
value = "x^2",
placeholder = "Enter function here"),
),
mainPanel(
helpblock(withMathJax(uiOutput("entered", inline = TRUE)))
)
)
server <- function(input, output) {
output$entered = renderUI({
paste0(
"\\(",
yac_str(paste0("TeXForm(", input$ui_function, ")")),
"\\)"
)
})
} # end server function
shinyApp(ui = ui, server = server)
The mathjaxr package is not for Shiny, it is used for help files (Rd).
Following on from Stephane's suggestion, I re-looked at my code and this version now works, as intended:
library(shiny)
library(Ryacas)
library(Ryacas0)
library(mathjaxr) # for rendering Latex expressions in Shiny
ui <- fluidPage(
sidebarPanel(
textInput(
inputId = "ui_function",
label = 'f(x) = ',
value = "x^2",
placeholder = "Enter function here"),
),
mainPanel(
withMathJax(uiOutput("entered"))
)
)
server <- function(input, output) {
output$entered = renderUI({
withMathJax(
helpText(
paste0(
"\\(",
yac_str(paste0("TeXForm(", input$ui_function, ")")),
"\\)"
)
)
)
})
} # end server function
shinyApp(ui = ui, server = server)
The inclusion of withMathJax inside mainPanel in the ui seemed to make the difference. It also seems that the "\\(" strings that are concatenated to the string inside the server are critical to its success.
I want to update a selectInput item on a Shiny app with more than 1,000 items but it obviously don't accept more than 1,000.
Is there a method to add more values or load it from server, as user start typing? server parameter also doesn't work.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
tags$head(tags$script(src = "message-handler.js")),
# Application title
titlePanel("Large selectInput"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput("Names",
"List of Names",
choices = c("A")
)
),
mainPanel("Empty")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
names <- 1:5000
observe({
updateSelectInput(session, "Names", label = "Updated", choices = names, server = TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
selectizeInput() can handle more than 1,000 records.
I have a simple shiny app in R for reading a PDF file from the user and display it. I can't seem to get it to work. On the shiny server in the www directory I see a 1 KB file with the name "myreport.pdf" that just has the first character
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Testing File upload"),
sidebarLayout(
sidebarPanel(
fileInput('file_input', 'upload file ( . pdf format only)', accept = c('.pdf'))
),
mainPanel(
uiOutput("pdfview")
)
)
))
server <- shinyServer(function(input, output) {
observe({
req(input$file_input)
test_file <- readBin(input$file_input$datapath, what="character")
writeBin(test_file, "www/myreport.pdf")
})
output$pdfview <- renderUI({
tags$iframe(style="height:600px; width:100%", src="myreport.pdf")
})
})
shinyApp(ui = ui, server = server)
I think the issue is with the binary reading and writing. Instead trying to copy the files using file.copy seems to work. Also I've taken the iframe inside observeEvent for the iframe to update every time the pdf is uploaded in the same session.
Updated Code:
library(shiny)
ui <- shinyUI(fluidPage(
titlePanel("Testing File upload"),
sidebarLayout(
sidebarPanel(
fileInput('file_input', 'upload file ( . pdf format only)', accept = c('.pdf'))
),
mainPanel(
uiOutput("pdfview")
)
)
))
server <- shinyServer(function(input, output) {
observe({
req(input$file_input)
#test_file <- readBin(input$file_input$datapath, what="raw")
#writeBin(test_file, "myreport.pdf")
#cat(input$file_input$datapath)
file.copy(input$file_input$datapath,"www", overwrite = T)
output$pdfview <- renderUI({
tags$iframe(style="height:600px; width:100%", src="0.pdf")
})
})
})
shinyApp(ui = ui, server = server)
In the attached MWE Shiny example, I have a nested tabsetPanel within a tabPanel for a navbar. If you run the MWE with only one tabPanel within the tabSet you will see that Shiny behaves exactly as it is expected. However, if you run the MWE with two tabPanels, the result is not printed to the main panel of each tab.
Why does this behaviour occur? And how do I resolve this conundrum?
library(shiny)
ui <- shinyUI(navbarPage("tabalicious",
tabPanel("Nav1", value = "nav1",
mainPanel(h2("Hello"),
br(),
p("This is my app.")
)
)
,
tabPanel("Nav2", value = "nav2",
tabsetPanel(
tabPanel("tabsettab1",
sidebarLayout(
sidebarPanel(
helpText("Choose your settings"),
selectInput("zone_type",
label = "Choose a zone type to display",
choices = list("Industrial", "Residential"),
selected = "Industrial")
),
mainPanel(h2("A tab for a tabSet"),
textOutput('zone_type')
)
)
)
# Uncomment this to see the issue
# ,
# tabPanel("tabsettab2",
# sidebarLayout(
# sidebarPanel(
# helpText("Choose your settings"),
# selectInput("zone_type",
# label = "Choose a zone type to display",
# choices = list("Industrial", "Residential"),
# selected = "Industrial")
# ),
# mainPanel(h2("A tab for a tabSet"),
# textOutput('zone_type')
# )
# )
# )
)
)
)
)
server <- shinyServer(function(input, output) {
output$zone_type <- renderText({
paste("You have selected", input$zone_type)
})
})
# Run the application
shinyApp(ui = ui, server = server)
It doesn't have to do with tabs, but multiple calls to output the results of the same render* function. For example, a simplified page (with no tabs) will work fine, but if you uncomment the duplicated call, will fail to display zone_type:
library(shiny)
server <- shinyServer(function(input, output) {
output$zone_type <- renderText({paste("You have selected", input$zone_type)})
})
ui <- shinyUI(fluidPage(
selectInput("zone_type",
label = "Choose a zone type to display",
choices = list("Industrial", "Residential")),
# textOutput('zone_type'),
textOutput('zone_type')
))
runApp(shinyApp(server = server, ui = ui))
While your shinyUI function can only call each output of shinyServer once, within shinyServer you can call the inputs as many times as you like, so it's easy to duplicate outputs:
library(shiny)
server <- shinyServer(function(input, output) {
output$zone_type <- renderText({paste("You have selected", input$zone_type)})
output$zone_type2 <- renderText({paste("You have selected", input$zone_type)})
})
ui <- shinyUI(fluidPage(
selectInput("zone_type",
label = "Choose a zone type to display",
choices = list("Industrial", "Residential")),
textOutput('zone_type'),
textOutput('zone_type2')
))
runApp(shinyApp(server = server, ui = ui))
If you don't want to duplicate work for the server, you can't pass one output to another, but you can just save the render* results to a local variable which you can pass to both outputs:
server <- shinyServer(function(input, output) {
zone <- renderText({paste("You have selected", input$zone_type)})
output$zone_type <- zone
output$zone_type2 <- zone
})