2017-02-23 94 views
0

晚安閃亮的應用程序,用於圖表

我做閃亮的應用程序,並順利完美下載按鈕,嘗試根據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')) 
    )) 

回答

0

這應該爲你工作:

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() 
    } 
) 

}) 

我你的包裹代碼我所進一步用於renderPlotdownloadHandler內的功能(testplot())的內部。

*對於未來,如果你給/附加樣本數據會更好,這樣你的代碼可以在R

+0

可以輕鬆運行謝謝!!很好 –

相關問題