library(stringr) # データベース管理関数 create.card.db <- function () { data.frame() } save.card.db <- function (card.db, filename) { saveRDS(card.db, file=filename) } ### 04-0 で変更 load.card.db <- function (filename) { tryCatch(suppressWarnings(readRDS(filename)), error=function(e){ create.card.db() }) } # ユニークID生成関数 generateID <- function(timestamp) { floor(timestamp) + runif(1, 0, 1.0) } # カード操作関数 05でスタック追加 add.card <- function(card.db, front, back, category.id) { timestamp <- as.numeric(Sys.time()) id <- generateID(timestamp) list(db= rbind(card.db, list(ID=id, 表=front, 裏=back, カテゴリ=category.id, 作成日=timestamp, 更新日=0, 出題回数=0, 最終出題日=0, スタック=1), stringsAsFactors = FALSE), id=id) } update.card <- function (card.db, card.id, front, back) { index <- card.db$ID ==card.id card.db[index, "表"] <- front card.db[index, "裏"] <- back card.db[index, "更新日"] <- as.numeric(Sys.time()) card.db } delete.card <- function (card.db, card.id) { card.db[card.db$ID != card.id, ] } # スタックの移動 05で追加 MAX.STACK <- 4 move.to.next.stack <- function (card.db, card.id) { index <- card.db$ID == card.id stack <- card.db[index, "スタック"] if ( stack < MAX.STACK) card.db[index, "スタック"] <- stack + 1 card.db } ####### 02 カテゴリの実装 # カテゴリデータベース管理関数 create.category.db <- function () { data.frame() } save.category.db <- function (category.db, filename) { saveRDS(category.db, file=filename) } ### 04-0 で変更 load.category.db <- function (filename) { tryCatch(suppressWarnings(readRDS(filename)), error=function(e){ create.category.db() }) } # カテゴリの追加 add.category <- function(category.db, name, parentID) { timestamp <- as.numeric(Sys.time()) id <- generateID(timestamp) # データベースと新規作成したカテゴリのIDをリストにして返す list(db=rbind(category.db, list(ID=id, カテゴリ名=name, 親カテゴリ=parentID), stringsAsFactors = FALSE), id=id) } # カテゴリの更新 update.category <- function (category.db, id, name, parentID) { index <- category.db$ID == id category.db[index, "カテゴリ名"] <- name category.db[index, "親カテゴリ"] <- parentID category.db } # カテゴリIDでカテゴリ階層を全て抽出 get.categories.by.id <- function(category.db, id){ # parentIDの下に連なるカテゴリのIDを返す関数を作成 get.children.ids <- function(parentID) { ids <- category.db[category.db$親カテゴリ == parentID, "ID"] sub <- c() for( i in ids) { sub <- c(sub, get.children.ids(i)) } c(ids, sub) } c(id, get.children.ids(id)) } delete.category <- function (category.db, id) { del.ids <- get.categories.by.id(category.db, id) ids <- setdiff(category.db$ID, del.ids) list(db=subset(category.db, ID %in% ids), deleted=subset(category.db, ID %in% del.ids)) } ####### 04-0 アプリ用データベースの準備 # アプリ用データベースファイル名 card.db.filename <- "e:/shito/card-db.rds" cat.db.filename <- "e:/shito/category-db.rds" # アプリ専用データベース CARD.DB <- load.card.db(card.db.filename) CAT.DB <- load.category.db(cat.db.filename) ## 05 で変更 # アプリ専用カード保存関数 SAVE.CARD <- function(db=NULL) { if (!is.null(db)) assign("CARD.DB", db, envir=globalenv()) save.card.db(CARD.DB, card.db.filename) # 変更をファイルに保存 } ## 05 で変更 # アプリ専用カテゴリ保存関数 SAVE.CATEGORY <- function (db=NULL) { if (!is.null(db)) assign("CAT.DB", db, envir=globalenv()) save.category.db (CAT.DB, cat.db.filename) # 変更をファイルに保存 } ####### 04-2 カテゴリの追加機能の実装(その2) # カテゴリ一覧表示用リスト生成関数 # cat.dbを親子関係順にソート & 字下げ調整済みカテゴリ名をベクトル化 # 結果はリスト(dataとnames)にして返す. make.category.list <- function (cat.db, id=NULL) { get.children <- function(id, depth) { data <- cat.db[cat.db$ID==id, ] # カテゴリ名の前に字下げ用の空白をdepth分だけ挿入 names <- paste(paste(rep("  ", depth), collapse="", sep=""), data$カテゴリ名, sep="") for (i in which(cat.db$親カテゴリ==id)) { children <- get.children(cat.db[i, "ID"], depth+1) data <- rbind(data, children$data) names <- c(names, children$names) } list(data=data, names=names) } df <- NULL # 親子関係ソート済みcategoryのデータフレーム格納用 nm <- NULL # 字下げしたカテゴリ名格納用ベクトル if(is.null(id)) { ids <- which(cat.db$親カテゴリ == 0) } else { ids <- which(cat.db$ID == id) } for (i in ids) { res <- get.children(cat.db[i, "ID"], 0) df <- rbind(df, res$data) nm <- c(nm, res$names) } list(data=df, names=nm) } #### 05で変更 ## 選択したカテゴリIDを返す.-1はキャンセルの選択を表す. ## show.no.parent=TRUEなら0は「親カテゴリなし」 ## show.add=TRUEなら0は「カテゴリの新規追加」を表す. category.choice.menu <- function(category.list, title=NULL, show.no.parent=TRUE, show.add=FALSE) { if (is.null(title)) title="\nカテゴリを番号で選択してください(0でキャンセル)." if (show.add) { choice <- menu(c("【カテゴリの新規追加】", category.list$names), title=title) - 1 } else if (show.no.parent) choice <- menu(c("【親カテゴリなし】", category.list$names), title=title) - 1 else choice <- menu(category.list$names, title) if (choice > 0) return(category.list$data[choice, "ID"]) else if (show.no.parent || show.add) return(choice) # 0 or -1 else return(-1) } ####### 04-1 カテゴリ編集機能の実装(その1) # 新規カード(メインメニュー項目) # add.card.menu <- list(menu.title="新規カード", # fn=function() { # cat ("\n\n処理: 新規カード作成中.....\n\n") # }) ####### 04-2 カテゴリ編集機能の実装(その2) # カテゴリ編集(サブメニュー項目) add.category.menu <- list(menu.title="カテゴリの追加", fn=function() { category.list <- make.category.list(CAT.DB) cat (category.list$names, sep="\n") name <- readline("\n新規カテゴリ名: ") parent.id <- category.choice.menu(category.list, title="\n親カテゴリを番号で選択してください(0でキャンセル).", show.no.parent=TRUE) if (parent.id >= 0) { SAVE.CATEGORY( add.category(CAT.DB, name, parent.id)$db) cat("\n追加されました.\n") } }) ## カテゴリ更新(サブメニュー項目) edit.category.menu <- list(menu.title="カテゴリの更新", fn=function() { category.list <- make.category.list(CAT.DB) id <- category.choice.menu(category.list, title="\n更新するカテゴリを番号で選択してください(0でキャンセル).", show.no.parent=FALSE) if (id < 0) { cat("\n更新をキャンセルします.\n") return() # キャンセル } id <- category.list$data[id, "ID"] cat("「", category.list$names[id], "」", sep="") name <- readline("の新しいカテゴリ名: ") parent.id <- category.choice.menu(category.list, title="\n親カテゴリを番号で選択してください(0で更新キャンセル).", show.no.parent=TRUE) if (parent.id >= 0) { SAVE.CATEGORY( update.category(CAT.DB, name, id, parent.id)) cat("\n更新しました.\n") } }) ## カテゴリ削除(サブメニュー項目) delete.category.menu <- list(menu.title="カテゴリの削除", fn=function() { category.list <- make.category.list(CAT.DB) id <- category.choice.menu(category.list, title="\n削除するカテゴリを番号で選択してください(0でキャンセル).", show.no.parent=FALSE) if (id < 0) return() # キャンセル cat("\n以下のカテゴリが削除されます.", make.category.list(CAT.DB, id)$names, sep="\n") repeat { ans <- readline("\nよろしいですか?[y/n]: ") if (ans == "y") { SAVE.CATEGORY( delete.category(CAT.DB, id)$db) cat("\n削除しました.\n") break; } else if (ans == "n") { cat("\n削除をキャンセルします.\n") break; } } }) ####### リファクタリング版 # メニューを表示する関数を作成し返す make.menu.func <- function(menus, title=NULL) { # 引数をクロージャにして渡す function () { menu.items <- sapply(menus, function(x)x$menu.title) while(TRUE) { choice <- menu(menu.items, title=title) if (choice == 0) return() menus[[choice]]$fn() } } } # カテゴリ編集(メインメニュー項目) category.menus <- list(menu.title="カテゴリの編集", fn=make.menu.func( list(add.category.menu, edit.category.menu, delete.category.menu))) # 04-02 カテゴリの追加機能の実装(その2)宿題 # カテゴリ一覧(メインメニュー項目) show.category.menu <- list(menu.title="カテゴリ一覧", fn=function() { cat("\nカテゴリ一覧\n") cat( "------------\n") cat(make.category.list(CAT.DB)$names, sep="\n") cat( "------------\n") }) ####### 05 カード入力機能の実装 ##----- ヘルパー関数 -----## ## カードのサマリ表示数 ITEMS.PER.PAGE <- 20 ## カードのサマリ表示 ## ページ番号を指定するとカードのサマリ表示メニューが表示し, ## 選択されたカードのCARD.DB上のインデックスを返す. ## 何も選ばれなかった場合は0を返す. card.chooser <- function (page) { len <- nrow (CARD.DB) if (len == 0) { cat("\n表示するカードがありません\n") return(0) } cat <- CAT.DB$カテゴリ名 # カテゴリの名前付きベクトルを作成 names(cat) <- as.character(CAT.DB$ID) repeat { from <- ITEMS.PER.PAGE*(page-1)+1 to <- min(ITEMS.PER.PAGE*page, len) maxpage <- ceiling(len / ITEMS.PER.PAGE) topage <- to%%ITEMS.PER.PAGE # ページ内の実際のカード数 if (topage == 0) topage <- ITEMS.PER.PAGE cards <- CARD.DB[from:to, c("表", "裏", "カテゴリ")] cards$表 <- str_trunc(cards$表, 12, "right") cards$裏 <- str_trunc(cards$裏, 26, "right") cards$カテゴリ <- str_trunc(cat[as.character(cards$カテゴリ)], 12, "right") cat("\n------------------------------------------------\n") print.data.frame(cards, right=FALSE) cat("\n------------------------------------------------\n") if (page == 1 && page == maxpage) # 1ページ目かつ最終ページ prompt <- "[カード番号/キャンセル(c)] > " else if (page == 1) # 1ページ目 prompt <- "[番号/次ページ(n)/キャンセル(c)] > " else if (page == maxpage) # 最終ページ prompt <- "[番号/前ページ(p)/キャンセル(c)] > " else prompt <- "[番号/前ページ(p)/次ページ(n)/キャンセル(c)] > " repeat { choice <- readline(prompt) if (grepl("^[[:digit:]]{1,2}$", choice)) { num <- as.integer(choice) if (0 < num && num <= topage) return (from + num - 1) # CARD.DB内のインデックスを返す } if (choice == "p" && 1 < page) { page <- page - 1 break } if (choice == "n" && page < maxpage) { page <- page + 1 break } if (choice == "c") { return (0) } } } } ## CARD.DB内のインデックス番号を取り,カードデータの詳細を画面表示する. print.card.detail <- function (index) { row <- CARD.DB[index,] df <- t(row) df["カテゴリ", 1] <- as.character( subset(CAT.DB, ID == row$カテゴリ, select=カテゴリ名)) get.data.string <- function (colname) { time <- row[1, colname] if (time == 0) return ("") as.character(as.POSIXlt(time, origin="1970-01-01")) } df["作成日", 1] <- get.data.string("作成日") df["更新日", 1] <- get.data.string("更新日") df["最終出題日", 1] <- get.data.string("最終出題日") print(df) } ## CARD.DB内のインデックス番目のカードを更新する. edit.card <- function (index) { repeat { front <- readline(prompt="\n表面を記入してください: ") back <- readline(prompt="裏面を記入してください: ") category.list <- make.category.list(CAT.DB) cat.id <- category.choice.menu(category.list, show.add=TRUE, title="カテゴリを番号で選択してください(0で変更なし).") if (cat.id == 0) cat.id <- add.category.menu$fn() ## 最終確認 repeat { choice <- readline( prompt="変更を保存しますか?[はい(y)/いいえ(n)/キャンセル(c)] > ") if (choice == "n") break if (choice == "c") return (NULL) if (choice == "y") { CARD.DB[index, "表"] <- front CARD.DB[index, "裏"] <- back if (cat.id > 0) CARD.DB[index, "カテゴリ"] <- cat.id CARD.DB[index, "更新日"] <- as.numeric(Sys.time()) SAVE.CARD(CARD.DB) return (NULL) } } } } ## CARD.DB内のインデックス番号を取り,カードデータの詳細画面を ## ブラウズする.ブラウズ中にカード編集画面にも遷移する. ## 返り値は現在のカードに対応するサマリ表示ページ番号. ## 存在しないカードが指定された場合,ページ番号0を返す. browse.card.details <- function (index) { len <- nrow(CARD.DB) ## カード削除の確認と削除を担うローカル関数を定義 ## Closureにより外側のindexにアクセスできる.ただし,copy-on-modify ## ルールにより書き込みはできない. ## 0を返した場合削除なし,1を返した場合削除成功. delete.card.prompt <- function () { repeat { choice <- readline(prompt="このカードを本当に削除してよろしいですか?[y/n] > ") if (choice == "n") return (0) if (choice == "y") { SAVE.CARD(CARD.DB[-index,]) return (1) } } } repeat { if (len == 0 || index > len) {# 削除後にカードがなくなった場合len==0 cat("\n表示するカードがありません\n") return (0) } cat("----------------------------------\n") print.card.detail(index) cat("----------------------------------\n") if (index == 1 && index == len) # 1番目かつ最終カード prompt <- "[編集(e)/削除(d)/一覧へ戻る(c)] > " else if (index == 1) # 1番目 prompt <- "[編集(e)/削除(d)/次のカード(n)/一覧へ戻る(c)] > " else if (index == len) # 最終カード prompt <- "[編集(e)/削除(d)/前のカード(p)/一覧へ戻る(c)] > " else prompt <- "[編集(e)/削除(d)/前のカード(p)/次のカード(n)/一覧へ戻る(c)] > " repeat { choice <- readline(prompt) if (choice == "e") { edit.card(index) break } if (choice == "p" && 1 < index) { index <- index - 1 break } if (choice == "n" && index < len) { index <- index + 1 break } if (choice == "d") { if (delete.card.prompt() == 1) len <- len - 1 if (index > len) index <- index - 1 break } if (choice == "c") { ## index番号からサマリ表示画面のページ番号を計算 return (ceiling(index/ITEMS.PER.PAGE)) } } } } ## 新規カード(メインメニュー項目) add.card.menu <- list( menu.title="新規カード", fn=function() { front <- readline(prompt="\n表面を記入してください: ") back <- readline(prompt="裏面を記入してください: ") category.list <- make.category.list(CAT.DB) cat.id <- category.choice.menu(category.list, show.add=TRUE) if (cat.id == 0) cat.id <- add.category.menu$fn() else if (cat.id < 0) return SAVE.CARD(add.card(CARD.DB, front, back, cat.id)$db) }) ## カードの編集・削除(メインメニュー項目) edit.card.menu <- list( menu.title="カードの編集・削除", fn=function() { page <- 1 repeat { choice <- card.chooser(page) if (choice == 0) break page <- browse.card.details(choice) if (page == 0) break } }) # アプリ起動関数 run.app <- make.menu.func(list(add.card.menu, category.menus, edit.card.menu, show.category.menu), title="\nメインメニュー (0で終了)") # アプリを起動 run.app()