# GiNZAをRから使う関数
# 以下の条件を満たすマシンでのみ動作する
# 1) reticulateパッケージを導入済み
# 2) pythonを導入済み
# 3) pythonでja_ginza/ja_ginza_electraを導入済み
# 動作しているpython環境，バージョンの確認にはreticulateパッケージのpy_config()関数を用いる
#
# 【オプション】
# mode：A，B，C（語の区切りが短，中，長）
# dic：small，core，full（辞書のサイズ；それぞれに対応するsudachidictを予めインストールしておく必要がある；GiNZAの学習にはcoreが使われているので，公式にはcoreの使用が推奨されている）
#
# 【バージョン情報】
# 1) 1.0.0（2023/8/7公開）
# 2) 1.1.0（2024/8/16公開）
# ・ginent関数のaddオプションのエラーを修正
# 3) 1.2.0（2025/9/16公開）
# ・ベクトル形式の入力に対応
# ・IDを1はじまりに変更
# ・ginbun関数の出力を拡張
# ・depplot関数，buncuts関数，gincho関数，ginkou関数を追加


# SpacyとGiNZAを設定する関数
setSpacy <- function(mode = "C", dic = "core", model = "ja_ginza"){
    spacypy <- reticulate::import(module = "spacy")
    ginzapy <- reticulate::import(module = "ginza")
    sudachipy <- reticulate::import(module = "sudachipy")
    tokenizer_obj <- sudachipy$dictionary$Dictionary(dict_type = dic)$create()

    nlp <- spacypy$load(model)
    nlp$tokenizer$tokenizer <- tokenizer_obj
    ginzapy$set_split_mode(nlp, mode)
    return(list(ginzapy = ginzapy, nlp = nlp))
}


# メイン関数
# target：分析対象となる文字列
# 入力がベクトルであった場合には，要素ごとにidを付与
ginzaru <- function(target, mode = "C", dic = "core", model = "ja_ginza"){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    if(length(target) == 1){
        doc <- nlp(target)
        analyzedmat <- do.call("rbind", lapply(1:length(doc), function(x) getToken(doc[x-1])))
    }else{
        doc <- lapply(target, nlp)
        doc <- doc[sapply(doc, length) != 0]# 空レコードを除外
        analyzedmat <- do.call("rbind", mapply(function(v, w) cbind("id" = w, do.call("rbind", lapply(1:length(v), function(x) getToken(v[x-1])))), doc, 1:length(doc), SIMPLIFY = FALSE))
    }

    analyzeddat <- as.data.frame(analyzedmat)
    return(analyzeddat)
}


# docからトークン情報を取り出す関数
getToken <- function(res_part){
    inft <- res_part$morph$get("Inflection")
    tokenv <- c("no" = res_part$i + 1, 
#        "Orth" = res_part$orth_, 
        "Text" = res_part$text, 
        "Lemma" = res_part$lemma_, 
        "POS" = res_part$pos_, 
        "Tag" = res_part$tag_, 
        "Inflection" = replace(inft, typeof(inft) == "list", NA)[[1]], 
        "Reading" = paste0(res_part$morph$get("Reading"), collapse = ""), 
        "Norm" = res_part$norm_, 
        "Shape" = res_part$shape_, 
        "Alpha" = res_part$is_alpha, 
        "SpaceAfter" = res_part$whitespace_ == " ", 
#        "Punct" = res_part$is_punct, 
#        "Quote" = res_part$is_quote, 
        "Stop" = res_part$is_stop, 
        "Dep" = res_part$dep_, 
        "Head" = res_part$head$text, 
        "HeadID" = res_part$head$i + 1, 
        "children" = paste0("[", paste(reticulate::iterate(res_part$children, f = function(x) x$text), collapse = ", "), "]"))
    return(tokenv)
}


# MeCab式の解析結果を返す関数
# target：分析対象となる文字列
# 入力がベクトルであった場合には，要素ごとにidを付与
ginzame <- function(target, mode = "C", dic = "core", model = "ja_ginza"){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    if(length(target) == 1){
        doc <- nlp(target)
        analyzedmat <- do.call("rbind", lapply(1:length(doc), function(x) getToken2(doc[x-1])))
    }else{
        doc <- lapply(target, nlp)
        doc <- doc[sapply(doc, length) != 0]# 空レコードを除外
        analyzedmat <- do.call("rbind", mapply(function(v, w) cbind("id" = w, do.call("rbind", lapply(1:length(v), function(x) getToken2(v[x-1])))), doc, 1:length(doc), SIMPLIFY = FALSE))
    }

    analyzeddat <- as.data.frame(analyzedmat)
    return(analyzeddat)
}


# docからトークン情報を取り出す関数2（ginzame用）
getToken2 <- function(res_part){
    inft <- res_part$morph$get("Inflection")
    if(typeof(inft) == "list"){
        inftv <- c(NA, NA)
    }else{
        inftv <- strsplit(inft, ";")[[1]]
    }
    posv <- strsplit(res_part$tag_, "-")[[1]]
    posvsup <- c(posv, rep(NA, 4 - length(posv)))
    tokenv <- c("Surface_Value" = res_part$text, 
        "Part_of_Speech" = posvsup[1], 
        "Part_of_Speech1" = posvsup[2], 
        "Part_of_Speech2" = posvsup[3], 
        "Part_of_Speech3" = posvsup[4], 
        "Conjugation" = inftv[1], 
        "Inflection" = inftv[2], 
        "Root_Form" = res_part$norm_,
        "Reading" = paste0(res_part$morph$get("Reading"), collapse = ""), 
        "Pronunciation" = NA)
    return(tokenv)
}


# ginzaruの出力オブジェクトをグラフにする関数
# ginzaru()の出力を入力として受け取る
# textplotパッケージが必要
depplot <- function(res, ...){
    req_packages <- c("textplot", "ggraph", "igraph")
    pexist <- setdiff(req_packages, rownames(installed.packages()))
    if(length(pexist) != 0) install.packages(pexist)

    names(res) <- gsub("Dep", "dep_rel", gsub("HeadID", "head_token_id", 
        gsub("Tag|XPOS", "xpos", gsub("POS|UPOS", "upos", gsub("Text", "token", 
        gsub("no", "token_id", names(res)))))))
    res <- cbind(sentence_id = 1, res)
    textplot::textplot_dependencyparser(res, ...)
}


# 文ごとに分割する関数
# target：分析対象となる文字列
ginsep <- function(target, mode = "C", dic = "core", model = "ja_ginza"){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    if(length(target) == 1){
        doc <- nlp(target)
        sentences <- reticulate::iterate(doc$sents)
    }else{
        doc <- lapply(target, nlp)
        sentences <- lapply(doc, function(x) reticulate::iterate(x$sents))
    }

    return(sentences)
}


