短歌から受ける印象に関する調査

※この記事は、短歌から読み手が受ける印象について調査したnote記事にRのコードを添えて、一部をリライトしたものです。

短歌の印象に関する調査|さちこ|note

この記事について

皆川直凡(2008)「俳句への興味・関心が俳句の情緒的意味の評定に及ぼす影響 -創作経験の少ない鑑賞者を対象とするSD法による検討-」を参考にやってみたものです。

皆川(2008)では、3因子×5対の形容詞対を用いたSD法によって被検者に俳句の情緒的意味の評定を求めています。提示した俳句の多くを知っていた高興味群と、提示した俳句をあまり知らなかった低興味群の違いを分析したところ「高興味群ではすべての因子において明瞭な個人差が認められたが、
低興味群では、印象因子での個人差のみが見いだされた」と報告しています。そのうえで、こうした違いは俳句に興味がある人とあまり興味がない人の読み方の違いに起因するものではないかと考察しています。

この記事では、短歌の場合、読み慣れている人とそうでない人とで短歌の読み方にどんな違いがあるかを簡単に分析してみます。

調査方法

皆川(2008)を参考にして、Googleフォームで調査紙を作りました。

調査紙では、以下の8つの短歌について、皆川が用いている3因子×5対(あわせて15対)の形容詞対による印象の評定を求めています。

  • ぱんぱかぱーん たまごを割っただけのものなのになんだかしあわせでしょう /あんずわかこ
  • 身勝手な春の嵐のせいにして会いたいなんて言わせてほしい/街田青々
  • つららへし折ってわかめを巻いていくわたしは何をしてるんだろう/佐野ちゃり
  • シャンプーを切らした時に買ってきてくれるあなたを切らしています/たろりずむ
  • 赤あげて白さげないで冷戦の意味も知らずに両手を挙げる/さよなら あかね
  • 肺胞のひとつひとつに海がありあなたを呼ぶたび満ちてしまって/楓子
  • 爪先を濡らした海がおなじ夏なのに記憶の方がつめたい/アベハルカ
  • 「辞めたい」も「旅に出たい」も「死にたい」も 家にいたいというほどの意味/まび

※提示順とは異なる。また、作者名は提示していない。

形容詞対は以下の15対で、7件法で尋ねています。

  • 印象因子(5対):「明るい-暗い」「冷たい-温かい」「嬉しい-悲しい」「若い-老いた」「瑞々しい-枯れた」
  • 静穏因子(6対):「迫力がある-迫力がない」「激しい-穏やかな」「男性的な-女性的な」「大きい-小さい」「速い-遅い」「動的な-静的な」
  • 技巧因子(4対):「深みがある-深みがない」「洒落ている-野暮ったい」「おもしろい-つまらない」「リズム感がある-リズム感がない」

また、これとあわせて提示した短歌を知っているか(「見たことがあるし作者も知っている」「見たことがあるが作者は知らない」「見たことがある気がする」「はじめて見た」の4択)と短歌を趣味にしてどのくらい経つか(「普段は短歌を読んだり作ったりはしない」「6ヶ月未満」「6ヶ月以上1年未満」「1年以上」)を尋ねました。

GoogleフォームはTwitter上で回答を呼びかけて、2018年6月29日13時頃までで40件の回答を得ました。

データの準備

ライブラリを読み込んでデータを準備します。form.csvがGoogleフォームからエクスポートしたデータで、mini.csvはTwitter Analyticsからエクスポートできるツイートに関するデータです。

library(tidyverse)  
library(jmv)  
library(lavaan)  
library(semPlot)  
library(OpenRepGrid)  
library(plotly)  
library(ggalluvial)  

Sys.setenv("plotly_username" = "YOUR_USERNAME")  
Sys.setenv("plotly_api_key" = "YOUR_API_KEY")  

form <- read_csv("form.csv")  
tweet <- read_csv("mini.csv")  

