保護犬・保護猫・保護動物のデータ解析その２ー犬種・猫種で保護・譲渡が多いのは？ー
前回（保護犬・保護猫・保護動物のデータ解析その１）の続きです。 まずは、ライブラリとデータを読み込みます。
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"Outcome.Typeという変数が、動物の顛末のようです。どんな変数があるか見てみます。
unique(df$Outcome.Type) ## [1] "Rto-Adopt" "Adoption" "Euthanasia" "Transfer"
## [5] "Return to Owner" "Died" "Disposal" ""
## [9] "Missing" "Relocate"Adoptionというのが、養子ということで新しい飼い主に引き取られたということでしょう。 養子となったか否かに着目したいと思います。そのため、以下の変換を行います。
df$Outcome.Type <- ifelse(df$Outcome.Type=="Adoption","Yes","No")犬セット、猫セットを作ります。
dfdog <- df %>% filter(Animal.Type=="Dog")
dfcat <- df %>% filter(Animal.Type=="Cat")まず、犬で保護されている犬種はどういったものでしょうか。多い50種を見てみます。並び替えは、arrangeです。
Breeddf_dog <- as.data.frame(table(dfdog$Breed))
Breeddf_dog <- Breeddf_dog %>% arrange(-Freq)
top50_dog <- Breeddf_dog[1:50,]犬種カテゴリが多すぎて、barchartが見づらい。修正する過程をメモっておきます。
ggplot(top50_dog) +
geom_bar(aes(x=Var1,y=Freq),stat="identity")
文字が見えない。。
ggplot(top50_dog) +
geom_bar(aes(x=Var1,y=Freq),stat="identity")+
coord_flip()
y軸が、アルファベット順になってて分かりずらい。。
ggplot(top50_dog) +
geom_bar(aes(x=reorder(Var1, Freq),y=Freq),stat="identity")+
xlab("")+
ylab("Frequency")+
coord_flip()
ピットブルが最多
アメリカならではなのでしょうか。次に、ラブラドール、次にチワワ。 飼育数が影響しているのでしょう。
元データは犬種の数が非常に多いので、さきほどの多かった50種に搾って解析します。 top50の犬種リスト内に存在するかどうかチェックするのは、 %in%です。 %in%のショートカットがないようなので、Shift + Ctrl + Mのおして %>% を出して、>をinに手動で修正します。
dogBreed <- dfdog %>%
select(Outcome.Type,Breed) %>%
filter(Breed %in% top50_dog[,1]) ggplotのbarチャートを使いたいのですが、そのためにreshape２でデータの形を変えます。
Wide to long : melt(data, id.vars = c( “残す列1“ ,”残す列2” ) )
Long to wide: dcast(data, 残す列1＋残る列2～くずす列, value.var = “ くずした下のデータ “)
dogBreed2 <- as.data.frame(table(Breed=dogBreed$Breed,Adaption=dogBreed$Outcome.Type))
head(dogBreed2)## Breed Adaption Freq
## 1 American Bulldog Mix No 246
## 2 American Pit Bull Terrier Mix No 155
## 3 American Staffordshire Terrier Mix No 175
## 4 Anatol Shepherd Mix No 160
## 5 Australian Cattle Dog No 130
## 6 Australian Cattle Dog Mix No 644dogBreed2 <- dcast(dogBreed2,Breed~Adaption,id.var=Freq)head(dogBreed2)## Breed No Yes
## 1 American Bulldog Mix 246 200
## 2 American Pit Bull Terrier Mix 155 142
## 3 American Staffordshire Terrier Mix 175 109
## 4 Anatol Shepherd Mix 160 250
## 5 Australian Cattle Dog 130 170
## 6 Australian Cattle Dog Mix 644 854グラフを書きます。グラフの順番を変更するためにreorderを使います。dplyrのarrangeで順番を変更しても、ggplotの順番を変更できません。ggplot用のreorderを使わないとダメです。 reoder(順番を変更したい列１、列１の順番を変更するときに順番となる数字を参照する列２)
ggplot(dogBreed2,aes(x=reorder(Breed,Yes))) +
geom_bar(aes(y=Yes,fill="Yes"),stat = "identity") +
geom_bar(aes(y=-No,fill="No"),stat = "identity") +
scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
labs(x="Breed",y="Frequency") +
coord_flip() +
theme_minimal()
ピットブルの譲渡不成功数が多い
猫についても同様の解析をします。
Breeddf_cat <- as.data.frame(table(dfcat$Breed))
Breeddf_cat <- Breeddf_cat %>% arrange(-Freq)
top50_cat <- Breeddf_cat[1:50,]
ggplot(top50_cat) +
geom_bar(aes(x=reorder(Var1, Freq),y=Freq),stat="identity")+
xlab("Frequency")+
ylab("")+
coord_flip()
ドメスティックショートヘアー、つまり雑種が多いと分かりました。
catBreed <- dfcat %>%
select(Outcome.Type,Breed) %>%
filter(Breed %in% top50_cat[,1])
catBreed2 <- as.data.frame(table(Breed=catBreed$Breed,Adaption=catBreed$Outcome.Type))
catBreed2 <- dcast(catBreed2,Breed~Adaption,id.var=Freq)ggplot(catBreed2,aes(x=reorder(Breed,Yes))) +
geom_bar(aes(y=Yes,fill="Yes"),stat = "identity") +
geom_bar(aes(y=-No,fill="No"), stat = "identity") +
scale_fill_manual("Adopted",values=c(Yes="pink",No="lightblue"))+
labs(x="",y="") +
coord_flip() +
theme_minimal()
猫は犬と違い、猫種は譲渡に影響しなそうです
次に続きます。