Final

Introduction

The main objective of this research is to perform data analysis for the Dog Description data set. Dog description is a list of breed, color, size, age, etc… of all the adoptable dogs in the States.

Through the data set, we learn and explore insights about these adoptable dogs using the step below:

Load data set and packages
Data Preparation
Exploratory Data Analysis
Visualization
Summary

Packages Required

library(tidyverse) #used to install and load tidyverse packages
library(readr) #used to read csv file
library(ggplot2) #used to create plots
library(tibble) #used to create tibbles

Data Preparation

The data set and code book come from the 2019 Adoptable dogs.

We use the following code to import the data set and evaluate the data:

#import the csv file
dog <- read.csv('dog_descriptions.csv')

#find the total observation and variable
str(dog)

#check for missing values
sum(is.na(dog))

There are 58180 observations, 35 variables, and 474771 missing values in the “dog” data set

Some of the variables in the dog data set are:

color_primary - The primary color of the dog
age - The age of the dog
size - The size
fixed - Whether the dog is fixed or not
evn_children - Whether the dog is hostile to children
tag - The traits of the dog

The current data set is having quite a lot of missing values and abundant variables. We will tidy up the data set using the following code:

#adjust the data types of env_children, env_dogs, cat, and declaw
dog$env_children <- as.character(dog$env_children)
dog$env_dogs <- as.character(dog$env_dogs)
dog$env_cats <- as.character(dog$env_cats)
dog$declawed <- as.character(dog$declawed)

#adjust secondary breed 
dog$breed_secondary[is.na(dog$breed_secondary)] <- "Unknown"

#replace NA in env_children
dog$env_children[is.na(dog$env_children)] <- "Unknown"

#replace NA in env dog
dog$env_dogs[is.na(dog$env_dogs)] <- "Unknown"

#replace NA in env cat 
dog$env_cats[is.na(dog$env_cats)] <- "Unknown"

#replace NA in color 
dog$color_primary[is.na(dog$color_primary)] <- "Unknown"
dog$color_secondary[is.na(dog$color_secondary)] <- "Unknown"
dog$color_tertiary[is.na(dog$color_tertiary)] <- "Unknown"

#replace NA in coat
dog$coat[is.na(dog$coat)] <- "Unknown"

#replace NA in declawed
dog$declawed[is.na(dog$declawed)] <- "Unknown"

#replace NA in tags, photo, and contact zip, description
dog$tags[is.na(dog$tags)] <- "None"
dog$photo[is.na(dog$photo)] <- "None"
dog$contact_zip[is.na(dog$contact_zip)] <- "None"
dog$description[is.na(dog$description)] <- "None"

#replace NA in accessed with the appropriate info 
dog$accessed[is.na(dog$accessed)] <- "20/9/2019"

#remove the row "type" and "contact_country" because they do not contain any valuable information
dog <- dog %>% select(-type,-contact_country)

The final data set will look like this:

Dog Description
id	breed_primary	breed_mixed	color_primary	age	sex	size	coat	fixed	house_trained	declawed	special_needs	shots_current	env_children	env_dogs	env_cats	name	tags	photo	contact_city
46042150	American Staffordshire Terrier	TRUE	White / Cream	Senior	Male	Medium	Short	TRUE	TRUE	Unknown	FALSE	TRUE	Unknown	Unknown	Unknown	HARLEY	None	None	Las Vegas
46042002	Pit Bull Terrier	TRUE	Brown / Chocolate	Adult	Male	Large	Short	TRUE	TRUE	Unknown	FALSE	TRUE	Unknown	Unknown	Unknown	BIGGIE	None	None	Las Vegas
46040898	Shepherd	FALSE	Brindle	Adult	Male	Large	Short	TRUE	FALSE	Unknown	FALSE	TRUE	Unknown	Unknown	Unknown	Ziggy	None	None	Mesquite
46039877	German Shepherd Dog	FALSE	Unknown	Baby	Female	Large	Unknown	FALSE	FALSE	Unknown	FALSE	FALSE	Unknown	Unknown	Unknown	Gypsy	None	None	Pahrump
46039306	Dachshund	FALSE	Unknown	Young	Male	Small	Long	TRUE	FALSE	Unknown	FALSE	TRUE	TRUE	TRUE	TRUE	Theo	None	None	Henderson
46039304	Boxer	TRUE	Unknown	Baby	Male	Medium	Short	TRUE	FALSE	Unknown	FALSE	TRUE	TRUE	TRUE	TRUE	Oliver	None	None	Henderson
46039303	Italian Greyhound	TRUE	Unknown	Baby	Female	Small	Short	TRUE	FALSE	Unknown	FALSE	TRUE	TRUE	TRUE	TRUE	Macadamia	None	None	Henderson
46039302	Cattle Dog	TRUE	Unknown	Baby	Male	Medium	Medium	TRUE	FALSE	Unknown	FALSE	TRUE	TRUE	TRUE	TRUE	Dodger	None	None	Henderson
46039301	Cattle Dog	TRUE	Unknown	Baby	Female	Medium	Medium	TRUE	FALSE	Unknown	FALSE	TRUE	TRUE	TRUE	TRUE	Huckleberry	None	None	Henderson
46038709	Cattle Dog	TRUE	Unknown	Baby	Male	Medium	Medium	TRUE	FALSE	Unknown	FALSE	TRUE	TRUE	TRUE	TRUE	Fagin	None	None	Henderson

