# For TALIS2018 # K.RIN # # ★設定項目(★マーク) # ・質問ID(「selected_question = " "」の部分) # ・表示順(「order_setting = 1」の部分) # ・表示順の組合わせ(「mutate('list_order' = `1`)」の部分) library(tidyverse) library(plyr) library(labelled) #★質問番号 selected_question = "TT3G42P" selected_question_big = substring(selected_question, 4,6) #★表示順(降順1,昇順-1) order_setting = -1 #言語(英語1,日本語2) lang_setting = 2 #ラベル if (lang_setting == 1) { y_label <- "Percent %" x_label <- "Country" legend_label <- "Response" } if (lang_setting == 2) { y_label <- "パーセント %" x_label <- "国" legend_label <- "回答" } #質問文データから質問番号に該当する質問文を抽出 if (lang_setting == 1) { #for English if (is.na(question_items$en[grep(selected_question, question_items$q_no, value = FALSE, fixed = FALSE)][[1]])) { q_title <- paste("【", selected_question_big,"】") } else { #質問文が空欄でなければ… q_title <- paste("【", selected_question_big,"】", question_items$en[grep(selected_question_big, question_items$q_no, value = FALSE, fixed = FALSE)][[1]]) } } if (lang_setting == 2) { #for Japanese if (is.na(question_items$ja[grep(selected_question, question_items$q_no, value = FALSE, fixed = FALSE)][[1]])) { q_title <- paste("【", selected_question_big,"】") } else { #質問文が空欄でなければ… q_title <- paste("【", selected_question_big,"】", question_items$ja[grep(selected_question_big, question_items$q_no, value = FALSE, fixed = FALSE)][[1]]) } } if(lang_setting == 1) { #for English q_sub <- paste("\n", question_items$en[grep(selected_question, question_items$q_no)]) } if(lang_setting == 2) { #for Japanese q_sub <- paste("\n", question_items$ja[grep(selected_question, question_items$q_no)]) } #質問文整形 q_width = 47 q_title_disp <- character() q_sub_disp <- character() q_title_length <- nchar(q_title) #大質問文 q_sub_length <- nchar(q_sub) #小質問文 if (q_title_length >1) { for(i in 1:q_title_length%/%q_width+1) { q_title_disp[i] <- paste(substring(q_title, ((i-1)*q_width+1), ((i-1)*q_width+1)+(q_width-1)), '\n') } } else { q_title_disp[1] <- q_title } if (q_sub_length >1) { for(j in 1:q_sub_length%/%q_width+1) { q_sub_disp[j] <- paste(substring(q_sub, ((j-1)*q_width+1), ((j-1)*q_width+1)+(q_width-1)), '\n') } } else { q_sub_disp[1] <- q_sub } q_title_all <- paste(q_title_disp, collapse="") q_sub_all <- paste(q_sub_disp, collapse="") q_all <- paste(q_title_all, q_sub_all, collapse="") #各質問の選択肢データの個数 #ans_item_count <- as.numeric(answer_items$items_count[grep(selected_question, answer_items$q_no)]) ans_item_count <- 0 repeat { if (is.null(val_label(ATGINTT3[[selected_question]],ans_item_count+1))){ break } ans_item_count <- ans_item_count + 1 } ans_item_colcount <- as.integer(answer_items$items_count[grep(selected_question_big, answer_items$q_no)][1]) #grepした結果1つ目 #回答選択肢データの読み込みと設定 ans_limits <- as.character(answer_items[grep(selected_question_big, answer_items$q_no),][1,4:sum(ans_item_count + 3)]) #数値回答 if (lang_setting == 1) { ans_labels <- as.character(answer_items[grep(selected_question, answer_items$q_no),][1,sum(4):sum(ans_item_count+3)]) #for English Answer } if (lang_setting == 2) { ans_labels <- as.character(answer_items[grep(selected_question, answer_items$q_no),][1,sum(ans_item_colcount+4):sum(ans_item_colcount+ans_item_count+3)]) #for Japanese Answer } #回答データ抽出 stu_tmp <- subset(ATGINTT3, ATGINTT3[[selected_question]] != "NaN") #無回答を除く(質問されてない国もあるため) data_ans <- table(stu_tmp[["CNTRY"]],stu_tmp[[selected_question]]) #質問番号のデータを抽出 ans_df <- as_tibble(data_ans,validate = FALSE) #df(データフレーム)へ変換 colnames(ans_df) <- c("CNT", "answer", "count") #dfの列ラベル設定 ans_wide <- spread(ans_df, answer, count) #横長dfへ変換 #行番号をデータに変換して列として追加 #★グラフ表示順を決める回答項目の数値合計を列として追加[ +`2`+`3`+`4`+`5`] ans_wide <- ans_wide %>% rownames_to_column('num') %>% mutate('list_order' = `1` + `2`) #num列の数字を文字から数値にモード変換 mode(ans_wide$num) <- "integer" typeof(ans_wide$num) #国コードをもとに国名をcountry_name列として追加 if (lang_setting == 1) { ans_wide <- ddply(ans_wide, 'CNT', transform, country_name = country_code$Name[grep(CNT, country_code$Alpha3)]) } if (lang_setting == 2) { ans_wide <- ddply(ans_wide, "CNT", transform, country_name = country_code$Name_ja[grep(CNT, country_code$Alpha3)]) } #列ラベルの設定 colnames(ans_wide) <- c("num", "CNT", ans_limits, "list_order", "country_name") #縦長dfに変換 ans_df <- gather(ans_wide, answer,count,-num,-CNT,-list_order,-country_name) #国コードと回答で並べ替え ans_df <- arrange(ans_df, desc(CNT), desc(answer)) #パーセント計算(描画計算用パーセント) ans_df <- ddply(ans_df, "CNT", transform, percent = count / sum(count) * 100, 0.1) #小数点以下1桁処理(表示用パーセント) country_ans <- ddply(ans_df, "CNT", transform, percent_rounded = round_any(count / sum(count) * 100, 0.1)) #数値合計した分のパーセント数値を計算(表示順序用パーセント) country_ans <- ddply(country_ans, "CNT", transform, list_percent_order = round_any(list_order / sum(count) * 100 * order_setting, 0.1)) #ラベル位置計算 country_ans <- ddply(country_ans, "CNT", transform, percent_label_y = cumsum(percent)-0.5*percent) #フォント準備(Mac用) # quartzFonts(HiraKaku = quartzFont(rep("HiraginoSans-W3", 4))) par(family = "HiraKaku") #グラフ描画準備 # graph <- ggplot(country_ans, aes(x = reorder(country_name, list_percent_order), y = percent, fill = factor(answer))) + ggtitle(sprintf("%s", q_all)) + #タイトル ylab(y_label) + #国ラベル xlab(x_label) + #パーセントラベル labs(fill = legend_label) + #凡例タイトル coord_flip(expand = FALSE) + geom_bar(stat = "identity", position='stack') + geom_text(aes(y = percent_label_y, label = paste(format(percent_rounded, nsmall = 1),"")), color = "white", size = 4) + #データラベル scale_y_reverse(breaks = c(100.0,75.0,50.0,25.0,0.0), labels = c("0%","25%","50%","75%","100%")) + #横軸 scale_fill_discrete(limits = ans_limits, labels = ans_labels) + #凡例 scale_color_manual(values = rainbow(7)) + #カラー theme_bw() + theme(plot.margin = margin(1, 1, 1, 1, "cm"), plot.title = element_text(family = "HiraKaku", size = 10), plot.caption = element_text(family = "HiraKaku", size = 10), legend.title = element_text(family = "HiraKaku", size = 10), legend.text = element_text(family = "HiraKaku", size = 7), axis.title = element_text(family = "HiraKaku", size = 9), axis.title.y = element_text(angle = 0, vjust = 0.5), axis.text.x = element_text(family = "HiraKaku", size = 9), axis.text.y = element_text(family = "HiraKaku", size = 10)) print(graph) #グラフ描画