R語言程式設計導論

林嶔 (Lin, Chin)

Lesson 14 網頁App之前後端優化

第一節：增加介面複雜度(1)

##                  Functions    Characteristic
## 1        pageWithSidebar()    Main structure
## 2              fluidPage()    Main structure
## 3             navbarPage()    Main structure
## 4 tabsetPanel()+tabPanel()          Sub page
## 5           navlistPanel()   navigation list
## 6      fluidRow()+column() Splitted function
## 7          absolutePanel()     movable panel

– 請在這裡下載介面參數範例

練習1：增加開發者資訊

  1. 產生兩個分頁，第一個分頁為主要的運算區域，第二個分頁為軟體開發者的資訊(可以鑲入國防醫學院的網頁)
  2. 在第一個分頁中，讓用戶選擇是否要使用範例DATA，並且將控制物件放在頁面的最上方，而輸出結果放在下方。(需要用到conditionalPanel())

– 範例DATA可以用下列程式碼獲得：

data(iris)
head(iris,10)

上週解答

library(shiny)

shinyUI(pageWithSidebar(
  
  headerPanel("Linear regression for two continuous variables."), 
  
  sidebarPanel(
    fileInput(inputId="files", label=h4("Upload your data file:"), multiple=FALSE, accept="text/plain"),
    helpText("Note: you only can upload the .txt file."),
    uiOutput("choose_columns1"),   #這裡是關鍵
    uiOutput("choose_columns2"),   #這裡是關鍵
    radioButtons("method", "What is the method to analysis?", choices = c("Pearson correlation" = "pearson", "Spearman correlation" = "spearman")),
    radioButtons("Color", "Select the color of histogram:", choices = c("Red" = "red", "Blue" = "blue", "Green" = "green"))
  ),
  
  mainPanel(
    verbatimTextOutput("summary"),
    plotOutput("plot",width = "500px", height = "500px")
  )  
  
))
library(shiny)

shinyServer(function(input, output) {
  
  DATA = reactive({
    if (is.null(input$files)) {return()} else {
      dat = read.table(input$files$datapath,header=T)
      return(dat) 
    }
  })
  
  output$choose_columns1 = renderUI({  #這裡是關鍵
    dat = DATA()
    if (is.null(dat)) {return()} else {
      colnames = colnames(dat)
      selectInput("Y", h4("Choose a dependence variable:"), choices = colnames)
    }
  })
  
  output$choose_columns2 = renderUI({  #這裡是關鍵
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)) {return()} else {
      colnames = colnames(dat)
      selectInput("X", h4("Choose a independence variable:"), choices = colnames[which(colnames!=input$Y)])
    }
  })
  
  output$summary = renderPrint({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      X = dat[,input$X]  #這裡是關鍵
      Y = dat[,input$Y]  #這裡是關鍵
      Result=cor.test(X,Y,method=input$method)
      return(Result)
    }  
  })
  
  output$plot = renderPlot({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      X = dat[,input$X]  #這裡是關鍵
      Y = dat[,input$Y]  #這裡是關鍵
      plot(X,Y,pch=19,col=input$Color)
      abline(lm(Y~X),col="black")   
    }  
  })
  
})

練習1答案

library(shiny)

shinyUI(navbarPage("Linear regression for two continuous variables.",
                   tabPanel("Analysis",
                            fluidRow(
                              column(4,
                                     h3(p(strong(span(style="color:blue","Step 1: Data selection")))),
                                     h4("Do you want to analyze your data?"),
                                     radioButtons("data","",c("No, I want to use example data." = "Example", "Yes, I want to analyze my data." = "Mydata")),
                                     conditionalPanel("input.data == 'Mydata'",
                                                      h4("Please upload your data file:"),
                                                      fileInput(inputId="files", label=h4("Upload your data file:"), multiple=FALSE, accept="text/plain"),
                                                      helpText("Note: you only can upload the .txt file.")
                                     )
                              ),
                              column(4,
                                     h3(p(strong(span(style="color:green","Step 2: Please select two variables")))),
                                     uiOutput("choose_columns1"),
                                     uiOutput("choose_columns2")
                              ),
                              column(4,
                                     h3(p(strong(span(style="color:red","Step 3: Please select method and color")))),
                                     radioButtons("method", "What is the method to analysis?", choices = c("Pearson correlation" = "pearson", "Spearman correlation" = "spearman")),
                                     radioButtons("Color", "Select the color of histogram:", choices = c("Red" = "red", "Blue" = "blue", "Green" = "green"))
                              )
                            ),
                            hr(),
                            fluidRow(
                              column(6,
                                     tags$style(type='text/css', '#summary {background-color: rgba(255,255,0,0.40); color: blue;}'),
                                     verbatimTextOutput("summary")
                              ),
                              column(6,
                                     plotOutput("plot",width = "500px", height = "500px")
                              )
                            )
                   ),
                   tabPanel("Software information",
                            p(strong(h4(span(style="color:green","Basic information:")))),                      
                            p(strong("Software name:"), span(style="color:blue", "Test")),
                            p(strong("Contributors:"), tags$a(href="https://3qd4oellj5fbz3vzuob5dg-on.drv.tw/Website", "Chin Lin"), span(style="color:blue", "<xup6fup@gmail.com>")),
                            p(strong("Maintainer:"), tags$a(href="https://3qd4oellj5fbz3vzuob5dg-on.drv.tw/Website", "Chin Lin"), span(style="color:blue", "<xup6fup@gmail.com>")),
                            p(strong("License:"), tags$a(href="http://www.gnu.org/licenses/gpl-3.0.en.html", "GPL (>= 3)")),
                            p(strong("Provider:"), tags$a(href="http://www.ndmctsgh.edu.tw/", "National Defence Medical Center (NDMC)"))
                            )
))
library(shiny)

