15hw

library(readxl)
library(psych)
library(lattice)
library(ggplot2)

## 
## Attaching package: 'ggplot2'

## The following objects are masked from 'package:psych':
## 
##     %+%, alpha

library(showtext)

## Loading required package: sysfonts

## Loading required package: showtextdb

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(forcats)
library(scales)

## 
## Attaching package: 'scales'

## The following objects are masked from 'package:psych':
## 
##     alpha, rescale

library(tidyr)
#install.packages("forcats")
#install.packages("showtext")
#install.packages("sysfonts")
#install.packages("curl")
#install.packages("scales")
#install.packages("tidyr")

library(showtext)
library(sysfonts)

font_add_google("Noto Sans KR", "Noto Sans KR")
showtext_auto()

df <- read_excel("Austin_Animal_Center_Outcomes_(2020~2025).xlsx")
#View(df)

1. 프로젝트 주제 유기동물 입양 결정 요인에 대한 통합 분석: 건강, 연령, 보호 상태, 시계열 구조 중심으로

2. 데이터 분석의 목적

• 유기동물의 구조, 보호, 입양 과정을 분석하여 입양 성패의 결정 요인을 규명하고자 함
• 보호소 운영 환경, 건강 상태, 연령 분포, 중성화 여부, 품종, 시간 흐름 등 다차원적 요인 간 상관관계를 시각적으로 탐색함
• 분석을 통해 입양률 향상, 정책 개입 지점, 디자인 개선 전략 제안을 도출함

3. 데이터 개요

• 출처: Austin Animal Center Open Data (2020~2025)
• 파일명: Austin_Animal_Center_Outcomes_(2020~2025).xlsx
• 관측치 수 (행 수): 59,089개
• 변수 수 (열 수): 12개
• 주요 변수 설명 id_1: 고유 식별자 / birth_2: 출생일 / outcome_4: 보호소에서의 사건(입양, 안락사 등) 발생일 / month_5: 사건 월 (YYYY-MM) / type_6: 사건 유형(입양, 반환, 안락사 등) / subtype_7: 세부 보호 상태 (노령, 임시보호, 병원 등) / species_8: 종(개, 고양이, 기타) / sex_9: 성별 및 중성화 상태 / age_10: 사건 발생 시점 기준 나이 / breed_11: 품종 / color_12: 털 색상

4. 데이터 처리

• 날짜 처리: outcome_4 열에서 날짜 정보를 추출하여 date 및 month 열을 생성함
• 입양 여부 분류: type_6 열을 기준으로 Adoption은 입양, 그 외는 비입양으로 분류함
• 집계 및 시각화: 월별로 입양 및 비입양 동물의 수를 집계하여, ggplot2를 사용해 선 그래프로 시각화함

5. 전체 분석 결과 요약

• 입양 성패를 가르는 핵심 요인은 건강 상태, 특히 Snr(노령), Suffering, Rabies Risk 등 젊은 나이(1~3세)임에도 건강 이상이 많아 입양 기피되는 현상 존재
• 2개월령 중성화된 개체는 입양률이 가장 높음
• Snr 비중이 높은 달에는 전체 입양률이 뚜렷하게 하락함 -> 건강 상태 비중과 입양률은 반비례
• 계절적 패턴: 여름철 구조와 입양량 모두 증가, 겨울철 저조
• 입양률 제고를 위해선 건강 개체 중심의 초기 구조·보호 전략 필요

[1. 유기동물 기본 분포 현황 분석]

유기동물 보호소에 유입되는 개체는 종, 성별, 색상, 나이, 건강 상태 등 다양한 조건을 갖고 있으며, 이들 요소는 입양 가능성과 직결되는 핵심 변수로 작용함 본 분석은 ‘입양 결정 요인 분석’이라는 최종 목표에 앞서, 먼저 보호소에 유입되는 유기동물의 기초적인 특성과 분포 현황을 파악하는 것으로 시작함 특히, ‘어떤 동물이 보호소에 가장 많이 들어오는가’, ‘어떤 특징이 빈번한가’에 대한 탐색을 통해 분석의 출발점을 설정하며, 이는 이후의 건강·연령·입양률 분석과의 연결고리를 형성함

1-1. 유기동물 종류

보호소에 유입되는 동물의 종 분포를 분석하여, 입양 결정의 기본 단위가 되는 개체 유형을 파악함

1. 개의 개채 수가 가장 높게 나타났으며, 반려견 유기가 가장 빈번하게 발생하고 있음
2. 개 다음으로는 고양이가 두 번째로 많은 유기동물이며 대중적으로 많이 키운다는 점에서 사례가 많음
3. 개+고양이의 유기동물의 수는 전체의 90%이상을 차지할 정도로 압도적임
4. 기타 동물도 일부 존재하나 상대적으로 매우 적은 편이며, 비중이 거의 없음
5. 가축은 유기동물 분류에서 보호소 통계에는 거의 미비하게 확인이 됨

df$species <- as.factor(df$species_8)
ggplot(df, aes(x = species)) +
  geom_bar(fill = "skyblue", color = "black") +
  labs(title = "유기동물의 종류", x = "종", y = "개체수") +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold", margin = margin(b = 10)),
    axis.text = element_text(size = 10),
    axis.text.x = element_text(size = 10, margin = margin(b = 12, t = 6)),
    axis.text.y = element_text(margin = margin(r = 10)),
    axis.title.x = element_text(margin = margin(t = 20)),  # 방향 수정
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

