Function

コメント・参照等
  • 日銀短観データコードを日本語文字列タイトルに変換する関数

FUN = f_convert_datacode_to_title_in_tankan_data.r
function (obj0, col_code = 1) 
{
    code <- obj0[, col_code]
    select0502 <- sapply(seq(code), function(x) {
        gsub("\\(.+\\)", "", koumoku05[which(substring(code[x], 10, 12) == koumoku05[, 1]), 2])
    })
    select0503 <- sapply(seq(code), function(x) {
        gsub("\\(.+\\)", "", koumoku05[which(substring(code[x], 10, 12) == koumoku05[, 1]), 3])
    })
    print(unique(select0502))
    print(unique(select0503))
    for (iii in 1:8) {
        if (iii == 1) {
            codedf <- koumoku03
            first = 5
            last = 5
            col01 = 1
            col02 = 2
        }
        if (iii == 2) {
            codedf <- koumoku04
            first = 6
            last = 9
            col01 = 1
            col02 = 2
        }
        if (iii == 3) {
            codedf <- koumoku05
            first = 10
            last = 12
            col01 = 1
            col02 = 3
        }
        if (iii == 4) {
            codedf <- koumoku06
            first = 13
            last = 13
            col01 = 1
            col02 = 2
        }
        if (iii == 5) {
            codedf <- koumoku07
            first = 14
            last = 15
            col01 = 1
            col02 = 2
        }
        if (iii == 6) {
            codedf <- koumoku08
            first = 16
            last = 16
            col01 = 2
            col02 = 3
        }
        if (iii == 7) {
            codedf <- koumoku09
            first = 17
            last = 17
            col01 = 1
            col02 = 2
        }
        if (iii == 8) {
            codedf <- koumoku10
            first = 18
            last = 20
            col01 = 2
            col02 = 3
        }
        if (iii != 6 & iii != 8) {
            buf0 <- sapply(seq(code), function(x) {
                codedf[which(substring(code[x], first, last) == codedf[, col01]), col02]
            })
        }
        if (iii == 6 | iii == 8) {
            if (iii == 6) {
                selectword <- select0502
            }
            else {
                selectword <- select0503
            }
            buf0 <- sapply(seq(code), function(x) {
                tmpdf <- codedf[which(substring(code[x], first, last) == codedf[, col01]), , drop = F]
                rrr <- grepl(selectword[x], tmpdf[, 1])
                if (unique(rrr) == F) {
                  rrr <- 1
                }
                return(tmpdf[rrr, col02])
            })
        }
        if (iii == 1) {
            titletxt <- buf0
        }
        else {
            titletxt <- paste0(titletxt, ":", buf0)
        }
    }
    obj0$title <- titletxt
    return(obj0)
}