# 固有表現抽出を行う関数
# target：分析対象となる文字列
# add：追加で判定したい固有表現を挙げたデータフレームを指定する；このデータフレームには，一列目にlabel，二列目にpatternを並べる
ginent <- function(target, mode = "C", dic = "core", model = "ja_ginza", add = NULL){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp
    ginzapy$set_split_mode(nlp, mode)

    # ルール追加
    if(!is.null(add)){
        ruler <- nlp$add_pipe("entity_ruler")
        ruler$overwrite <- TRUE
        ruler$add_patterns(apply(add, 1, function(x) reticulate::dict("label" = x[1], "pattern" = x[2])))
    }

    # 解析
    entlab <- c("Text", "Label", "StartChar", "EndChar")
    if(length(target) == 1){
        doc <- nlp(target)
        entmat <- do.call("rbind", lapply(doc$ents, function(x) c(x$text, x$label_, x$start_char, x$end_char)))
    }else{
        doc <- lapply(target, nlp)
        doc <- doc[sapply(doc, length) != 0]# 空レコードを除外
        entlist <- mapply(function(v, w) cbind("id" = w, do.call("rbind", lapply(v$ents, function(x) c(x$text, x$label_, x$start_char, x$end_char)))), doc, 1:length(doc), SIMPLIFY = FALSE)
        entmat <- do.call("rbind", entlist[sapply(entlist, length) != 1])# 空レコードを除外
        entlab <- c("id", entlab)
    }

    if(is.null(entmat)){
        return(NA)
    }else{
        entdat <- as.data.frame(entmat)
        colnames(entdat) <- entlab
        return(entdat)
    }
}


# 文節に分ける関数
# target：分析対象となる文字列
ginbun <- function(target, mode = "C", dic = "core", model = "ja_ginza", position = FALSE){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    if(length(target) == 1){
        doc <- nlp(target)
        if(position){
            bout <- ginzapy$bunsetu_position_types(doc)
        }else{
            bunsetsu <- ginzapy$bunsetu_spans(doc)
            phspan <- ginzapy$bunsetu_phrase_spans(doc)
            bdat <- data.frame("Text" = sapply(bunsetsu, function(x) x$text), 
                "Label" = sapply(bunsetsu, function(x) x$label_), 
                "Head" = sapply(phspan, function(x) x$text), 
                "Head_Lemma" = sapply(phspan, function(x) x$lemma_))

            sents <- reticulate::iterate(doc$sents)
            sp_part <- lapply(sents, function(x) ginzapy$sub_phrases(x$root, ginzapy$bunsetu))
            root_part <- lapply(sents, function(x) list("root", ginzapy$bunsetu(x$root)))
            ddat <- do.call("rbind", c(sp_part[[1]], root_part)) |> as.data.frame()
            names(ddat) <- c("dep", "bunsetsu")

            bout <- list(bdat, ddat)
        }
    }else{
        doc <- lapply(target, nlp)
        if(position){
            bout <- lapply(doc, function(x) ginzapy$bunsetu_position_types(x))
        }else{
            bunsetsu <- lapply(doc, function(x) ginzapy$bunsetu_spans(x))
        }
    }
    return(bout)
}


# 名詞句を取り出す関数
# target：分析対象となる文字列
ginnoun <- function(target, mode = "C", dic = "core", model = "ja_ginza"){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    if(length(target) == 1){
        doc <- nlp(target)
        nouns <- reticulate::iterate(doc$noun_chunks)
    }else{
        doc <- lapply(target, nlp)
        nouns <- lapply(doc, function(x) reticulate::iterate(x$noun_chunks))
    }
    return(nouns)
}


# 長単位相当の解析結果を返す関数
# target：分析対象となる文字列
# mixed：TRUEを指定すると長短混合形式のデータフレームを出力する
# 入力文字列は予め一文ごとに分けておく（一要素につきひとつのROOTを判定）
# 一文ずつに分けた文字列をベクトルとして連結した入力は可
gincho <- function(target, mode = "C", dic = "core", model = "ja_ginza", mixed = FALSE){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    if(length(target) == 1){
        doc <- nlp(target)
        chodat <- tan2cho(doc, ginzapy = ginzapy, mixed = mixed)
    }else{
        doc <- lapply(target, nlp)
        gres <- lapply(doc, function(x) tan2cho(x, ginzapy = ginzapy, mixed = mixed))
        chodat <- do.call("rbind", lapply(1:length(gres), function(x) cbind(id = x, gres[[x]])))
    }

    return(chodat)
}


# ベクトル中の最大値の位置を返すが，タイの場合は最後にヒットした位置を返す関数
which.max.last <- function(vec){
    mvec <- which(vec == max(vec))
    return(mvec[length(mvec)])
}


# 短単位形式の出力を長単位形式の出力に変換する関数
tan2cho <- function(doc, ginzapy = NULL, mixed = FALSE){
    # 解析結果の展開
    analyzedmat <- do.call("rbind", lapply(1:length(doc), function(x) getToken(doc[x-1])))
    analyzeddat <- as.data.frame(analyzedmat)
    maxelem <- length(doc)
    ptext <- analyzeddat$Text
    plemma <- analyzeddat$Lemma
    txnorm <- analyzeddat$Norm
    headid <- analyzeddat$HeadID |> as.numeric()
    posvec <- analyzeddat$POS
    suw_tag <- analyzeddat$Tag
    infvec <- analyzeddat$Inflection
    pdep <- analyzeddat$Dep
    shapevec <- analyzeddat$Shape
    stopvec <- analyzeddat$Stop
    spaceafter <- analyzeddat$SpaceAfter
    alphatexts <- grep("[A-Za-z]+$", ptext)
    punctpos <- which(posvec == "PUNCT")
    numpos <- which(posvec == "NUM")
    sympos <- which(posvec == "SYM")
    adppos <- which(posvec == "ADP")
    verbpos <- which(posvec == "VERB")
    suruverb <- c(intersect(grep("サ行変格", infvec), 
        intersect(c(grep("^NOUN$|^VERB$|^ADV$", posvec), grep("普通名詞", suw_tag)), 
            grep(FALSE, stopvec)) + 1), # 「〇〇をする」などのサ変動詞に語幹が隣接しない場合は含めない
        intersect(c(which(posvec == "AUX" & txnorm == "出来る"), 
            which(posvec == "AUX" & txnorm == "易い"), 
            which(posvec == "VERB" & txnorm == "致す"), 
            which(posvec == "VERB" & txnorm == "為さる"), 
            which(posvec == "VERB" & txnorm == "過ぎる"), 
            which(posvec == "AUX" & txnorm == "頂く")), 
            grep("^NOUN$|^VERB$|^ADJ$|^ADV$|^AUX$", posvec) + 1)) |> sort()

    # 文節情報の取得
    bpostype <- ginzapy$bunsetu_position_types(doc)
    bheadpos <- ginzapy$bunsetu_head_list(doc) |> unlist() + 1# 文節の主辞となる要素の番号
    bilabel <- ginzapy$bunsetu_bi_labels(doc)
    bunstartpos <- which(bilabel == "B")# 文節の始点となる要素の番号
    brange <- rep(1:length(bunstartpos), diff(unique(c(bunstartpos, maxelem + 1))))

    phspan <- ginzapy$bunsetu_phrase_spans(doc)
    hstarts <- sapply(phspan, function(x) x$start + 1)# 主辞開始位置
    cstarts <- sapply(phspan, function(x) x$end + 1)# 付属語開始位置
    buntype <- sapply(phspan, function(x) x$label_)# 文節の種類

    # 複合語の結合
    cbase <- rep(1, maxelem)
    compos <- grep("^compound$", pdep)
    comchk <- stopvec[headid[compos]] == TRUE
    comsel <- setdiff(compos[!comchk], setdiff(which(stopvec == TRUE), grep("接頭辞|接尾辞", suw_tag)))
    comzone <- lapply(comsel, function(x) headid[x]:x |> sort())
    comzonechk <- lapply(comzone, function(x) any(pdep[x] %in% c("aux", "fixed"))) |> unlist()
    comzone[comzonechk] <- comsel[comzonechk]
    casepos <- grep("^case$", pdep)
    markpos <- grep("^mark$", pdep)
    naipos <- which(txnorm == "無い" & stopvec == TRUE)
    postadj <- which(pdep == "obj" & posvec == "ADJ")# 形容詞が後続要素になる場合
    casechk <- sapply(comzone, function(x) any(x %in% casepos))
    auxnoun <- intersect(grep("NOUN", posvec), grep("AUX", posvec) + 1)# 助動詞の直後に名詞が来る場合
    compsuff <- lapply(comzone[!casechk], function(x) tail(x, -1)) |> unlist()
    compsuff <- setdiff(compsuff, setdiff(grep("advcl", pdep), naipos))
    kutenpos <- setdiff(grep("句点", suw_tag), c(numpos - 1, numpos + 1))# 数値に挟まれている場合は小数点の可能性がある
    parenpos <- grep("括弧", suw_tag)
    compsuff <- setdiff(compsuff, c(auxnoun, postadj, setdiff(punctpos, kutenpos), parenpos + 1))# 記号その他は複合語の一部にしない（句読点は略語を表すピリオドとして使われることがある）
    cbase[compsuff] <- 0

    tcasepos <- intersect(markpos + 1, casepos)
    cbase[tcasepos[headid[tcasepos] %in% markpos]] <- 0# mark-caseの系列を前者が後者のheadである場合のみ結合

    # NOUN・PROPNが直接連続する場合は文節境界を超えて結合；数詞もいったん名詞に結合
    nouncand <- posvec %in% c("NOUN", "PROPN", "NUM") | (grepl("接頭辞|接尾辞", suw_tag) & posvec %in% c("PART", "ADP"))
    compnum <- which(pdep %in% c("compound", "nummod", "dep", "fixed"))
    nouncand[intersect(sympos, compnum)] <- TRUE# 複合語の一部としての記号を含める
    nounseq <- which(c(FALSE, diff(nouncand) == 0) & nouncand & !grepl("形状詞", suw_tag))# 名詞連続の2つ目以降の位置；形状詞は除く
    ntagseq <- which(c(FALSE, diff(grepl("^名詞", suw_tag)) == 0) & grepl("^名詞", suw_tag))# Tagで名詞と判定されている箇所
    nounseq <- c(nounseq, setdiff(ntagseq, c(which(stopvec == TRUE) + 1, suruverb - 1))) |> unique()
    nadv <- setdiff(grep("副詞", suw_tag) + 1, grep("名詞|接頭辞", suw_tag, invert = TRUE))# 副詞的用法であれば名詞句に結合しないはず
    obladjv <- intersect(grep("obl", pdep), grep("形状詞可能", suw_tag)) + 1
    nwsv <- grep("助数詞", suw_tag) + 1
    nounseq <- setdiff(nounseq, c(nadv, nwsv, obladjv, which(stopvec == TRUE & headid != 0:(maxelem - 1) & !(headid %in% grep("ROOT", pdep)))) |> unique())
    cbase[nounseq] <- 0

    crosssuff <- intersect(nounseq, which(suw_tag == "接尾辞-名詞的-一般" & stopvec == TRUE) + 1)
    crosssuff <- crosssuff[headid[crosssuff] == headid[crosssuff - 1]]
    crosspre <- intersect(grep("接頭辞", suw_tag), grep("接尾辞", suw_tag) + 1)
    geopos <- grep("地名", suw_tag)
    dgeo <- setdiff(geopos[c(FALSE, diff(geopos) == 1)], grep("NOUN", posvec) - 1)# 地名連続を結合しない
    dtail <- intersect(dgeo + 1, grep("PROPN", posvec))
    cbase[c(crosssuff, crosspre, dgeo, dtail)] <- 1

    addadj <- intersect(which(posvec == "ADJ") + 1, which(grepl("接尾辞", suw_tag) & pdep %in% c("nsubj", "obj", "iobj")))
    addadj2<- intersect(which(suw_tag == "形状詞-一般" & pdep != "advcl") + 1, grep("^NOUN$", posvec))
    addadv <- intersect(nadv, which(grepl("接尾辞|助数詞", suw_tag) & pdep == "advcl"))
    cbase[c(addadj, addadj2, addadv)] <- 0

    oblv <- grep("obl", pdep) + 1
    cbase[intersect(intersect(which(posvec == "NOUN" & suw_tag == "副詞") + 1, oblv), which(stopvec == TRUE))] <- 0# 名詞と助詞で副詞を形成する場合

    cbase[intersect(which(pdep == "amod" & suw_tag == "形状詞-一般") + 1, which(pdep == "nmod"))] <- 0

    # 付属語部分の処理
    fixpos <- which(pdep == "fixed")
    if(length(fixpos) > 0){
        nonfixpos <- which(pdep != "fixed")
        ccoppos <- which(pdep %in% c("cop", "compound"))
        tposv <- headid[fixpos]# fixedの親要素
        criteria <- !(posvec[tposv] == "SCONJ" & posvec[fixpos] == "VERB" & !grepl("非自立", suw_tag[fixpos]))
        dupchk <- sapply(fixpos, function(x) (sum(pdep[brange == brange[x]] == "aux") > 1) & 
            (sum(pdep[brange == brange[x]] == "cop") > 0)) & (tposv %in% ccoppos)# copを含む文節中にauxがあるか
        auxchk <- sapply(fixpos, function(x) sum(brange == brange[x] & pdep %in% c("aux", "mark", "ROOT"))) > 1 & pdep[tposv] %in% c("aux", "ROOT")
        cbase[fixpos[criteria & !dupchk & !auxchk]] <- 0
    }

    dearupos <- intersect(grep("だ", txnorm) + 1, grep("有る", txnorm))
    dearupos <- dearupos[headid[dearupos] == dearupos - 1]
    cbase[dearupos] <- 0

    kudasaipos <- intersect(intersect(grep("下さる", txnorm), grep("動詞-非自立可能", suw_tag)), 
        grep("^ADP$", posvec, invert = TRUE) + 1)
    cbase[kudasaipos] <- 0

    tekurupos <- setdiff(intersect(grep("て", txnorm) + 1, grep("来る", txnorm)), c(fixpos + 1, which(stopvec == FALSE)))
    cbase[tekurupos] <- 0
    if(length(tekurupos) > 0){
        for(i in tekurupos){
            if(posvec[i - 2] == "VERB" & headid[i] != i - 1){
                headid[i - 2] <- headid[i]
                headid[headid == i] <- i - 2
                if(pdep[i] == "ROOT") pdep[i - 2] <- "ROOT"
                headid[i] <- i - 2
                headid[i - 1] <- i - 2
                pdep[i] <- "aux"
            }
        }
    }

    advclpos <- which(pdep == "advcl")
    conadpos <- advclpos[-1][diff(advclpos) == 1]# advclが連続する場合の後続位置
    hdchk <- headid[conadpos] == conadpos - 1# 結合先が親要素の場合のみ結合
    cbase[conadpos[hdchk]] <- 0

    nverbpos <- grep("^動詞-非自立可能$", suw_tag)
    cbase[verbpos[-1][diff(verbpos) == 1 & diff(brange[verbpos]) == 0]] <- 0# 同一文節内での動詞連続
    cbase[intersect(verbpos + 1, nverbpos)] <- 0# 動詞に非自立可能が後続
    cbase[nverbpos[-1][diff(nverbpos) == 1]] <- 0# 非自立可能の動詞が連続する場合

    # する動詞の動詞部分は語幹に結合
    cbase[suruverb] <- 0
    posvec[suruverb - 1] <- ifelse(txnorm[suruverb] == "易い", "ADJ", "VERB")

    # 接頭辞のみの長単位ができないようにする
    prefpos <- grep("接頭辞", suw_tag)
    cbase[pmin(prefpos + 1, maxelem)] <- 0

    # 接尾辞のみの長単位ができないようにする
    suffpos <- grep("接尾辞", suw_tag)
    cbase[setdiff(suffpos, c(1, verbpos))] <- 0

    # 数を表す要素の前で切る
    numposad <- c(numpos, grep("^d", shapevec)) |> unique()# NUMに数詞扱いでないが形態素のはじまりが数であるものを追加
    prenum <- intersect(prefpos, numposad - 1)# 数の直前に接頭辞がある箇所
    nreppos <- which(posvec == "NUM" & suw_tag == "名詞-数詞")
    nrep <- head(nreppos, -1)[diff(nreppos) == 1]# 数詞が連続する箇所
    nrzone <- c(nrep, nrep + 1) |> unique() |> sort()
    alphasuff <- pmin(alphatexts + 1, maxelem)# 末尾がアルファベットの要素に後続する要素
    nondigits <- intersect(grep("PROPN", posvec) + 1, grep("^d", shapevec, invert = TRUE))
    cbase[setdiff(numposad, c(prenum + 1, nrzone, alphasuff, nondigits))] <- 1

    fractpos <- grep("^分$", txnorm)
    fractpos <- fractpos[intersect(fractpos + 1, grep("^の$", txnorm))]
    fractpos <- fractpos[(fractpos + 2) %in% numposad]
    cbase[c(fractpos + 1, fractpos + 2)] <- 0# 分数への対応

    hyphenpos <- grep("^-$", shapevec)# ハイフン
    alphanum <- c(alphatexts, grep("d+", shapevec))
    symposplus <- setdiff(sympos, setdiff(hyphenpos, alphanum + 1))
    btwchk <- (sympos - 1) %in% numposad & (sympos + 1) %in% numpos# 数と数が記号でつながっている箇所
    snum <- setdiff((symposplus + 1) %in% numpos, grep("^*$", shapevec))# 記号直後に数字
    consym <- symposplus[c(FALSE, diff(symposplus) == 1)]# 記号が連続する箇所
    cbase[c(symposplus[btwchk], symposplus[btwchk] + 1, symposplus[snum] + 1, consym)] <- 0# 記号の前後

    # かっこなどの記号区切りの反映
    breakpos <- c(punctpos, pmin(punctpos + 1, maxelem)) |> unique() |> sort()
    breakpos <- setdiff(breakpos, compsuff)# 複合語の途中は除く
    cbase[breakpos] <- 1

    crange <- cumsum(cbase)# 長単位の区分を確定

    # POSの修正：参照位置の設定と述語類
    spbase <- split(1:maxelem, crange)
    cfpos <- sapply(spbase, function(x) head(x, 1))
    clpos <- sapply(spbase, function(x) tail(x, 1))
    lrankpos <- mapply(function(x, y) y[match(x, c("NO_HEAD", "FUNC", "CONT", "SYN_HEAD", "SEM_HEAD", "ROOT")) |> which.max.last()], split(bpostype, crange), spbase)
    frankpos <- mapply(function(x, y) y[match(x, c("NO_HEAD", "FUNC", "CONT", "SYN_HEAD", "SEM_HEAD", "ROOT")) |> which.max.last()], split(bpostype, crange), spbase)
    ncue <- (posvec[clpos] == "NOUN" | grepl("名詞", suw_tag[clpos])) & pdep[cfpos] != "advmod"
    crankpos <- ifelse(ncue, frankpos, lrankpos)
    rcrankpos <- ifelse(ncue, lrankpos, frankpos)

    clen <- sapply(spbase, length)
    clenlen <- rep(clen, clen)
    mwpos <- spbase[clen > 1] |> unlist()# 複数の形態素が結合される位置
    cfguide <- rep(cfpos, clen)
    crankguide <- rep(crankpos, clen)
    rcrankguide <- rep(rcrankpos, clen)

    luw_pos <- rep(NA, maxelem)
    luw_pos[cfpos] <- ifelse(ncue, posvec[clpos], posvec[cfpos])
    dcompos <- intersect(which(clenlen != 1), compos)
    luw_pos[dcompos] <- posvec[headid[dcompos]]
    overpref <- intersect(cfpos, grep("接頭辞", suw_tag))# 接頭辞が先頭と重なる位置
    luw_pos[cfguide[overpref]] <- posvec[headid[overpref]]

    mwv <- intersect(intersect(verbpos, clpos), mwpos)# 結合の末尾が動詞
    luw_tag <- gsub("-$", "", paste(suw_tag, gsub(";.+$", "", ifelse(is.na(infvec), "", infvec)), sep = "-"))
    luw_tag[mwv - 1] <- ifelse(grepl("助詞", suw_tag[mwv - 1]), suw_tag[mwv - 1], paste(suw_tag[mwv - 1], gsub(";.+$", "", infvec[mwv]), sep = "-"))
    luw_tag[crankguide[suruverb]] <- ifelse(txnorm[suruverb] == "為る", 
        gsub("非自立可能", "一般", paste(suw_tag[suruverb], gsub(";.+$", "", infvec[suruverb]), sep = "-")), 
        ifelse(txnorm[suruverb] == "出来る", "動詞-一般-上一段-カ行", 
        ifelse(txnorm[suruverb] == "易い", "形容詞-一般-形容詞", 
        ifelse(txnorm[suruverb] == "致す", "動詞-一般-五段-サ行", 
        ifelse(txnorm[suruverb] == "為さる", "動詞-一般-五段-ラ行", 
        ifelse(txnorm[suruverb] == "過ぎる", "動詞-一般-上一段-ガ行", 
        ifelse(txnorm[suruverb] == "頂く", "動詞-一般-五段-カ行", NA)))))))
    usuru <- suruverb[duplicated(cfguide[suruverb]) == FALSE]
    luw_pos[cfguide[usuru]] <- ifelse(posvec[cfguide[usuru]] == "ADJ", "ADJ", "VERB")
    pdep[rcrankguide[suruverb]] <- pdep[headid[suruverb]]
    headid[rcrankguide[suruverb]] <- headid[headid[suruverb]]

    adjnpos <- intersect(grep("形状詞可能$", suw_tag), grep("助動詞", suw_tag) - 1)
    luw_pos[adjnpos] <- "ADJ"
    luw_pos[adjnpos + 1] <- ifelse(grepl("助動詞", suw_tag[adjnpos + 1]), "AUX", posvec[adjnpos + 1])
    luw_pos[intersect(grep("PROPN|VERB", posvec), grep("^形容詞-一般", suw_tag))] <- "ADJ"
    luw_tag[luw_pos == "ADJ" & luw_tag == "名詞-普通名詞-形状詞可能"] <- "形状詞-一般"

    suffverb <- intersect(grep("接尾辞-動詞的", suw_tag), grep("VERB", posvec))
    luw_tag[suffverb - 1] <- paste(gsub("接尾辞-動詞的", "動詞-一般", suw_tag[suffverb]), gsub(";.+$", "", infvec[suffverb]), sep = "-")
    luw_tag <- ifelse(pdep %in% c("advmod", "acl"), 
        gsub("^-一般$", "名詞-普通名詞-一般", gsub("^副詞-一般$", "副詞", gsub("サ変", "", gsub("名詞-普通名詞-", "", gsub("可能$", "-一般", luw_tag))))), 
        gsub("名詞-普通名詞-.*$", "名詞-普通名詞-一般", luw_tag))

    luw_tag <- gsub("-非自立可能-", "-一般-", luw_tag)
    luw_tag[luw_tag == "一般"] <- "名詞-普通名詞-一般"
    luw_pos[grep("^副詞$", luw_tag)] <- "ADV"

    okerupos <- intersect(grep("^おけ$", ptext) + 1, grep("^る$", ptext))
    luw_tag[okerupos] <- luw_tag[cfguide[okerupos]]
    luw_tag[cfpos] <- ifelse(ncue, gsub("接尾辞-名詞的-", "名詞-普通名詞-", luw_tag[clpos]), gsub("可能$", "", gsub("接尾辞-名詞的-", "", luw_tag[crankpos])))# 接尾辞なしの場合に適用しないようにしたい
    adpcue <- posvec[cfpos] == "ADP" & grepl("助詞", suw_tag[cfpos])
    luw_tag[cfpos][adpcue] <- suw_tag[cfpos][adpcue]
    luw_tag[cfguide[overpref]] <- luw_tag[headid[overpref]]
    luw_pos[grep("^動詞-一般", suw_tag)] <- "VERB"

    if(length(kudasaipos) > 0){
        luw_pos[cfpos[crange[kudasaipos]]] <- "VERB"
        luw_tag[cfpos[crange[kudasaipos]]] <- "動詞-一般-五段-ラ行"
    }

    # POSの修正：固有名詞を含む複合語
    propnvec <- posvec
    propnvec[c(grep("接尾辞-名詞的", suw_tag), parenpos)] <- "PROPN"# 接尾辞と補助記号
    propnvec[grep("固有名詞", luw_tag)] <- "PROPN"# 判定にずれがある場合
    nnpos <- spbase[sapply(split(propnvec, crange), function(x) all(x %in% c("NOUN", "PROPN", "SYM")))] |> unlist(use.names = FALSE)# NOUN・PROPN・SYMのみで構成される長単位要素に含まれる位置（接尾辞は含む）
    cnzone <- intersect(mwpos, nnpos)# 名詞だけの複合語が形成される位置
    if(length(cnzone) > 0){
        cntree <- split(cnzone, crange[cnzone])
        cnhead <- sapply(cntree, function(x) head(x, 1))
        luw_pos[cnhead] <- ifelse(sapply(cntree, function(x) all(propnvec[x] == "PROPN")), 
            "PROPN", "NOUN")
        luw_tag[cnhead] <- ifelse(sapply(cntree, function(x) 
            all(propnvec[x] == "PROPN" & !grepl("接尾辞|地名", suw_tag[x]))), 
            "名詞-固有名詞-一般", "名詞-普通名詞-一般")
    }

    percue <- intersect(grep("人名", suw_tag), cnzone)
    if(length(percue) > 0){
        pntmp <- lapply(percue, function(x) suw_tag[cfguide[x] == cfguide])
        pnint <- sapply(pntmp, function(x) any(grepl("人名-姓", x)) & any(grepl("人名-名", x)))# 「人名-姓」と「人名-名」が結合する場合は「人名-一般」にする
        luw_tag[cfguide[percue]] <- ifelse(pnint, "名詞-固有名詞-人名-一般", sapply(pntmp, function(x) c(grep("人名", x, value = TRUE), grep("接頭辞|接尾辞", x, invert = TRUE, value = TRUE))[1]))
    }
    disnpos <- intersect(grep("普通名詞", luw_tag), grep("^PROPN$", luw_pos))# 齟齬がある場合に修正
    luw_pos[disnpos] <- "NOUN"
    disppos <- intersect(grep("固有名詞", luw_tag), grep("^PROPN$", luw_pos, invert = TRUE))# 齟齬がある場合に修正
    luw_pos[disppos] <- "PROPN"

    # POSの修正：数詞を含む複合語
    numvec <- posvec
    numvec[c(alphatexts, grep("助数詞", suw_tag), grep("接頭辞|^接尾辞-.+可能$", suw_tag), intersect(grep("^接尾辞-名詞的-一般$", suw_tag), which(stopvec == TRUE)))] <- "SYM"# 数量の単位と助数詞，具体的内容を持たない接尾辞を追加
    numcue <- sapply(split(numvec, crange), function(x) any(grepl("NUM", x)) & all(x %in% c("NUM", "SYM")))# NUM・助数詞・接尾辞・SYMのみで構成され，ひとつ以上のNUMを含む単位
    luw_pos[cfpos[numcue]] <- "NUM"
    luw_tag[cfpos[numcue]] <- "名詞-数詞"
    pdep[rcrankpos[numcue]] <- ifelse(pdep[rcrankpos[numcue]] == "compound", "nummod", pdep[rcrankpos[numcue]])

    luw_pos[intersect(grep("PROPN", posvec), grep("^補助記号", suw_tag))] <- "SYM"

    # POSの修正：PART末尾の複合語を形成した場合
    posref <- data.frame(tag = c("名詞", "形容詞", "形状詞", "副詞", "動詞", "サ変"), 
        pos = c("NOUN", "ADJ", "ADJ", "ADV", "VERB", "NOUN"))
    partbase <- intersect(setdiff(c(grep("^PART$", posvec), grep("接尾辞", suw_tag)), grep("一般$|助数詞$", suw_tag)), intersect(clpos, mwpos))
    partbase <- setdiff(partbase, nnpos)
    partpos <- intersect(intersect(which(posvec %in% c("NOUN", "PROPN", "PRON", "VERB")), partbase - 1), mwpos)
    partcand <- ifelse(grepl("非自立可能$", suw_tag[partpos]) & grepl("的$", suw_tag[partpos + 1]), 
        gsub("的$", "", gsub("接尾辞-", "", suw_tag[partpos + 1])), 
        ifelse(grepl("PART", posvec[partpos]) | pdep[crankguide[partpos]] == "ROOT", 
            gsub("-.*$", "", suw_tag[partpos]), 
            gsub("可能$|的$", "", gsub("接尾辞.*-", "", suw_tag[partpos + 1]))))
    luw_pos[cfguide[partpos]] <- lapply(partcand, function(x) posref$pos[grep(x, posref$tag)]) |> unlist()
    luw_tag[cfguide[partpos]] <- gsub("^形容詞-一般$", "形容詞-一般-形容詞", ifelse(partcand == "副詞", partcand, paste(partcand, "一般", sep = "-")))

    # POSの修正：形容詞・形状詞化
    suffnoun <- intersect(grep("接尾辞", suw_tag), grep("NOUN", posvec))
    pdep[suffnoun] <- ifelse(luw_pos[cfguide[suffnoun]] == "ADV", "advmod", pdep[suffnoun])

    # POSの修正：助詞と動詞・助動詞が結合し，動詞か助動詞が終端の場合
    auxcue <- (grepl("VERB|AUX", posvec[clpos]) & pdep[headid[clpos]] != "case" | grepl("非自立", suw_tag[clpos])) & sapply(spbase, function(x) any(posvec[x] %in% c("ADP", "SCONJ")))
    luw_pos[cfpos[auxcue]] <- "AUX"
    luw_tag[cfpos[auxcue]] <- paste("助動詞", gsub(";.+$", "", infvec[clpos[auxcue]]), sep = "-")

    # POSの修正：複合語として接続詞が作られた場合
    cconcue <- pdep[cfpos] == "cc"
    luw_pos[cfpos[cconcue]] <- "CCONJ"
    luw_tag[cfpos[cconcue]] <- "接続詞"

    # POSの修正：接頭辞・接尾辞のみの単位が残っている場合
    modcand <- grepl("接頭辞|接尾辞", luw_tag[cfpos]) & clen == 1
    luw_tag[cfpos[modcand]] <- gsub("可能$", "", gsub("接頭辞-名詞的-|接尾辞-名詞的-", "", luw_tag[cfpos[modcand]]))

    # POSの修正：不一致の調整
    adnpos <- c(intersect(grep("普通名詞", luw_tag[cfpos]), grep("ADJ", posvec[cfpos])), 
        which(grepl("普通名詞", luw_tag[cfpos]) & grepl("ADV", posvec[cfpos]) & !grepl("advmod|advcl", pdep[crankpos])))
    luw_pos[cfpos[adnpos]] <- "NOUN"
    auxcand <- intersect(grep("助動詞", luw_tag), grep("ADP", luw_pos))
    luw_pos[auxcand] <- ifelse(pdep[headid[headid[auxcand]]] %in% c("acl", "ROOT"), "AUX", "ADP")
    luw_tag[auxcand] <- ifelse(pdep[headid[headid[auxcand]]] %in% c("acl", "ROOT"), luw_tag[auxcand], "助詞-格助詞")
    sconjpos <- intersect(grep("助詞-接続助詞", luw_tag), grep("ADP", luw_pos))
    luw_pos[sconjpos] <- "SCONJ"
    pdep[sconjpos] <- "mark"

    sconadp <- intersect(grep("SCONJ", luw_pos), grep("助詞-格助詞", luw_tag))
    noncomp <- sapply(sconadp, function(x) sum(crange[x] == crange)) < 2
    luw_pos[sconadp[noncomp]] <- "ADP"

    denaipos <- intersect(intersect(grep("助動詞", luw_tag), grep("ADJ", luw_pos)), grep("VERB", luw_pos) + 1)
    if(length(denaipos) != 0){
        if(pdep[denaipos] == "ROOT"){
            pdep[denaipos - 1] <- "ROOT"
            headid[headid == denaipos] <- denaipos - 1
            headid[denaipos - 1] <- denaipos - 1
        }
    }
    pdep[denaipos] <- "aux"

    disscon <- c(setdiff(setdiff(grep("SCONJ", luw_pos), grep("助詞", luw_tag)), grep("SCONJ", luw_pos) - 1), intersect(grep("SCONJ", posvec), grep("SCONJ", posvec) - 1))
    luw_tag[disscon] <- "助詞-接続助詞"

    disnv <- intersect(grep("普通名詞", luw_tag), grep("VERB", luw_pos))
    luw_pos[disnv[posvec[disnv + 1] != "AUX"]] <- "NOUN"

    modvpos <- grep("^動詞-一般$", luw_tag)
    luw_tag[modvpos] <- paste(luw_tag[modvpos], gsub(";.+$", "", infvec[modvpos + 1]), sep = "-")

    # 依存構造の修正：mark, fixed, cop
    depref <- data.frame(pos = c("ADP", "AUX", "SCONJ", "VERB", "NOUN", "PROPN", "PRON", "ADJ", "ADV", "NUM", "PUNCT", "SYM", "PART", "DET", "INTJ", "CCONJ"), 
            dep = c("case", "aux", "mark", "acl", "nmod", "nmod", "nmod", "acl", "advcl", "nummod", "punct", "dep", "mark", "det", "discourse", "cc"))
    luw_fix <- grep("fixed", pdep[rcrankpos])
    comcop <- which(clen > 1 & pdep[rcrankpos] == "cop")
    bunends <- c(tail(hstarts - 1, -1), maxelem)# 文節終末位置
    seqcop <- setdiff(intersect(grep("cop", pdep[rcrankpos]), grep("AUX", luw_pos[cfpos])), which(pdep[headid[rcrankpos]] %in% c("ROOT", "advcl", "ccomp")))
    pdep[rcrankpos[c(luw_fix, comcop, seqcop)]] <- lapply(luw_pos[cfpos[c(luw_fix, comcop, seqcop)]], function(x) depref$dep[grep(x, depref$pos)]) |> unlist()

    auxdep <- intersect(grep("mark", pdep), grep("^AUX$", luw_pos))
    pdep[auxdep] <- "aux"

    ccpunct <- intersect(punctpos, grep("CCONJ", luw_pos) + 1)
    ccpunct <- ccpunct[headid[ccpunct] != ccpunct -1]
    headid[ccpunct] <- ccpunct - 1

    # 依存構造の修正：Headの位置
    headid[c(compos, fixpos)] <- headid[headid[c(compos, fixpos)]]
    markchildren <- pdep[headid] == "mark"
    headid[markchildren] <- headid[headid[markchildren]]

    # 依存構造の修正：不明な依存構造
    depcand <- data.frame(pos = c("ADP", "AUX", "SCONJ", "VERB", "NOUN", "PROPN", "PRON", "ADJ", "ADV", "NUM", "PUNCT", "SYM", "PART", "DET", "INTJ", "CCONJ"), 
        dep = c("case", "aux", "mark", "advcl", "amod", "amod", "amod", "acl", "advcl", "amod", "punct", "dep", "mark", "det", "discourse", "cc"))
    deppos <- setdiff(grep("dep", pdep), grep("SYM", posvec))
    pdep[deppos] <- lapply(deppos, function(x) depcand$dep[grep(posvec[headid[x]], depcand$pos)]) |> unlist()

    # 依存構造の修正：advcl, advmod
    advcl_adv <- intersect(grep("advcl|compound", pdep), grep("ADV", luw_pos))
    advcl_to_mod <- advcl_adv[luw_pos[headid[advcl_adv]] %in% c("VERB", "ADJ", "ADV")]
    pdep[advcl_to_mod] <- "advmod"

    advcl_v <- intersect(grep("advcl", pdep), grep("VERB", luw_pos))
    advcl_to_acl <- advcl_v[pdep[headid[advcl_v]] %in% c("nmod") & luw_pos[headid[advcl_v]] %in% c("NOUN", "PROPN", "PRON", "ADJ")]
    amod_v <- intersect(grep("amod", pdep), grep("VERB", luw_pos))
    amod_to_acl <- amod_v[pdep[headid[amod_v]] %in% c("ROOT", "advmod")]
    pdep[c(advcl_to_acl, amod_to_acl)] <- "acl"

    advmod_n <- intersect(grep("advmod", pdep[crankpos]), grep("NOUN|PROPN", luw_pos[cfpos]))
    pdep[crankpos[advmod_n]] <- "obl"
    advmod_j <- intersect(grep("advmod", pdep[crankpos]), grep("ADJ", luw_pos[cfpos]))
    pdep[crankpos[advmod_j]] <- "advcl"

    advmodpos <- intersect(grep("advmod", pdep), grep("ADV", luw_pos))
    clchk <- lapply(advmodpos, function(x) any(luw_pos[x == headid] %in% c("AUX"))) |> unlist()
    pdep[advmodpos[clchk]] <- "advcl"

    # 依存構造の修正：複数ROOTの回避
    rootuni <- (grepl("ROOT", pdep) | headid == 1:maxelem) & 1:maxelem %in% crankpos
    luw_head <- headid
    if(sum(rootuni) > 1){# headidの数
        nroots <- which(pdep == "ROOT")
        if(length(nroots) == 1){
            troot <- nroots
        }else{
            troot <- max(which(rootuni))
        }
        rroot <- setdiff(which(rootuni), troot)
        compr <- clen[crange[rroot]] == 1
        for(i in 1:length(rroot)){
            if(compr[i]){# 変更する単位にひとつの形態素のみの場合
                pdep[rcrankpos[crange[rroot[i]]]] <- depref$dep[posvec[rcrankpos[crange[rroot[i]]]] == depref$pos]
                luw_head[rcrankpos[crange[rroot[i]]]] <- crankpos[crange[troot]]
            }else{# 同じ単位に複数の形態素がある場合
                elpos <- sapply(pdep[spbase[[crange[rroot[i]]]]], function(x) match(x, c("ROOT", "dep", "advmod", "advcl", "compound", "punct", "mark", "case", "fixed", "obj", "obl", "amod", "nummod", "nsubj", "nmod"))) |> which.max()
                crankpos[crange[rroot[[i]]]] <- spbase[[crange[rroot[i]]]][elpos]
                luw_head[rcrankpos[crange[rroot[i]]]] <- rcrankpos[crange[troot]]
                if(pdep[crankpos[crange[rroot[i]]]] == "ROOT"){
                    pdep[crankpos[crange[rroot[i]]]] <- depcand$dep[depcand$pos == luw_pos[crankpos[crange[rroot[i]]]]]
                }
            }
        }
    }

    # 依存構造の修正：サイクルチェック
    ohead <- crange[match(luw_head[rcrankpos], 1:maxelem)]
    htmp <- ohead
    for(i in 1:length(ohead)){
        htmp <- ohead[htmp]
    }
    if(!all(htmp %in% which(pdep[crankpos] == "ROOT"))){
        mpos <- rcrankpos[which(htmp != which(pdep[crankpos] == "ROOT"))]
        luw_head[mpos] <- min(rcrankpos[rcrankpos > max(mpos)])# 直近のrcrankposに付属させる
    }

    # 依存構造の修正：修正に伴うHead位置の修正
    rootpos <- intersect(grep("^ROOT$", pdep), crankpos)
    advclpos <- grep("advcl", pdep)
    modHDpos <- advclpos[headid[advclpos] < advclpos & headid[advclpos] %in% advclpos]
    amodpos <- grep("amod", pdep)
    amodpos <- amodpos[headid[amodpos] < amodpos & posvec[headid[amodpos]] %in% c("NOUN", "PROPN", "PRON")]
    modHDpos <- c(modHDpos, amodpos)
    if(length(modHDpos) > 0){
        luw_head[modHDpos] <- rootpos
        for(i in modHDpos){
            modsuffzone <- (i + 1):(min(c(bunstartpos[i < bunstartpos], maxelem)) - 1)
            luw_head[modsuffzone] <- ifelse(headid[modsuffzone] == headid[i], headid[modsuffzone], rootpos)
        }
    }

    # 出力
    if(mixed){
        mixeddat <- cbind(analyzeddat, "bunsetu_id" = brange, "BPtype" = bpostype, 
            "BIlabel" = bilabel, "UPOS" = posvec, "luw_id" = crange)
        return(mixeddat)
    }else{
        ptext[spaceafter == TRUE] <- paste0(ptext[spaceafter == TRUE], " ")
        luw_lemma <- ifelse(c(diff(crange) == 0, 0), ptext, plemma)
        luw_norm <- ifelse(c(diff(crange) == 0, 0), ptext, txnorm)
        modadppos <- clpos[luw_pos[cfpos] == "ADP"]# 助詞の場合は末尾要素もママとする
        luw_lemma[modadppos] <- ptext[modadppos]
        contpos <- clenlen > 1
        luw_norm[contpos] <- luw_lemma[contpos]
        chodat <- data.frame("no" = crange[cfpos],
            "Text" = sapply(split(ptext, crange), function(x) paste0(x, collapse = "")), 
            "Lemma" = sapply(split(luw_lemma, crange), function(x) paste0(x, collapse = "")), 
            "UPOS" = luw_pos[cfpos], "XPOS" = luw_tag[cfpos], 
            "Dep" = pdep[crankpos], "HeadID" = crange[match(luw_head[rcrankpos], 1:maxelem)], 
            "Norm" = sapply(split(luw_norm, crange), function(x) paste0(x, collapse = "")), 
            "BIlabel" = bilabel[cfpos], "BPtype" = bpostype[crankpos], row.names = NULL)
        return(chodat)
    }
}


# 一連の文字列を句点ごとに分割する関数
# sbr：TRUEを指定すると，句点＋鍵括弧閉が連続した場合に鍵括弧閉の後を文境界と見なす
# 「。」「！」「？」と改行を文境界と見なす
buncuts <- function(textdata, sbr = TRUE){
    if(sbr){
        sbq <- "[。！？\n」]+"
    }else{
        sbq <- "[。！？\n]+"
    }
    period_pos <- gregexpr(sbq, textdata)[[1]]# すべての句点の終了位置を取得
    last_pos <- period_pos + attributes(period_pos)$match.length - 1# 句点連続の末尾位置のみ取得
    last_pos <- unique(c(last_pos, nchar(textdata)))# 句点なしの終末に対応するため，いったんテキスト末尾を加えて重複を削除
    if(length(last_pos) == 0) return(textdata)# 句点がひとつもなかった場合は入力をそのまま返す
    segmented_text <- gsub("\n", "", mapply(function(x, y) substr(textdata, x, y), c(0, head(last_pos, -1) + 1), last_pos))
    return(segmented_text)
}


# 各形態素と文，節，文節との対応を出力する関数
# target：分析対象となる文字列
ginkou <- function(target, mode = "C", dic = "core", model = "ja_ginza"){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    doc <- nlp(target)
    stoppos <- sapply(1:length(doc), function(x) doc[x-1]$tag_ == "補助記号-句点")# 句点位置
    sspan <- diff(unique(c(0, which(stoppos), length(stoppos))))
    sid <- lapply(1:length(sspan), function(x) rep(x, sspan[x])) |> unlist()

    cheadpos <- sapply(1:length(doc), function(x) ginzapy$clause_head_i(doc[x-1]))# 節ヘッドID
    cspan <- diff(c(0, which(diff(cheadpos) != 0), length(cheadpos)))
    cid <- lapply(1:length(cspan), function(x) rep(x, cspan[x])) |> unlist()
    while(any(sid > cid)){# 文境界・句点を超える節境界を修正
        cid[min(which(sid > cid)):length(cid)] <- cid[min(which(sid > cid)):length(cid)] + 1
    }

    bulabs <- ginzapy$bunsetu_bi_labels(doc)# 文節ラベル
    bspan <- diff(c(grep("B", bulabs), length(bulabs) + 1))
    bid <- lapply(1:length(bspan), function(x) rep(x, bspan[x])) |> unlist()

    kdat <- data.frame("SentenceID" = sid, "ClauseID" = cid, "BunsetuID" = bid, 
        "Text" = sapply(1:length(doc), function(x) doc[x-1]$text), 
        "Punct" = sapply(1:length(doc), function(x) doc[x-1]$is_punct))
    return(kdat)
}