We noticed that there are total 216 breeds in the data set. Within the 216 breeds, Pit Bull Terrier is the most popular breed with 7890 individuals, coming in second place is Lab Retriever with 7198 canines. For people who are looking for specific age group of the canines, 9397 puppies are available. New York has the most puppies in the United States with nearly 700 puppies available to adopt.Furthermore, New York is the State that has the most adoptable dogs with 4002 available canines.

There is one thing that is worth to mention is 28% of the dogs are not having the current shot, so vaccination fee has to be considered when you decide to bring home a buddy.

Exploratory Data Analysis

First, we want to see how many breeds are there in the data set:

#find the number of breed
dog %>% group_by(breed_primary)%>% 
  count() %>% 
  arrange(desc(n))

## # A tibble: 216 × 2
## # Groups:   breed_primary [216]
##    breed_primary                      n
##    <chr>                          <int>
##  1 Pit Bull Terrier                7890
##  2 Labrador Retriever              7198
##  3 Chihuahua                       3766
##  4 Mixed Breed                     3242
##  5 Terrier                         2641
##  6 Hound                           2282
##  7 German Shepherd Dog             2122
##  8 Boxer                           2050
##  9 Shepherd                        1972
## 10 American Staffordshire Terrier  1862
## # ℹ 206 more rows

#Create a bar chart of breed
dog_count = dog %>% group_by(breed_primary)%>% 
  count() %>% 
  arrange(desc(n)) %>%
  head(8)

ggplot(data = dog_count, aes(x = breed_primary, y = n)) +
geom_bar(stat = "identity") +
labs(title = "Top 8 breeds in United States", 
  x = "Breed", y = "Count")

And we check how many dogs are there in each state:

#find the number of breed in each state
dog %>% group_by(contact_state) %>%
  count() %>% arrange(desc(n))

## # A tibble: 75 × 2
## # Groups:   contact_state [75]
##    contact_state     n
##    <chr>         <int>
##  1 NY             4002
##  2 GA             3479
##  3 VA             3058
##  4 NJ             3022
##  5 PA             2821
##  6 OH             2670
##  7 FL             2659
##  8 NC             2627
##  9 AZ             2248
## 10 IN             1877
## # ℹ 65 more rows

I want to find out what are the most suitable breeds for families with kids:

#Create a new data set of dog breed, sample size has to be more than 30
dog_breed = dog %>% group_by(breed_primary)%>% 
  count() %>% 
  arrange(desc(n)) %>%
  filter(n > 30) %>%
  rename(number_of_breed = n)

#Create another data set to calculate the average of dog percentage of canines in the breed that are marked with children friendly
dog %>% 
  group_by(breed_primary,env_children) %>% 
  filter(env_children == TRUE) %>% 
  count() %>%
  left_join(dog_breed, by = "breed_primary") %>% 
  summarise(percent = n/number_of_breed*100) %>% 
  arrange(desc(percent)) %>% 
  head(10)

## # A tibble: 10 × 3
## # Groups:   breed_primary [10]
##    breed_primary              env_children percent
##    <chr>                      <chr>          <dbl>
##  1 English Pointer            TRUE            82.2
##  2 English Springer Spaniel   TRUE            80  
##  3 Brittany Spaniel           TRUE            58.1
##  4 Flat-Coated Retriever      TRUE            55.8
##  5 Great Pyrenees             TRUE            55.1
##  6 Manchester Terrier         TRUE            53.8
##  7 Great Dane                 TRUE            53.3
##  8 German Shorthaired Pointer TRUE            52.3
##  9 French Bulldog             TRUE            52.2
## 10 Feist                      TRUE            51.8

Top 5 friendliest breeds to kids:

#Create a bar chart for friendly breed
dog_kid = dog %>% 
  group_by(breed_primary,env_children) %>% 
  filter(env_children == TRUE) %>% 
  count() %>%
  left_join(dog_breed, by = "breed_primary") %>% 
  summarise(percent = n/number_of_breed*100) %>% 
  arrange(desc(percent)) %>% 
  head(5)

ggplot(data = dog_kid, aes(x = breed_primary, y = percent)) +
geom_bar(stat = "identity") +
labs(title = "Top 5 friendly breeds to kids", 
         x = "Breed", y = "Percent") + 
theme(legend.position="none", panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          panel.background = element_blank(), 
          axis.line = element_line(colour = "blue"))

Next, we will find out which city has the most adoptable dogs:

#Number of dogs by city
dog_city = dog %>% group_by(contact_city) %>%
  count() %>% arrange(desc(n)) %>% head(10)

#Create a bar chart
ggplot(data = dog_city, aes(x = contact_city, y = n)) +
geom_bar(stat = "identity") +
labs(title = "Top 10 cities have the most adoptable dogs", 
         x = "City", y = "Count") + 
theme(legend.position="none", panel.grid.major = element_blank(),
          panel.grid.minor = element_blank(),
          panel.background = element_blank(), 
          axis.line = element_line(colour = "blue"))

Next, I want to find out whether fixing a dog would make it more friendly with the kids, other dogs, and cats.

dog %>% 
  group_by(fixed) %>% count()

## # A tibble: 2 × 2
## # Groups:   fixed [2]
##   fixed     n
##   <lgl> <int>
## 1 FALSE 11559
## 2 TRUE  46621

dog %>%
  select(id,breed_primary, fixed, env_children,env_dogs,env_cats) %>%
  filter(fixed == TRUE,env_dogs == TRUE, env_children == TRUE, env_cats == TRUE) %>%
  count()

##      n
## 1 7970

As we can see, in 58180 dogs, 46621 canines were fixed. In those fixed canines, 7970 of them are friendly with either kids, other dogs, or cats. The rate is 17%.

How about those that were not fixed?

dog %>%
  select(id,breed_primary, fixed, env_children,env_dogs,env_cats) %>%
  filter(fixed != TRUE,env_dogs == TRUE, env_children == TRUE, env_cats == TRUE) %>%
  count()

##      n
## 1 2227

In 11559 non-fixed canines, 2227 of them are either friendly with kids, other dogs, or cats. The rate is 19%. So does it mean that the non-fixed dogs perform better than the fixed one. Based on the data set, yes, but there is a lot of “unknown” information in the data set. Therefore, I can’t surely confirm that dogs will get get worse when you neuter them.

Summary

Based on the analysis, we see that the most common breeds in the United States are Pit Bull Terrier, Lab, and Chihuahua. New York, Georgia, and Virginia have the most adoptable dogs. Furthermore, we also found out the most kid-friendly dogs, those are English Pointer, English Spaniel, and Brittany Spaniel. Unfortunately, Labrador Retrieve did not make it to the top.

I also tried to use the data set to predict the outcome of neutering a dog. It is well-known that fixing a dog could yield many health benefit and neutral the wildness. However, my research yielded a different result. The rate of non-fixed canines that are friendly to kids, other dogs, and cats are slightly better than the rate of the fixed one. There are so many more factors need to be considered. Therefore, I have to hold up this statement. More data needed for the final conclusion.