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でスタック追加 06で正解数追加
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,
                    最終出題日=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
## 06で修正
## 与えられたcard.idのカードの正・誤とスタックを更新し，
## 変更後のカードデータベースを返す．
mark.card <- function (card.db, card.id, is.correct) {
    index <- card.db$ID == card.id
    card <- card.db[index,]
    if (is.correct) {
        card$正解数 <- card$正解数 + 1
        stack <- card$スタック
        if ( stack < MAX.STACK)
            card$スタック <- stack + 1
    } else {
        card$スタック <- 1
    }
    card$出題回数 <- card$出題回数 + 1
    card$最終出題日 <- as.numeric(Sys.time())
    card.db[index, ] <- card
    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 <- "~/Documents/git-repositories/R-programming-lecnote/flashcard/card-db.rds"
cat.db.filename <- "~/Documents/git-repositories/R-programming-lecnote/flashcard/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 カテゴリの追加機能の実装（その２）

# カテゴリ一覧表示用リスト生成関数
#    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 & 06で変更
## 選択したカテゴリIDを返す．-1はキャンセルの選択を表す．
## show.no.parent=TRUEなら0は「親カテゴリなし」
## show.add=TRUEなら0は「カテゴリの新規追加」を表す．
## add.choiceに文字列が指定されたら，選択肢のトップにそれを表示する．
## この場合，show.no.parent引数は無視される．
category.choice.menu <- function(category.list, title=NULL, show.no.parent=TRUE,
                                 show.add=FALSE, add.choice=NULL) {
    if (is.null(title))
        title="\nカテゴリを番号で選択してください（0でキャンセル）．"
    if (is.null(add.choice)) {
        if(show.add)
            add.choice <- "【カテゴリの新規追加】"
        else if (show.no.parent)
            add.choice <- "【親カテゴリなし】"
    }
        
    if (is.null(add.choice))
        choice <- menu(category.list$names, title)
    else
        choice <- menu(c(add.choice, category.list$names),
                       title=title) - 1
    if (choice > 0)
        return(category.list$data[choice, "ID"])
    else if (is.null(add.choice))
        return (-1)
    else
        return(choice)   # 0 or -1
}

####### 04-1 カテゴリ編集機能の実装（その１）

# 新規カード（メインメニュー項目）

# add.card.menu <- list(menu.title="新規カード",
#                       fn=function() {
#                           cat ("\n\n処理: 新規カード作成中.....\n\n")
#                       })

####### 04-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 カテゴリの追加機能の実装（その２）宿題
# カテゴリ一覧（メインメニュー項目）
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) # １ページ目かつ最終ページ
            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) # １番目かつ最終カード
            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
        }
    })

####### 06 テスト機能の実装

## スタック抽出関数
draw.stack <- function() {
    x <- runif(n=1, min=0, max=1)  # 一様分布から乱数を生成
    if (x < 0.5)  return(1)
    if (x < 0.8)  return(2)
    if (x < 0.95) return(3)
    return(4)
}

## スタック番号とカテゴリIDを取り，出題回数の少ない順に並べた
## データフレームを返す．スタックが空の場合はNULLを返す．
## カテゴリID引数にNULLが指定された場合，全てのカードが対象になる．
create.card.pool <- function(stack.num, category.id=NULL) {
    if (is.null(category.id))
        df <- subset(CARD.DB, スタック==stack.num)
    else
        df <- subset(CARD.DB, スタック==stack.num && カテゴリ==category.id)
    if (nrow(df)==0)
        return(NULL)
    df[order(df$出題回数, decreasing=FALSE),]
}

## カードを出題回数の少ない順にランダムに抽出する関数を返す．
## category.idがNULLの場合，全てのカテゴリからカードを抽出する．
## [使い方]
##     drawer <- get.card.drawer(cat.id)
##     drawer()
get.card.drawer <- function(category.id) {
    ## 出題用temporaryスタックを作成
    stack <- lapply(1:4, create.card.pool, category.id)
    if (all(sapply(stack, is.null))) {
        cat("\n------------------------------------------")
        cat("\n指定されたカテゴリにはカードがありません．")
        cat("\n------------------------------------------\n")
        return(NULL)
    }
    draw.next.card <- function() {
        repeat {
            s <- draw.stack()
            df <- stack[[s]]
            if (!is.null(df))
                break
        }
        obj.name <- paste("stack[", s, "]", sep="")
        ## 空ならtemporaryスタックを作り直す
        if (nrow(df) == 0) {
            df <- create.card.pool(s, category.id)
            assign(obj.name, df, envir=parent.env(environment()))
        }
        candidates <- subset(df, 出題回数==df[1,"出題回数"])
        i <- sample(1:nrow(candidates), size=1)
        ## 出題するカードをtemporaryスタックから削除
        assign("stack", `[[<-`(get('stack'), s, value=df[-i,]),
               envir=parent.env(environment()))
        #----- For Debugging ----
        # cat("\n----\n")
        # print(stack[[s]])
        # cat("----\n")
        return(df[i,])
    }
    return(draw.next.card) # 関数を返す
}

## データフレームの1行を受け取り，is.front.firstがTなら
## 表から，FALSEなら裏から表示する．
flash <- function (card, is.front.first) {
    disp <- ifelse(is.front.first,
                    paste("表:", card$表),
                   paste("裏:", card$裏))
    cat("-------------------\n")    
    cat(disp, "\n")
    readline("-------------------")
    disp <- ifelse(is.front.first,
                   paste("裏:", card$裏),
                   paste("表:", card$表))
    cat(disp, "\n")
    cat("-------------------\n")
}

## フラッシュカード（メインメニュー項目）
flash.menu <- list(
    menu.title="学習",
    fn=function() {
        ## 正解・不正解を処理するローカル関数．終了なら-1を返す．
        judge.prompt <- function (card.id) {
            repeat {
                choice <- readline("正解[リターンキー]/不正解[n]/終了[q] > ")
                if (str_length(choice)==0 || choice=="n" || choice=="q")
                    break
            }
            if (str_length(choice)==0) { # 正解
                SAVE.CARD(mark.card(CARD.DB, card.id, is.correct=TRUE))
                return(1)
            } else if (choice == "n") { # 不正解
                SAVE.CARD(mark.card(CARD.DB, card.id, is.correct=FALSE))       
                return(1)
            } else
                return(-1)
        }
        ## カテゴリの選択
        cat.id <- category.choice.menu(make.category.list(CAT.DB),
                                       add.choice="【全カテゴリ】")
        if (cat.id < 0)
            return ()
        else if (cat.id == 0)
            cat.id <- NULL
        ## 表・裏の選択
        is.front.first <- TRUE
        ## 学習開始
        drawer <- get.card.drawer(cat.id)
        if (is.null(drawer))
            return ()
        repeat {
            card <- drawer()
            flash(card, is.front.first)
            if (judge.prompt(card$ID) < 0)
                break # 学習終了
        }
    })

## 06
## スタックのヒストグラムを表示．
show.stack.menu <- list(
    menu.title="スタックを表示",
    fn=function() {
        hist(CARD.DB$スタック, breaks=c(0, 1, 2, 3, 4), freq=FALSE)
    })

# アプリ起動関数
run.app <- make.menu.func(list(flash.menu,
                               add.card.menu, category.menus,
                               edit.card.menu, show.category.menu,
                               show.stack.menu),
                           title="\nメインメニュー （0で終了）")

# アプリを起動
run.app()