カテゴリー: Stats

以前のブログ記事で，likert packageを使った視覚化について書いたけれど，今度はHH packageも使う方法。データとしては以前と同じ，以下のイメージ。質問項目は，Q1からQ5まであって，例えば，１が「全く良くない」で，５が「とても良い」のような５件法だとする。データのcsvはこちら。

Q1	Q2	…	Q5
1	4	…	5
5	3	…	3
…	…	…	….

library(HH)
library(likert)
library(plyr)
dat=read.csv("likert_test.csv", header= T) #データの読み込み
　　dat2=data.frame(lapply(dat, factor, levels=1:5)) 
#datの中身をfactor（文字列）に変換。その際に，五件法なので範囲を1から５までとする。つまり，ある設問への反応として１が含まれていない場合などでも，１が０回とするための処置。その上で，データ・フレームにする
　　HH::plot.likert(　 #HHでPlotを出す
　　likert::likert(dat2), #likert packageで集計する
　　col=rev(grey(seq(0,1,0.25))),　#１を白，５を黒，中間がグレーの指定。revをしているので，これを外すと５が黒，１が白。また，１から5段階なので，0.25ずつグラデーションにする。
　　main ="TEST1"　タイトルはTEST1とする
　　)

Itemの順番がQ5からQ1になっているのが気になるのと，１が白字なので，枠線がないと見えない。これらを解消。

HH::plot.likert(
　　likert::likert(dat2),
　　col=rev(grey(seq(0,1,0.25))),
　　main ="TEST2", 
　　reverse=F, 　＃Itemの順番を上からQ1の順に
　　border = c("#111111", "#111111", "#111111", "#111111", "#111111")　#グラフの周りを黒枠で囲む
　　)

グラフの中に%で数値を入れたい。

以下のFunctionはStakFlowのこちらの答えから引用し，変更したもの。グラフ内に数値％を表示する。

myPanelFunc = function(...){
  panel.likert(...)
  vals <- list(...)
  DF <- data.frame(x=vals$x, y=vals$y, groups=vals$groups)
  
  ### some convoluted calculations here...
  grps <- as.character(DF$groups)
  for(i in 1:length(origNames)){
    grps <- sub(paste0('^',origNames[i]),i,grps)
  }
  
  DF <- DF[order(DF$y,grps),]
  
  DF$correctX <- ave(DF$x,DF$y,FUN=function(x){
    x[x < 0] <- rev(cumsum(rev(x[x < 0]))) - x[x < 0]/2
    x[x > 0] <- cumsum(x[x > 0]) - x[x > 0]/2

    return(x)

  })

subs <- sub(' Positive
,'',DF$groups) 
collapse <- subs[-1] == subs[-length(subs)] & DF$y[-1] == DF$y[-length(DF$y)] 
DF$abs <- abs(DF$x) 
DF$abs[c(collapse,FALSE)] <- DF$abs[c(collapse,FALSE)] + DF$abs[c(FALSE,collapse)] DF$correctX[c(collapse,FALSE)] <- 0 DF <- DF[c(TRUE,!collapse),] DF$perc <- round(ave(DF$abs,DF$y,FUN=function(x){x/sum(x) * 100})) 
### 
panel.text(x=DF$correctX, y=DF$y, label=paste0(DF$perc,'%'), cex=1.0,col=c("black","black","black","white","white")) } #ここは数値と%の表示色を決める。今回は白字とグレーと黒なので，それに合わせて変更している。

以下がPackageを使用したスクリプト

origNames=rownames(dat) #Functionで使うデータの定義
HH::plot.likert(
  likert::likert(dat2), 
  col=rev(grey(seq(0,1,0.25))),
  main ="TEST3", 
  reverse=F, 
  border = c("#111111", "#111111", "#111111", "#111111", "#111111"), 
 panel =myPanelFunc #上で定義したFunctionを使う。
 )

備忘録その３ですが，その２の落穂拾い。凡例をつけて見やすくする。なので，データ例は，その２と同じ。

library(dplyr)
library(plotrix)

dat=read.csv("test2.csv") #データ読み込み

dat2 = dat %>% #datを対象とした以下の処理をして，それをdat2へ入れる
　　　gather(Section_Year,Score, -ID) %>%　#縦長のデータにする。Section_Yearという新しい変数を作り，SectionX_20xxデータを並べる。Scoreはの横に配置。IDは入れない。
　　　separate(col="Section_Year", sep="_", into=c("Section", "Year"))%>%　#Section_Yearを_を区切りに分けて，SectionとYearを別々の列とする 
　　　group_by(Section,Year) %>% #SectionとYearでグループ化する
　　　summarize(mean=mean(Score)) %>% 　#Scoreの平均を出す
　　　spread(Section, mean) #横向きデータに変更

