I am trying to run the following code, but keep getting this error:
Error in readLines: 'con' is not a connection
The following is my program:
library(shiny)
library(shinyFiles)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
fileInput("file1", "Choose the first HTML File", accept = ".html")
),
mainPanel(
p("File Name"),
verbatimTextOutput("file_name"),
htmlOutput(outputId = 'result')
)
)
)
server <- function(input, output) {
file <- reactive({input$file1})
req(file)
if(is.null( reactive(input$file1$datapath))) return(NULL)
rawHTML <- reactive(paste(readLines(input$file1$datapath), collapse="\n"))
output$file_name <- renderText({
print(rawHTML)
})
output$result <- renderUI({
getPage<-function() {
return(includeHTML( input$file1$datapath))
}
output$inc<-renderUI({getPage()})
})
}
runApp(list(ui = ui, server = server), launch.browser =T)
I want to read the html code from an external file, and save the code as a string. Is there a solution for this?
Related
library(shiny)
library(ggplot2)
report.Rmd
date: "2023-01-15"
output: html_document
params:
x_column: "Sepal.Width"
y_column: "Sepal.Length"
library(ggplot2)
ggplot(data = iris)+
aes_string(params$x_column,params$y_column)+
geom_point()
shiny app
library(shiny)
library(ggplot)
library(rmarkdown)
ui <- fluidPage(
titlePanel("Iris Data"),
sidebarLayout(
sidebarPanel(
selectizeInput("xcol",
"Choose X Axis",
choices = names(iris)
),
selectizeInput("ycol",
"Choose Y Axis",
choices = names(iris)
),
downloadButton("project", "Download plot")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
filename = "report.html
output$plot <- renderPlot({
ggplot(data=iris)+
aes_string(x=input$xcol, y=input$ycol)+
geom_point()
})
output$print <- downloadHandler({
filename="report.html"
content = function(file) {
rmarkdown::render("report.Rmd",
output_file=file, params=list(x_column = input$xcol,
y_column = input$ycol))
}
})
}
I can't get the app to render my rmarkdown file. I can't seem to see the mistake. report.Rmd is in my working directory. I can get it to work outside of shiny, but in shiny it says there is an error and the content is missing without a default value
There are two issues with your code. First, you used the id Project for the downloadButton but named the output print. Second, the API of downloadHandler is a bit different from reactive or renderXXX, i.e. you have to pass filename and content as arguments.
Note: Also it's good practice to copy the report file to a temporary directory before processing it and to evaluate the document in a child of the global environment. See Generating downloadable reports. As an example where missing the last step fails to render an Rmd correctly see this post. Finally, note that aes_string is deprecated since ggplot2 3.4.0. Instead it's recommended to use the .data pro-noun as I do in the code below.
library(shiny)
library(ggplot2)
ui <- fluidPage(
titlePanel("Iris Data"),
sidebarLayout(
sidebarPanel(
selectizeInput("xcol",
"Choose X Axis",
choices = names(iris)
),
selectizeInput("ycol",
"Choose Y Axis",
choices = names(iris)
),
downloadButton("print", "Download plot")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
output$plot <- renderPlot({
ggplot(data = iris) +
aes(.data[[params$x_column]], .data[[params$y_column]]) +
geom_point()
})
output$print <- downloadHandler(
filename = "report.html",
content = function(file) {
tempReport <- file.path(tempdir(), "report.Rmd")
file.copy("report.Rmd", tempReport, overwrite = TRUE)
rmarkdown::render(tempReport,
output_file = file,
params = list(
x_column = input$xcol,
y_column = input$ycol
),
envir = new.env(parent = globalenv())
)
}
)
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:5776
#> Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
#> ℹ Please use tidy evaluation ideoms with `aes()`
no idea what the problem is here. Any time I give an inputID to fileInput other than "file", I'll get an error saying "Error: '[inputID here]' not found."
ui <- fluidPage(
titlePanel("BF591 Final"),
sidebarPanel(
fileInput("file1", "Upload metadata in CSV or TSV format.", accept = c(".csv", ".tsv"))
),
mainPanel(
tableOutput("sample_info_tb")
)
)
server <- function(input, output) {
load_meta <- reactive({
if(is.null(file1)){return()}
metadata_df <- read.csv(input$file1$datapath, row.names=1)
return(metadata_df)
})
options(shiny.maxRequestSize=30*1024^2)
output$sample_info_tb <- renderTable({
req(input$file1)
load_meta()
})
}
shinyApp(ui = ui, server = server)
I have a simple Shiny app. The user enters a code eg: a1, b1, c1 etc in the textInput.
When only one code is listed it works great, but if the user writes two or more codes separated by a comma it doesn't.
How can the user input as many codes as they like?
library(shiny)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
textInput(inputId = "textBox",
label = "Code Search",
placeholder = "Enter codes here seperated by a comma"),
actionButton("textSearchButton", "Generate the Table")
),
fluidRow(
tableOutput("dtOut")
)
)
)
server <- function(input, output) {
df <- data.frame(Code = paste0(letters, 1),
Description = "Something here",
Value = "Some value")
outputFunc <- function(code, df){
# # Dummy data
# code <- c('a1', 'b1', 'c1')
outTbl <- df[df$Code %in% code,]
return(list(outTbl))
}
textSearch <- eventReactive(input$textSearchButton, {
outputFunc(input$textBox, df)
})
output$dtOut <- renderTable({
textSearch()[[1]]
})
}
shinyApp(ui, server)
I simplified your code a bit:
library(shiny)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
textInput(inputId = "textBox",
label = "Code Search",
placeholder = "Enter codes here seperated by a comma"),
actionButton("textSearchButton", "Generate the Table")
),
fluidRow(
tableOutput("dtOut")
)
)
)
server <- function(input, output) {
df <- eventReactive(input$textSearchButton, {
# outputFunc(input$textBox, df)
req(input$textBox)
codes <- unlist(strsplit(input$textBox, ", "))
return(data.frame(Code = codes,
Description = "Something here",
Value = "Some value"))
})
output$dtOut <- renderTable({
df()
})
}
shinyApp(ui, server)
Does it respond to your need ?
I saw the following code here on StackOverflow. When you enter values into X and Y, the sum is calculated, and the message "X + Y = " is displayed. However, when you reset, the "X + Y = " message still appears from the previous example. How can I clear that message, please?
Here is the code:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id="form",
sidebarLayout(
sidebarPanel(
numericInput("x","X",0),
numericInput("y","Y",0)
),
mainPanel(
br(),
column(width=6,actionButton("calc", "Calculate")),
column(width=6,actionButton("reset", "Reset")),
br(),br(),br(),
textOutput("sum"))
)
))
# Define the server logic
server <- function(input, output) {
output$sum <- renderText({
req(input$calc)
isolate(paste("X + Y =", input$x + input$y))
})
observeEvent(input$reset, {
reset("form")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Please test the following:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
div(id="form",
sidebarLayout(
sidebarPanel(
numericInput("x","X",0),
numericInput("y","Y",0)
),
mainPanel(
br(),
column(width=6,actionButton("calc", "Calculate")),
column(width=6,actionButton("reset", "Reset")),
br(),br(),br(),
textOutput("sum"))
)
))
# Define the server logic
server <- function(input, output) {
values <- reactiveValues()
output$sum <- renderText({
req(values$calc_text)
})
observeEvent(input$calc, {
values$calc_text <- paste("X + Y =", input$x + input$y)
})
observeEvent(input$reset, {
reset("form")
values$calc_text <- ''
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am unsure why you need the isolate() so I've left it out but you can add it back in.
I am trying to get a custom field on the header so people know when the last time the data was refreshed.
In my test runs, I had it work when just putting a variable in the code but when I use textOutput it is giving me the HTML background logic instead.
<div id="Refresh" class="shiny-text-output"></div>
Below is my code:
library (shiny)
library (shinydashboard)
rm(list=ls())
header <- dashboardHeader(
title = "TEST",
tags$li(class = "dropdown", tags$a(paste("Refreshed on ", textOutput("Refresh")))))
body <- dashboardBody(
fluidRow(box(textOutput("Refresh")))
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$Refresh <- renderText({
toString(as.Date("2017-5-4"))
})
}
shinyApp(ui, server)
This is what I am currently seeing:
EDITED to show corrected code
library (shiny)
library (shinydashboard)
header <- dashboardHeader(
title = "TEST",
tags$li(class = "dropdown", tags$a((htmlOutput("Refresh1")))))
body <- dashboardBody(
fluidRow(box(textOutput("Refresh2")))
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$Refresh1 <- renderUI({
HTML(paste("Refreshed on ", toString(as.Date("2017-5-4"))))
})
output$Refresh2 <- renderText({
toString(as.Date("2017-5-4"))
})
}
shinyApp(ui, server)
You will have to paste the content as HTML inside tags$a, as shown below. You will also have to renderText twice, as the same value cannot be used in the UI.
library (shiny)
library (shinydashboard)
rm(list=ls())
header <- dashboardHeader(
title = "TEST",
tags$li(class = "dropdown", tags$a(HTML(paste("Refreshed on ", textOutput("Refresh1"))))))
body <- dashboardBody(
fluidRow(box(textOutput("Refresh2")))
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$Refresh1 <- renderText({
toString(as.Date("2017-5-4"))
})
output$Refresh2 <- renderText({
toString(as.Date("2017-5-4"))
})
}
shinyApp(ui, server)