shinyServer(function(input, output) {
  
  DATA = reactive({
    if (input$data=="Example") {
      data(iris)
      return(iris[,-5])
    } else {
      if (is.null(input$files)) {return()} else {
        dat = read.table(input$files$datapath,header=T)
        return(dat) 
      }
    }
  })
  
  output$choose_columns1 = renderUI({
    dat = DATA()
    if (is.null(dat)) {return()} else {
      colnames = colnames(dat)
      selectInput("Y", h4("Choose a dependence variable:"), choices = colnames)
    }
  })
  
  output$choose_columns2 = renderUI({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)) {return()} else {
      colnames = colnames(dat)
      selectInput("X", h4("Choose a independence variable:"), choices = colnames[which(colnames!=input$Y)])
    }
  })
  
  output$summary = renderPrint({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      X = dat[,input$X]
      Y = dat[,input$Y]
      Result=cor.test(X,Y,method=input$method)
      return(Result)
    }  
  })
  
  output$plot = renderPlot({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      X = dat[,input$X]
      Y = dat[,input$Y]
      plot(X,Y,pch=19,col=input$Color)
      abline(lm(Y~X),col="black")   
    }  
  })
  
})

第二節：基本的Output種類(1)

##              Functions     Outputs Library
## 1         plotOutput()  basic plot   shiny
## 2        tableOutput()  html table   shiny
## 3         textOutput()        text   shiny
## 4 verbatimTextOutput()  R response   shiny
## 5           uiOutput() control bar   shiny
## 6    dataTableOutput()   datatable      DT
## 7         htmlOutput()   html form   shiny

– 請複製貼上下列的ui & server

library(shiny)
library(DT)

shinyUI(navbarPage(
  title = 'DataTable Options',
  tabPanel('Basic',     
           DT::dataTableOutput('ex1'),
           verbatimTextOutput('out1')),
  tabPanel('Select single cell',        
           DT::dataTableOutput('ex2')),
  tabPanel('Filter',      
           DT::dataTableOutput('ex3')),
  tabPanel('show/hide button',       
           DT::dataTableOutput('ex4')),
  tabPanel('Colorful',  
           DT::dataTableOutput('ex5'))
))
library(shiny)
library(DT)

data(iris)
dat = iris

shinyServer(function(input, output) {

  output$ex1 = DT::renderDataTable({
    Result = DT::datatable(dat)
    return(Result)
  })
  
  output$out1 = renderPrint({
    input$ex1_rows_selected
  })
  
  output$ex2 = DT::renderDataTable({
    Result = DT::datatable(dat, selection = "single")
    return(Result)
  })
  
  output$ex3 = DT::renderDataTable({
    Result = DT::datatable(dat, filter = 'top')
    return(Result)
  })
  
  output$ex4 = DT::renderDataTable({
    Result = DT::datatable(
      dat, rownames = FALSE,
      extensions = 'ColVis', options = list(dom = 'C<"clear">lfrtip')
    )
    return(Result)
  })
  
  output$ex5 = DT::renderDataTable({
    Result = DT::datatable(dat)
    Result = formatStyle(Result, 'Sepal.Length', fontWeight = styleInterval(5, c('normal', 'bold')))
    Result = formatStyle(Result, 'Sepal.Width', color = styleInterval(c(3.4, 3.8), c('white', 'blue', 'red')),
                         backgroundColor = styleInterval(3.4, c('gray', 'yellow')))
    Result = formatStyle(Result, 'Petal.Length', background = styleColorBar(dat$Petal.Length, 'steelblue'),
                         backgroundSize = '100% 90%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center')
    Result = formatStyle(Result, 'Species', transform = 'rotateX(45deg) rotateY(20deg) rotateZ(30deg)',
                         backgroundColor = styleEqual(unique(iris$Species), c('lightblue', 'lightgreen', 'lightpink')))
    return(Result)
  })
  
})