colnames(tweet) <- c("timestamp", "text", "impression", "engagement", "fav", "rt")  
tweet <- tweet %>%  
    filter(  
        text %in% c(  
            "ぱんぱかぱーん たまごを割っただけのものなのになんだかしあわせでしょう /あんずわかこ",  
            "身勝手な春の嵐のせいにして会いたいなんて言わせてほしい/街田青々",  
            "つららへし折ってわかめを巻いていくわたしは何をしてるんだろう/佐野ちゃり",  
            "シャンプーを切らした時に買ってきてくれるあなたを切らしています/たろりずむ",  
            "赤あげて白さげないで冷戦の意味も知らずに両手を挙げる/さよなら あかね",  
            "肺胞のひとつひとつに海がありあなたを呼ぶたび満ちてしまって/楓子",  
            "爪先を濡らした海がおなじ夏なのに記憶の方がつめたい/アベハルカ",  
            "「辞めたい」も「旅に出たい」も「死にたい」も 家にいたいというほどの意味/まび"  
        )  
    ) %>%  
    bind_cols(  
        data_frame(  
            idx = c(4,5,8,6,1,2,3,7)  
        )  
    ) %>%  
    arrange(idx) %>%  
    mutate(engagement = fav/impression*1000)  

このデータを泥臭いやり方で修正していきます。

colnames(form) <- c(  
    "timestamp",  
    "since",  
    "know1", "know2", "know3", "know4", "know5", "know6", "know8",  
    "imp11", "imp12", "imp13", "imp14", "imp15", "dyn11", "dyn12", "dyn13", "dyn14", "dyn15", "dyn16", "tec11", "tec12", "tec13", "tec14",  
    "imp21", "imp22", "imp23", "imp24", "imp25", "dyn21", "dyn22", "dyn23", "dyn24", "dyn25", "dyn26", "tec21", "tec22", "tec23", "tec24",  
    "imp31", "imp32", "imp33", "imp34", "imp35", "dyn31", "dyn32", "dyn33", "dyn34", "dyn35", "dyn36", "tec31", "tec32", "tec33", "tec34",  
    "imp41", "imp42", "imp43", "imp44", "imp45", "dyn41", "dyn42", "dyn43", "dyn44", "dyn45", "dyn46", "tec41", "tec42", "tec43", "tec44",  
    "imp51", "imp52", "imp53", "imp54", "imp55", "dyn51", "dyn52", "dyn53", "dyn54", "dyn55", "dyn56", "tec51", "tec52", "tec53", "tec54",  
    "imp61", "imp62", "imp63", "imp64", "imp65", "dyn61", "dyn62", "dyn63", "dyn64", "dyn65", "dyn66", "tec61", "tec62", "tec63", "tec64",  
    "imp71", "imp72", "imp73", "imp74", "imp75", "dyn71", "dyn72", "dyn73", "dyn74", "dyn75", "dyn76", "tec71", "tec72", "tec73", "tec74",  
    "imp81", "imp82", "imp83", "imp84", "imp85", "dyn81", "dyn82", "dyn83", "dyn84", "dyn85", "dyn86", "tec81", "tec82", "tec83", "tec84",  
    "know7"  
)  

