Question

晚安

我使应用程序处于闪亮状态，并且完美无缺，尝试根据gammls系列调整变量，应用程序将图形放在前四个变量中。唯一的问题是，当我想创建一个按钮来下载图形时，我无法做到这一点

附加服务器和wm

我非常感谢帮助

Server
library(shiny)
shinyServer(function(input,output,session){
  observe({
    inFile<-input$file1
    #print(inFile)
    if(is.null(inFile)) return(NULL)
    dt = read.csv(inFile$datapath, header=input$header, sep=input$sep)
    updateSelectInput(session, "product", choices = names(dt))
    updateSelectInput(session, "familia", choices = c("realAll","realline","realplus","real0to1","counts","binom"))
  })
  output$distPlot <- renderPlot({
    require(gamlss)
    inFile<-input$file1
    dt = read.csv(inFile$datapath, header=input$header, sep=input$sep)
    k<-input$k
    m <- fitDist(dt[,input$product], type=input$familia, k=k)
    par(mfrow=c(2, 2))
    for (i in 1:4) {
      denst <- density(dt[,input$product])
      res <- histDist(dt[,input$product], family=names(m$fits)[i],
                      main=names(m$fits)[i],
                      xlab=input$product,
                      line.wd=3,
                      line.ty=1,
                      line.col='dodgerblue2',
                      ylim=c(0, 1.3 * max(denst$y)))
      param <- c('mu', 'sigma', 'nu', 'tau') 
      np <- length(res$parameters) 
      fun1 <- function(x) eval(parse(text=x))
      hat.param <- sapply(as.list(paste('res$', param[1:np], sep='')),
                          fun1)
      hat.param <- round(hat.param, digits=2)
      txt <- paste('hat(', param[1:np], ')==', hat.param, sep='')
      txt <- paste(txt, collapse=', ')
      legend('topright', bty='n',
             legend=eval(parse(text=paste('expression(', txt, ')'))))
    }
  })
  output$descarga<-downloadHandler(
    filename=function(){
      paste("grafica","png",sep=".")
    },content=function(file){
      png(file)
      plotOutput("distPlot")
      dev.off() 
     }
    )

})

UI

library(shiny)
shinyUI(pageWithSidebar(
  headerPanel( "Mejor Ajuste de Distribución para una variable", "Flowserve"),
  sidebarPanel(
    h5('Esta aplicacion sirve para mostrar las cuatro mejores distribuciones
       que ajustan a una variable elegida de una base de datos'),
    br(),
    fileInput('file1', 'Use el boton siguiente para cargar la base de datos.',
              accept = c(
                'text/csv',
                'text/comma-separated-values',
                'text/tab-separated-values',
                'text/plain',
                '.csv',
                '.tsv'
              )
    ),
    checkboxInput('header', 'Tiene encabezado la base de datos?', TRUE),
    radioButtons('sep', 'Cual es la separacion de sus datos?',
                 c(Tab='\t', Comma=',', Semicolon=';' )
    ),
    tags$hr(),
    selectInput("product", "Seleccione la variable de la base de datos",""),
    selectInput("familia", "Seleccione la familia de distribuciones, realAll son todas
                las distribuciones reales, realline son todas las distribuciones reales lineales, 
                realPlus son todas las distribuciones reales positivas, real0to1 son las distribuciones
                reales de 0 a 1, counts son las distribuciones de conteo, binom son tipos de distribuciones
                binomiales",""),
    numericInput(inputId="k",
                 label="Ingrese una penalización de cantidad de parametros entre mayor sea el k mayor la penalizacion",
                 min=1,
                 value=4,
                 step=1) 
    ),
  mainPanel(h4('A continuacion el ajuste para la variable seleccionada por 
               el usuario'),
            plotOutput("distPlot"),downloadButton(outputId="descarga",'Descargar'))
    ))

Answer 1

这应该适合你：

<强> server.R：

library(shiny)
shinyServer(function(input,output,session){
  observe({
    inFile<-input$file1
    #print(inFile)
    if(is.null(inFile)) return(NULL)
    dt = read.csv(inFile$datapath, header=input$header, sep=input$sep)
    updateSelectInput(session, "product", choices = names(dt))
    updateSelectInput(session, "familia", choices = c("realAll","realline","realplus","real0to1","counts","binom"))
  })
  testplot <- function(){
    require(gamlss)
    inFile<-input$file1
    dt = read.csv(inFile$datapath, header=input$header, sep=input$sep)
    k<-input$k
    m <- fitDist(dt[,input$product], type=input$familia, k=k)
    par(mfrow=c(2, 2))
    for (i in 1:4) {
      denst <- density(dt[,input$product])
      res <- histDist(dt[,input$product], family=names(m$fits)[i],
                      main=names(m$fits)[i],
                      xlab=input$product,
                      line.wd=3,
                      line.ty=1,
                      line.col='dodgerblue2',
                      ylim=c(0, 1.3 * max(denst$y)))
      param <- c('mu', 'sigma', 'nu', 'tau') 
      np <- length(res$parameters) 
      fun1 <- function(x) eval(parse(text=x))
      hat.param <- sapply(as.list(paste('res$', param[1:np], sep='')),
                          fun1)
      hat.param <- round(hat.param, digits=2)
      txt <- paste('hat(', param[1:np], ')==', hat.param, sep='')
      txt <- paste(txt, collapse=', ')
      legend('topright', bty='n',
             legend=eval(parse(text=paste('expression(', txt, ')'))))
    }
  }

  output$distPlot <- renderPlot({testplot()})

  output$descarga<-downloadHandler(
    filename=function(){
      paste("grafica","png",sep=".")
    },content=function(file){
      png(file)
      print(testplot())
      dev.off() 
    }
  )

})

我将您的代码包含在我已经习惯testplot()和renderPlot内部的函数（downloadHandler）中。

*对于将来，如果您提供/附加样本数据会更好，因此您的代码可以在R中轻松运行

闪亮的应用程序，下载图表按钮

1 个答案: