データが動く！Shinyで体験する世界

第12回 大阪SAS 勉強会 データが動く！ Shinyで体験する世界 関根 暁史 （藤本製薬株式会社） Explore the Interacitive World of Shiny! Satoshi Sekine Fujimoto Pharmaceutical Corp. 1

Shinyとは？ ➢ RのコードだけでWebアプリを構築可能。 ➢ ユーザーの操作に応じて、結果がリアルタイムで更新される。 ➢ shinyapps.io や Posit Connect を使えば、インターネット上にすぐ公 開できる。 もちろんローカ ルでも動作可能。 https://sasone-dash1.shinyapps.io/bmi_calculator/ 2

• https://sasone-dash1.shinyapps.io/bmi_calculator/

年齢を計算するアプリ
library(shiny)
ui <- fluidPage(
hr(),
textInput("textIn01",label="生年月日","1992-2-29"),
textInput("textIn02",label="同意取得日","2001-2-28"),
hr(),
p("年齢(歳)"),
textOutput("textOut01")
)
server <- function(input, output, session) {
output$textOut01 <- renderText({
dat1 <- as.Date(input$textIn01)
dat2 <- as.Date(input$textIn02)
value=length(seq(dat1,dat2,by="year"))-1
})
session$onSessionEnded(function(){
stopApp()
})
}
runApp(shinyApp(ui=ui,server=server),launch.browser=TRUE);

画面レイアウトを
作っているui

裏で計算をおこなっ
ているserver
ブラウザを閉じるとR
の動作を終了する
session
ご使用のEdge上にブ
ラウザを立ち上げる

3

