2017-02-23 84 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

可以轻松运行谢谢!!很好 –

相关问题