【備忘録】 Shinyでダッシュボードを作る（テンプレ）

## ui.R
```R:ui.R

library(shiny)
library(shinythemes)
library(DT)
library(shinydashboard)
library(tidyverse)
library(caret)

shinyUI(
  navbarPage("Data Dashboard Sample Application",
             
              tabPanel("可視化", sidebarLayout(
               sidebarPanel(
                 selectInput("selected_data_for_plot", label = h3("Select Dataset"),
                             choices = c("Iris" = "iris",
                                         "Boston" = "Boston",
                                         "Titanic" = "titanic"),
                             selected = "Iris"),
                 # sliders to select status of 6 parameters
                 sliderInput("Sepal.Length", "Sepal.Length:",
                             min = 0, max = 8, value = c(0,8)),
                 sliderInput("Sepal.Width", "Sepal.Width:",
                             min = 0, max = 5, value = c(0,5)),
                 sliderInput("Petal.Length", "Petal.Length:",
                             min = 0, max = 7, value = c(0,7)),
                 sliderInput("Petal.Width", "Petal.Width:",
                             min = 0, max = 3, value = c(0,3)),
                 
                 # checkboxes to select type
                tags$p("Species"),
                 checkboxInput("setosa", "setosa", TRUE),
                 checkboxInput("versicolor", "versicolor", TRUE),
                 checkboxInput("virginica ", "virginica ", TRUE),
                 
                 selectInput("select_input_data_for_hist",
                             "ヒストグラムを表示する列番号",
                             choices = colnames(iris)),
                 sliderInput("slider_input_data",
                             "Number of bins:",
                             min = 1,
                             max = 50,
                             value = 30),
                 actionButton("trigger_histogram", "ヒストグラムを出力"),
                 
                 h3("散布図を表示する列を指定"),
                 selectInput("input_data_for_scatter_plotX",
                             "x軸",
                             choices = colnames(iris), selected = colnames(iris)[1]),
                 selectInput("input_data_for_scatter_plotY",
                             "y軸",
                             choices = colnames(iris), selected = colnames(iris)[1]),
                 actionButton("trigger_scatter_plot", "散布図を出力")
               ),
               mainPanel(
                 tabsetPanel(type = "tabs",
                             tabPanel("Table",
                                      DT::dataTableOutput("table_for_plot")),
                             tabPanel("ヒストグラム", plotOutput("histgram")),
                             tabPanel("散布図", plotOutput("scatter_plot", brush = brushOpts(id="plot_brush")),
                                      DT::dataTableOutput("plot_brushedPoints")),
                             tabPanel("みたいに他にも図を表示する")
                 )
               )
             )),
             
             tabPanel("回帰", sidebarLayout(
               sidebarPanel(
                 selectInput("data_for_regressionX", label = h3("データセットを選択してください。"),
                             choices = c("アヤメのデータ" = "iris",
                                         "不妊症の比較データ" = "infert",
                                         "ボストン近郊の不動産価格データ" = "Boston",
                                         "スパムと正常メールのデータ" = "spam",
                                         "ニューヨークの大気状態データ" = "airquality",
                                         "タイタニックの乗客データ" = "titanic"),
                             selected = "iris"),
                 h3("回帰を出力"),
                 selectInput("data_for_regressionY",
                             "目的変数を選択",
                             choices = colnames(iris), selected = colnames(iris)[1]),
                 h3("選択された説明変数はこちら"),
                 verbatimTextOutput("rows_selected"),
                 selectInput("regression_type",
                             "回帰の手法を選択",
                             choices = c("重回帰分析" = "lm",
                                         "ランダムフォレスト" = "rf",
                                         "3層ニューラルネット" = "nnet")),
                 actionButton("regression_button", "回帰")
               ),
               mainPanel(
                 tabsetPanel(type = "tabs",
                             tabPanel("Table", h3("説明変数を選択してください。"), 
                                      DT::dataTableOutput("data_table_for_regression")),
                             tabPanel("回帰結果", verbatimTextOutput("summary_regression")),
                             tabPanel("プロットで結果を確認", plotOutput("plot_regression"))
                 )
               )
             )),
             
             
             navbarMenu("その他",
                        tabPanel("About",
                                 h2("私の名前はNp-Urです。")),
                        tabPanel("ソースコード",
                                 a(href="https://github.com/Np-Ur/ShinyBook", 
                                   p("https://github.com/Np-Ur/ShinyBook"))
                        )
             )
  )
)
```

## server.R