年齢を計算するアプリ(SASの中で使いたい)
proc fcmp;
declare object py(python);
submit into py;
def PyProduct():
"""Output:"""
import rpy2.robjects as ro
ro.r('library(shiny)')
ro.r('ui <- fluidPage(hr(),textInput("textIn01",label="生年月日","1992-2-29"),textInput("textIn02",label="同意取得日
","2001-2-28"),hr(),p("年齢(歳)"),textOutput("textOut01"))')
ro.r('server <- function(input, output, session) {output$textOut01<-renderText({dat1<-as.Date(input$textIn01);dat2<as.Date(input$textIn02);value=length(seq(dat1,dat2,by="year"))-1;});session$onSessionEnded(function(){stopApp()});}')
ro.r('runApp(shinyApp(ui=ui,server=server),launch.browser=TRUE);')
endsubmit;
rc=py.publish();
rc=py.call('PyProduct');
run;

以下の初期設定は必要
x 'setx R_HOME "C:/Program Files/R/R-4.5.0"’;
x 'setx MAS_M2PATH "C:\Program Files\SASHome\SASFoundation\9.4\tkmas\sasmisc\mas2py.py“’;
x 'setx MAS_PYPATH "C:\Users\[user_name]\AppData\Local\Programs\Python\Python313\python.exe"';

4

年齢を計算するアプリ うるう日生まれ 平年では3/1に 加齢 https://sasone-dash1.shinyapps.io/age_calculator/ 5

• https://sasone-dash1.shinyapps.io/age_calculator/

eGFRを計算するアプリ
library(shiny)
ui <- fluidPage(
hr(),
selectInput("textIn00",label="性別",choices=c("女性","男性")),
textInput("textIn01",label="年齢(歳)"),
textInput("textIn02",label="血清クレアチニン(mg/dL)"),
textInput("textIn03",label="体重(kg)"),
hr(),
p("eGFR(mL/min/1.73m^2)"),
textOutput("textOut01"),
hr(),
p("CCR(mL/min) (Cockcroft-Gault式)"),
textOutput("textOut02")
)
server <- function(input,output,session){
output$textOut01 <- renderText({
age <- as.numeric(input$textIn01);
cre <- as.numeric(input$textIn02);
value=194*cre**(-1.094)*age**(-0.287);
result=ifelse(input$textIn00=="女性",value*0.739,value)
});
output$textOut02 <- renderText({
age <- as.numeric(input$textIn01);
cre <- as.numeric(input$textIn02);
wei <- as.numeric(input$textIn03);
value=(140-age)*wei/(72*cre);
result=ifelse(input$textIn00=="女性",value*0.85,value)
});
session$onSessionEnded(function(){
stopApp();
})
}
runApp(shinyApp(ui=ui,server=server),launch.browser=TRUE);

女性と男性で式が
異なる

6

eGFRを計算するアプリ 体重まで入力す ればCCR値が出 る https://sasone-dash1.shinyapps.io/egfr_calculator/ 7

• https://sasone-dash1.shinyapps.io/egfr_calculator/

Dataset-JSONを整形するツール 整形したい Pinnacle21のData Converterは 1行JSONで出力する 8

Dataset-JSONを整形するツール
library(shiny)
library(jsonlite)
library(zip)
ui <- fluidPage(
titlePanel("複数JSON整形（Prettify）ツール"),
fileInput("json_files", "複数のJSONファイルをアップロードしてください
", multiple = TRUE, accept = ".json"),
actionButton("process", "整形実行"),
verbatimTextOutput("result"),
downloadButton("download_zip", "整形済みZIPをダウンロード"))
server <- function(input, output, session) {
temp_dir <- reactiveVal(NULL)
result_text <- reactiveVal("")
observeEvent(input$process, {
req(input$json_files)
now <- format(Sys.time(), "%Y%m%dT%H%M%S")
dir_path <- file.path(tempdir(), paste0("pretty_json_", now))
dir.create(dir_path, showWarnings = FALSE)
temp_dir(dir_path)
success_count <- 0
error_files <- c()
for (i in 1:nrow(input$json_files)) {
file_info <- input$json_files[i, ]
file_path <- file_info$datapath
file_name <- tolower(file_info$name)
tryCatch({
raw_text <- readLines(file_path, warn = FALSE, encoding = "UTF-8")
json_obj <- fromJSON(paste(raw_text, collapse = "\n"))
pretty_json <- toJSON(json_obj, pretty = TRUE, auto_unbox = TRUE)
writeLines(pretty_json, file.path(dir_path, file_name), useBytes = TRUE)
success_count <- success_count + 1
}, error = function(e) {
error_files <<- c(error_files, paste(file_info$name, ":", e$message))
})}

result <- paste0(success_count, " 件のJSONファイルを整形しました。\n")
if (length(error_files) > 0) {
result <- paste0(result, "整形に失敗したファイル一
覧:\n", paste(error_files, collapse = "\n"))
}
result_text(result)
})
output$result <- renderText({
result_text()
})
output$download_zip <- downloadHandler(
filename = function() {
"pretty_jsons.zip"
},
content = function(file) {
req(temp_dir())
zip::zip(zipfile = file, files = list.files(temp_dir(), full.names = TRUE), mode = "
cherry-pick")
}
)
session$onSessionEnded(function(){
stopApp()
})

}
runApp(shinyApp(ui=ui,server=server),launch.browser=TRUE);

9

Dataset-JSONを整形するツール 複数ファイル OK ファイル名は小 文字化される https://sasone-dash1.shinyapps.io/prettify_json/ 10

• https://sasone-dash1.shinyapps.io/prettify_json/

2つのPDFファイルを結合するツール + スキャンPDF （署名ページ） スキャン PDFとテキ ストPDFを 結合させた い 11

2つのPDFファイルを結合するツール
library(shiny)
library(pdftools)
library(qpdf)
ui <- fluidPage(
titlePanel("PDFファイルのページを選んで結合するツール"),
h3("1つ目のPDFファイル"),
fileInput("file1", "PDFファイルをアップロードしてください", accept = ".pdf"),
numericInput("st1", "開始ページ", value = 1, min = 1),
numericInput("en1", "終了ページ", value = 1, min = 1),
h3("2つ目のPDFファイル"),
fileInput("file2", "PDFファイルをアップロードしてください", accept = ".pdf"),
numericInput("st2", "開始ページ", value = 1, min = 1),
numericInput("en2", "終了ページ", value = 1, min = 1),
actionButton("merge", "PDFを結合する"),
br(), br(),
uiOutput("download_ui"),
verbatimTextOutput("status"))
server <- function(input, output, session) {
pdf_output_file <- reactiveVal(NULL)
observeEvent(input$file1, {
req(input$file1)
info1 <- pdf_info(input$file1$datapath)
updateNumericInput(session, "st1", max = info1$pages, value = 1)
updateNumericInput(session, "en1", max = info1$pages, value = info1$pages)})
observeEvent(input$file2, {
req(input$file2)
info2 <- pdf_info(input$file2$datapath)
updateNumericInput(session, "st2", max = info2$pages, value = 1)
updateNumericInput(session, "en2", max = info2$pages, value = info2$pages)})
# downloadHandler は先に定義しておく（renderUIより先）
output$download <- downloadHandler(
filename = function() {
paste0("merged_", format(Sys.time(), "%Y%m%dT%H%M"), ".pdf")
},
content = function(file) {
file.copy(pdf_output_file(), file)
})

observeEvent(input$merge, {
req(input$file1, input$file2)
if (input$st1 > input$en1 || input$st2 > input$en2) {
output$status <- renderText("開始ページは終了ページ以下にしてください。")
return()
}

pages1 <- input$st1:input$en1
pages2 <- input$st2:input$en2
temp1 <- tempfile(fileext = ".pdf")
temp2 <- tempfile(fileext = ".pdf")
output_file <- tempfile(fileext = ".pdf")
tryCatch({
pdf_subset(input$file1$datapath, pages = pages1, output = temp1)
pdf_subset(input$file2$datapath, pages = pages2, output = temp2)
pdf_combine(c(temp1, temp2), output = output_file)
pdf_output_file(output_file)
output$status <- renderText("結合されたファイルを生成しました。")
output$download_ui <- renderUI({
downloadButton("download", "ダウンロード")
})

}, error = function(e) {
output$status <- renderText(paste("エラー:", e$message))
})
})
session$onSessionEnded(function() {
stopApp()
})
}
runApp(shinyApp(ui=ui,server=server),launch.browser=TRUE);

12

2つのPDFファイルを結合するツール これでAdobe要ら ずです PDF内のハイパー リンクは生きてま す https://connect.posit.cloud/sasone-dash1/content/019ab8de-c492-1ff3-ae6f15cde4c99187 13

• https://connect.posit.cloud/sasone-dash1/content/019ab8de-c492-1ff3-ae6f-15cde4c99187

画像ファイルをトリムするツール グラフの余白を削 除したい 14

画像ファイルをトリムするツール
library(shiny)
library(magick)
ui <- fluidPage(
titlePanel("画像ファイルをトリムします"),
sidebarLayout(
sidebarPanel(
fileInput("image", "画像ファイル (.png, .jpg) を選択してください", accept =
c("image/png", "image/jpeg")),
numericInput("top", "上 (%)", value = 35, min = 0, max = 100),
numericInput("bottom", "下 (%)", value = 35, min = 0, max = 100),
numericInput("left", "左 (%)", value = 25, min = 0, max = 100),
numericInput("right", "右 (%)", value = 25, min = 0, max = 100),
actionButton("trim", "画像をトリム"),
downloadButton("download", "トリミング画像をダウンロード")
),
mainPanel(
imageOutput("cropped_image")
)))
server <- function(input, output, session) {
cropped_img <- reactiveVal(NULL)
observeEvent(input$trim, {
req(input$image)
img <- image_read(input$image$datapath)
info <- image_info(img)
width <- info$width
height <- info$height
top <- height * input$top / 100
bottom <- height * (100 - input$bottom) / 100
left <- width * input$left / 100
right <- width * (100 - input$right) / 100
cropped <- image_crop(img, geometry_area(width = right - left, height = bottom
- top, x_off = left, y_off = top))
cropped_img(cropped) })

output$cropped_image <- renderImage({
req(cropped_img())
tmpfile <- tempfile(fileext = ".png")
image_write(cropped_img(), tmpfile)
list(src = tmpfile, contentType = "image/png", alt = "トリミングされた画像")
}, deleteFile = TRUE)
output$download <- downloadHandler(
filename = function() {
paste0(tools::file_path_sans_ext(input$image$name), "_trimmed.png")
},
content = function(file) {
req(cropped_img())
image_write(cropped_img(), path = file)
}
)
session$onSessionEnded(function() {
stopApp()
})
}
# アプリの起動
runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)

15

画像ファイルをトリムするツール プレビューが 映る https://connect.posit.cloud/sasone-dash1/content/019ab90b-df2b-f856-e7988f54cc008260 16

• https://connect.posit.cloud/sasone-dash1/content/019ab90b-df2b-f856-e798-8f54cc008260

SASログのエラーチェッカー
library(shiny)
library(readr)
library(stringr)
library(writexl)
ui <- fluidPage(
hr(),
fileInput("file", label = "ログファイル(UTF8)を選択して下さい"),
hr(),
actionButton("submit", "エラーチェックを返します"),
hr(),
tableOutput("result_table"), # 表形式で表示
hr(),
downloadButton("download_excel", "Excelでダウンロード")
)
server <- function(input, output, session) {
result_data <- reactiveVal(NULL)
observeEvent(input$submit, {
req(input$file)
text <- read_file(input$file$datapath)
df <- data.frame(
キーワード = c("ERROR", "エラー", "WARNING", "欠損", "無効", "欠落"),
件数 = c(
str_count(text, "ERROR"),
str_count(text, "エラー"),
str_count(text, "WARNING"),
str_count(text, "欠損"),
str_count(text, "無効"),
str_count(text, "欠落")
)
)
result_data(df)
})

output$result_table <- renderTable({
result_data()
})
output$download_excel <- downloadHandler(
filename = function() {
paste0("error_check_", Sys.Date(), ".xlsx")
},
content = function(file) {
write_xlsx(result_data(), path = file)
}
)
session$onSessionEnded(function() {
stopApp()
})
}

runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)

17

SASログのエラーチェッカー UTF-8専用です。 チェック結果を Excelでもダウン ロードできます。 https://connect.posit.cloud/sasone-dash1/content/019ab87d-6c2a-197f-3936d47fd397422a 18

• https://connect.posit.cloud/sasone-dash1/content/019ab87d-6c2a-197f-3936-d47fd397422a

テキストファイルの内容からワードクラウドを作る 19

テキストファイルの内容からワードクラウドを作る
library(shiny)
library(wordcloud)
library(udpipe)
library(stringi)
library(stringr)
library(RColorBrewer)
# モデルの読み込み（パスは適宜調整）
# モデルは .udpipe ファイルです
model <- udpipe_load_model("C:/Users/[user_name]/Documents/japanese-gsd-ud2.5-191206.udpipe")
ui <- fluidPage(
titlePanel("テキストファイル可視化（名詞抽出・udpipe使用）"),
fileInput("logfile", "テキストファイルをアップロードしてください", accept =
c(".log", ".txt")),
plotOutput("wc_plot"),
downloadButton("download_wc", "ワードクラウド画像をPNGでダウンロード")
)
server <- function(input, output, session) {
log_text <- reactive({
req(input$logfile)
raw_data <- readBin(input$logfile$datapath, "raw",
file.info(input$logfile$datapath)$size)
enc <- tryCatch(stri_enc_detect(raw_data)[[1]]$Encoding[1], error = function(e)
"UTF-8")
if (is.na(enc)) enc <- "UTF-8"
paste(readLines(input$logfile$datapath, encoding = enc), collapse = "\n")
})

noun_freq <- reactive({
text <- log_text()
annotation <- udpipe_annotate(model, x = text)
anno_df <- as.data.frame(annotation)
nouns <- subset(anno_df, upos == "NOUN" & !is.na(token))
freq_tbl <- sort(table(nouns$token), decreasing = TRUE)
freq_df <- data.frame(Term = names(freq_tbl), Freq = as.integer(freq_tbl),
stringsAsFactors = FALSE)
freq_df <- freq_df[freq_df$Freq > 1, ]
freq_df
})
output$wc_plot <- renderPlot({
req(noun_freq())
wordcloud(words = noun_freq()$Term, freq = noun_freq()$Freq,
scale = c(4, 0.5), colors = brewer.pal(8, "Dark2"))
})
output$download_wc <- downloadHandler(
filename = function() {"text_wordcloud.png"},
content = function(file) {
png(file, width = 800, height = 600)
wordcloud(words = noun_freq()$Term, freq = noun_freq()$Freq,
scale = c(4, 0.5), colors = brewer.pal(8, "Dark2"))
dev.off()
}
)
session$onSessionEnded(function() {
stopApp()
})
}
runApp(shinyApp(ui=ui, server=server), launch.browser = TRUE)

20

テキストファイルの内容からワードクラウドを作る 21

XPTファイルのViewer
library(shiny);library(bslib);library(DT);library(haven);
ui<-page_sidebar(title="XPT Viewer",
sidebar=sidebar(width=400,
fileInput("file",label="XPORT:",accept=c(".xpt"))),
mainPanel(width=400, DTOutput("outFile"))
)
server<-function(input,output,session){
inFile<-reactive({ read_xpt(input$file$datapath) });
output$outFile<-renderDataTable({ data.frame(inFile())
});
session$onSessionEnded(function(){
stopApp();
})
}
runApp(shinyApp(ui=ui,server=server),launch.browser=TRUE)

22

XPTファイルのViewer 英数字データセッ ト専用です。 https://sasone-dash1.shinyapps.io/xpt_viewer/ 23

• https://sasone-dash1.shinyapps.io/xpt_viewer/

Shinyapps.ioにクラウド公開する手順 例：p.3のプログ ラム ➢ RStudioでアプリを完成させる（例：age.R） ➢ RStudioの右上「Publish」ボタンをクリック ➢ shinyapps.io にアカウント登録（無料枠あり） ➢ アプリがクラウドにアップロードされ、URLが発行される https://sasone-dash1.shinyapps.io/age_calculator/ 24

• https://sasone-dash1.shinyapps.io/age_calculator/

参考文献 1) 水間 浩太郎 (2025)．R shinyによる簡単アプリ作成入門，第5回ナニワデータサイエンス研 究会 2) 舟尾 暢男 (2025)．R shiny超入門，第5回ナニワデータサイエンス研究会 25

ご清聴有難うございました 26