1-2. 유기동물 성별 및 중성화 상태 분포

1. 전체 유기동물 중 중성화된 수컷이 가장 많음
2. Spayed Female: 그다음으로 많음 -> 중성화된 암컷도 다수 존재
3. Intact Male/Female: 각각 8천여 건으로 비교적 적음(Intact Male/Female) -> 중성화되지 않은 개체는 소수
4. Unknown: 약 4천여 건 -> 성별 또는 중성화 상태가 확인되지 않은 경우 -> 센터에 들어오는 동물 중 다수는 이미 중성화된 상태임(구조 후 중성화를 했을 가능성도 포함)

ggplot(df, aes(x = factor(sex_9))) +
  geom_bar(fill = "tomato", color = "black") +
  labs(title = "유기동물의 성별", x = "성별", y = "개채수") +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold", margin = margin(b = 10)),
    axis.text = element_text(size = 10),
    axis.text.x = element_text(size = 10, margin = margin(b = 12, t = 6)),
    axis.text.y = element_text(margin = margin(r = 10)),
    axis.title.x = element_text(margin = margin(r = 20)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

1-3. 유기동물 색상 분포

1. 가장 흔하게 유기된 색상은 black/white이며, 6,000마리 이상 기록이 됨 -> 주로 고양이의 이색 털 패턴에서 많이 보이며 구조시 외형 식별이 용이한 형태임
2. 단일 색상중 black이 가장 많이 기록됨
3. 줄무니 패턴인 tabby도 높은 빈도이며 고양이에서 흔한 유전적 패턴임

df$color <- as.factor(df$color_12)

color_counts <- table(df$color)
top_10_colors <- head(sort(color_counts, decreasing = TRUE), 10)

color_df <- as.data.frame(top_10_colors)
colnames(color_df) <- c("color", "count")
color_df$color <- factor(color_df$color, levels = color_df$color)

ggplot(color_df, aes(x = color, y = count)) +
  geom_col(fill = "#1957FF", color = "black") +
  labs(title = "유기동물 색상 상위 10개", x = "색상", y = "개체수") +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1, size = 8),
    axis.text.y = element_text(size = 10, margin = margin(r = 10)),
    axis.title.x = element_text(margin = margin(t = 15)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

1-4. 월별 신규 유기동물 발생 추이

1. 코로나 첫해인 2020년 초반은 유기동물 수가 급감하며, 보호소 접근 어려움과 시민 이동 제약으로 인해 구조 및 유기 자체가 감소함
2. 2020년 하반기부터 회복세를 보이며, 2021년 상반기에는 초고점을 도달함
3. 2021년 6~9월 피크 이후 전체적으로 서서히 하향 안정화를 보임
4. 2021년 중반~말에 정점을 보이며 이 시기 이후로는 고점이 점점 낮아지는 경향을 보임
5. 2022년~2024년 전체적으로 평균선 부근에서 진동하며, 월별 변동은 있지만 극단적인 폭은 줄어듦

df$date <- as.Date(substr(df$outcome_4, 1, 10))

df$month <- as.Date(paste0(format(df$date, "%Y-%m"), "-01"))  
monthly_counts <- aggregate(x = list(n = rep(1, nrow(df))), 
                            by = list(month = df$month), 
                            FUN = sum)

mean_count <- mean(monthly_counts$n, na.rm = TRUE)

ggplot(monthly_counts, aes(x = month, y = n)) +
  geom_line(color = "skyblue", linewidth = 0.8) +
  geom_point(color = "blue", size = 1) +
  geom_hline(yintercept = mean_count, linetype = "dashed", color = "pink", linewidth = 0.6) +
  labs(
    title = "월별 유기동물 발생 건수", subtitle = "(2020-01 ~ 2025-04)",
    x = "월",
    y = "유기동물 수"
  ) +
  scale_x_date(
    date_breaks = "3 months", date_labels = "%Y-%m", limits = c(as.Date("2020-01-01"), as.Date("2025-05-01")) 
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 7, margin = margin(b = 10, t = 6)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

[2] 유기동물 보호환경의 실태 파악

2-1. 보호소 운영 방식과 건강 이상 상태

1. partner(제휴기관 전송)와 foster(임시보호)가 상위 2개로 보호소의 구조 및 보호 방식은 외부 기관 의존형임을 시사함 -> in kennel(보호소 내 직접 보호)은 매우 낮은 수준이며 내부 수용보다는 외부 분산 보호 체계 중심임
2. Rabies Risk(관견병 위험), Suffering(고통), At vet(병원 치료 중)의료적 처치가 필요한 상태의 유기동물 비중이 높음
3. 노령 유기동물(Snr)은 나이가 많아 입양 가능성이 낮고 의료비 부담이 큰 개체군으로 비율이 높음
4. Field(현장 구조), Out State(타주 전송)는 상대적으로 낮은 빈도를 보이며, 보호소 운영의 보조적 수단에 불과함

subtype_counts <- table(df$subtype_7)
top_10_subtypes <- head(sort(subtype_counts, decreasing = TRUE), 10)

top_10_df <- as.data.frame(top_10_subtypes)
colnames(top_10_df) <- c("subtype", "count")

top_10_df$subtype <- factor(top_10_df$subtype, levels = top_10_df$subtype)

ggplot(top_10_df, aes(x = subtype, y = count)) +
  
  geom_col(fill = "skyblue", color = "black") +
  labs(
    title = "유기동물 상태", subtitle = "상위 10개 기준", x = "상태", y = "유기동물 수"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 7, margin = margin(b = 10, t = 6)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

임시 보호 이외의 전반적인 유기동물 상태는 Ravies Risk, Snr, Suffering등 과 같이 아픈 유기 동물이 상당 수를 차지하고 있음

-> 해당 유기동물은 어떤 연령대일까? 앞서 전반적인 나이에 대하여 분석해 봄

2-2. 구조되는 유기동물의 연령 분포

1. 1살 미만이 전체에서 가장 많으며, 유기동물 상당수가 생후 수개월 이내에 구조되고 있음 -> 보호소에 유입되는 동물들이 출생 직후, 입양 실패로 인해 빠르게 버려지고 있음
2. 1~3살 연령층도 상당한 비율을 차지하며 성숙기 동물의 유기 가능성이 매우 높음
3. 3살 이후부터는 급격한 유기 감소

df$age_years <- df$age_10
df$age_years <- ifelse(grepl("year", df$age_10), as.numeric(gsub(" ?years?|\\s?year", "", df$age_10)),
                ifelse(grepl("month", df$age_10), as.numeric(gsub(" ?months?|\\s?month", "", df$age_10)) / 12,
                ifelse(grepl("week", df$age_10), as.numeric(gsub(" ?weeks?|\\s?week", "", df$age_10)) / 52,
                ifelse(grepl("day", df$age_10), as.numeric(gsub(" ?days?|\\s?day", "", df$age_10)) / 365,
                NA))))

## Warning in ifelse(grepl("year", df$age_10), as.numeric(gsub("
## ?years?|\\s?year", : NAs introduced by coercion

## Warning in ifelse(grepl("month", df$age_10), as.numeric(gsub("
## ?months?|\\s?month", : NAs introduced by coercion

## Warning in ifelse(grepl("week", df$age_10), as.numeric(gsub("
## ?weeks?|\\s?week", : NAs introduced by coercion

## Warning in ifelse(grepl("day", df$age_10), as.numeric(gsub(" ?days?|\\s?day", :
## NAs introduced by coercion

df$age_group <- cut(df$age_years,
                    breaks = c(-Inf, 1, 3, 6, 10, Inf),
                    labels = c("1살 미만", "1~3살", "3~6살", "6~10살", "10살 이상"),
                    right = FALSE)

ggplot(data = df %>% filter(!is.na(age_group))) +
  geom_bar(aes(x = age_group), fill = "skyblue", color = "black") +
  labs(
    title = "나이대별 유기동물 분포", x = "나이대", y = "빈도수"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold", margin = margin(b = 10)),   
    axis.text.x = element_text(size = 10, margin = margin(b = 6, t = 8)), 
    axis.text.y = element_text(size = 10, margin = margin(r = 6)),       
    axis.title.x = element_text(margin = margin(t = 6)),              
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

[3] 연령과 건강 문제의 상관관계

3-1. 나이별 주요 건강 위험 분석

1. 2년령, 1년령, 3년령 등 젊은 나이대에서도 Snr(노령)으로 판정을 함 -> 보호소의 Snr 판정 기준이 상대적으로 낮거나 건강 상태 저하가 조기화된 개체가 많다는 구조적 특성이 반영이 됨
2. Rabies(광견병)는 2년령에서 가장 크며, 1년령, 6개월령 등에서도 다수로 보임, 전형적인 성체 구간에서 빈도가 높음 -> 외부 구조된 유기 동물 중 성체의 비중이 높으며 이 시기 개체들이 백신을 맞지 않거나 야외 노출 이력이 많음을 시사함 3. Suffering(고통 상태)는 다양한 나이대에서 간혈적으로 발견됨

target_subtypes <- c("Suffering", "Rabies Risk", "Snr", "At Vet")

df_focus <- df %>%
  filter(!is.na(age_10), subtype_7 %in% target_subtypes) %>%
  count(age_10, subtype_7)

top_ages <- df_focus %>%
  group_by(age_10) %>%
  summarise(total = sum(n)) %>%
  slice_max(total, n = 10) %>%
  pull(age_10)

df_filtered <- df_focus %>%
  filter(age_10 %in% top_ages)

ggplot(df_filtered, aes(x = age_10, y = subtype_7, size = n)) +
  geom_point(alpha = 0.75, color = "darkred") +
  scale_size_continuous(name = "빈도 수") +
  labs(
    title = "주요 건강 상태와 나이 분포",
    subtitle = "상위 10개 나이 기준 버블 차트",
    x = "나이", y = "건강 상태"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11),
    axis.text.x = element_text(angle = 45, hjust = 1),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

3-2. 구조량 상위 연령의 건강상태 평가

1. 전체 유기동물 중 약 70~80%가 3세 미만임, 이는 사회적/생물학적으로 입양 적령기이며 입양 선호도가 높은 연령층임 -> 표면적으로는 입양 가능성이 매우 높음
2. 그러나 이 주요 연령대에서는 건강 이상 빈도가 집중되어 있음 -> 3세 미만인 개체들도 노령으로 일부 분류가 되기도 하며 심각한 건강 상태가 대량 분포 되어 있음 = 즉, 가장 많은 유기동물들이 실제로는 입양이 어려운 상태에 처해 있음
3. 특히 2년령은 젊지만 아픈 개체가 가장 많이 몰린 구간으로 입양 기피 -> 보호소 체휴 장기화 -> 의료 부담 증가의 악순환이 집중되는 연령대임

입양이 되어야 할 연령대에서 건강 문제가 많이 보임 그렇다면 실제 입양은 어떠한가?

[4] 입양 여부 결정 요인 분석

4-1. 연령에 따른 입양 선호도

1. 입양은 2월령이 가장 선호되고, 해당 시기에 구조된 동물은 입양 성공률이 가장 높음
2. 2년령에서 입양 갈림길이 되는 분기점임 -> 많이 구조되지만 병력 등의 문제로 입양에 문제가 있음(앞선 표를 참고하면, 실제로 2년령에 건강상에 문제가 있는 유기동물의 분포가 많았음)
3. 3년령 이상에서는 구조도 적고 입양률도 낮으며, 특히 Snr은 질환 동방률이 높아 입양전 치료와 관리 필요성이 큰 구간임 4. 1년령~3년령은 전체 구조의 핵심 연령층이지만 비입양이 입양보다 더 짙게 나타남

df_age <- df %>%
  filter(!is.na(age_10), !is.na(type_6)) %>%
  mutate(adopted = ifelse(type_6 == "Adoption", "입양", "비입양"))

age_count <- df_age %>%
  count(age_10, sort = TRUE)

top_ages <- head(age_count$age_10, 10)

df_age_top10 <- df_age %>%
  filter(age_10 %in% top_ages) %>%
  group_by(adopted, age_10) %>%
  summarise(count = n(), .groups = "drop")

ggplot(df_age_top10, aes(x = age_10, y = adopted, fill = count)) +
  geom_tile(color = "white") +
  scale_fill_gradient(low = "lightblue", high = "darkblue") +
  labs(
    title = "나이별 입양 여부",
    x = "나이", y = "입양 여부"
  ) +
  theme_minimal() +
  theme(
    axis.text.x = element_text(angle = 45, hjust = 1),
    plot.title = element_text(size = 14, face = "bold", margin = margin(b = 10)),   
    text = element_text(family = "Noto Sans KR"),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

=> 즉 건강상태 및 노령이 입양 여부에 대해서 중요하게 작용을 함(특히 2년령은 건강상의 이유로 유기 동물이 많고, 입양률이 적음)

4-2. 중성화 상태와 입양의 상관성

1. 2개월령 시점은 중성화된 개체가 대부분
2. 1개월령은 비중성화 비율이 가장 높음(생리적으로 중성화가 어려운 연령임)
3. 1~5년령 사이 중성화 비율이 안정적이며, 나이가 많아질수록 중성화율은 높아지는 경향이 유지가 됨
4. 전반적 으로 나이가 많을 수록 중성화율이 높음

df_neuter <- df %>%
  mutate(neuter_status = case_when(
    grepl("Spayed|Neutered", sex_9) ~ "중성화",
    grepl("Intact", sex_9) ~ "비중성화",
    TRUE ~ "미상"
  )) %>%
  filter(neuter_status != "미상")

top_ages <- df_neuter %>%
  count(age_10, sort = TRUE) %>%
  slice_head(n = 10) %>%
  pull(age_10)

df_top_ages <- df_neuter %>%
  filter(age_10 %in% top_ages) %>%
  mutate(age_10 = fct_infreq(age_10))

ggplot(df_top_ages, aes(x = age_10, fill = neuter_status)) +
  geom_bar(position = "fill", color = "black") +
  scale_y_continuous(labels = scales::percent) +
  labs(title = "상위 10개 나이별 유기동물의 중성화 여부 비율",
       x = "나이", y = "비율",  fill = "중성화 여부") +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold", margin = margin(b = 10)),
    axis.text = element_text(size = 10),
    axis.text.x = element_text(size = 9, angle = 45, hjust = 1),
    axis.title.x = element_text(margin = margin(t = 12)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 1)
  )

-> 중성화 여부는 입양 선호도에 영향을 미치는 것으로 나타남 -> 한편, 건강 이상 상태 역시 입양을 어렵게 만드는 요인이며, 보호소 체류 기간과 비용 증가의 원인이 됨 -> 중성화 여부가 입양에 미치는 영향은 건강 상태와도 관련이 있을 수 있기에, 이에 따라 2개월령 개체를 중심으로 중성화율과 입양률의 동시 분포를 확인함

4-3. 건강 상태에 따른 입양 결과 교차 분석

• 4-1은 2개월령 개체는 입양 수가 많다
• 4-2는 2개월령 개체는 중성화 비율도 높다 를 도출할 수 있음 -> 이 두 그래프에서 동일한 나이대에서의 높은 입양 수를, 높은 중성화 비율로 설명할 수 있음 -> 중성화된 2개월령 개체는 입양 선호도가 높음(중성화 여부가 중요한 영향을 미침)

[5] 품종별 입양 경향

5-1. 2개월령 주요 품종 입양 분석

1. Domestic Shorthair가 가장 많이 입양이 선호됨
2. 상위 5개 품종 모두 입양수가 비입양수 보다 높음 -> 2개월령이라는 나이대에서 입양 선호도가 전반적으로 높음을 다시 확인할 수 있음
3. 품종별 편차가 존재함

df_2mo <- df %>%
  filter(age_10 == "2 months") %>%
  filter(!is.na(breed_11), !is.na(type_6)) %>%
  mutate(
    adopted = ifelse(type_6 == "Adoption", "입양", "비입양")
  )

top_breeds <- df_2mo %>%
  count(breed_11, sort = TRUE) %>%
  top_n(5, n) %>%
  pull(breed_11)

df_top_breeds <- df_2mo %>%
  filter(breed_11 %in% top_breeds) %>%
  mutate(
    breed_11 = fct_infreq(breed_11),
    adopted = factor(adopted, levels = c("입양", "비입양"))
  )

ggplot(data = df_top_breeds) +
  geom_bar(aes(x = breed_11, fill = adopted), position = "dodge", color = "black") +
  labs(
    title = "2개월령 유기동물의 상위 5개 품종별 입양 여부 분포",
    x = "품종", y = "개체 수", fill = "입양 여부"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold", margin = margin(b = 10)),   
    axis.text.x = element_text(size = 7, angle = 45, hjust = 1, margin = margin(b = 6, t = 8)), 
    axis.text.y = element_text(size = 10, margin = margin(r = 6)),       
    axis.title.x = element_text(margin = margin(t = 6)),              
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

어떤 보호 상태에 있는 유기동물이 실제로 입양되는가?

[6] 보호 상태별 입양 경향

6-1. 보호 상태별 입양 경향 분석

1. 입양률이 높은 상태 - Foster(임시보호), Partner(외부 제휴), In kennel(보호소 내)가 대부분이며 주로 보호가 안정적으로 관리되고 있고 상태가 상대적으로 양호한 개체들이 많음
2. 입양률이 낮은 상태 - Snr(노령), Suffering(고통),Rabies Risk(광견병 위험), At vet(병원 치료 중) -> 모두 건강 이상이 있으며 입양자는 건강 부담, 치료비 부담, 생존 가능성에 대한 우료 때문에 기피함

df_subtype_adopt <- df %>%
  filter(!is.na(subtype_7), !is.na(type_6)) %>%
  mutate(adopted = ifelse(type_6 == "Adoption", "입양", "비입양"))

top_subtypes <- df_subtype_adopt %>%
  count(subtype_7) %>%
  top_n(10, n) %>%
  pull(subtype_7)

df_top <- df_subtype_adopt %>%
  filter(subtype_7 %in% top_subtypes) %>%
  group_by(subtype_7) %>%
  summarise(
    total = n(),
    adopted = sum(adopted == "입양"),
    adoption_rate = adopted / total
  ) %>%
  arrange(desc(adoption_rate)) %>%
  mutate(subtype_7 = fct_inorder(subtype_7))

ggplot(df_top, aes(x = adoption_rate, y = subtype_7)) +
  geom_segment(aes(x = 0, xend = adoption_rate, y = subtype_7, yend = subtype_7),
               color = "#87CEEB", linewidth = 1.2) +
  geom_point(color = "#003366", size = 4) +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1)) +
  labs(
    title = "유기동물 상태", 
    subtitle = "상위 10개 기준", 
    x = "입양률", y = "유기동물 수"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(size = 7, margin = margin(b = 10, t = 6)),
    axis.text.y = element_text(size = 10, margin = margin(r = 6)),
    axis.title.y = element_text(margin = margin(r = 12)),
    axis.title.x = element_text(margin = margin(t = 6)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

입양률이 낮은 상태는 어떤 연령대에 집중되어 있는가?

6-2. 입양률이 낮은 보호 상태의 연령대 구성

1. 전체적으로 1~3살 연령대가 주요 비중임 2.노령으로 분류되었음에도 1~3살 비중이 크며, 노령의 판정 기준이 낮거나 실제로 건강이 빠르게 저하된 젊은 개체가 많음 -> 입양률이 낮은 상태라고 하더라도 실제로는 젊은 개체에 집중되어 있음 -> 즉, 나이가 많아서가 아니라 건강 문제로 입양이 어려운 구조임
2. 1살 미만 연령대는 상대적으로 낮은 분포 -> 해당 연령대에서는 심각한 질환 진단 빈도가 낮고 보호소 유입 시점도 비교적 건강하다는 의미
3. 6~10살, 10살 이상 구간은 일부 상태에서만 존재 -> Snr에서만 비교적 고령 개체 비율이 눈에 띄며 나머지 상태는 실제 노령보다는 성체기 개체에 집중

target_subtypes <- c("Suffering", "Snr", "At Vet", "Rabies Risk")

df_sub_age <- df %>%
  filter(!is.na(age_group), subtype_7 %in% target_subtypes)

df_grouped <- df_sub_age %>%
  group_by(subtype_7, age_group) %>%
  summarise(count = n(), .groups = "drop")

df_grouped$age_group <- factor(df_grouped$age_group,
                               levels = c("1살 미만", "1~3살", "3~6살", "6~10살", "10살 이상"))

ggplot(df_grouped, aes(x = age_group, y = count, fill = age_group)) +
  geom_col(color = "black") +
  facet_wrap(~ subtype_7, scales = "free_y") +
  labs(
    title = "보호 상태별 연령대 구성",
    subtitle = "입양률 낮은 주요 상태 기준",
    x = "연령대", y = "유기동물 수"
  ) +
  scale_fill_brewer(palette = "Blues") +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4),
    legend.position = "none"
  )

그렇다면 이 연령대 개체들이 실제로 입양되었는가?

6-3. 보호 상태별 연령대-입양 여부 교차 분석(구간별 집중도 분석)

1. 모든 상태에서 1~3살 _ 비입양 구간이 가장 짙음 -> 해당 건강 상태는 젊은 연령대에서 주로 발생하며 입양으로 연결되지 못하고 있음
2. Suffering과 At vet는 특히 1~3세에 집중되어 있음
3. Snr은 노령상태지만 여전히 1~3세가 중심이 되어 있음

• 위와 동일하게 생물학적 노령이 아니라 건강 저하에 따른 분류임, 입양 개체가 존재하나 비입양 비중이 절대적으로 높음
• 6~1-세, 10세 이상의 입양 비율은 거의 전무함 -> 고령 개체는 구조는 되지만 입양까지 연결되기 매우 어려움

4. Rabies Risk의 입양은 거의 이루어지지 않으며, 광견병 위험이 있는 성체 개체가 입양 기피됨

df_3way <- df %>%
  filter(!is.na(age_group), !is.na(subtype_7), !is.na(type_6)) %>%
  mutate(
    adopted = ifelse(type_6 == "Adoption", "입양", "비입양")
  ) %>%
  filter(subtype_7 %in% c("Suffering", "Snr", "At Vet", "Rabies Risk")) %>%
  group_by(subtype_7, age_group, adopted) %>%
  summarise(count = n(), .groups = "drop")

df_3way$age_group <- factor(df_3way$age_group,
                            levels = c("1살 미만", "1~3살", "3~6살", "6~10살", "10살 이상"))

ggplot(df_3way, aes(x = age_group, y = adopted, fill = count)) +
  geom_tile(color = "white") +
  scale_fill_gradient(low = "lightblue", high = "darkblue") +
  facet_wrap(~ subtype_7) +
  labs(
    title = "보호 상태별 연령대-입양 여부 교차",
    subtitle = "입양률이 낮은 상태 중심 3자 비교",
    x = "연령대", y = "입양 여부", fill = "개체 수"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 9),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

6-4. 종합 시사점 정리

1. 입양률이 낮은 보호 상태는 특정 연령대에 집중되어 있음
2. 실제 입양이 발생하는 보호 상태는 특히 제한적임 -> 건강 문제가 있는 경우 입양률이 거의 전무함
3. 젊은 연령대임에도 건강 이상으로 입양이 어려운 구조 -> 1~3세는 입양 적령기임에도 건강 이상으로 인해 입양률이 낮음, 2년령은 구조 수가 가장 많음에도 건강 이슈로 인해 입양 기피 현상이 뚜렷함
4. 입양률을 높이기 위한 중재가 필요함

[7] 시간 흐름에 따른 입양 변화와 건강 요인 동태 분석

7-1.입양과 비입양 수의 월별 흐름 분석

1. 그래프 초반인 2020년에는 입양 수와 비입양 수의 차이가 적지만, 2021년 중반 이후부터는 입양 수가 뚜렷하게 우세해지는 구간이 발생함 -> 입양의 절대량이 비입양을 지속적으로 상회하는 구조가 장기적으로 자리잡음
2. 비입양 수는 상대적으로 넓은 폭의 진동을 보임, 특히 2021~2023년 구간에서 일부 비입양 급증 시점이 관찰됨
3. 다소 등락은 있으나, 시간이 지날수록 입양수가 상승세 유지함, 2023~2024년 구간에선 입양 수가 최고치를 기록하는 달이 여러 차례 등장
4. 특정 계절에만 입양/비입양이 집중되는 일관된 패턴은 약함 -> 다만, 여름(6~8월) 전후에 구조량/비입양 수 증가 현상은 일부 있음

df$date <- as.Date(substr(df$outcome_4, 1, 10))
df$month <- as.Date(paste0(format(df$date, "%Y-%m"), "-01"))

df_adopt <- df %>%
  filter(!is.na(month), !is.na(type_6)) %>%
  mutate(adopted = ifelse(type_6 == "Adoption", "입양", "비입양")) %>%
  group_by(month, adopted) %>%
  summarise(count = n(), .groups = "drop")

ggplot(df_adopt, aes(x = month, y = count, color = adopted)) +
  geom_line(linewidth = 1) +  # 수정됨
  geom_point(size = 2) +
  labs(
    title = "월별 유기동물 입양 및 비입양 추이", subtitle = "(2020-01 ~ 2025-04)",
    x = "월", y = "유기동물 수",
    color = "입양 여부"
  ) +
  scale_x_date(
    date_breaks = "3 months", date_labels = "%Y-%m",
    limits = c(as.Date("2020-01-01"), as.Date("2025-05-01"))
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 7, margin = margin(b = 10, t = 6)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

7-2. 입양률의 시계열 추이 분석

1. 입양률은 2020~2021 초반까지 60~70%로 비교적 높은 수준을 유지하지만 2021년 중반부터는 40%까지 하락
2. 2022년 구간에는 수치가 불안정하며, 특정 달에 입양률이 급등하거나 급락하는 경우가 명확히 나타남
3. 2024년 말에는 70% 초과 이뱡률을 기록하며 입양률이 꾸준히 상승하며 최고점을 갱신함

df$date <- as.Date(substr(df$outcome_4, 1, 10))
df$month <- as.Date(paste0(format(df$date, "%Y-%m"), "-01"))

df_age <- df %>%
  filter(!is.na(month), !is.na(type_6)) %>%
  mutate(adopted = ifelse(type_6 == "Adoption", "입양", "비입양")) %>%
  group_by(month, adopted) %>%
  summarise(count = n(), .groups = "drop") %>%
  tidyr::pivot_wider(names_from = adopted, values_from = count, values_fill = 0) %>%
  mutate(
    total = 입양 + 비입양,
    입양률 = 입양 / total
  )

ggplot(df_age, aes(x = month, y = 입양률)) +
  geom_line(color = "darkgreen", linewidth = 1.2) +
  geom_point(color = "darkgreen", size = 2) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_date(
    date_breaks = "3 months", date_labels = "%Y-%m",
    limits = c(as.Date("2020-01-01"), as.Date("2025-05-01"))
  ) +
  labs(
    title = "월별 입양률 변화 추이", subtitle = "(2020-01 ~ 2025-04)",
    x = "월", y = "입양률"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 7, margin = margin(b = 10, t = 6)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

7-3. 건강 이상 상태 구조 비중의 변화

1. Snr은 대부분의 시기에 걸쳐 높은 비율을 차지함 -> 특히 겨울철 및 코로나 이후 시절에서 소폭 상승 경향이 있으며, 노령 동물의 구조 비중이 안정적으로 높다는 구조 현실을 반영함
2. Suffering은 전체 구조 동물 중 비율은 낮으나, 일정 시점에서 급등현상 존재, 특히 2023년 중반과 2024년 초반에 소폭 상승세 확인됨
3. At vet는 전반적으로 비율이 낮고 일시적 상승 후 감소하는 흐름을 보임
4. Rabies Risk는 특정 시기에 급격한 상승을 보이고, 전체적으로는 불규칙하고 예외적인 분포임

df$date <- as.Date(substr(df$outcome_4, 1, 10))
df$month <- as.Date(paste0(format(df$date, "%Y-%m"), "-01"))

df_total <- df %>%
  filter(!is.na(month)) %>%
  group_by(month) %>%
  summarise(total_count = n(), .groups = "drop")

target_subtypes <- c("Suffering", "Snr", "At Vet", "Rabies Risk")

df_sub <- df %>%
  filter(!is.na(month), subtype_7 %in% target_subtypes) %>%
  group_by(month, subtype_7) %>%
  summarise(sub_count = n(), .groups = "drop")

df_ratio <- merge(df_sub, df_total, by = "month")
df_ratio$ratio <- df_ratio$sub_count / df_ratio$total_count

ggplot(df_ratio, aes(x = month, y = ratio, color = subtype_7)) +
  geom_line(linewidth = 0.8) +
  geom_point(size = 1.8) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(
    title = "건강 이상 상태의 전체 구조 대비 비중 추이",
    subtitle = "(월별 %)",
    x = "월", y = "비중",
    color = "건강 이상 상태"
  ) +
  scale_x_date(
    date_breaks = "3 months", date_labels = "%Y-%m",
    limits = c(as.Date("2020-01-01"), as.Date("2025-05-01"))
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 7, margin = margin(b = 10, t = 6)),
    axis.title.y = element_text(margin = margin(r = 12)),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4),
    legend.position = "bottom"
  )

Snr 상태의 유기동물 비중이 높았던 시기에, 입양률은 실제로 하락했는가? 입양률이 낟아진 원인을 구조 동물의 특성인 Snr 비중이 높은 지 확인이 필요함

7-4. 노령 개체 비중과 입양률의 관계

1. Snr 비중은 전체 구조 중 약 2~7% 범위에서 분포하며, 구조량과 상관없이 일정한 수준으로 유지되는 구간이 다수 존재함, 특히 겨울철 및 2022년~2023년 초에 Snr 비중이 소폭 상승함
2. 입양률은 2022 구간에서 눈에 띄게 하락함 -> 해당 시점에서 Snr 비중도 함께 상승하거나 유지되는 추세를 보임
3. Snr 비중이 눈에 띄게 낮았던 시기인 2024년 후반에는 입양률이 비교적 높게 유지됨 -> 20%를 초과하는 입양률은 대체로 Snr 비중이 2~3% 수준으로 낮은 구간에서 관찰됨 => Snr 상태 개체의 구조 비중은 입양률과 반비례 관계를 보이는 경향이 있음

df$date <- as.Date(substr(df$outcome_4, 1, 10))
df$month <- as.Date(paste0(format(df$date, "%Y-%m"), "-01"))

df_total <- df %>%
  filter(!is.na(month)) %>%
  group_by(month) %>%
  summarise(total = n(), .groups = "drop")

df_snr <- df %>%
  filter(!is.na(month), subtype_7 == "Snr") %>%
  group_by(month) %>%
  summarise(snr_count = n(), .groups = "drop")

df_snr <- merge(df_snr, df_total, by = "month")
df_snr$snr_ratio <- df_snr$snr_count / df_snr$total

df_adopt <- df %>%
  filter(!is.na(month), !is.na(type_6)) %>%
  mutate(adopted = ifelse(type_6 == "Adoption", "입양", "비입양")) %>%
  group_by(month, adopted) %>%
  summarise(count = n(), .groups = "drop") %>%
  tidyr::pivot_wider(names_from = adopted, values_from = count, values_fill = 0) %>%
  mutate(total = 입양 + 비입양, 입양률 = 입양 / total)

df_join <- merge(df_snr[, c("month", "snr_ratio")],
                 df_adopt[, c("month", "입양률")],
                 by = "month")

ggplot(df_join, aes(x = month)) +
  geom_line(aes(y = snr_ratio, color = "Snr 비중"), linewidth = 1.2) +
  geom_line(aes(y = 입양률, color = "입양률"), linewidth = 1.2) +
  scale_color_manual(values = c("Snr 비중" = "steelblue", "입양률" = "forestgreen")) +
  scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
  scale_x_date(date_breaks = "3 months", date_labels = "%Y-%m") +
  labs(
    title = "월별 Snr 비중과 입양률 변화 비교",
    subtitle = "(노령 개체 구조 비중 vs 입양률)",
    x = "월", y = "비율(%)", color = ""
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    axis.text.x = element_text(angle = 45, hjust = 1, size = 7),
    legend.position = "bottom",
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

7-5. 계절별 구조 및 입양 집중도 비교

1. 전체적으로 여름에 유긱동물 구조 및 입양 수가 가장 많음 -> 계절적 외부 활동이 증가하며 유실 가능성이 상승하여 구조량이 증가됨, 동시에 입양 캠페인, 방학 등으로 입양도 상대적으로 활발함
2. 겨울은 구조 및 입양이 모두 감소 -> 야외활동이 가모하고 보호소 방문률이 저하로 인한 결과
3. 봄과 가을은 구조량과 입양량 모두 안정적이고 균형적임 => 구조량 대비 입양량의 비율은 큰 차이는 없으나, 여름철에 구조와 입양이 집중되는 현상이 두드러지게 나타남, 봄과 가을은 안정적인 흐름을 유지하며, 겨울철은 구조 및 입양이 저조한 수준에 머물음

get_season <- function(month) {
  if (month %in% 3:5) {
    return("봄")
  } else if (month %in% 6:8) {
    return("여름")
  } else if (month %in% 9:11) {
    return("가을")
  } else {
    return("겨울")
  }
}
df$date <- as.Date(substr(df$outcome_4, 1, 10))
df$month <- as.integer(format(df$date, "%m"))
df$season <- sapply(df$month, get_season)

df_season <- df %>%
  filter(!is.na(season), !is.na(type_6)) %>%
  mutate(adopted = ifelse(type_6 == "Adoption", "입양", "비입양")) %>%
  group_by(season, adopted) %>%
  summarise(count = n(), .groups = "drop")

df_season$season <- factor(df_season$season, levels = c("봄", "여름", "가을", "겨울"))

ggplot(df_season, aes(x = season, y = count, fill = adopted)) +
  geom_bar(stat = "identity", position = "dodge", color = "black") +
  labs(
    title = "계절별 유기동물 구조 및 입양 수",
    subtitle = "(전체 누적 기준)",
    x = "계절", y = "유기동물 수", fill = "입양 여부"
  ) +
  theme_minimal() +
  theme(
    text = element_text(family = "Noto Sans KR"),
    plot.title = element_text(size = 14, face = "bold"),
    plot.subtitle = element_text(size = 11, margin = margin(b = 10)),
    axis.title.y = element_text(margin = margin(r = 12)),
    axis.title.x = element_text(margin = margin(t = 8)),
    axis.text.x = element_text(size = 11),
    panel.border = element_rect(color = "#505050", fill = NA, linewidth = 0.4)
  )

7-6. 시간 기반 입양 구조 분석의 종합 요약 및 통합 분석

1. 입양률의 핵심 영향 요인은 건강상태임
2. Snr 비중이 높을 수록 입양률이 낮아지는 경향이 뚜렷함(Snr 비중과 입양률은 뚜렷한 반비례 관계)
3. 젊은 나이인 1~3이어도 Snr 등 건강 이상 상태면 입양을 기피함
4. 여름철 구조와 입양량이 상승하며, 겨울철 저조한 계절 변화가 존재함
5. 구조방식은 건강 상태에 비해 경향력이 낮음