```R:server.R
library(shiny)
library(MASS)
library(kernlab)
library(DT)
library(tidyverse)
library(plm)
library(caret)

shinyServer(function(input, output, session) {
  output$distPlot_shiny <- renderPlot({
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins_shiny + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
  
  data_for_plot <- reactive({
    data <- switch(input$selected_data_for_plot,
                   "iris" = iris,
                   "Boston" = Boston,
                   "titanic" = data.frame(lapply(data.frame(Titanic), 
                                                 function(i){rep(i, data.frame(Titanic)[, 5])}))
    ) %>% 
      dplyr::filter(
        Sepal.Length  >= input$Sepal.Length[1], Sepal.Length  <= input$Sepal.Length[2],
        Sepal.Width  >= input$Sepal.Width[1], Sepal.Width  <= input$Sepal.Width[2],
        Petal.Length  >= input$Petal.Length[1], Petal.Length  <= input$Petal.Length[2],
        Petal.Width  >= input$Petal.Width[1], Petal.Width  <= input$Petal.Width[2],
        Species %in% c(
          if_else(input$setosa == T, "setosa", ""),
          if_else(input$versicolor == T, "versicolor", ""),
          if_else(input$virginica == T, "virginica", "")
        )
      )
    
    updateSelectInput(session, "select_input_data_for_hist", choices = colnames(data))
    updateSelectInput(session, "input_data_for_scatter_plotX", 
                      choices = colnames(data), selected = colnames(data)[1])
    updateSelectInput(session, "input_data_for_scatter_plotY", 
                      choices = colnames(data), selected = colnames(data)[1])
    
    return(data)
  })
  
  output$histgram <- renderPlot({
    input$trigger_histogram
    
    tmpData <- data_for_plot()[, isolate(input$select_input_data_for_hist)]
    x <- na.omit(tmpData)
    bins <- seq(min(x), max(x), length.out = isolate(input$slider_input_data) + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
  
  output$table_for_plot <- DT::renderDataTable({
    data_for_plot()
  })
  
  
  output$scatter_plot <- renderPlot({
    isolate(temp <- data.frame(
      x = data_for_plot()[, input$input_data_for_scatter_plotX],
      y = data_for_plot()[, input$input_data_for_scatter_plotY]
    ))
    input$trigger_scatter_plot
    g <- ggplot(temp, aes(x=x, y=y))
    g + geom_point()
    
  })
  
  output$plot_brushedPoints <- DT::renderDataTable({
    res <- brushedPoints(data_for_plot(), input$plot_brush, 
                         xvar = input$input_data_for_scatter_plotX,
                         yvar = input$input_data_for_scatter_plotY)
    
    if (nrow(res) == 0)
      return()
    res
  })
  
  data_for_regression <- reactive({
    data <- switch(input$data_for_regressionX,
                   "iris" = iris,
                   "infert" = infert,
                   "Boston" = Boston,
                   "spam" = spam,
                   "airquality" = airquality,
                   "titanic" = data.frame(lapply(data.frame(Titanic), 
                                                 function(i){rep(i, data.frame(Titanic)[, 5])}))
    )
    updateSelectInput(session, "data_for_regressionY", choices = colnames(data), 
                      selected = colnames(data)[1])
    
    return(data)
  })
  
  output$data_table_for_regression <- DT::renderDataTable(
    t(data_for_regression()[1:10, ]), selection = list(target = 'row')
  )
  
  output$rows_selected <- renderPrint(
    input$data_table_for_regression_rows_selected
  )
  
  data_train_and_test <- reactiveValues()
  
  regression_summary <-  reactive({
    input$regression_button
    
    y <- data_for_regression()[, isolate(input$data_for_regressionY)]
    x <- data_for_regression()[, isolate(input$data_table_for_regression_rows_selected)]
    
    tmp_data <- cbind(na.omit(x), na.omit(y))
    colnames(tmp_data) <- c(colnames(x), "dependent_variable")
    train_index <- createDataPartition(tmp_data$"dependent_variable", p = .7,
                                       list = FALSE,
                                       times = 1)
    data_train_and_test$train <- tmp_data[train_index, ]
    data_train_and_test$test <- tmp_data[-train_index, ]
    
    return(train(dependent_variable ~.,
                 data = data_train_and_test$train,
                 method = isolate(input$regression_type),
                 tuneLength = 4,
                 preProcess = c('center', 'scale'),
                 trControl = trainControl(method = "cv"),
                 linout = TRUE))
  })
})
```

## global.R

```R:global.R
library(shiny)
library(DT)
library(MASS)
library(kernlab)
library(tidyverse)

data(spam)

# ui modules
dataSelectUI <- function(id){
  ns <- NS(id)
  
  tagList(
    selectInput(ns("selected_data"), label = h3("データセットを選択してください。"),
                choices = c("アヤメのデータ" = "iris",
                            "不妊症の比較データ" = "infert",
                            "ボストン近郊の不動産価格データ" = "Boston",
                            "スパムと正常メールのデータ" = "spam",
                            "ニューヨークの大気状態データ" = "airquality",
                            "タイタニックの乗客データ" = "titanic"),
                selected = "iris")
  )
}

# server modules
dataSelect <- function(input, output, session, type){
  data <- switch(input$selected_data,
                 "iris" = iris,
                 "infert" = infert,
                 "Boston" = Boston,
                 "spam" = spam,
                 "airquality" = airquality,
                 "titanic" = data.frame(lapply(data.frame(Titanic), 
                                               function(i){rep(i, data.frame(Titanic)[, 5])}))
  )
  return(data)
}

# etc
get_train_and_test_data <- function(data, dependent_variable, independent_variable){
  y <- data[, dependent_variable]
  x <- data[, independent_variable]
  
  tmp_data <- cbind(x, y)
  colnames(tmp_data) <- c(colnames(x), "dependent_variable")
  
  # 学習用データと検証データに分ける
  train_index <- createDataPartition(tmp_data$"dependent_variable", 
                                     p = .7, list = FALSE, times = 1)
  data_list <- list()
  data_list <- c(data_list, list(tmp_data[train_index, ]))
  data_list <- c(data_list, list(tmp_data[-train_index, ]))
  
  return(data_list)
}

```