2017-02-23 3 views
0

おやすみシャイニーアプリケーション、グラフ

私は光沢でアプリケーションを作ってるんだ、それは完全に行くための[ダウンロード]ボタンは、gammlsファミリに応じて可変に調整しようとすると、アプリケーションがグラフに最初の4つの変数を置きます。唯一の問題は、私は、グラフィックをダウンロードするボタンを作成したい場合、私はそれを行うことができませんでした

は、サーバーと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() 
    } 
) 

}) 

私は私がさらにrenderPlotへとdownloadHandlerの内部で使用している機能(testplot())の内側にあなたのコードを包みました。

*アタッチ/サンプルデータを与えればあなたのコードが簡単にR

+0

で実行することができて、将来のために、それは、良いだろうがサンキュー!!とても良い –

関連する問題