ui.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
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
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)
}