I'd like to clean a text write inside a textAreaInput() after a writeLines operation using the function updateTextInput without success. In my example:
# Packages
require(shiny)
require(shinythemes)
# Create the shiny dash
ui <- fluidPage(
theme = shinytheme("cosmo"),
titlePanel(title="My Map Dashboard"),
sidebarLayout(
sidebarPanel(
textAreaInput("text_input","Write something"),
actionButton("erefunction", "Erase")
),
mainPanel(
textOutput("idSaida")
)
)
)
server <- function(input, output){
observeEvent(input$erefunction, {
filePath <- tempfile(fileext = ".txt")
writeLines(c(input$text_input), filePath)
updateTextInput(value="")
})
}
shinyApp(ui, server)
##
Please, any tips or a solution. Thanks in advance!
Instead of updateTextInput use updateTextAreaInput; you also need to add a session to your shiny server function and pass that on to updateTextAreaInput.
Here is the revised server function:
server <- function(input, output, session){
observeEvent(input$erefunction, {
filePath <- tempfile(fileext = ".txt")
writeLines(c(input$text_input), filePath)
updateTextAreaInput(session, "text_input", value="")
})
}
I added the session parameter and the id so updateSelectInput knows what input is being updated.
require(shiny)
require(shinythemes)
# Create the shiny dash
ui <- fluidPage(
theme = shinytheme("cosmo"),
titlePanel(title="My Map Dashboard"),
sidebarLayout(
sidebarPanel(
textAreaInput("text_input","Write something"),
actionButton("erefunction", "Erase")
),
mainPanel(
textOutput("idSaida")
)
)
)
server <- function(input, output, session){
observeEvent(input$erefunction, {
filePath <- tempfile(fileext = ".txt")
writeLines(c(input$text_input), filePath)
##added session and the name of the input to update
updateTextInput(session, "text_input", value="")
})
}
shinyApp(ui, server)
Related
Let's say I have 4 sets of UI/Server modules in 4 different directories ("./X1/Y1/", "./X1/Y2/", "./X2/Y1/", "./X2/Y2/"). I want to load the selected set based on the input in the sidebar.
I tried using source() within dashboardBody(), but I was not successful.
library(shiny)
library(shinydashboard)
# path to modules
in_path <- "C:/a/b/c/"
# ui
ui <- dashboardPage(
dashboardHeader(title = "test"),
dashboardSidebar(
br(),
selectInput('f1', 'Folder 1', choices = c("X1", "X2")),
helpText(""),
selectInput('f2', 'Folder 2', choices = c("Y1", "Y2")),
br(),
actionButton("load", "Load", icon("thumbs-up"), width = "85%")
),
dashboardBody(
# UI module here from, e.g., "C:/a/b/c/X1/Y2/my_UI.R"
)
)
# server
server <- function(input, output, session) {
# server module here from, e.g., "C:/a/b/c/X1/Y2/my_Server.R"
}
shinyApp(ui, server)
As shiny modules are simply functions, I'd source them in the beginning, and use uiOutput to display the differnt modules.
Here's a working example of the general idea (sample module code proudly stolen from the official Shiny documentation):
<mod1.R>
counterButton <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out"))
)
}
counterServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$out <- renderText({
count()
})
count
}
)
}
<mod2.R>
csvFileUI <- function(id, label = "CSV file") {
ns <- NS(id)
tagList(
fileInput(ns("file"), label),
checkboxInput(ns("heading"), "Has heading"),
selectInput(ns("quote"), "Quote", c(
"None" = "",
"Double quote" = "\"",
"Single quote" = "'"
))
)
}
csvFileServer <- function(id, stringsAsFactors = TRUE) {
moduleServer(
id,
## Below is the module function
function(input, output, session) {
# The selected file, if any
userFile <- reactive({
# If no file is selected, don't do anything
validate(need(input$file, message = FALSE))
input$file
})
# The user's data, parsed into a data frame
dataframe <- reactive({
read.csv(userFile()$datapath,
header = input$heading,
quote = input$quote,
stringsAsFactors = stringsAsFactors)
})
# We can run observers in here if we want to
observe({
msg <- sprintf("File %s was uploaded", userFile()$name)
cat(msg, "\n")
})
# Return the reactive that yields the data frame
return(dataframe)
}
)
}
<app.R>
library(shiny)
source("mod1.R")
source("mod2.R")
my_mods <- list("Counter Button" = list(ui = counterButton,
server = counterServer),
"CSV Uploader" = list(ui = csvFileUI ,
server = csvFileServer))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("mod_sel",
"Which Module should be loaded?",
names(my_mods))
),
mainPanel(
uiOutput("content"),
verbatimTextOutput("out")
)
)
)
server <- function(input, output) {
uuid <- 1
handler <- reactiveVal()
output$content <- renderUI({
my_mods[[req(input$mod_sel)]]$ui(paste0("mod", uuid))
})
observeEvent(input$mod_sel, {
handler(my_mods[[req(input$mod_sel)]]$server(paste0("mod", uuid)))
uuid <<- uuid + 1
})
output$out <- renderPrint(req(handler())())
}
shinyApp(ui, server)
Some Explanation
You put the module code in mod[12].R and it is rather straight forward.
In your main app, you load both(!) source files and for housekeeping reasons, I put both modules functions (ui and server) in a list, but this is not strictly necessary, but facilitates future extension.
In your UI you have an uiOutput which renders dynamically according to the selected module.
In your server you put the code to dynamically render the UI and call the respective server function.
The uid construct is basically there to force a fresh render, whenever you change the selection. Otherwise, you may see still some old values whenever you come back to a module which you have rendered already.
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 want to create a shiny app that do two things. Frist it has to be able to upload XLS file and after the user can add it some columns (in this case, just the column "Tecnico"), but for the moment I cant be able to do that. Once the user write the value for the column and update the table, the app crashed.
library(shiny)
library(readxl)
runApp(
list(
ui = fluidPage(
titlePanel("Use readxl"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xlsx file',
accept = c(".xlsx")),textInput("tecnix","Tecnico"),
actionButton("go", "update")),
mainPanel(
tableOutput('my_output_data'))
)
),
server = function(input, output){
data1 <- reactive({
inFile <- input$file1
if (is.null(inFile)){return(NULL)}
isolate({
input$file1
my_data <- read_excel(inFile$datapath)
})
my_data
})
observeEvent(input$go, {
data1()$Técnico <- input$tecnix
})
output$my_output_data <- renderTable({data1()})
}
))
Any ideas?
Thank you so much,
As suggested by #Till using reactiveValues will help solve the problem.
library(shiny)
library(readxl)
runApp(
list(
ui = fluidPage(
titlePanel("Use readxl"),
sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose xlsx file',
accept = c(".xlsx")),textInput("tecnix","Tecnico"),
actionButton("go", "update")),
mainPanel(
tableOutput('my_output_data'))
)
),
server = function(input, output){
rv <- reactiveValues(my_data = NULL)
observeEvent(input$file1, {
req(input$file1$datapath)
rv$my_data <- read_excel(input$file1$datapath)
})
observeEvent(input$go, {
rv$my_data$Techni <- input$tecnix
})
output$my_output_data <- renderTable({rv$my_data})
}
))
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)
I need to embed a webpage reached through a URL inputted by the user.
I found this script but I can't make the iframe depend on a textInput() containing a URL. This example fails and I am not sure why.
library(shiny)
ui <- fluidPage(
textInput('url','url',value = "www.google.com"),
uiOutput('o')
)
server <- function(input, output, session) {
output$o = renderUI({
tags$iframe(src=input$url)
})
}
shinyApp(ui, server)
You can do like this:
library(shiny)
ui <- fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
textInput("url", label = "Enter url"),
actionButton("go", "Go")
),
mainPanel(
htmlOutput("frame")
)
))
server <- function(input, output) {
output$frame <- renderUI({
validate(need(input$go, message=FALSE))
tags$iframe(src=isolate(input$url), height=600, width=535)
})
}
shinyApp(ui, server)