# コサイン類似度を計算する関数
# text1：分析対象となる文字列1
# text2：分析対象となる文字列2
# modelpath：単語ベクトルを追加したカスタムモデルのパス
# - いずれの文字列もベクトルを指定することが可能
ginsim <- function(text1, text2, mode = "C", dic = "core", model = "ja_ginza", modelpath = NA){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    if(!is.na(modelpath)){
        nlp$from_disk(modelpath)
    }

    doc1 <- lapply(text1, function(x) nlp(x))
    simmat <- lapply(doc1, function(x) sapply(text2, function(y) x$similarity(nlp(y))))
    simscore <- do.call("rbind", simmat) |> as.data.frame()
    row.names(simscore) <- text1
    return(simscore)
}


# 単語ベクトルを入れ替えてカスタムモデルを生成する関数
# pythonでgensimをインストールしておく必要がある
# sourcepath：単語ベクトルへのパスを指定
# outpath：出力先のパスを指定
# - モデルのサイズにもよるが非常に時間がかかることに注意
createModel <- function(sourcepath, outpath, mode = "C", dic = "core", model = "ja_ginza"){
    spacySet <- setSpacy(mode = mode, dic = dic, model = model)
    ginzapy <- spacySet$ginzapy
    nlp <- spacySet$nlp

    gensimpy <- reticulate::import(module = "gensim.models")
    wvm <- gensimpy$KeyedVectors$load_word2vec_format(sourcepath)
    nlp$vocab$reset_vectors(width = ncol(wvm$vectors))
    for(i in wvm$index_to_key){
        nlp$vocab$set_vector(i, wvm[i])
    }
    cat(nlp$vocab$vectors$shape)# 語彙数と次元数の確認
    nlp$to_disk(outpath)
}