sugitora/SecurityGuardMatchingApp01
0
1# app.R - 警備マッチング可視化アプリ（改良版）2# 要件: 充足率表示、日付期間選択、要営業強化エリア識別3 4library(shiny)5library(dplyr)6library(leaflet)7 8# =========================================================9# 0) 設定10# =========================================================11BBOX <- list(12 lat_min = 36.0,13 lat_max = 36.9,14 lng_min = 139.3,15 lng_max = 140.316)17 18# 充足率の閾値19THRESHOLD_LOW <- 80 # 80%未満 = 要営業強化（赤）20THRESHOLD_HIGH <- 100 # 100%以上 = 充足（緑）21 22# =========================================================23# 1) ユーティリティ24# =========================================================25read_csv_bom <- function(path) {26 if (!file.exists(path)) stop(paste("ファイルが見つからない:", path))27 df <- tryCatch(28 read.csv(path, fileEncoding = "UTF-8-BOM", stringsAsFactors = FALSE, check.names = FALSE),29 error = function(e) read.csv(path, stringsAsFactors = FALSE, check.names = FALSE)30 )31 df32}33 34to_date <- function(x) {35 if (inherits(x, "Date")) return(x)36 x <- as.character(x)37 x <- trimws(x)38 x[x == ""] <- NA39 x2 <- gsub("/", "-", x, fixed = TRUE)40 as.Date(x2)41}42 43haversine_km <- function(lat1, lon1, lat2, lon2) {44 r <- 6371.045 to_rad <- function(x) x * pi / 18046 dlat <- to_rad(lat2 - lat1)47 dlon <- to_rad(lon2 - lon1)48 a <- sin(dlat/2)^2 + cos(to_rad(lat1)) * cos(to_rad(lat2)) * sin(dlon/2)^249 2 * r * asin(pmin(1, sqrt(a)))50}51 52extract_city <- function(addr) {53 if (is.na(addr) || trimws(addr) == "") return(NA_character_)54 a <- gsub(" ", " ", addr, fixed = TRUE)55 a <- gsub("\\（.*?\\）", "", a)56 a <- gsub("\\(.*?\\)", "", a)57 a2 <- sub(".*県", "", a)58 m <- regexpr("(市|町|村|区)", a2)59 if (m[1] == -1) return(NA_character_)60 endpos <- m[1] + attr(m, "match.length") - 161 substr(a2, 1, endpos)62}63 64# 充足率に応じた色を返す65get_fill_color <- function(rate) {66 case_when(67 is.na(rate) ~ "gray",68 rate < THRESHOLD_LOW ~ "#e74c3c", # 赤 - 要営業強化69 rate < THRESHOLD_HIGH ~ "#f39c12", # オレンジ - 注意70 TRUE ~ "#27ae60" # 緑 - 充足71 )72}73 74# =========================================================75# 2) データ読み込み＆前処理76# =========================================================77load_all_data <- function() {78 contract_raw <- read_csv_bom("contract_list.csv")79 guard_raw <- read_csv_bom("guard_master.csv")80 avail_raw <- read_csv_bom("availability.csv")81 82 # ---- contract_list ----83 contract <- contract_raw %>%84 mutate(85 `案件予定日(開始)` = to_date(`案件予定日(開始)`),86 `案件予定日(終了)` = to_date(`案件予定日(終了)`),87 現場住所 = paste0(88 ifelse(is.na(`現場住所１`), "", `現場住所１`),89 ifelse(is.na(`現場住所２`) | trimws(`現場住所２`) == "", "", paste0(" ", `現場住所２`))90 ),91 required_guards = `必要人数`,92 site_city = `市区町村`93 )94 95 # ---- guard_master ----96 guard <- guard_raw %>%97 mutate(98 従業員番号 = suppressWarnings(as.integer(`従業員番号`)),99 guard_city = vapply(`住所`, extract_city, character(1))100 )101 102 # ---- availability ----103 avail <- avail_raw %>%104 mutate(105 日付 = to_date(`日付`),106 従業員番号 = suppressWarnings(as.integer(`従業員番号`)),107 available_flag = as.integer(`対応可否`)108 )109 110 list(contract = contract, guard = guard, avail = avail)111}112 113DATA <- NULL114LOAD_ERROR <- NULL115tryCatch({116 DATA <- load_all_data()117}, error = function(e) {118 LOAD_ERROR <<- e$message119})120 121# =========================================================122# 3) UI123# =========================================================124ui <- fluidPage(125 tags$head(126 tags$link(rel = "icon", href = "data:,"),127 tags$style(HTML("128 .legend-box { padding: 10px; background: white; border-radius: 5px; }129 .legend-item { display: flex; align-items: center; margin: 5px 0; }130 .legend-color { width: 20px; height: 20px; border-radius: 50%; margin-right: 8px; }131 .summary-header { background-color: #f8f9fa; padding: 10px; border-radius: 5px; margin-bottom: 10px; }132 "))133 ),134 titlePanel("警備マッチング可視化（充足率・期間選択対応）"),135 sidebarLayout(136 sidebarPanel(137 if (!is.null(LOAD_ERROR)) {138 tags$div(139 style = "color:#b00020; font-weight:600;",140 paste0("データ読込エラー: ", LOAD_ERROR),141 tags$br(),142 "同じフォルダに contract_list.csv / guard_master.csv / availability.csv を置いているか確認する。"143 )144 } else {145 tagList(146 h4("📅 期間選択"),147 sliderInput(148 "date_range",149 "対象期間",150 min = min(DATA$contract$`案件予定日(開始)`, na.rm = TRUE),151 max = max(DATA$contract$`案件予定日(終了)`, na.rm = TRUE),152 value = c(153 min(DATA$contract$`案件予定日(開始)`, na.rm = TRUE),154 min(DATA$contract$`案件予定日(開始)`, na.rm = TRUE) + 7155 ),156 timeFormat = "%m/%d",157 step = 1158 ),159 hr(),160 h4("🗺️ 表示設定"),161 checkboxInput("show_guards", "アベイラブル隊員を表示", TRUE),162 radioButtons(163 "match_mode",164 "マッチング方法",165 choices = c("市区町村一致" = "city", "距離（半径km）" = "dist"),166 selected = "city"167 ),168 conditionalPanel(169 condition = "input.match_mode == 'dist'",170 numericInput("radius_km", "半径（km）", value = 20, min = 1, max = 200, step = 1)171 ),172 hr(),173 h4("📊 凡例"),174 tags$div(175 class = "legend-box",176 tags$div(class = "legend-item",177 tags$div(class = "legend-color", style = "background-color: #27ae60;"),178 tags$span("充足（100%以上）")179 ),180 tags$div(class = "legend-item",181 tags$div(class = "legend-color", style = "background-color: #f39c12;"),182 tags$span("注意（80-99%）")183 ),184 tags$div(class = "legend-item",185 tags$div(class = "legend-color", style = "background-color: #e74c3c;"),186 tags$span("要営業強化（80%未満）")187 ),188 tags$div(class = "legend-item",189 tags$div(class = "legend-color", style = "background-color: #3498db; opacity: 0.7;"),190 tags$span("アベイラブル隊員")191 )192 )193 )194 },195 width = 3196 ),197 mainPanel(198 # サマリー統計199 fluidRow(200 column(3, 201 tags$div(class = "summary-header",202 h5("稼働現場数"),203 textOutput("stat_sites", inline = TRUE)204 )205 ),206 column(3,207 tags$div(class = "summary-header",208 h5("必要人数合計"),209 textOutput("stat_required", inline = TRUE)210 )211 ),212 column(3,213 tags$div(class = "summary-header",214 h5("対応可能人数"),215 textOutput("stat_available", inline = TRUE)216 )217 ),218 column(3,219 tags$div(class = "summary-header",220 h5("平均充足率"),221 textOutput("stat_avg_rate", inline = TRUE)222 )223 )224 ),225 leafletOutput("map", height = 480),226 br(),227 h4("現場別 需給状況（選択期間）"),228 tableOutput("summary"),229 width = 9230 )231 )232)233 234# =========================================================235# 4) Server236# =========================================================237server <- function(input, output, session) {238 if (!is.null(LOAD_ERROR)) {239 output$map <- renderLeaflet({ leaflet() %>% addTiles() })240 output$summary <- renderTable({241 data.frame(エラー = LOAD_ERROR, stringsAsFactors = FALSE)242 })243 return()244 }245 246 contract <- DATA$contract247 guard <- DATA$guard248 avail <- DATA$avail249 250 # 選択期間のデータを取得251 daily <- reactive({252 date_range <- input$date_range253 d_start <- date_range[1]254 d_end <- date_range[2]255 256 # 期間内に稼働中の現場257 active_sites <- contract %>%258 filter(!is.na(`案件予定日(開始)`), !is.na(`案件予定日(終了)`)) %>%259 filter(`案件予定日(開始)` <= d_end, `案件予定日(終了)` >= d_start)260 261 # 期間内で「対応可」の日が1日でもある隊員262 available_emp <- avail %>%263 filter(!is.na(日付), 日付 >= d_start, 日付 <= d_end, available_flag == 1L) %>%264 distinct(従業員番号)265 266 available_guards <- guard %>%267 inner_join(available_emp, by = "従業員番号")268 269 list(270 date_start = d_start,271 date_end = d_end,272 active_sites = active_sites,273 available_guards = available_guards274 )275 })276 277 # 需給サマリー計算278 summary_tbl <- reactive({279 dd <- daily()280 sites <- dd$active_sites281 gds <- dd$available_guards282 283 if (nrow(sites) == 0) {284 return(data.frame(メッセージ = "選択期間に稼働中の現場がない", stringsAsFactors = FALSE))285 }286 287 if (input$match_mode == "city") {288 g_by_city <- gds %>%289 mutate(guard_city = ifelse(is.na(guard_city), "不明", guard_city)) %>%290 count(guard_city, name = "available_guards")291 292 result <- sites %>%293 mutate(site_city = ifelse(is.na(site_city), "不明", site_city)) %>%294 left_join(g_by_city, by = c("site_city" = "guard_city")) %>%295 mutate(296 available_guards = ifelse(is.na(available_guards), 0L, available_guards),297 shortage = pmax(required_guards - available_guards, 0L),298 fulfillment_rate = round(available_guards / required_guards * 100, 0)299 )300 } else {301 radius <- input$radius_km302 if (is.null(radius) || is.na(radius) || radius <= 0) radius <- 20303 304 if (nrow(gds) == 0) {305 result <- sites %>%306 mutate(307 available_guards = 0L,308 shortage = required_guards,309 fulfillment_rate = 0310 )311 } else {312 result <- sites %>%313 rowwise() %>%314 mutate(315 available_guards = {316 dist <- haversine_km(site_lat, site_lng, gds$home_lat, gds$home_lng)317 sum(dist <= radius, na.rm = TRUE)318 }319 ) %>%320 ungroup() %>%321 mutate(322 shortage = pmax(required_guards - available_guards, 0L),323 fulfillment_rate = round(available_guards / required_guards * 100, 0)324 )325 }326 }327 328 # 色と状態を追加329 result <- result %>%330 mutate(331 fill_color = get_fill_color(fulfillment_rate),332 status = case_when(333 fulfillment_rate < THRESHOLD_LOW ~ "⚠️ 要営業強化",334 fulfillment_rate < THRESHOLD_HIGH ~ "△ 注意",335 TRUE ~ "○ 充足"336 )337 )338 339 result340 })341 342 # 表示用テーブル343 output$summary <- renderTable({344 tbl <- summary_tbl()345 if ("メッセージ" %in% colnames(tbl)) return(tbl)346 347 tbl %>%348 transmute(349 契約ID = contract_id,350 契約No = `契約No`,351 顧客 = `顧客`,352 件名 = paste0(`件名１`, ifelse(is.na(`件名２`) | trimws(`件名２`) == "", "", paste0(" ", `件名２`))),353 市区町村 = site_city,354 必要人数 = required_guards,355 対応可能 = as.integer(available_guards),356 充足率 = paste0(fulfillment_rate, "%"),357 状態 = status358 )359 })360 361 # サマリー統計362 output$stat_sites <- renderText({363 dd <- daily()364 paste0(nrow(dd$active_sites), " 件")365 })366 367 output$stat_required <- renderText({368 tbl <- summary_tbl()369 if ("メッセージ" %in% colnames(tbl)) return("-")370 paste0(sum(tbl$required_guards, na.rm = TRUE), " 人")371 })372 373 output$stat_available <- renderText({374 dd <- daily()375 paste0(nrow(dd$available_guards), " 人")376 })377 378 output$stat_avg_rate <- renderText({379 tbl <- summary_tbl()380 if ("メッセージ" %in% colnames(tbl)) return("-")381 avg_rate <- mean(tbl$fulfillment_rate, na.rm = TRUE)382 paste0(round(avg_rate, 0), "%")383 })384 385 # 地図（初回のみ）386 output$map <- renderLeaflet({387 center_lat <- mean(c(BBOX$lat_min, BBOX$lat_max))388 center_lng <- mean(c(BBOX$lng_min, BBOX$lng_max))389 390 leaflet() %>%391 addTiles() %>%392 setView(lng = center_lng, lat = center_lat, zoom = 9) %>%393 addLayersControl(394 overlayGroups = c("現場（充足率）", "アベイラブル隊員"),395 options = layersControlOptions(collapsed = FALSE)396 )397 })398 399 # 地図更新（マーカー）400 observe({401 dd <- daily()402 sites_data <- summary_tbl()403 gds <- dd$available_guards404 405 proxy <- leafletProxy("map")406 proxy %>%407 clearGroup("現場（充足率）") %>%408 clearGroup("アベイラブル隊員")409 410 # 現場マーカー（充足率付き）411 if (!("メッセージ" %in% colnames(sites_data)) && nrow(sites_data) > 0) {412 # CircleMarkersを追加413 proxy %>%414 addCircleMarkers(415 data = sites_data,416 lng = ~site_lng, lat = ~site_lat,417 radius = 14,418 color = ~fill_color,419 fillColor = ~fill_color,420 fillOpacity = 0.85,421 weight = 2,422 label = ~paste0(423 "【", `契約No`, "】", `件名１`,424 " | 充足率: ", fulfillment_rate, "%",425 " | 必要: ", required_guards, "人",426 " | 対応可: ", available_guards, "人"427 ),428 group = "現場（充足率）"429 )430 431 # 充足率ラベルを個別に追加（色を動的に設定するため）432 for (i in seq_len(nrow(sites_data))) {433 row <- sites_data[i, ]434 proxy %>%435 addLabelOnlyMarkers(436 lng = row$site_lng,437 lat = row$site_lat,438 label = paste0(row$fulfillment_rate, "%"),439 labelOptions = labelOptions(440 noHide = TRUE,441 direction = "top",442 textOnly = TRUE,443 style = list(444 "font-weight" = "bold",445 "font-size" = "11px",446 "color" = "white",447 "background-color" = row$fill_color,448 "padding" = "2px 5px",449 "border-radius" = "4px"450 )451 ),452 group = "現場（充足率）"453 )454 }455 }456 457 # アベイラブル隊員マーカー458 if (isTRUE(input$show_guards) && nrow(gds) > 0) {459 proxy %>%460 addCircleMarkers(461 data = gds,462 lng = ~home_lng, lat = ~home_lat,463 radius = 6,464 color = "#3498db",465 fillColor = "#3498db",466 fillOpacity = 0.6,467 weight = 1,468 label = ~paste0("従業員番号: ", 従業員番号, " | ", 苗字, " ", 名前, " | ", guard_city),469 group = "アベイラブル隊員"470 )471 }472 })473}474 475shinyApp(ui, server)476