shiny app scripts

FinalProject/server.R

+library(shiny); library(knitr);
+
+shinyServer(function(input, output, session){
+  file <- reactive({
+    fileUploaded <- input$file
+    if (is.null(fileUploaded)){
+      return(NULL)
+    } else {
+      return(fileUploaded$datapath)
+    }
+  })
+  dataset <- reactive({
+    fileurl <- isolate(file())
+    input$run
+    if (is.null(fileurl)){
+      return(NULL)
+    } else {
+      data <- read.table(fileurl,
+                         header=input$header,
+                         sep=input$separator,
+                         quote=input$quotation,
+                         dec=input$decimal)
+      return(data)
+    }
+  })
+  observe({
+    data <- dataset()
+    if (!is.null(data)) {
+      updateSelectInput(session,
+                        inputId="yvar",
+                        choices=names(data),
+                        selected=names(data)[1])
+      updateCheckboxGroupInput(session,
+                               inputId = "choosenvar",
+                               choices = names(data))
+    }
+  })
+
+  output$instructions <- renderUI({
+    l0 <- ""
+    l1 <- "This Shiny App executes simple or multiple linear regression
+    analysis."
+    l2 <- "The dataset longley is available to exemplify all that can be
+    done here."
+    l3 <- "But the main idea is that the user itself will upload a .csv
+    file and run the analysis."
+    break1 <- ""
+    l4 <-  "So, starting by the sidebar. First, you may check a box to see
+    the example running, or you can just run the analysis yourself,
+    with your own data. This starts when you check the second box in
+    the sidebar."
+    l5 <- "Then, we have the upload box. This is where you will
+    upload your own file."
+    l6 <- "On the following, the response variable and the explanatory
+    variables in which there is interest have to be choosen."
+    break2 <- ""
+    l7 <- "Now moving to the tabset. This is the first tab. The next one
+    will show the dataset to be analysed."
+    l8 <- "The third tab is composed by a summary of the linear model
+    that was adjusted inside this app."
+    l9 <- "The next tab shows the model's ANOVA table."
+    l10 <- "The fifth tab prints out four plots. They are there to check
+    for departures from homocedasticity and normality of the model."
+    break3 <- ""
+    l11 <- "At the end, you can download a report (pdf, html or docx),
+    with the analysis you conducted."
+    HTML(paste(l0, l1, l2, l3, break1, l4, l5, l6, break2, l7, l8, l9,
+               l10, break3, l11, sep = '<br/>'))
+  })
+
+  #-----------------------------
+  fc <- reactive({
+    y <- dataset()[,input$yvar]
+    x <- model.matrix(~.,dataset()[,input$choosenvar])
+    m <- lm(y~x)
+    return(list(m=m, y=y))
+  })
+  ldata <- reactive({
+    l <- get('longley')
+    yl <- l[,input$longleyy]
+    xl <- model.matrix(~., l[,input$longleyx])
+    ml <- lm(yl~xl)
+    return(list(l=l, ml=ml))
+  })
+  observe({
+    if(input$example){
+      output$table <- renderDataTable({longley})
+      output$model <- renderPrint({
+        m0 <- ldata()$ml
+        cat("-----", capture.output(summary(m0)),
+                       sep="\n")
+      })
+      output$anova <- renderPrint({
+        m0 <- ldata()$ml
+        cat("------------------------",
+            capture.output(anova(m0)), sep="\n")
+      })
+      output$plots <- renderPlot({
+        m0 <- ldata()$ml
+        par(mfrow=c(2,2)); plot(m0)
+        ; layout(1)
+      }, width=600, height=600)
+    }
+    if(input$user){
+      output$table <- renderDataTable({
+        inFile <- input$file
+        if (is.null(inFile))
+          return(NULL)
+
+        read.csv(inFile$datapath, header=input$header,
+                 sep=input$separator,
+                 quote=input$quotation)
+      })
+      output$model <- renderPrint({
+        sum1 <- fc()$m
+        cat("-----", capture.output(summary(sum1)),
+                       sep="\n")
+      })
+      output$anova <- renderPrint({
+        m1 <- fc()$m
+        cat("------------------------",
+            capture.output(anova(m1)), sep="\n")
+      })
+      output$plots <- renderPlot({
+        m1 <- fc()$m
+        par(mfrow=c(2,2)); plot(m1); layout(1)
+      }, width=600, height=600)}
+    output$download <- downloadHandler(
+    filename = function() {
+      paste('my-report', sep = '.', switch(
+        input$format, PDF = 'pdf', HTML = 'html', Word = 'docx'
+      ))
+    },
+
+    content = function(file) {
+      src <- normalizePath('report.Rmd')
+
+      # temporarily switch to the temp dir, in case you do not have write
+      # permission to the current working directory
+      owd <- setwd(tempdir())
+      on.exit(setwd(owd))
+      file.copy(src, 'report.Rmd')
+
+      library(rmarkdown)
+      out <- render('report.Rmd', switch(
+        input$format,
+        PDF = pdf_document(), HTML = html_document(), Word = word_document()
+      ))
+      file.rename(out, file)
+    }
+  )
+  })
+}
+)
+
+
+
+
+
+
+