第二節：基本的Output種類(2)

– ui.R

library(shiny)
library(DT)

fluidPage(
  
  h1('A Client-side Table'),
  
  fluidRow(
    column(6, DT::dataTableOutput('x1')),
    column(6, plotOutput('x2', width = "500px", height = "500px"))
  )
  
)

– server.R

library(shiny)
library(DT)

data(cars)
dat = cars

shinyServer(function(input, output, session) {
  
  output$x1 = DT::renderDataTable({
    Result = DT::datatable(dat)
    return(Result)
  })
  
  output$x2 = renderPlot({
    selection = as.numeric(input$x1_rows_selected)
    X = dat[,1]
    Y = dat[,2]
    plot(X,Y)
    if (length(selection)!=0) {points(X[selection],Y[selection], pch = 19, cex = 2, col = "red")}
  })
  
})

練習2：活用Datatable

– 請在這裡下載練習用檔案

– 現在，請利用Datatable，讓使用者能Highlight他所選重的個案

練習2答案

library(shiny)

shinyUI(pageWithSidebar(
  
  headerPanel("Linear regression for two continuous variables."), 
  
  sidebarPanel(
    fileInput(inputId="files", label=h4("Upload your data file:"), multiple=FALSE, accept="text/plain"),
    helpText("Note: you only can upload the .txt file."),
    uiOutput("choose_columns1"),   #這裡是關鍵
    uiOutput("choose_columns2"),   #這裡是關鍵
    radioButtons("method", "What is the method to analysis?", choices = c("Pearson correlation" = "pearson", "Spearman correlation" = "spearman")),
    radioButtons("Color", "Select the color of histogram:", choices = c("Red" = "red", "Blue" = "blue", "Green" = "green"))
  ),
  
  mainPanel(
    verbatimTextOutput("summary"),
    fluidRow(
      column(6, DT::dataTableOutput('table')),
      column(6, plotOutput("plot",width = "500px", height = "500px"))
    )
  )  
  
))
library(shiny)

shinyServer(function(input, output) {
  
  DATA = reactive({
    if (is.null(input$files)) {return()} else {
      dat = read.table(input$files$datapath,header=T)
      return(dat) 
    }
  })
  
  output$choose_columns1 = renderUI({  #這裡是關鍵
    dat = DATA()
    if (is.null(dat)) {return()} else {
      colnames = colnames(dat)
      selectInput("Y", h4("Choose a dependence variable:"), choices = colnames)
    }
  })
  
  output$choose_columns2 = renderUI({  #這裡是關鍵
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)) {return()} else {
      colnames = colnames(dat)
      selectInput("X", h4("Choose a independence variable:"), choices = colnames[which(colnames!=input$Y)])
    }
  })
  
  output$summary = renderPrint({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      X = dat[,input$X]  #這裡是關鍵
      Y = dat[,input$Y]  #這裡是關鍵
      Result=cor.test(X,Y,method=input$method)
      return(Result)
    }  
  })
  
  output$table = DT::renderDataTable({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      new.dat = dat[,c(input$X,input$Y)]
      Result = DT::datatable(new.dat)
      return(Result)
    }
  })
  
  output$plot = renderPlot({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      selection = as.numeric(input$table_rows_selected)
      X = dat[,input$X]  #這裡是關鍵
      Y = dat[,input$Y]  #這裡是關鍵
      plot(X,Y,pch=19,col=input$Color)
      abline(lm(Y~X),col="black")
      if (length(selection)!=0) {points(X[selection],Y[selection], pch = 19, cex = 2, col = input$Color)}
    }  
  })
  
})

第三節 在網頁應用程式中的高耗時程序(1)

max.x = 10000

x = 2:max.x
answer.x = rep(TRUE, max.x-1)
indexes = 1:(max.x/2-1) * 2
answer.x[indexes + 1] = FALSE
  
for (i in indexes) {
  pos = which(answer.x[1:((i-1)/3)])
  for (j in pos) {
    if (x[i] %% x[j] == 0) {
      answer.x[i] = FALSE
      break
    }
  }
}
  
tail(x[answer.x], 1)

第三節 在網頁應用程式中的高耗時程序(2)

– reactive()、eventReactive()可以幫助我們做到這個功能

