R shiny でデータの基礎分析用アプリの作成③

はじめに

R shiny でデータの基礎分析用アプリの作成①
R shiny でデータの基礎分析用アプリの作成②
の続き。統計量の表示ができたので、可視化の部分を書いていく。

プロットの作成

プロットの出力はrenderPlotでできるが軸をファイルから読み取った値にするのに一工夫必要になる。server側にrenderUIを使ってUIを定義して、ui側にhtmlOutputで書き加えれば、インタラクティブなプロットが作成できる。前回の記事より細かい変更もした（インデントなど）。
変更点にコメントを加えていく。

app.R

# Load packages ----
library(shiny)
library(DT)
library(ggplot2) #プロットのためにパッケージを導入

# Source helpers ----
source("helpers.R")

# User interface ----
ui <- fluidPage(
  titlePanel("Basic analysis"),
  
  sidebarLayout(
    sidebarPanel(
      fileInput(
        "file",
        label = "File input",
        accept = c("text/csv"),
        multiple = FALSE,
        width = "80%")
    ),
    
    mainPanel(
      tabsetPanel(
        type = "tabs",
        tabPanel("Data", dataTableOutput("outFile")),
        tabPanel("Statistic", dataTableOutput("outStat")),
        tabPanel("Correlation", dataTableOutput("outCor")),
        tabPanel(
          "Histogram", plotOutput("hist"), #ヒストグラムの表示
          fluidRow(
            column(3, htmlOutput("Hist.Bins")),
            column(4, htmlOutput("Hist.X")),
            column(4, htmlOutput("Hist.Fill"))
            )
          ),
        tabPanel(
          "Scatter", plotOutput("scat"), #散布図の表示
          fluidRow(
            column(4, htmlOutput("Scat.X"), htmlOutput("Scat.Y")),
            column(4, htmlOutput("Scat.Col"), htmlOutput("Scat.Sha"))
            )
          ),
        tabPanel(
          "Bar", plotOutput("bar"), #度数分布の表示
          fluidRow(
            column(4, htmlOutput("Bar.X")),
            column(4, htmlOutput("Bar.Fil"))
            )
          )
        )
      )
    )
  )

# Server logic
server <- function(input, output) {
  
  inFile <- reactive({
    tmp <- input$file
    if (is.null(tmp)){
      return(NULL)
    } else {
      df <- read.csv(tmp$datapath, header=TRUE)
      return(df)
    }
  })
  
  stat <- reactive({
    tmp <- inFile()
    if (is.null(tmp)) {
      return(NULL)
    } else {
      res <- ana_stat(tmp)
      return(res)
    }
  })
  
  r <- reactive({
    tmp <- inFile()
    if (is.null(tmp)) {
      return(NULL)
    } else {
      res <- ana_cor(tmp)
      return(res)
    }
  })

  output$outFile <- DT::renderDataTable({
    inFile()
  }, extensions = c('Buttons'), options = list(dom = 'Blfrtip', buttons = c('csv', 'excel', 'pdf'))
  )
  
  output$outStat <- DT::renderDataTable({
    stat()
  }, extensions = c('Buttons'), options = list(dom = 'Blfrtip', buttons = c('csv', 'excel', 'pdf'))
  )
  
  output$outCor <- DT::renderDataTable({
    r()
  }, extensions = c('Buttons'), options = list(dom = 'Blfrtip', buttons = c('csv', 'excel', 'pdf'))
  )
  
  #以下ヒストグラムの描画部分
  output$Hist.Bins <- renderUI({
    sliderInput('hist.bins', 'bins', min=1, max=(round(nrow(inFile())/10)), value=(round(nrow(inFile())/20)))
  })
  
  output$Hist.X <- renderUI({
    selectInput('hist.x', 'x', names(inFile()))
  })
  
  output$Hist.Fill <- renderUI({
    selectInput('hist.fill', 'fill', c(None='None', names(inFile())))
  })
  
  output$hist <- renderPlot({
    g <- ggplot(inFile(), aes_string(x = input$hist.x)) + geom_histogram(bins = input$hist.bins)
    if (input$hist.fill != 'None') {
      g <- g + aes_string(fill = input$hist.fill)
    }
    print(g)
  })
  
  # 以下散布図の描画部分
  output$Scat.X <- renderUI({
    selectInput('scat.x', 'x', names(inFile()))
  })
  
  output$Scat.Y <- renderUI({
    selectInput('scat.y', 'y', names(inFile()))
  })
  
  output$Scat.Col <- renderUI({
    selectInput('scat.col', 'color', c(None='None', names(inFile())))
  })
  
  output$Scat.Sha <- renderUI({
    selectInput('scat.sha', 'shape', c(None='None', names(inFile())))
  })
  
  output$scat <- renderPlot({
    g <- ggplot(inFile(), aes_string(x = input$scat.x, y = input$scat.y)) + geom_point()
    if (input$scat.col != 'None') {
      g <- g + aes_string(color = input$scat.col)
    }
    if (input$scat.sha != 'None') {
      g <- g + aes_string(shape = input$scat.sha)
    }
    print(g)
  })
  
  # 以下、度数分布の描画部分
  output$Bar.X <- renderUI({
    selectInput('bar.x', 'x', names(inFile()))
  })
  
  output$Bar.Fil <- renderUI({
    selectInput('bar.fil', 'fill', c(None='None', names(inFile())))
  })

  output$bar <- renderPlot({
    g <- ggplot(inFile(), aes_string(x = input$bar.x)) + geom_bar()
    if (input$bar.fil != 'None') {
      g <- g + aes_string(fill = input$bar.fil)
    }
    print(g)
  })
  
}

# Run the app
shinyApp(ui, server)

おわりに

以上で基礎分析用アプリケーションの作成は終了とし、今度は dashboard 風の可視化アプリケーションを作成してみたいと思う。