form <- form %>%  
    mutate(  
        since = case_when(  
            since == "普段は短歌を読んだり作ったりはしない" ~ 0,  
            since == "6ヶ月未満" ~ 1,  
            since == "6ヶ月以上1年未満" ~ 2,  
            since == "1年以上" ~ 3  
        ),  
        know1 = case_when(  
            know1 == "見たことがあるし作者も知っている" ~ 0,  
            know1 == "見たことがあるが作者は知らない" ~ 1,  
            know1 == "見たことがある気がする" ~ 2,  
            know1 == "はじめて見た" ~ 3  
        ),  
        know2 = case_when(  
            know2 == "見たことがあるし作者も知っている" ~ 0,  
            know2 == "見たことがあるが作者は知らない" ~ 1,  
            know2 == "見たことがある気がする" ~ 2,  
            know2 == "はじめて見た" ~ 3  
        ),  
        know3 = case_when(  
            know3 == "見たことがあるし作者も知っている" ~ 0,  
            know3 == "見たことがあるが作者は知らない" ~ 1,  
            know3 == "見たことがある気がする" ~ 2,  
            know3 == "はじめて見た" ~ 3  
        ),  
        know4 = case_when(  
            know4 == "見たことがあるし作者も知っている" ~ 0,  
            know4 == "見たことがあるが作者は知らない" ~ 1,  
            know4 == "見たことがある気がする" ~ 2,  
            know4 == "はじめて見た" ~ 3  
        ),  
        know5 = case_when(  
            know5 == "見たことがあるし作者も知っている" ~ 0,  
            know5 == "見たことがあるが作者は知らない" ~ 1,  
            know5 == "見たことがある気がする" ~ 2,  
            know5 == "はじめて見た" ~ 3  
        ),  
        know6 = case_when(  
            know6 == "見たことがあるし作者も知っている" ~ 0,  
            know6 == "見たことがあるが作者は知らない" ~ 1,  
            know6 == "見たことがある気がする" ~ 2,  
            know6 == "はじめて見た" ~ 3  
        ),  
        know7 = case_when(  
            know7 == "見たことがあるし作者も知っている" ~ 0,  
            know7 == "見たことがあるが作者は知らない" ~ 1,  
            know7 == "見たことがある気がする" ~ 2,  
            know7 == "はじめて見た" ~ 3  
        ),  
        know8 = case_when(  
            know8 == "見たことがあるし作者も知っている" ~ 0,  
            know8 == "見たことがあるが作者は知らない" ~ 1,  
            know8 == "見たことがある気がする" ~ 2,  
            know8 == "はじめて見た" ~ 3  
        )  
    ) %>%  
    select(  
        since, know1, know2, know3, know4, know7, know8,  
        starts_with("imp"),  
        starts_with("dyn"),  
        starts_with("tec")  
    )  

変数の選択

皆川(2008)は自身の別の研究を援用して上に挙げた15対の形容詞対でSD尺度を構成していますが、これが今回そのまま使えるかはよくわかりません。そこで、あらためて因子分析をおこなって変数を再選択しました。

皆川ではこういうモデルでしたが、

今回は「若い-老いた」「男性的な-女性的な」「大きい-小さい」「リズム感がある-リズム感がない」の4つの形容詞対を落としてしまって、こんな感じのモデルを仮定することにします。

すなわち、短歌を読んだとき受ける印象には3つの軸があり、1つ目の軸(Imp=印象因子)が「明るい-暗い」「冷たい-温かい」「嬉しい-悲しい」「瑞々しい-枯れた」の判断に、2つ目の軸(Dyn=静穏因子)が「迫力がある-迫力がない」「激しい-穏やかな」「速い-遅い」「動的な-静的な」の判断に、3つ目の軸(Tch=技巧因子)が「深みがある-深みがない」「洒落ている-野暮ったい」「おもしろい-つまらない」の判断にそれぞれ影響しているという仮定です。

各因子はどの短歌を読んだか(key)という影響を受けて印象の評定に影響を及ぼすはずなので、このモデル全体を書くとたぶんこうなります。ただし「どの短歌を読んだか」が各因子にどう影響するかは個人差が大きいようで、うまく一般化することはできないようです。

なお、このセクションで用いた図を出力するコードは以下のような感じです。

#### Factor Analysis ####  
data <- form %>%  
    select(  
        starts_with("imp"),  
        starts_with("dyn"),  
        starts_with("tec")  
    )  


