Я пытаюсь настроить кнопку загрузки в интерактивном R блестящем документе для пользователей. Блестящий документ R работает нормально, но кнопка загрузки не работает, когда я пытаюсь сохранить загруженный файл где-нибудь. Идея состоит в том, чтобы загрузить все входы и выходы, я использую код downloadHandler:
Я потратил некоторое время, пытаясь отладить это, и я не совсем понял, чего мне, возможно, не хватает. Я новичок в R блестящие веб-приложения, и я надеюсь, что этого достаточно информации, чтобы помочь найти решение моей проблемы
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(rmarkdown)
library(knitr)
library(pander)
library(tibble)
ui <- dashboardPage(
dashboardHeader(
title = "",
titleWidth = 1000),
dashboardSidebar(
sidebarMenu(
menuItem("Camada 1", tabName = "camada1", icon = icon("th")),
menuItem("Camada 2", tabName = "camada2", icon = icon("th")),
menuItem("Parâmetros Calculados", tabName = "parcalc", icon = icon("th")),
br(),
br()
)
),
hr(),
radioButtons("format", "Download report:", c("PDF", "Word"),
inline = TRUE
),
#checkboxInput("echo", "Show code in report?", FALSE),
downloadButton("downloadReport"),
hr()
)
dashboardBody(
tabItems(
#Camada 1 tab content
tabItem(tabName = "camada1",
fluidRow(
box(
title = "",
tags$b(""),
tags$b(":"),
textInput("x1", "", value = "7, 8, 10, 11, 12, 13"
),
textInput("y1", "", value = "225, 235, 237, 239, 245, 255"
),
hr(),
tags$b("Plot:"),
textInput("xlab", label = "Título do eixo x:", value = "", placeholder = "xlabel"),
textInput("ylab", label = "Título do eixo y:", value = "", placeholder = "ylabel"),
checkboxInput("se", "Inserir intervalo de confiança na regressão?", FALSE)
),
box(
tags$b("Seus Dados:"),
DT::dataTableOutput("tbl1"),
br(),
uiOutput("data1"),
br(),
plotOutput("plot1", height = 500)
)
)),
tabItem(tabName = "camada2",
fluidRow(
box(
title = "",
textInput("f12", "", value = "11, 11.5, 11.7, 11.9, 12, 12.5"
),
textInput("x2", "", value = "15, 16, 17, 18, 19, 20"
),
textInput("y2", "", value = "330, 335, 337, 342, 345, 350"
),
tags$b("Plot2:"),
textInput("xlab2", label = "Título do eixo x:", value = "", placeholder = "xlabel"),
textInput("ylab2", label = "Título do eixo y:", value = "", placeholder = "ylabel"),
checkboxInput("se2", "Inserir intervalo de confiança na regressão?", FALSE)
),
box(
DT::dataTableOutput("tbl2"),
br(),
uiOutput("data2"),
br(),
plotOutput("plot2", height = 500)
)
)),
tabItem(tabName = "parcalc",
fluidRow(
box(
tags$b("Camada 1"),
verbatimTextOutput("summary1")
),
box(
tags$b("Camada 2"),
verbatimTextOutput("summary2")
)
))
)
))
server <- function(input, output) {
extract <- function(text){
text <- gsub(" ", " ", text)
split <- strsplit(text, ",", fixed = FALSE)[[1]]
as.numeric(split)
}
#data output 1
output$tbl1 <- DT::renderDataTable({
y1 <- extract(input$y1)
x1 <- extract(input$x1)
yval1 <- extract(input$yval1)
xval1 <- extract(input$xval1)
DT::datatable(data.frame(x1, y1, xval1, yval1),
extensions = "Buttons",
options = list(
lengthChange = FALSE,
dom = "Blfrtip",
buttons = c("copy", "csv", "excel", "pdf", "print")
))
})
output$plot1 <- renderPlot({
y1 <- extract(input$y1)
x1 <- extract(input$x1)
yval1 <- extract(input$yval1)
xval1 <- extract(input$xval1)
#dat <- as.data.frame(x,y)
fit1 <- lm(y1 ~ x1)
newx1 <- seq(min(x1), max(x1),by = 0.05)
conf_interval1 <- predict(fit1, newdata = data.frame(x1 = newx1),
interval="confidence",
level = 0.95)
yvalid <- round(predict(fit1, newdata = data.frame(x1 = xval1)),2)
mse_train <- mean(fit1$residuals^2)
mse_val <- mean((yval1 - yvalid)^2)
plot(x1, y1, pch = 19, col = "black", cex = 1.5,
xlab = input$xlab,
ylab = input$ylab)
abline(fit1, col = "red", lwd = 2)
points(xval1, yval1, pch = 19, col = "blue", cex = 1.5)
points(xval1, yvalid, col = "salmon", cex = 2)
legend("topleft", inset = 0.05, legend = c("Pontos Exp.", "fit", "Val. Exp.", "Val. Calc."),
col = c("black", "red", "blue", "salmon"), lty=1:2, cex=1)
if(input$se == TRUE){
lines(newx1, conf_interval1[,2], col="blue", lty=2)
lines(newx1, conf_interval1[,3], col="blue", lty=2)
legend("topleft", inset = 0.05, legend = c("Pontos Exp.", "fit", "Val. Exp.","Val. Calc.", "C.I 95%"),
col = c("black", "red", "blue", "salmon", "blue"), lty=1:2, cex=1)
}
})
output$data1 <- renderUI({
y1 <- extract(input$y1)
x1 <- extract(input$x1)
if(anyNA(x1) | length(x1) < 2 | anyNA(y1) | length(y1) < 2) {
"Entrada Inválida ou quantidade de dados insuficiente"
} else if (length (x1) != length (y1)){
"Número de dados de x deve ser igual ao número de dados de y"
} else {
withMathJax(
paste0("\\(\\bar{x} = \\) ", round(mean(x1), 3)),
br(),
paste0("\\(\\bar{y} = \\) ", round(mean(y1), 3)),
br(),
paste0("\\(n = \\) ", length(x1))
)
}
})
output$summary1 <- renderPrint({
y1 <- as.numeric(extract(input$y1))
x1 <- as.numeric(extract(input$x1))
fit1 <- lm(y1 ~ x1)
summary(fit1)
})
#data output Camada 2
output$tbl2 <- DT::renderDataTable({
y2 <- extract(input$y2)
x2 <- extract(input$x2)
#fit da camada 1 para camada 2
y1 <- extract(input$y1)
x1 <- extract(input$x1)
fit1 <- lm(y1 ~ x1)
f12 <- extract(input$f12)
p12 <- round(predict(fit1, newdata = data.frame(x1 = f12)),2)
pcam2 <- y2 - p12
DT::datatable(data.frame(f12, p12, x2, y2, pcam2),
extensions = "Buttons",
options = list(
lengthChange = FALSE,
dom = "Blfrtip",
buttons = c("copy", "csv", "excel", "pdf", "print")
))
})
output$plot2 <- renderPlot({
p2 <- extract(input$y2)
x2 <- extract(input$x2)
#dat <- as.data.frame(x,y)
y1 <- extract(input$y1)
x1 <- extract(input$x1)
fit1 <- lm(y1 ~ x1)
f12 <- extract(input$f12)
p12 <- round(predict(fit1, newdata = data.frame(x1 = f12)),2)
y2 <- as.numeric(p2) - as.numeric(p12)
fit2 <- lm(y2 ~ x2)
newx2 = seq(min(x2),max(x2),by = 0.05)
conf_interval2 <- predict(fit2, newdata=data.frame(x2 = newx2),
interval="confidence",
level = 0.95)
plot(x2, y2, pch = 1,
xlab = input$xlab2,
ylab = input$ylab2)
})
})
output$data2 <- renderUI({
y2 <- extract(input$y2)
x2 <- extract(input$x2)
if(anyNA(x2) | length(x2) < 2 | anyNA(y2) | length(y2) < 2) {
"Entrada Inválida ou quantidade de dados insuficiente"
} else if (length (x2) != length (y2)){
"Numero de dados de x deve ser igual ao número de dados de y"
} else {
withMathJax(
paste0("\\(\\bar{x} = \\) ", round(mean(x2), 3)),
br(),
paste0("\\(\\bar{y} = \\) ", round(mean(y2), 3)),
br(),
paste0("\\(n = \\) ", length(x2))
)
}
})
output$summary2 <- renderPrint({
p2 <- as.numeric(extract(input$y2))
x2 <- as.numeric(extract(input$x2))
#dat <- as.data.frame(x,y)
y1 <- extract(input$y1)
x1 <- extract(input$x1)
fit1 <- lm(y1 ~ x1)
f12 <- extract(input$f12)
p12 <- round(predict(fit1, newdata = data.frame(x1 = f12)),2)
y2 <- as.numeric(p2) - as.numeric(p12)
fit2 <- lm(y2 ~ x2)
summary(fit2)
})
})
})
output$downloadReport <- downloadHandler(
filename = function() {
paste0("my-report", sep = ".", switch(
input$format, PDF = "pdf", Word = "docx"
))
},
content = function(file) {
src <- normalizePath("report.Rmd")
# temporarily switch to the temp dir, in case you do not have write
# permission to the current working directory
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, "report.Rmd", overwrite = TRUE)
library(rmarkdown)
out <- render("report.Rmd", switch(
input$format,
PDF = pdf_document(), Word = word_document()
))
file.rename(out, file)
}
)
}
shinyApp(ui, server)