---
title: 'R語言之shiny CRUD範例'
disqus: hackmd
---

R語言之shiny CRUD範例
===

[TOC]
## 流程圖

## 載入所需套件

rm(list=ls());gc()
library(shiny)
library(shinyjs)

## 建立前端頁面
本次使用4個欄位，其中id為讀取、刪除資料所需(Unique)，因此此欄位輸入不可更改。

ui <- fluidPage(
  # 使用shinyjs
  shinyjs::useShinyjs(),
  
  # 顯示資料表
  DT::dataTableOutput("responses", width = 300), 
  
  # 輸入欄位
  tags$hr(),
  shinyjs::disabled(textInput("id", "Id", "0")),
  textInput("name", "Name", ""),
  checkboxInput("used_shiny", "Used Shiny", FALSE),
  sliderInput("r_num_years", "R Years", 0, 25, 2, ticks = FALSE),
  
  # 點擊按鈕
  actionButton("submit", "Submit"),
  actionButton("new", "New"),
  actionButton("delete", "Delete")
)

完成後輸入欄位如下圖所示：

## 建立CRUD資料函數
在server端中會使用C、R、U、D等函數進行新增、讀取、更新、刪除資料表

# 讀取資料函數
GetTableMetadata <- function() {
  fields <- c(id = "Id", 
              name = "Name", 
              used_shiny = "Used Shiny", 
              r_num_years = "R Years")
  
  result <- list(fields = fields)
  return (result)
}

# 更新id函數
GetNextId <- function() {
  if (exists("responses") && nrow(responses) > 0) {
    max(as.integer(rownames(responses))) + 1
  } else {
    return (1)
  }
}


# 創建資料函數
CreateData <- function(data) {
  
  data <- CastData(data)
  rownames(data) <- GetNextId()
  if (exists("responses")) {
    responses <<- rbind(responses, data)
  } else {
    responses <<- data
  }
}


# 讀取資料函數
ReadData <- function() {
  if (exists("responses")) {
    responses
  }
}

# 更新資料函數
UpdateData <- function(data) {
  data <- CastData(data)
  responses[row.names(responses) == row.names(data), ] <<- data
}

# 刪除資料函數
DeleteData <- function(data) {
  responses <<- responses[row.names(responses) != unname(data["id"]), ]
}

# 將目前輸入資料轉換成dataframe格式
CastData <- function(data) {
  datar <- data.frame(name = data["name"], 
                      used_shiny = as.logical(data["used_shiny"]), 
                      r_num_years = as.integer(data["r_num_years"]),
                      stringsAsFactors = FALSE)
  
  rownames(datar) <- data["id"]
  return (datar)
}

# 更新輸入欄位內容 - 預設值
CreateDefaultRecord <- function() {
  mydefault <- CastData(list(id = "0", name = "", used_shiny = FALSE, r_num_years = 2))
  return (mydefault)
}

# 更新輸入欄位內容
UpdateInputs <- function(data, session) {
  updateTextInput(session, "id", value = unname(rownames(data)))
  updateTextInput(session, "name", value = unname(data["name"]))
  updateCheckboxInput(session, "used_shiny", value = as.logical(data["used_shiny"]))
  updateSliderInput(session, "r_num_years", value = as.integer(data["r_num_years"]))
}

## 後端Server
由於前端有三個按鈕，因此要針對三個按鈕進行觸發事件設定，並及時儲存輸入內容

server <- function(input, output, session) {
  
  # 每次動作時更新輸入的內容
  formData <- reactive({
    sapply(names(GetTableMetadata()$fields), function(x) input[[x]])
  })
  
  # 點擊submit按鈕後觸發，如果該資料id非為0(初始值)將進行UpdateData
  observeEvent(input$submit, {
    if (input$id != "0") {
      UpdateData(formData())
    } else {
      CreateData(formData())
      UpdateInputs(CreateDefaultRecord(), session)
    }
  }, priority = 1)
  
  # 點擊new按鈕後觸發，重置輸入欄位內容
  observeEvent(input$new, {
    UpdateInputs(CreateDefaultRecord(), session)
  })

  # 點擊delete按鈕後觸發，根據點擊的id刪除該資料
  observeEvent(input$delete, {
    DeleteData(formData())
    UpdateInputs(CreateDefaultRecord(), session)
  }, priority = 1)
  
  # 點擊資料表欄位，根據點擊的id更新輸入欄位內容
  observeEvent(input$responses_rows_selected, {
    if (length(input$responses_rows_selected) > 0) {
      data <- ReadData()[input$responses_rows_selected, ]
      UpdateInputs(data, session)
    }
    
  })
  
  # 顯示資料表格
  output$responses <- DT::renderDataTable({
    #update after submit is clicked
    input$submit
    #update after delete is clicked
    input$delete
    ReadData()
  }, server = FALSE, selection = "single",
  colnames = unname(GetTableMetadata()$fields)[-1]
  )     

}

shinyApp(ui = ui, server = server)