　dat3 = select_if(dat2, is.numeric)　#数値しか入れられないので，数値以外は削除。

　radial.plot(dat3, #データ入力
　　　　　　　rp.type = "p",　 #表示方法。オプションは、r (中心から直線が出る),p (線で結ぶ),s (点のみ)
　　　　　　　start = pi/2, #グラフを始める位置。Section1を12時にする。
　　　　　　　radial.lim=c(40,60), #軸の範囲。
　　　　　　　labels=colnames(dat3), #項目名
　　　　　　　line.col=1:2, #線の色。ここでは１（黒）と２（赤）。
　　　　　　　lwd=2, #線の太さ。
　　　　　　　lty=1:2 #線の種類。ここでは1(実線)と２(点線)。
              show.grid.labels =FALSE #軸のラベル（数値）が邪魔な場合はFALSEで表示させない。

)
legend("bottomright", #表示させる位置
　　　　legend=c("2016", "2017"),　#表示させるもの 
　　　　col=1:2, #線の色（グラフ本体と合わせる）
　　　　lty=1:2  #線のスタイル（グラフ本体と合わせる）
)

備忘録その２。よくもらうデータのタイプとしては，以下のようなものもある。

ID	Section1_2016	…	Section4_2016	…	Section4_2017
1	49	…	71	…	8
2	98	…	28	…	5
3	55	…	51	…	30
4	91	…	2	…	47
5	60	…	20	…	56
…	…	…	…	…	…
30	90	…	17	…	44

library(dplyr)
library(tidyverse)
library(plotrix)

dat=read.csv("test2.csv") #データ読み込み

dat2 = dat %>% #datを対象とした以下の処理をして，それをdat2へ入れる
      gather(Section_Year,Score, -ID) %>%　#縦長のデータにする。Section_Yearという新しい変数を作り，SectionX_20xxデータを並べる。Scoreはの横に配置。IDは入れない。
      separate(col="Section_Year", sep="_", into=c("Section", "Year"))%>%　#Section_Yearを_を区切りに分けて，SectionとYearを別々の列とする 
      group_by(Section,Year) %>% #SectionとYearでグループ化する
      summarize(mean=mean(Score)) %>% 　#Scoreの平均を出す
      spread(Section, mean) #横向きデータに変更
 
dat3 = select_if(dat2, is.numeric)　#数値しか入れられないので，数値以外は削除。

radial.plot(dat3, #データ入力
　　　　　rp.type = "p",　 #表示方法。オプションは、r (中心から直線が出る),p (線で結ぶ),s (点のみ)
　　　　　start = pi/2, #グラフを始める位置。Section1を12時にする。
　　　　　radial.lim=c(40,60), #軸の範囲。
　　　　　labels=colnames(dat3), #項目名
　　　　　line.col=1:2, #線の色。ここでは１（黒）と２（赤）。
　　　　　lwd=2, #線の太さ。
　　　　　lty=1:2 #線の種類。ここでは1(実線)と２(点線)。
)

うーん、もっとスマートな整形の仕方はないものか。

Radar Chartを描く方法をいくつか試したので、備忘録的に書いておく。
今回は，plotrixを使用した。

データとしては、個人的にエクセルでもらうことの多い、以下のような形式。ファイル名は取り合えず、test.csvとしておく。

ID	Section1	Section2	Section3	Section4
1	40	30	50	79
2	72	65	24	77
3	24	15	10	31
…	…	…	…	…
30	26	14	97	53

 

library(dplyr)
library(plotrix)

dat=read.csv("test.csv")
dat$ID=as.factor(dat$ID) #IDはfactorに変換

dat2=dat %>% summarize_if(is.numeric, funs(mean)) #dplyrのsummarizeで、numericの列だけ平均を出す。

radial.plot(dat2, #データの入力
　　　　　rp.type="p", #表示方法。オプションは、r (中心から直線が出る),p (線で結ぶ),s (点のみ)
　　　　　start = pi/2, #グラフを始める位置。Section1を12時にする。
　　　　　radial.lim = c(50,56), #軸の範囲。
　　　　　labels = colnames(dat2), #項目名
　　　　　clockwise = TRUE #時計回りに表示
)