df <- select(data, matches("imp.1")) %>% gather(key, imp1) %>%  
    bind_cols(  
        select(data, matches("imp.2")) %>% gather(key, imp2) %>% select(-key),  
        select(data, matches("imp.3")) %>% gather(key, imp3) %>% select(-key),  
        select(data, matches("imp.4")) %>% gather(key, imp4) %>% select(-key),  
        select(data, matches("imp.5")) %>% gather(key, imp5) %>% select(-key)  
    ) %>%  
    bind_cols(  
        select(data, matches("dyn.1")) %>% gather(key, dyn1) %>% select(-key),  
        select(data, matches("dyn.2")) %>% gather(key, dyn2) %>% select(-key),  
        select(data, matches("dyn.3")) %>% gather(key, dyn3) %>% select(-key),  
        select(data, matches("dyn.4")) %>% gather(key, dyn4) %>% select(-key),  
        select(data, matches("dyn.5")) %>% gather(key, dyn5) %>% select(-key),  
        select(data, matches("dyn.6")) %>% gather(key, dyn6) %>% select(-key)  
    ) %>%  
    bind_cols(  
        select(data, matches("tec.1")) %>% gather(key, tec1) %>% select(-key),  
        select(data, matches("tec.2")) %>% gather(key, tec2) %>% select(-key),  
        select(data, matches("tec.3")) %>% gather(key, tec3) %>% select(-key),  
        select(data, matches("tec.4")) %>% gather(key, tec4) %>% select(-key)  
    ) %>%  
    mutate(  
        key = case_when(  
            key == "imp11" ~ 1,  
            key == "imp21" ~ 2,  
            key == "imp31" ~ 3,  
            key == "imp41" ~ 4,  
            key == "imp51" ~ 5,  
            key == "imp61" ~ 6,  
            key == "imp71" ~ 7,  
            key == "imp81" ~ 8  
        )  
    )  
df$key <- as.factor(df$key)  

fit <- lavaan::cfa(  
    model = "  
        Impression =~ imp1 + imp2 + imp3 + imp4 + imp5  
        Dynamics =~ dyn1 + dyn2 + dyn3 + dyn4 + dyn5 + dyn6  
        Technique =~ tec1 + tec2 + tec3 + tec4  
    ",  
    data = df  
)  
summary(fit, standardized = TRUE, fit.measures = TRUE)  
semPaths(  
    fit,  
    whatLabels = "stand",  
    layout = "circle2",  
    nDigits = 2,  
    sizeMan = 8,  
    sizeLat = 8,  
    sizeLat2 = 8,  
    edge.label.cex = 1.2,  
    curve = 0.7,  
    optimizeLatRes = TRUE,  
    edge.color = "black"  
)  

ef <- efa(  
    df,  
    vars = c("imp1","imp2","imp3","imp4","imp5","dyn1","dyn2","dyn4","dyn5","dyn6","tec1","tec2","tec3","tec4"),  
    nFactorMethod = "fixed",  
    nFactors = 3,  
    rotation = "varimax",  
    hideLoadings = 0.35,  
    screePlot = TRUE,  
    factorSummary = TRUE,  
    modelFit = TRUE  
)  

fit <- lavaan::cfa(  
    model = "  
    Impression =~ imp1 + imp2 + imp3 + imp5  
    Dynamics =~ dyn1 + dyn2 + dyn5 + dyn6  
    Technique =~ tec1 + tec2 + tec3  
    ",  
    data = df  
)  
summary(fit, standardized = TRUE, fit.measures = TRUE)  
semPaths(  
    fit,  
    whatLabels = "stand",  
    layout = "tree2",  
    nDigits = 2,  
    sizeMan = 8,  
    sizeLat = 8,  
    sizeLat2 = 8,  
    edge.label.cex = 1.2,  
    curve = 0.7,  
    optimizeLatRes = TRUE,  
    edge.color = "black"  
)  
fit <- sem(  
    model = "  
    Impression =~ imp1 + imp2 + imp3 + imp5  
    Dynamics =~ dyn1 + dyn2 + dyn5 + dyn6  
    Technique =~ tec1 + tec2 + tec3  
    Impression ~~ Dynamics  
    Impression ~~ Technique  
    Dynamics ~~ Technique  
    Impression + Dynamics + Technique ~ key  
    ",  
    data = df  
)  

評定値の傾向

それぞれの短歌の各形容詞対における評定値の最頻値を表にまとめたものです。行と列について、クラスタリングした結果にもとづいて並べ替えています。上は、短歌を趣味にしてどのくらい経つかの設問に対して「1年以上」と回答した人(n=31)の最頻値で、下は「それ以外」の回答をした人(n=9)の最頻値です。

「それ以外」の回答が少ないのでなんとも言えませんが、短歌に触れない人のほうが5以上をつけているセルが多いようにも見えます。

このセクションで用いたコードは以下。

