# 【listmaker：DOIを受け取って引用文献リストを作成する関数】
# 1)フリーの統計ソフトウェア「R」で動作する関数
# 2)DOIを記載したCSVファイルを読み込むと同じディレクトリにdocxファイルを出力する
# 
# 【CSVファイルの作り方】
# 1)一行目はヘッダとする（DOIとしては参照されない）
# 2)一列目にDOIを入力する（二列目以降の情報は参照されない；https～などが付いていても可）
# 
# 【オプション】
# 1)datpath……CSVファイルのパスを指定する（指定がない場合はファイル選択ダイアログが開く）
# 2)jp……jp = Tとすると，日本語文献は日本語でリスト化する
# 3)font.size……数値を指定すると，出力のフォントサイズが変更される
# 4)font.family……英語文献のフォントを変更する（Rから参照できるフォント名にすること）
# 5)font.familyJ……日本語文献のフォントを変更する（Rから参照できるフォント名にすること）
# 
# 【使用上の注意】
# この関数は，CrossRefとJapan Link CenterのAPIを呼び出して文献情報を参照します。そのため，以下のことに注意してください。
# 1)これらのAPIが利用できない状況では動作しません（ネットワークが利用できない，サービスがメンテナンス中など）。
# 2)APIから参照できる情報に誤りや欠落があった場合には出力もそれらを反映します。
# 3)短時間で過度なアクセスを行うと使用が制限される場合があります。
#
# 【この関数の使用に関して】
# 1)このファイルのコードは，自由に使用，改変，再配布していただいて結構です。
# 2)このファイルに含まれるコードの使用によって生じるいかなる結果に関しても作成者は責任を負いかねますのでご了承ください。

# 読み込み時に必要なパッケージを呼び出す（導入されていない場合にはインストール）
req_packages <- c("rjson", "officer")
pexist <- setdiff(req_packages, rownames(installed.packages()))
if(length(pexist) != 0) install.packages(pexist)
library(rjson)
library(officer)

