Zenn
📚

R Shinyで時系列データの入力フォームとデータ表示の枠組みを作る

2023/06/02に公開
R
#
shiny
tech

実現したいこと

時系列に沿った何かしらのデータを入力し、そのデータフレームを閲覧できるような枠組みを作る。

実行画面

ここから具体的な説明に移ります。最後にソースコードの全文を載せているので、そちらを見ながら読んでください。

UIの設計 (ui.R)

shinyTimeを使った日付入力

また、日付の入力にはshinyTimeというパッケージがおすすめです。今回はそこからdateInputとtimeInputを使用しました。読み込まれたデータの詳細は処理側の説明で書きます。timeInputはnumericInputを二つ置けば同じようなことができますが、timeInputの方がレイアウトがしやすい印象でした。

DTを使ったデータフレーム表示

データフレームの表示に便利なライブラリです。これを使わなくてもデータの表示は可能ですが、データ削除の実装で必要でした。

全体のレイアウト

sidebarLayoutを使って、sidebarPanelでデータを入力し、mainPanelでデータを表示させました。

処理の設計 (server.R)

データフレームの準備

ただのデータフレームを作るのではなく、reactiveValuesの一要素として定義しています。こうすることでデータフレーム内の変更を感知して、表示が切り替わります。
initializeMeasVal関数内ではShiny関連の変数を使っていないため、shinyServer内で定義する必要はありません。

入力ボタンの反応

observeEventを使うことで指定したイベントに応じて処理が実行されます。今回はactionButtonのイベントと組み合わせることでボタンを押すと何かしらの動作が起こるようにしました。
server.Rではinputという変数が利用できます。これはui.RのInputとつく関数と紐づいていて、それらの値がリストのような形で入っています（実際にはreactivevaluesというオブジェクトです）。
例えばdateInput("obsday", label = "測定日", language = "ja")の情報はinput$obsdayとして利用できます。

なお、input$obstimeは以下のようなデータなので、strftimeで見やすい形式に変換しています。

input$obstimeの中身
Browse[2]> input$obstime
[1] "2023-06-01 JST"
Browse[2]> input$obstime %>% class()
[1] "POSIXlt" "POSIXt"

削除ボタンの反応

DTパッケージを使っていると表示しているデータ上で行が選択可能になります（複数選択可）。選択されている行の行番号はinput$[table名]rows_selectedに保存されています（今回ならinput$table_rows_selected）。
今回は、単純に削除ボタンが押されたら、選択されている行を除いたデータで更新しています。なお、行が選択されていない場合はinput$table_rows_selectedにはNULLが入っており、slice関数内で-NULLという処理が発生してエラーとなるため、選択行がないときは何もしないようにさせています。

データの表示

先ほどinputという引数の話をしましたが、反対にoutputにデータを与えることで、ui.Rで使うことができます。
UI上で表示するときは列名が日本語の方が良かったので、outputに渡す直前で列名を変えています。もちろんinitializeMeasValの時点で日本語の列名に出来ますが、MeasValの列名はいろいろなところで使うので、日本語がソースコードの中に散在することを嫌って今回のようにしました。

まとめ

なるべくシンプルな設計になるように意識して、データを入力して表示する枠組みを作成しました。それぞれの目的に合わせてカスタマイズしてください。例えば、initializeMeasValと紐づければ簡単にリセットボタンを作れたりします。
今後は作成したデータを保存したり、保存したデータを読み込んだりする枠組みの作り方も書こうと思っています。
こうした方がいいなどアドバイスありましたら、どんなに細かいことでも是非お願いします。

ソースコード

ui.R
library(shiny)
library(shinyTime)
library(DT)

shinyUI(
  fluidPage(
    h1("測定値入力フォーム"),
    sidebarLayout(
      sidebarPanel(dateInput("obsday", label = "測定日", language = "ja"),
                   timeInput("obstime", label = "測定時間", second = FALSE),
                   numericInput("Val", label = "測定値", value = 0),
                   hr(),
                   actionButton("register_obs", "入力内容を登録"),
                   actionButton("delete_obs", "選択項目を削除")),
      mainPanel(DTOutput("table"))    )
  )
)
server.R
library(shiny)
library(DT)
library(dplyr)

initializeMeasVal <- function () {
  df <- matrix(rep(NA, 3), nrow = 1) %>%
    data.frame() %>%
    slice(0) %>%
    setNames(c("DAY", "TIME", "Val"))
  return(df)
}

shinyServer(function (input, output, session) {
# データフレームの準備
  MeasVal <- reactiveValues(df = initializeMeasVal())

# 入力ボタンの反応
  observeEvent(input$register_obs, {
    MeasVal$df <- MeasVal$df %>%
      rbind(data.frame(DAY = input$obsday,
                       TIME = strftime(input$obstime, "%R"),
                       Val = input$Val)) %>%
      arrange(DAY, TIME)
  })
  
# 削除ボタンの反応
  observeEvent(input$delete_obs, {
    if (is.null(input$table_rows_selected)) {
      return()
    }
    
    MeasVal$df <- MeasVal$df %>%
      slice(-input$table_rows_selected) %>%
      arrange(DAY, TIME)
  })
  
# データの表示
  output$table <- renderDT(MeasVal$df %>%
                             setNames(c("測定日", "測定時間", "測定値")))
}
)

Discussion