#### RepGrid ####  
statmode <- function(x) {  
    names(which.max(table(x)))  
}  
data <- form %>%  
    filter(since == 3) %>%  
    select(-since, -starts_with("know")) %>%  
    select(-matches("imp.4"), -matches("dyn.3"), -matches("dyn.4"), -matches("tec.4")) %>%  
    mutate_all(as.factor) %>%  
    summarise_all(statmode) %>%  
    mutate_all(as.integer)  

args <- list(  
    name = pull(tweet, text),  
    l.name = c(  
        "明るい", "冷たい", "嬉しい", "みずみずしい",  
        "迫力がある", "激しい", "速い", "動的な",   
        "深みがある", "洒落ている", "おもしろい"  
    ),  
    r.name = c(  
        "暗い", "温かい", "悲しい", "枯れた",  
        "迫力がない", "穏やかな", "遅い", "静的な",  
        "深みがない", "野暮ったい", "つまらない"  
    ),  
    scores = c(  
        select(data, contains("imp1"), contains("dyn1"), contains("tec1")) %>% gather(key, val) %>% pull(val),  
        select(data, contains("imp2"), contains("dyn2"), contains("tec2")) %>% gather(key, val) %>% pull(val),  
        select(data, contains("imp3"), contains("dyn3"), contains("tec3")) %>% gather(key, val) %>% pull(val),  
        select(data, contains("imp4"), contains("dyn4"), contains("tec4")) %>% gather(key, val) %>% pull(val),  
        select(data, contains("imp5"), contains("dyn5"), contains("tec5")) %>% gather(key, val) %>% pull(val),  
        select(data, contains("imp6"), contains("dyn6"), contains("tec6")) %>% gather(key, val) %>% pull(val),  
        select(data, contains("imp7"), contains("dyn7"), contains("tec7")) %>% gather(key, val) %>% pull(val),  
        select(data, contains("imp8"), contains("dyn8"), contains("tec8")) %>% gather(key, val) %>% pull(val)  
    )  
)  
grid <- makeRepgrid(args) %>% setScale(1,7)  
bertinCluster(  
    grid,  
    dmethod = "manhattan",  
    type = "rectangle",  
    draw.axis = FALSE,  
    cex.elements = 0.6  
)  
cluster(grid)  

因子得点

ここでは各因子が影響する尺度すべての平均を因子得点とします。たとえば技巧因子なら「深みがある-深みがない」「洒落ている-野暮ったい」「おもしろい-つまらない」の3尺度の平均値です。

各水準内での因子得点の標準偏差が下表です。短歌を趣味にしてどのくらい経つかに「1年未満」と回答した群では、どの因子得点も比較的ばらつきがなく、個人差があまりないことがわかります。それに対して「1年以上」と回答した群では技巧因子のばらつきがやや大きくなっています。また、短歌ごとに見てみると、どの短歌について見ても静穏因子と技巧因子のばらつきが大きいことがわかります。

短歌に慣れている人ほど、短歌が技術的に優れているかどうかの評価基準をその人独自のものとして確立させているということなのだと思います。また、短歌をどう受けとめるかは、ことばの意味から受ける印象以外の話になると人によってかなり差があるということなのかもしれません。

因子得点とエンゲージメント

今回の調査で提示した短歌は、いずれも以前にTwitter上で引用して紹介したことがあるものでした。それぞれの短歌のツイートとしてのエンゲージメント率などのデータがあるので、短歌の因子得点とTwitter上でのエンゲージメントとの相関を見てみます。

エンゲージメントはきっといろいろな定義ができると思いますが、ここでは「(ツイートインプレッションあたりのいいね数)×100」をエンゲージメントとしておきます。インプレッションに対してどれくらいの数のいいねをされているかみたいなことです。

3つの因子得点で張った3次元空間に、8つの短歌を布置したプロットを用意しました(厳密にはモデルの定義上3つの因子は直交しないのですが、あまり深く考えないでおきます)。短歌の因子得点には水準内における中央値を用いています。点の色はエンゲージメントで、暖色に行くほどエンゲージメントが高いことを表しています。