– 另外，我們再介紹進度條函數:withProgress()，這可以提示使用者目前正在運行中。

library(shiny)

shinyUI(pageWithSidebar(
  
  headerPanel("My App"),
  
  sidebarPanel(
    numericInput("max.x", "The search range of prime number:", min = 2, max = 100000, value = 10000),
    actionButton("submit",strong("Start to analyze!"),icon("list-alt"))
  ),
  
  mainPanel(
    verbatimTextOutput("Seq")
  )
))
library(shiny)

shinyServer(function(input, output) {
  
  RESULT = eventReactive(input$submit,{
    if (is.null(input$max.x)) {return()} else {
      withProgress(message = "In processing...",value=0,{
        
        x = 2:input$max.x
        answer.x = rep(TRUE, input$max.x-1)
        indexes = 1:(input$max.x/2-1) * 2
        answer.x[indexes + 1] = FALSE
        
        for (i in indexes) {
          pos = which(answer.x[1:((i-1)/3)])
          for (j in pos) {
            if (x[i] %% x[j] == 0) {
              answer.x[i] = FALSE
              break
            }
          }
          incProgress(1/length(indexes))
        }
        
        tail(x[answer.x], 1)
        
      })
    }
  })
  
  
  output$Seq = renderPrint({
    result = RESULT()
    if (is.null(result)) {return()} else {
      return(result)
    }
  })
  
})

練習3：為練習2增加起始鍵

– 請你利用練習2答案，試著讓流程做出按鍵，讓使用者在按了按鍵之後才開始進行分析！

練習3答案

library(shiny)

shinyUI(pageWithSidebar(
  
  headerPanel("Linear regression for two continuous variables."), 
  
  sidebarPanel(
    fileInput(inputId="files", label=h4("Upload your data file:"), multiple=FALSE, accept="text/plain"),
    helpText("Note: you only can upload the .txt file."),
    uiOutput("choose_columns1"),   #這裡是關鍵
    uiOutput("choose_columns2"),   #這裡是關鍵
    radioButtons("method", "What is the method to analysis?", choices = c("Pearson correlation" = "pearson", "Spearman correlation" = "spearman")),
    radioButtons("Color", "Select the color of histogram:", choices = c("Red" = "red", "Blue" = "blue", "Green" = "green")),
    actionButton("submit",strong("Start to analyze!"),icon("list-alt"))
  ),
  
  mainPanel(
    verbatimTextOutput("summary"),
    fluidRow(
      column(6, DT::dataTableOutput('table')),
      column(6, plotOutput("plot",width = "500px", height = "500px"))
    )
  )  
  
))
library(shiny)

shinyServer(function(input, output) {
  
  DATA = reactive({
    if (is.null(input$files)) {return()} else {
      dat = read.table(input$files$datapath,header=T)
      return(dat) 
    }
  })
  
  output$choose_columns1 = renderUI({  #這裡是關鍵
    dat = DATA()
    if (is.null(dat)) {return()} else {
      colnames = colnames(dat)
      selectInput("Y", h4("Choose a dependence variable:"), choices = colnames)
    }
  })
  
  output$choose_columns2 = renderUI({  #這裡是關鍵
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)) {return()} else {
      colnames = colnames(dat)
      selectInput("X", h4("Choose a independence variable:"), choices = colnames[which(colnames!=input$Y)])
    }
  })
  
  RESULT = eventReactive(input$submit,{
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      X = dat[,input$X]  #這裡是關鍵
      Y = dat[,input$Y]  #這裡是關鍵
      Result=cor.test(X,Y,method=input$method)
      return(Result)
    }  
  })
  
  
  
  output$summary = renderPrint({
    Result = RESULT()
    if (is.null(Result)) {return()} else {
      return(Result)
    }  
  })
  
  output$table = DT::renderDataTable({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      new.dat = dat[,c(input$X,input$Y)]
      Result = DT::datatable(new.dat)
      return(Result)
    }
  })
  
  output$plot = renderPlot({
    dat = DATA()
    if (is.null(dat)|is.null(input$Y)|is.null(input$X)) {return()} else {
      selection = as.numeric(input$table_rows_selected)
      X = dat[,input$X]  #這裡是關鍵
      Y = dat[,input$Y]  #這裡是關鍵
      plot(X,Y,pch=19,col=input$Color)
      abline(lm(Y~X),col="black")
      if (length(selection)!=0) {points(X[selection],Y[selection], pch = 19, cex = 2, col = input$Color)}
    }  
  })
  
})

小結

  1. conditionalPanel()
  2. 讓使用者能上傳檔案
  3. renderUI及uiOutput
  4. UI的優化
  5. Datatable
  6. 設計server的反應流程