# メインの関数
listmaker <- function(datpath = NA, jp = FALSE, font.size = 12, font.family = "Times New Roman", font.familyJ = "ＭＳ 明朝"){
  if(is.na(datpath)) datpath <- file.choose()
  doidat <- read.csv(datpath)
  doiinfo <- sapply(gsub(" ", "", doidat[, 1]), function(x) {
    doireg <- regexpr("\\/10.*$", x, perl = TRUE)
    doistr <- substr(x, doireg[1] + 1, nchar(x))
    return(doistr)
  })
  urlheader <- "https://doi.org/"

  refdoc <- read_docx()# Wordファイルの作成
  if(jp){
    refdoc <- body_add_fpar(refdoc, fpar(ftext("引用文献", prop = fp_text(font.size = font.size, 
      font.family = "ＭＳ ゴシック")), fp_p = fp_par(text.align = "center")))# タイトル行
  }else{
    refdoc <- body_add_fpar(refdoc, fpar(ftext("References", prop = fp_text(font.size = font.size, 
      font.family = font.family)), fp_p = fp_par(text.align = "center")))# タイトル行
  }
  refdoc <- body_add_par(refdoc, "")# 空行

  reflist <- list()
  reflistJ <- list()
  refdat <- data.frame()

  # 情報の取得
  for(i in doiinfo){
    if(jp){# Japan Link Centerへのアクセス
      jsondatJ <- tryCatch({
        paste0(readLines(paste0("https://api.japanlinkcenter.org/dois/", i), warn = FALSE), collapse = "")
      }, warning = function(w) {
        NA
      })
      if(is.na(jsondatJ)){
        reflistJ <- c(reflistJ, list(NA))
      }else{
        jsonlistJ <- fromJSON(jsondatJ)
        reflistJ <- c(reflistJ, list(jsonlistJ))
      }
    }

    jsondat <- tryCatch({# Crossrefへのアクセス
      readLines(paste0("https://api.crossref.org/v1/works/", i), warn = FALSE)
    }, warning = function(w) {
      NA
    })
    if(is.na(jsondat)){
      reflist <- c(reflist, list(NA))
      anames <- NA
      myear <- NA
      modtitle <- NA
      abbrev1 <- NA
      abbrev2 <- NA
      if(jp){
        if(!is.na(jsondatJ)){# JaLCのみに情報があった場合
          enpos <- sapply(reflistJ[[i]]$data$creator_list, function(w) 
            grep("\\ben\\b", sapply(w$names, function(x) x$lang)))
          anamesJ <- paste0(mapply(function(x, y) 
            paste(x$names[[y]]$last_name, x$names[[y]]$first_name), 
            jsonlistJ$data$creator_list, enpos), collapse = ", ")
          myear <- jsonlistJ$data$publication_date$publication_year
          entlvec <- sapply(jsonlistJ$data$title_list, function(x) x$lang == "en")
          modtitle <- paste0(jsonlistJ$data$title_list[[grep("TRUE", entlvec)]]$title, 
            jsonlistJ$data$title_list[[grep("TRUE", entlvec)]]$subtitle)
          modtitle <-
          abbrev1 <- paste(gsub("& ", "", anames), myear)
          abbrev2 <- paste(abbrev1, gsub("^The |A ", "", modtitle))
        }
      }
      tmpdat <- data.frame(i, anames, myear, modtitle, abbrev1, abbrev2)
      refdat <- rbind(refdat, tmpdat)
      next
    }else{
      jsonlist <- fromJSON(jsondat)
      reflist <- c(reflist, list(jsonlist))
    }

    if(jsonlist$message$type == "book"){# 書籍の場合
      if(is.null(jsonlist$message$editor)){
        pnames <- jsonlist$message$author
        suffix <- NULL
      }else{
        pnames <- jsonlist$message$editor
        if(length(pnames) == 1){
          suffix <- " (Ed.)."
        }else{
          suffix <- " (Eds.)."
        }
      }
      anames <- sapply(1:length(pnames), function(x) 
        paste0(pnames[[x]]$family, ", ", 
        ifelse(length(grep(" ", pnames[[x]]$given)) == 0, 
          gsub("(?<=^.)(.*)(?=$)", ".", pnames[[x]]$given, perl = TRUE), 
          gsub("(?<=^.)(.*)(?=\\s)", ".", pnames[[x]]$given, perl = TRUE))))
      if(length(anames) > 1){
        anames <- paste0(c(anames[-length(anames)], paste0("& ", anames[length(anames)])), collapse = ", ")
      }
      anames <- paste0(anames, suffix)
      myear <- jsonlist$message$published$`date-parts`[[1]][1]
      titleparts <- gsub("^\\s", "", strsplit(gsub(" $", "", 
        paste(jsonlist$message$title, jsonlist$message$subtitle)), ":")[[1]])
      modtitle <- paste0(toupper(substr(titleparts, 1, 1)), tolower(substring(titleparts, 2)), collapse = ": ")
    }else if(jsonlist$message$type == "book-chapter"){# 書籍の章
      anames <- sapply(1:length(jsonlist$message$author), function(x) 
        paste0(jsonlist$message$author[[x]]$family, ", ", 
        ifelse(length(grep(" ", jsonlist$message$author[[x]]$given)) == 0, 
          gsub("(?<=^.)(.*)(?=$)", ".", jsonlist$message$author[[x]]$given, perl = TRUE), 
          gsub("(?<=^.)(.*)(?=\\s)", ".", jsonlist$message$author[[x]]$given, perl = TRUE))))
      if(length(anames) > 1){
        anames <- paste0(c(anames[-length(anames)], paste0("& ", anames[length(anames)])), collapse = ", ")
      }
      myear <- jsonlist$message$`published-print`$`date-parts`[[1]][1]
      titleparts <- gsub("^\\s", "", strsplit(gsub(" $", "", 
        paste(jsonlist$message$title, jsonlist$message$subtitle)), ":")[[1]])
      modtitle <- paste0(toupper(substr(titleparts, 1, 1)), tolower(substring(titleparts, 2)), collapse = ": ")
    }else if(jsonlist$message$type == "journal-article" | jsonlist$message$type == "proceedings-article"){# 雑誌論文・プロシーディング
      anames <- sapply(1:length(jsonlist$message$author), function(x) 
        paste0(jsonlist$message$author[[x]]$family, ", ", 
        ifelse(length(grep(" ", jsonlist$message$author[[x]]$given)) == 0, # ミドルネームの有無を判別
          gsub("(?<=^.)(.*)(?=$)", ".", jsonlist$message$author[[x]]$given, perl = TRUE), 
         gsub("(?<=^.)(.*)(?=\\s)", ".", jsonlist$message$author[[x]]$given, perl = TRUE))))
      if(length(anames) > 1){
        anames <- paste0(c(anames[-length(anames)], paste0("& ", anames[length(anames)])), collapse = ", ")
      }
      myear <- jsonlist$message$`published`$`date-parts`[[1]][1]
      titleparts <- gsub("^\\s", "", strsplit(gsub(" $", "", 
        paste(jsonlist$message$title, jsonlist$message$subtitle)), ":")[[1]])
      modtitle <- paste0(toupper(substr(titleparts, 1, 1)), tolower(substring(titleparts, 2)), collapse = ": ")
    }else{# 文書の種類が不明
      anames <- NA
      myear <- NA
      modtitle <- NA
    }

    abbrev1 <- paste(gsub("& ", "", anames), myear)
    abbrev2 <- paste(abbrev1, gsub("^The |A ", "", modtitle))
    tmpdat <- data.frame(i, anames, myear, modtitle, abbrev1, abbrev2)
    refdat <- rbind(refdat, tmpdat)
  }

  # アルファベット順に並べ替え
  reforder <- sort.list(refdat$abbrev2)
  refdat <- refdat[reforder, ]
  reflist <- reflist[reforder]
  reflistJ <- reflistJ[reforder]
  duppos <- duplicated(refdat$abbrev1) | duplicated(refdat$abbrev1, fromLast = TRUE)#著者名と発行年がすべて一致するケース
  if(any(duppos)){# 一致するケースが1つ以上あった場合
    cue <- rle(duppos)
    yearsuf <- letters[ifelse(duppos, sapply(cue$lengths, function(x) seq(1, x)), 
      sapply(cue$lengths, function(x) rep(NA, x))) |> unlist()]
    refdat$myear <- gsub("NA", "", paste0(refdat$myear, yearsuf))
  }

  # 出力タイプの判定
  outtype <- NULL
  for(i in 1:length(reflist)){
    if(all(is.na(reflist[[i]]))){# Crossrefに情報なし
      if(!jp){
        outtype <- c(outtype, "unkown")
      }else{
        if(!all(is.na(reflistJ[[i]]))){# Japan Link Centerに情報あり
          outtype <- c(outtype, "journal-article")
        }else{
          outtype <- c(outtype, "unkown")
        }
      }
    }else{# Crossrefの情報を参照
      outtype <- c(outtype, reflist[[i]]$message$type)
    }
  }

  # 出力
  for(i in 1:nrow(refdat)){
    if(outtype[i] == "book"){# 書籍の場合
      refdoc <- body_add_fpar(refdoc, fpar(
        ftext(paste0(refdat$anames[i], " (", refdat$myear[i], "). "), 
          prop = fp_text(font.size = font.size, font.family = font.family)), 
        ftext(refdat$modtitle[i], prop = fp_text(font.size = font.size, 
          font.family = font.family, italic = TRUE)), # 斜体
        ftext(paste0(". ", reflist[[i]]$message$publisher, ". ", 
          paste0(urlheader, refdat$i[i])), prop = fp_text(font.size = font.size, 
          font.family = font.family))))
    }else if(outtype[i] == "book-chapter"){# 書籍の章
      modpage <- reflist[[i]]$message$page
      cntitleparts <- gsub("^\\s", "", strsplit(reflist[[i]]$message$`container-title`, ":")[[1]])
      cnmodtitle <- paste0(toupper(substr(cntitleparts, 1, 1)), tolower(substring(titleparts, 2)), collapse = ": ")

      refdoc <- body_add_fpar(refdoc, fpar(
        ftext(paste0(refdat$anames[i], " (", refdat$myear[i], "). ", refdat$modtitle[i], 
          ". In "), prop = fp_text(font.size = font.size, font.family = font.family)), 
        ftext("XXXX (Eds.). ", prop = fp_text(font.size = font.size, 
          font.family = font.family, color = "red")), # 書籍の編著者（doiからたどれないので赤字）
        ftext(cnmodtitle, prop = fp_text(font.size = font.size, 
          font.family = font.family, italic = TRUE)), # 斜体
        ftext(paste0(" (pp. ", modpage, "). ", reflist[[i]]$message$publisher, ". ", 
          paste0(urlheader, refdat$i[i])), prop = fp_text(font.size = font.size, 
          font.family = font.family))))
    }else if(outtype[i] == "journal-article" | outtype[i] == "proceedings-article"){# 雑誌論文・プロシーディング
      jpflag <- FALSE
      if(jp & length(reflistJ[[i]]) != 1){
        if(!is.null(reflistJ[[i]]$dat$content_type)){
          if(reflistJ[[i]]$dat$content_type == "JA"){
            jpflag <- TRUE
          }
        }
      }
      if(jpflag){# 和文誌
        japos <- sapply(reflistJ[[i]]$data$creator_list, function(w) 
          grep("\\bja\\b", sapply(w$names, function(x) x$lang)))
        anamesJ <- paste0(mapply(function(x, y) 
            paste(x$names[[y]]$last_name, x$names[[y]]$first_name), 
            reflistJ[[i]]$data$creator_list, japos), collapse = "・")
        if(is.na(refdat$myear[i])){
          myear <- reflistJ[[i]]$data$publication_date$publication_year
        }else{
          myear <- refdat$myear[i]
        }
        jatlvec <- sapply(reflistJ[[i]]$data$title_list, function(x) x$lang == "ja")
        modtitleJ <- paste0(reflistJ[[i]]$data$title_list[[grep("TRUE", jatlvec)]]$title, 
          reflistJ[[i]]$data$title_list[[grep("TRUE", jatlvec)]]$subtitle)# サブタイトルの区切りの有無，形式は多様なのでデータのままにしてある
        jatvec <- sapply(reflistJ[[i]]$data$journal_title_name_list, function(x) x$type == "full" & x$lang == "ja")
        modcontainerJ <- reflistJ[[i]]$data$journal_title_name_list[[grep("TRUE", jatvec)]]$journal_title_name
        if(reflistJ[[i]]$data$volume == "advpub"){# 印刷中
          modvolume <- NULL
          modp <- NULL
          missue <- NULL
        }else{
          modvolume <- reflistJ[[i]]$data$volume
          modp <- ", "
          missue <- paste0("(", reflistJ[[i]]$data$issue, "), ")
        }
        if(grepl("[[:alpha:]]", x = reflistJ[[i]]$data$first_page)){
          if(is.null(reflistJ[[i]]$data$first_page)){
            modpage <- NULL
          }else{
            modpage <- paste0("Article ", reflistJ[[i]]$data$first_page)
          }
        }else{
          modpage <- paste0(reflistJ[[i]]$data$first_page, "-", reflistJ[[i]]$data$last_page)
        }

        refdoc <- body_add_fpar(refdoc, fpar(
          ftext(paste0(anamesJ, "（"), 
            prop = fp_text(font.size = font.size, font.family = font.familyJ)), 
          ftext(myear, prop = fp_text(font.size = font.size, font.family = font.family)), # 欧文フォント
          ftext(paste0("）．", modtitleJ, " ", modcontainerJ, modp), 
            prop = fp_text(font.size = font.size, font.family = font.familyJ)), 
          ftext(modvolume, prop = fp_text(font.size = font.size, font.family = font.family, italic = TRUE)), # 斜体
          ftext(paste0(missue, modpage, ". ", paste0(urlheader, refdat$i[i])), 
            prop = fp_text(font.size = font.size, font.family = font.family))))# 欧文フォント
      }else{# 欧文誌
        if(is.null(reflist[[i]]$message$volume)){# 巻数がない（in pressの可能性が高い）
          modp <- NULL
          missue <- NULL
        }else{
          modp <- ", "
          missue <- paste0("(", reflist[[i]]$message$issue, "), ")
        }
        if(length(grep("-", reflist[[i]]$message$page)) == 0){
          if(is.null(reflist[[i]]$message$page)){
            modpage <- NULL
          }else{
            modpage <- paste0("Article ", reflist[[i]]$message$page)
          }
        }else{
          modpage <- reflist[[i]]$message$page
        }

        refdoc <- body_add_fpar(refdoc, fpar(
          ftext(paste0(refdat$anames[i], " (", refdat$myear[i], "). ", 
            refdat$modtitle[i], ". "), prop = fp_text(font.size = font.size, font.family = font.family)), 
          ftext(paste0(reflist[[i]]$message$`container-title`), prop = fp_text(font.size = font.size, 
            font.family = font.family, italic = TRUE)), # 斜体
          ftext(modp, prop = fp_text(font.size = font.size, font.family = font.family)), 
          ftext(paste0(reflist[[i]]$message$volume), prop = fp_text(font.size = font.size, 
            font.family = font.family, italic = TRUE)), # 斜体
          ftext(paste0(missue, modpage, ". ", paste0(urlheader, refdat$i[i])), 
            prop = fp_text(font.size = font.size, font.family = font.family))))
        }
    }else{# 文書の種類が不明
      refdoc <- body_add_fpar(refdoc, fpar(ftext(paste0("Unkonwn type for doi: ", refdat$i[i]), 
        prop = fp_text(font.size = font.size, font.family = font.family, color = "red"))))
    }
  }

  print(refdoc, target = paste(dirname(datpath), "references.docx", sep = .Platform$file.sep))# ファイル出力
  cat("Completed.")
}

# crossref：サブタイトルがtitleに含まれているもの，存在するのに記載されていないもの，subtitle欄にあるものが混在
# Japan Link Center：基本的にサブタイトルが存在しても記載されていない