Блестящая Application, Скачать кнопки для графов

Question

Goodnight

Я делаю заявление в блестящей, и это идет отлично, попробуйте настроить переменную в соответствии с 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