アメリカテキサス州Austineに、毎年18,000頭以上を保護している米国最大級の動物保護施設があるそうです。そこで、保護動物の顛末データを開示しています。そのデータを使用して、データ分析（EDA：Explanatory Data Analysis）をしてみたいと思います。どうしたら譲渡につながるのか、譲渡を増やすためのヒントを見つけたいと思います。

データのダウンロードはこちらから（今日時点では、2013年～2020年12月8日のデータ）

アメリカ政府データセンター https://catalog.data.gov/dataset/austin-animal-center-outcomes-version-1-demo

まず、お決まりのライブラリーを読み込みます。

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"

head(df)

##   Animal.ID     Name               DateTime              MonthYear
## 1   A794011    Chunk 05/08/2019 06:20:00 PM 05/08/2019 06:20:00 PM
## 2   A776359    Gizmo 07/18/2018 04:02:00 PM 07/18/2018 04:02:00 PM
## 3   A821648          08/16/2020 11:38:00 AM 08/16/2020 11:38:00 AM
## 4   A720371    Moose 02/13/2016 05:59:00 PM 02/13/2016 05:59:00 PM
## 5   A674754          03/18/2014 11:47:00 AM 03/18/2014 11:47:00 AM
## 6   A659412 Princess 10/05/2020 02:37:00 PM 10/05/2020 02:37:00 PM
##   Date.of.Birth Outcome.Type Outcome.Subtype Animal.Type Sex.upon.Outcome
## 1    05/02/2017    Rto-Adopt                         Cat    Neutered Male
## 2    07/12/2017     Adoption                         Dog    Neutered Male
## 3    08/16/2019   Euthanasia                       Other          Unknown
## 4    10/08/2015     Adoption                         Dog    Neutered Male
## 5    03/12/2014     Transfer         Partner         Cat      Intact Male
## 6    03/24/2013     Adoption                         Dog    Spayed Female
##   Age.upon.Outcome                              Breed             Color
## 1          2 years             Domestic Shorthair Mix Brown Tabby/White
## 2           1 year            Chihuahua Shorthair Mix       White/Brown
## 3           1 year                            Raccoon              Gray
## 4         4 months Anatol Shepherd/Labrador Retriever              Buff
## 5           6 days             Domestic Shorthair Mix      Orange Tabby
## 6          7 years            Chihuahua Shorthair Mix             Brown

データ解析に使う変数だけを取り出しました。

df <- df %>% select(Age.upon.Outcome,
                    Animal.Type,
                    Breed,
                    Outcome.Type,
                    Sex.upon.Outcome,
                    DateTime)

データ型を見てみます。

str(df)

## 'data.frame':    122839 obs. of  6 variables:
##  $ Age.upon.Outcome: chr  "2 years" "1 year" "1 year" "4 months" ...
##  $ Animal.Type     : chr  "Cat" "Dog" "Other" "Dog" ...
##  $ Breed           : chr  "Domestic Shorthair Mix" "Chihuahua Shorthair Mix" "Raccoon" "Anatol Shepherd/Labrador Retriever" ...
##  $ Outcome.Type    : chr  "Rto-Adopt" "Adoption" "Euthanasia" "Adoption" ...
##  $ Sex.upon.Outcome: chr  "Neutered Male" "Neutered Male" "Unknown" "Neutered Male" ...
##  $ DateTime        : chr  "05/08/2019 06:20:00 PM" "07/18/2018 04:02:00 PM" "08/16/2020 11:38:00 AM" "02/13/2016 05:59:00 PM" ...

DateTimeがcharactorなので、date型に変換します。その前に、05/08/2019 06:20:00 PMという形を修正します。後ろのほうを取ってしまいます。 substr（対象,1,10）は、string型の１番目と10番目の間を抜粋します。 その後、as.Dateでデータ型と認識させます。

df$DateTime <- substr(df$DateTime,1,10)
df$DateTime <- as.Date(df$DateTime, tryFormats = c("%m/%d/%Y"))

さらに、必要な変数を絞り込みます。 strftimeで、date型から月と年を取り出します。

df_ts <- df %>% select(Animal.Type,DateTime)
df_ts$year <- strftime(df_ts$DateTime,"%Y")
df_ts$month <- strftime(df_ts$DateTime, "%m")

年毎ごと、動物種類ごとに集計します。 table(y軸、ｘ軸)で、ｙとｘの集計が出来ます。それをデータフレーム型にしました。

df_ts_year <- as.data.frame(table(date=df_ts$year,animal=df_ts$Animal.Type))

こんなデータができました。

head(df_ts_year)

##   date animal Freq
## 1 2013   Bird    5
## 2 2014   Bird   53
## 3 2015   Bird   47
## 4 2016   Bird  137
## 5 2017   Bird   87
## 6 2018   Bird  111

年ごとに、データ数をグラフ化。

ggplot(df_ts_year)+ 
  geom_line(aes(x=date,y=Freq,group=animal,color=animal),size=1)+
  xlab("Year")+
  ylab("Number of Animals in the shelter")

df_ts_month <- as.data.frame(table(date=df_ts$month,animal=df_ts$Animal.Type))

ggplot(df_ts_month)+ 
  geom_line(aes(x=date,y=Freq,group=animal,color=animal),size=1)+
  xlab("Month")+
  ylab("Number of Animals in the shelter")

df_ts_2019 <- df_ts %>% filter(year==2019)
df_ts_2020 <- df_ts %>% filter(year==2020)

df_ts_2019_month <- as.data.frame(table(date=df_ts_2019$month,animal=df_ts_2019$Animal.Type))
df_ts_2020_month <- as.data.frame(table(date=df_ts_2020$month,animal=df_ts_2020$Animal.Type))

df_ts_2019_month$year <- 2019
df_ts_2020_month$year <- 2020

df_ts_2019_2020 <- rbind(df_ts_2019_month,df_ts_2020_month)

ggplot(df_ts_2019_2020)+ 
  geom_line(aes(x=date,y=Freq,group=animal,color=animal),size=1.2)+
  xlab("Month")+
  ylab("Number of Cases")+
  facet_grid(year~.)