定期試験などのテスト結果を解析して、学生さん全体の理解状況や各学生さんの得意不得意を、短時間にさくっと知りたいと思いました。
そこで、RとShinyを使って、学生の成績データからヒストグラムや科目間の相関図、低スコアの警告表示までをワンステップで行うアプリを作成しました。
この記事ではその背景と機能、使い方を紹介します。
■ アプリの概要
このアプリは、CSVファイルで読み込んだ複数教科の成績データをもとに、以下の可視化・分析を提供します：
- 科目別ヒストグラムの自動描画
- 任意2教科の相関関係のインタラクティブな可視化（Plotly）
- 任意ボーダー点数以下の成績を赤色で警告表示
- 上記すべてのグラフとテーブルを一括PNG形式でZip出力
対象ユーザー
- 小学校から大学まで、採点業務がある教員全員
- 教育実習やTA（ティーチングアシスタント）
- 成績の集計や共有を行う教務事務
- R/Shinyに興味のある教育系開発者
■ アプリの構成
以下の機能ブロックに分かれています：
1. CSVテンプレートの配布・アップロード
- ＜20人6教科のダミーデータ＞をダウンロード可能
StudentID,Name, 各教科（例：Math, English, Science, Art, Tech, Chemistry）で構成- ＊実際のデータを入力したい場合、人数・教科数、ともに変更可能です。
2. 成績の可視化
「データ一覧」タブ
- CSVの内容をそのまま表形式で表示
- 全教科の平均点を追加で表示
「ヒストグラム」タブ
- 各教科ごとに人数分布を棒グラフで表示
- 初期表示で全教科分を個別に描画
「相関関係」タブ
- 全教科の相関図と相関係数を自動で表示（
GGally::ggpairs()による教科全体の相関マトリクス） - さらに別途で任意の2教科を選択し、散布図を描画
- ドットにマウスオーバーすると、StudentIDと名前を表示
「ボーダー未満の生徒」タブ
- 各教科でボーダー点数未満の得点を赤文字表示した表を表示
■ 出力機能
「全項目の結果画像DL（ZIP）」ボタン
- 以下3種のPNGを一括保存できます：
- ボーダー未満の得点を赤色表示した表（
low_scores.png） - 各教科のヒストグラム（
histograms.png） - 相関マトリクス（
correlation.png）
- ボーダー未満の得点を赤色表示した表（
- ZIPファイルとしてダウンロードされ、報告用資料や共有用に活用可能
■ 利用方法（コード全文、コピペしてお試しください。）
下記コードをRstudioでR scriptにコピペして、全コードを実行してみてください。下記のようなShinyアプリが起動します。
手始めにテンプレートCSVをダウンロードし、そのファイルをアップロードして、グラフを書かせてみてください。
もちろん自身で何かしらデータをお持ちでしたら、それを利用していただいても構いません。
# 必要なパッケージをベクトルで列挙します
packages <- c("shiny", "readr", "dplyr", "ggplot2", "GGally", "DT", "plotly", "gridExtra", "grid", "zip")
# パッケージが未インストールであればインストールし、すべてのパッケージを読み込みます
lapply(packages, function(pkg) {
if (!requireNamespace(pkg, quietly = TRUE)) install.packages(pkg)
library(pkg, character.only = TRUE)
})
# UI（ユーザーインターフェース）の定義部分
ui <- fluidPage(
# タイトルバーを表示
titlePanel("成績レポート生成ツール"),
# サイドバーとメインエリアのレイアウト
sidebarLayout(
sidebarPanel(
# テンプレートCSVをダウンロードするボタン
downloadButton("downloadTemplate", "テンプレートCSVをダウンロード"),
# CSVファイルをアップロードするための入力フォーム
fileInput("upload", "CSVファイルをアップロード"),
# 数値入力：科目のボーダー点数を指定（初期値60）
numericInput("threshold", "科目ごとのボーダー点数", value = 60),
# 相関関係を調べるためのX軸変数選択
selectInput("xvar", "相関関係評価：X軸", choices = NULL),
# 相関関係を調べるためのY軸変数選択
selectInput("yvar", "相関関係評価：Y軸", choices = NULL),
# ZIPファイルとして全ての図を一括ダウンロードするボタン
downloadButton("downloadAll", "全項目の結果画像DL（ZIP）")
),
mainPanel(
# 複数のタブに分けてデータと図を表示
tabsetPanel(
tabPanel("データ一覧", DTOutput("preview")), # データのプレビュー表示
tabPanel("ヒストグラム", uiOutput("histograms")), # 各科目のヒストグラム
tabPanel("相関関係", # 相関行列と選択変数間の散布図
plotOutput("corMatrix", height = "600px"),
plotlyOutput("correlationPlot")
),
tabPanel("ボーダー未満の生徒", DTOutput("lowScores")) # 点数がボーダー未満の生徒の表示
)
)
)
)
# サーバーサイドの処理
server <- function(input, output, session) {
# テンプレートCSVをダウンロードする処理
output$downloadTemplate <- downloadHandler(
filename = "template.csv",
content = function(file) {
set.seed(1) # 再現性のため乱数の種を固定
write.csv(
data.frame(
StudentID = 1001:1020,
Name = paste("Student", LETTERS[1:20]),
Math = sample(40:100, 20),
English = sample(40:100, 20),
Science = sample(40:100, 20),
Art = sample(40:100, 20),
Tech = sample(40:100, 20),
Chemistry = sample(40:100, 20)
), file, row.names = FALSE
)
}
)
# アップロードされたCSVデータの読み込みと加工（平均点追加）
data <- reactive({
req(input$upload) # ファイルがアップロードされるのを待つ
df <- read_csv(input$upload$datapath, show_col_types = FALSE)
df$Average <- rowMeans(df[, 3:ncol(df)], na.rm = TRUE) # 各生徒の平均点を計算
updateSelectInput(session, "xvar", choices = names(df)[3:(ncol(df) - 1)]) # X軸候補の更新
updateSelectInput(session, "yvar", choices = names(df)[3:(ncol(df) - 1)]) # Y軸候補の更新
df
})
# 図をZIP形式でダウンロードできるようにする
output$downloadAll <- downloadHandler(
filename = function() { "all_outputs.zip" },
content = function(file) {
df <- data()
threshold <- input$threshold
cols <- names(df)[3:(ncol(df) - 1)]
tmpdir <- tempdir() # 一時ディレクトリ
# ボーダー未満を赤で表示した表画像の作成
lowfile <- file.path(tmpdir, "low_scores.png")
png(lowfile, width = 1200, height = 600)
style_matrix <- matrix("black", nrow = nrow(df), ncol = ncol(df))
for (j in seq_along(cols)) {
style_matrix[, j + 2] <- ifelse(df[[cols[j]]] < threshold, "red", "black")
}
formatted_table <- gridExtra::tableGrob(
df,
theme = ttheme_default(core = list(fg_params = list(
col = unlist(as.data.frame(style_matrix)), fontsize = 12)))
)
grid.draw(formatted_table)
dev.off()
# 各科目のヒストグラム画像の作成
histfile <- file.path(tmpdir, "histograms.png")
png(histfile, width = 1000, height = 800)
grid.arrange(grobs = lapply(cols, function(subj) {
ggplot(df, aes_string(x = subj)) +
geom_histogram(fill = "skyblue", bins = 15, color = "black") +
labs(title = paste("ヒストグラム：", subj), x = subj, y = "人数") +
theme_minimal(base_size = 16)
}), ncol = 2)
dev.off()
# 相関行列画像の作成
corfile <- file.path(tmpdir, "correlation.png")
png(corfile, width = 800, height = 800)
print(GGally::ggpairs(df[, cols]))
dev.off()
# 3つの画像をZIPファイルにまとめる
zip::zip(zipfile = file, files = c(lowfile, histfile, corfile), mode = "cherry-pick")
}
)
# アップロードされたCSVのデータをテーブルで表示
output$preview <- renderDT({ req(data()); datatable(data(), options = list(pageLength = 10)) })
# ヒストグラムを動的に描画するためのUI出力を定義
output$histograms <- renderUI({
req(data()) # データがアップロードされていることを確認
subjects <- names(data())[3:(ncol(data()) - 1)] # 科目名の列だけを抽出（1,2列目はIDと名前）
# 各科目について、描画処理をリストで作成
plots <- lapply(subjects, function(subj) {
plotname <- paste0("hist_", subj) # 出力オブジェクトの名前を生成（例：hist_Math）
# 各科目のヒストグラム描画を定義
output[[plotname]] <- renderPlot({
ggplot(data(), aes_string(x = subj)) + # 科目名をx軸に指定
geom_histogram(fill = "skyblue", bins = 15, color = "black") + # ヒストグラムの見た目設定
labs(title = paste("ヒストグラム：", subj), x = subj, y = "人数") + # タイトルと軸ラベル
theme_minimal(base_size = 16) # 見やすいテーマを適用
})
# 作成したプロットオブジェクトをUI出力として返す
plotOutput(plotname)
})
# リストのプロットをすべてまとめてUIに返す
do.call(tagList, plots)
})
# 相関行列のグラフ（GGally::ggpairs）を描画する部分
output$corMatrix <- renderPlot({
req(data()) # データが存在していることを確認
GGally::ggpairs(data()[, 3:(ncol(data()) - 1)]) # 各科目間の相関行列を表示（平均列除く）
})
# 選択された2科目の散布図を描画（インタラクティブなPlotly）
output$correlationPlot <- renderPlotly({
req(data(), input$xvar, input$yvar) # データとX軸・Y軸が選択されていることを確認
df <- data()
# Plotlyで散布図を作成
plot_ly(
data = df,
x = as.formula(paste0("~", input$xvar)), # X軸：選択された科目名
y = as.formula(paste0("~", input$yvar)), # Y軸：選択された科目名
text = ~paste("ID:", StudentID, "<br>名前:", Name), # ホバー表示にIDと名前を表示
hoverinfo = "text", # マウスオーバー時の情報設定
mode = "markers", # マーカー（点）で表示
type = "scatter", # 散布図に指定
marker = list(color = 'blue') # マーカーの色を青に設定
) %>%
layout(
title = paste("相関：", input$xvar, "×", input$yvar), # 図のタイトル
xaxis = list(title = input$xvar), # X軸のラベルを設定
yaxis = list(title = input$yvar) # Y軸のラベルを設定
)
})
# 各科目でボーダー点未満の成績を赤文字で強調するテーブル出力
output$lowScores <- renderDT({
req(data()) # データがアップロードされていることを確認（NULL防止）
df <- data() # アップロードされたデータを取得
threshold <- input$threshold # UIから入力されたボーダー点を取得
# 科目の列名のみを抽出（3列目から平均列の1つ手前まで）
red_cols <- names(df)[3:(ncol(df) - 1)]
# datatableで表を表示し、各科目の点数がthreshold未満なら赤字にする
datatable(df, options = list(pageLength = 10)) %>%
formatStyle(
red_cols, # 書式設定する対象の列（科目列）
color = styleInterval(threshold - 1, c("red", "black")) # ボーダー未満は赤、それ以上は黒
)
})
}
# アプリ全体を起動する関数。ui（見た目）とserver（処理）を結びつける
shinyApp(ui, server)
■ おわりに
このアプリは、教育現場における成績処理・確認・共有を効率化し、視覚的に理解しやすい形式で支援するツールです。Shinyの持つUI構築能力とRの集計力を組み合わせることで、誰でも使える教育支援ツールを作ることができます。
このコードをもとに、カスタマイズしてみてもよいかもしれませんね。
追加したい機能や、修正希望がございましたら、是非ご連絡ください。
お問い合わせはこちらから
コメント