技巧因子の軸に注目してみると、「1年未満」の群よりも「1年以上」の群のほうが技巧因子とエンゲージメントとの相関がはっきりしているように見えます。一方で、印象因子について見ると「1年未満」でも「1年以上」でもエンゲージメントとの相関はあまりはっきりしていないようです。短歌のTwitter上でのエンゲージメントは、短歌に慣れている人からのエンゲージメントであるかぎりにおいて、その作品の技術的な面での評価を反映していると考えられます。

以下、プロットに用いたコードです。

#### MDS ####  
fctr <- function(chr){  
    form %>%  
        select(-since, -starts_with("know")) %>%  
        select(-matches("imp.4"), -matches("dyn.3"), -matches("dyn.4"), -matches("tec.4")) %>%  
        select(matches(chr)) %>%  
        t() %>%  
        colMeans() %>%  
        sapply(as_mapper(~ round(.,2)))  
}  
data <- data_frame(  
    imp1 = fctr("imp1."), imp2 = fctr("imp2."), imp3 = fctr("imp3."), imp4 = fctr("imp4."), imp5 = fctr("imp5."), imp6 = fctr("imp6."), imp7 = fctr("imp7."), imp8 = fctr("imp8."),  
    dyn1 = fctr("dyn1."), dyn2 = fctr("dyn2."), dyn3 = fctr("dyn3."), dyn4 = fctr("dyn4."), dyn5 = fctr("dyn5."), dyn6 = fctr("dyn6."), dyn7 = fctr("dyn7."), dyn8 = fctr("dyn8."),  
    tec1 = fctr("tec1."), tec2 = fctr("tec2."), tec3 = fctr("tec3."), tec4 = fctr("tec4."), tec5 = fctr("tec5."), tec6 = fctr("tec6."), tec7 = fctr("tec7."), tec8 = fctr("tec8.")  
) %>%  
    bind_cols(as_tibble(form$since)) %>%  
    filter(value == 3) %>%  
    select(-value)  

temp <- bind_cols(  
    select(data, starts_with("imp")) %>% rowMeans() %>% as_tibble(),  
    select(data, starts_with("dyn")) %>% rowMeans() %>% as_tibble(),  
    select(data, starts_with("tec")) %>% rowMeans() %>% as_tibble()  
)  
colnames(temp) <- c("imp", "dyn", "tec")  
temp %>%  
    summarise_all(sd)  

data <- summarise_all(data, median)  
temp <- bind_rows(  
    select(data, ends_with("1")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble(),  
    select(data, ends_with("2")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble(),  
    select(data, ends_with("3")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble(),  
    select(data, ends_with("4")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble(),  
    select(data, ends_with("5")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble(),  
    select(data, ends_with("6")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble(),  
    select(data, ends_with("7")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble(),  
    select(data, ends_with("8")) %>% gather(key, val) %>% pull(val) %>% t() %>% as_tibble()  
)  

colnames(temp) <- c("imp", "dyn", "tec")  
d <- dist(temp, method = "manhattan", diag = TRUE)  
md <- cmdscale(d, k = 3, eig = TRUE)  

p <- md$points %>%  
    as_tibble() %>%  
    bind_cols(tweet) %>%  
    plot_ly(x = ~V1, y = ~V2, z = ~V3, color = ~engagement, text = ~text) %>%  
    layout(scene = list(  
        xaxis = list(title = "V1"),  
        yaxis = list(title = "V2"),  
        zaxis = list(title = "V3")  
    ))  
api_create(p, "tanka-impression")  

pt <- temp %>%  
    bind_cols(tweet) %>%  
    plot_ly(x = ~imp, y = ~dyn, z = ~tec, color = ~engagement, text = ~text) %>%  
    layout(scene = list(  
        xaxis = list(title = "印象"),  
        yaxis = list(title = "静穏"),  
        zaxis = list(title = "技巧")  
    ))  
api_create(pt, "tanka-impression-under3")  

わかったかもしれないこと

  • 短歌に慣れている人ほど、短歌が技術的に優れているかどうか判断する独自の評価基準をもっている
  • 短歌をどう受けとめるかは、ことばの意味から受ける印象以外の話になると人によってかなりの差がある
  • Twitter上での短歌のエンゲージメントは、その作品の技術的な面での評価を反映していると考えられる