保護犬・保護猫・保護動物のデータ解析その4ー年齢は譲渡に影響するか?ー





前回(保護犬・保護猫・保護動物のデータ解析その4)の続きです。 まずは、ライブラリとデータを読み込みます。

library(tidyverse)
library(reshape2)
df <- read.csv("C:\\Users\\shelter\\Austin_Animal_Center_Outcomes.csv")
colnames(df)
##  [1] "Animal.ID"        "Name"             "DateTime"         "MonthYear"       
##  [5] "Date.of.Birth"    "Outcome.Type"     "Outcome.Subtype"  "Animal.Type"     
##  [9] "Sex.upon.Outcome" "Age.upon.Outcome" "Breed"            "Color"
df$Outcome.Type <- ifelse(df$Outcome.Type=="Adoption","Yes","No")
dfdog <- df %>% filter(Animal.Type=="Dog")
dfcat <- df %>% filter(Animal.Type=="Cat")

今度は、年齢と譲渡の関係について見ていきます。

unique(df$Age.upon.Outcome)
##  [1] "2 years"   "1 year"    "4 months"  "6 days"    "7 years"   "2 months" 
##  [7] "2 days"    "3 weeks"   "9 months"  "4 weeks"   "2 weeks"   "3 months" 
## [13] "9 years"   "10 years"  "6 months"  "8 years"   "3 years"   "7 months" 
## [19] "6 years"   "4 years"   "1 month"   "12 years"  "5 years"   "1 weeks"  
## [25] "5 months"  "5 days"    "15 years"  "11 months" "10 months" "4 days"   
## [31] "16 years"  "1 day"     "8 months"  "11 years"  "13 years"  "1 week"   
## [37] "14 years"  "3 days"    "NULL"      "0 years"   "5 weeks"   "17 years" 
## [43] "18 years"  "20 years"  "22 years"  "-2 years"  "19 years"  "23 years" 
## [49] "24 years"  "-1 years"  "25 years"  "21 years"  "-3 years"

年齢表記がバラバラになっています。統一する必要があります。年で統一していきたいと思います。まず、年で書かれているやつを、yearをなくして数字だけにします。

文字列が、部分一致しているかは、str_detect(検索対象, “検索文字”)で調べられます。 下のコードは、yearが入っているかをTrue Falseで返ってくるので、それをfilterに使っています。

dfdog_year <- dfdog %>% filter(str_detect(dfdog$Age.upon.Outcome,"year"))

文字列の細かい操作は、stringrライブラリを使います。 str_remove(対象, “消す文字”)で、狙った文字を消せます。

library(stringr)
dfdog_year$Age.upon.Outcome <- str_remove(dfdog_year$Age.upon.Outcome, "years")
dfdog_year$Age.upon.Outcome <- str_remove(dfdog_year$Age.upon.Outcome, "year") 

str_trim(対象, side= “both”)で、両側の空白を消せます。sideは、left,rightも選べます。

dfdog_year$Age.upon.Outcome <- str_trim(dfdog_year$Age.upon.Outcome, side = "both")

# 0yearはおかしいので削除。
dfdog_year <- dfdog_year %>% filter(Age.upon.Outcome > 0)

○○ days ○○ weeksはすべて、0.5 yearにすることにしました。

dfdog_week <- dfdog %>% filter(str_detect(dfdog$Age.upon.Outcome,"week"))
dfdog_week$Age.upon.Outcome <- 0.5

dfdog_day <- dfdog %>% filter(str_detect(dfdog$Age.upon.Outcome,"day"))
dfdog_day$Age.upon.Outcome <- 0.5

year, week, dayでそれぞれ処理したものを、1つにrbindでまとめます。

dfdog_age <- rbind(dfdog_year,dfdog_week,dfdog_day)

dfdog_age2 <- as.data.frame(table(age=dfdog_age$Age.upon.Outcome,
                                  Adoption = dfdog_age$Outcome.Type))

なぜか、ageがfactorになっていたので、factorから数字にします。 factorから数字にするときに、いきなりas.numericをするとfactorの番号になってしまい、おかしな数字になってしまいます。 そのため、一回as.charactorをかませる必要があります。

dfdog_age2$age <- as.numeric(as.character(dfdog_age2$age))

グラフを作ります。stack bar chartです。

ggplot(dfdog_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
  geom_bar(stat = "identity") +
  scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
  xlab("Age")+
  ylab("Frequency")+
  theme_minimal()

犬は若齢のほうが、保護される数が多い事がわかりました。特に1、2歳が多い。

割合は? position=“fill”でbarcharで割合を表現できます。 y軸を割合にするには、scale_y_continuous(labels = scales::percent)を入れて下さい。

ggplot(dfdog_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
  geom_bar(position="fill", stat = "identity") +
  scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
  xlab("Age")+
  ylab("")+
  scale_y_continuous(labels = scales::percent)+
  theme_minimal()

犬は、若齢のほうが譲渡されやすい

猫についても分析します。

dfcat_year <- dfcat %>% filter(str_detect(dfcat$Age.upon.Outcome,"year"))

library(stringr)
dfcat_year$Age.upon.Outcome <- str_remove(dfcat_year$Age.upon.Outcome, "years")
dfcat_year$Age.upon.Outcome <- str_remove(dfcat_year$Age.upon.Outcome, "year") 
dfcat_year$Age.upon.Outcome <- str_trim(dfcat_year$Age.upon.Outcome, side = "both")
dfcat_year <- dfcat_year %>% filter(Age.upon.Outcome > 0)


dfcat_week <- dfcat %>% filter(str_detect(dfcat$Age.upon.Outcome,"week"))
dfcat_week$Age.upon.Outcome <- 0.5

dfcat_day <- dfcat %>% filter(str_detect(dfcat$Age.upon.Outcome,"day"))
dfcat_day$Age.upon.Outcome <- 0.5

dfcat_age <- rbind(dfcat_year,dfcat_week,dfcat_day)

dfcat_age2 <- as.data.frame(table(age=dfcat_age$Age.upon.Outcome,
                                  Adoption = dfcat_age$Outcome.Type))

dfcat_age2$age <- as.numeric(as.character(dfcat_age2$age))

ggplot(dfcat_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
  geom_bar(stat = "identity") +
  xlab("Age")+
  ylab("Frequency")+
  scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
  theme_minimal()

猫は犬に比べると、1歳未満の子猫が保護されることが多い

ggplot(dfcat_age2,aes(x=reorder(age,age),y=Freq,fill=Adoption)) +
  geom_bar(position="fill", stat = "identity") +
  scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
  xlab("Age")+
  ylab("")+
  scale_y_continuous(labels = scales::percent)+
  theme_minimal()

猫は犬に比べると、若くなくても譲渡される


Categories:

category