Exerciselab3
2540120074-LionelRiyadi
2022-06-02
library(readr)
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, unionlibrary(ggplot2)
library(openintro)## Loading required package: airports## Loading required package: cherryblossom## Loading required package: usdatacars <- read.csv("https://assets.datacamp.com/production/course_1796/datasets/cars04.csv")
comics <- read.csv("https://assets.datacamp.com/production/course_1796/datasets/comics.csv")
life <- read.csv("https://assets.datacamp.com/production/course_1796/datasets/life_exp_raw.csv")Bar Chart Expectation: 1. It essentialy what you would get if you used the table function with two variables 2. Which way you show the data can change the perception. 3. Bar charts with categorical variables on the x axis and in the fill are a common way to see a contingency table visually. 4. Which variable you use for the fill or the position of the bars (fill, dodge, stack) all can give different perceptions
#displaying first 5 rows
head(comics)## name id align eye hair
## 1 Spider-Man (Peter Parker) Secret Good Hazel Eyes Brown Hair
## 2 Captain America (Steven Rogers) Public Good Blue Eyes White Hair
## 3 Wolverine (James \\"Logan\\" Howlett) Public Neutral Blue Eyes Black Hair
## 4 Iron Man (Anthony \\"Tony\\" Stark) Public Good Blue Eyes Black Hair
## 5 Thor (Thor Odinson) No Dual Good Blue Eyes Blond Hair
## 6 Benjamin Grimm (Earth-616) Public Good Blue Eyes No Hair
## gender gsm alive appearances first_appear publisher
## 1 Male <NA> Living Characters 4043 Aug-62 marvel
## 2 Male <NA> Living Characters 3360 Mar-41 marvel
## 3 Male <NA> Living Characters 3061 Oct-74 marvel
## 4 Male <NA> Living Characters 2961 Mar-63 marvel
## 5 Male <NA> Living Characters 2258 Nov-50 marvel
## 6 Male <NA> Living Characters 2255 Nov-61 marvel#check levels of align
levels(as.factor(comics$align))## [1] "Bad" "Good" "Neutral"
## [4] "Reformed Criminals"#check levels of gender
levels(as.factor(comics$gender))## [1] "Female" "Male" "Other"#create 2-way contigency table
table(as.factor(comics$align),as.factor(comics$gender))##
## Female Male Other
## Bad 1573 7561 32
## Good 2490 4809 17
## Neutral 836 1799 17
## Reformed Criminals 1 2 0Dropping Levels
tab <- table(as.factor(comics$align),as.factor(comics$gender))
tab##
## Female Male Other
## Bad 1573 7561 32
## Good 2490 4809 17
## Neutral 836 1799 17
## Reformed Criminals 1 2 0#removeing level name Reformed Criminals
comics <- comics %>%
filter(align!='Reformed Criminals')%>%
droplevels()
levels(as.factor(comics$align))## [1] "Bad" "Good" "Neutral"#create side-by-side barchart of gender by alignment
ggplot(comics, aes(x = align, fill = gender))+ geom_bar(position="dodge")
#create side by side barchar of alignment by gender
ggplot(comics, aes(x = gender, fill = align))+ geom_bar(position="dodge")+ theme(axis.text.x=element_text(angle=90))
Bar Chart Intrepretation - among every align, males are the most commons - In general, there is an association between gender & alignment - There are more male characters than female characters in this dataset.
Count Vs Proportions
#simply display format
options(scipen=999,digits=3)
#create table of counts
tab2<- table(comics$id,as.factor(comics$align))
tab2##
## Bad Good Neutral
## No Dual 474 647 390
## Public 2172 2930 965
## Secret 4493 2475 959
## Unknown 7 0 2#proportional table
#all values add up to 1
prop.table(tab2)##
## Bad Good Neutral
## No Dual 0.030553 0.041704 0.025139
## Public 0.140003 0.188862 0.062202
## Secret 0.289609 0.159533 0.061815
## Unknown 0.000451 0.000000 0.000129#summ the all values that has been added up by 1
sum(prop.table(tab2))## [1] 1#All rows add up by 1
prop.table(tab2,1)##
## Bad Good Neutral
## No Dual 0.314 0.428 0.258
## Public 0.358 0.483 0.159
## Secret 0.567 0.312 0.121
## Unknown 0.778 0.000 0.222#all columns add up by 1
prop.table(tab2,2)##
## Bad Good Neutral
## No Dual 0.066331 0.106907 0.168394
## Public 0.303946 0.484137 0.416667
## Secret 0.628743 0.408956 0.414076
## Unknown 0.000980 0.000000 0.000864as we can see, there are very few characters with id = unknown
ggplot(comics,aes(x=id,fill=align))+geom_bar(position="fill")+ylab("proportion")
-Swap the x and fill variables. Notice the most bad cahracters are
secret (not unknown). - here you can see clearly that there are very few
characters with id = unknown
ggplot(comics,aes(x=align,fill=id))+geom_bar(position="fill")+ylab("proportion")
Conditional Proportions
tabs <- table(comics$align, comics$gender)
options(scipen=999,digits =3)#display fewer digits
prop.table(tabs)# joint proportion##
## Female Male Other
## Bad 0.082210 0.395160 0.001672
## Good 0.130135 0.251333 0.000888
## Neutral 0.043692 0.094021 0.000888prop.table(tabs,2)##
## Female Male Other
## Bad 0.321 0.534 0.485
## Good 0.508 0.339 0.258
## Neutral 0.171 0.127 0.258approximately what proportion of allfemale characters are good? - 51 % Counts Vs Proportions(2)
ggplot(comics,aes(x=align,fill=gender))+geom_bar()#plotting gender by align
ggplot(comics,aes(x=align,fill=gender))+geom_bar(position="fill")
#plot proportion of gender, conditional on alignDistribution of one variable
#we can use table function on just one variable
table(comics$id)#Usually called as Marginal Distribution##
## No Dual Public Secret Unknown
## 1511 6067 7927 9#Simple barchart
ggplot(comics,aes(x=id))+geom_bar()
we can se facet to see variable individually much easier than filtering
and plotting. this is a rearrangement of the bar chart we plotted
earlier - we facet by alignment rather than coloring the stack - this
can make it a little easier to answer some question
#We also able to facet to see variables individually
ggplot(comics,aes(x=id))+geom_bar()+facet_wrap(~align)
Marginal BarChart - makes more sense to put neutral between bad and good
- first we need to reorder the levels otherwise it’ll default to
alphabetically which are a-z
#Marginal Barchart
comics$align<- factor(comics$align,levels=c("Bad","Neutral","Good"))
ggplot(comics,aes(x = align))+geom_bar()
Conditional Barchart
#plot of alignment brokendown by gender
ggplot(comics,aes(x=align))+geom_bar()+facet_wrap(~ gender)
Improve Piechart
#reordering levels into descending order
level<- c("apple","key lime","boston creme","blueberry","cherry","pumpkin","strawberry")
pies <- data.frame(flavors = as.factor(rep(c("apple", "blueberry", "boston creme", "cherry", "key lime", "pumpkin", "strawberry"), times = c(17, 14, 15, 13, 16, 12, 11))))
pies$flavors<-factor(pies$flavors,levels=level)
head(pies$flavors)## [1] apple apple apple apple apple apple
## Levels: apple key lime boston creme blueberry cherry pumpkin strawberry#Create barchart of flavor
ggplot(pies,aes(x=flavors))+geom_bar(fill="chartreuse")+theme(axis.text.x=element_text(angle=90))
Exploring Numerical Data
#a dot plot shows all the data points
ggplot(cars,aes(x=weight))+geom_dotplot(dotsize=0.4)## Bin width defaults to 1/30 of the range of the data. Pick better value with `binwidth`.## Warning: Removed 2 rows containing non-finite values (stat_bindot).
histogram
#a histograms groups the points into bins so it does not get overwhelmming
ggplot(cars,aes(x=weight))+geom_histogram(dotsize=0.4,binwidth=500)## Warning: Ignoring unknown parameters: dotsize## Warning: Removed 2 rows containing non-finite values (stat_bin).
A density plot will represent a bigger picture of the distribution data
which will helpfull doing when there are a lot of data
ggplot(cars,aes(x=weight))+geom_density()## Warning: Removed 2 rows containing non-finite values (stat_density).
Boxplot,
ggplot(cars,aes(x=1,y=weight))+geom_boxplot()+coord_flip()## Warning: Removed 2 rows containing non-finite values (stat_boxplot).
boxplot also a good way to display the summary information of the
distribution FacetedHistogram
#summary data
str(cars)## 'data.frame': 428 obs. of 19 variables:
## $ name : chr "Chevrolet Aveo 4dr" "Chevrolet Aveo LS 4dr hatch" "Chevrolet Cavalier 2dr" "Chevrolet Cavalier 4dr" ...
## $ sports_car : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ suv : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ wagon : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ minivan : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ pickup : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ all_wheel : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ rear_wheel : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ msrp : int 11690 12585 14610 14810 16385 13670 15040 13270 13730 15460 ...
## $ dealer_cost: int 10965 11802 13697 13884 15357 12849 14086 12482 12906 14496 ...
## $ eng_size : num 1.6 1.6 2.2 2.2 2.2 2 2 2 2 2 ...
## $ ncyl : int 4 4 4 4 4 4 4 4 4 4 ...
## $ horsepwr : int 103 103 140 140 140 132 132 130 110 130 ...
## $ city_mpg : int 28 28 26 26 26 29 29 26 27 26 ...
## $ hwy_mpg : int 34 34 37 37 37 36 36 33 36 33 ...
## $ weight : int 2370 2348 2617 2676 2617 2581 2626 2612 2606 2606 ...
## $ wheel_base : int 98 98 104 104 104 105 105 103 103 103 ...
## $ length : int 167 153 183 183 183 174 174 168 168 168 ...
## $ width : int 66 66 69 68 69 67 67 67 67 67 ...ggplot(cars,aes(x=city_mpg))+geom_histogram()+facet_wrap(~ suv)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 14 rows containing non-finite values (stat_bin).
Boxplots and Density plots
unique(cars$ncyl)## [1] 4 6 3 8 5 12 10 -1table(cars$ncyl)##
## -1 3 4 5 6 8 10 12
## 2 1 136 7 190 87 2 3Filtering cars with 4 6 8 cylinder
filtered<- filter(cars, ncyl %in% c(4,6,8))
ggplot(filtered,aes(x=as.factor(ncyl),y=city_mpg))+geom_boxplot()## Warning: Removed 11 rows containing non-finite values (stat_boxplot).
creating overlaid density plots for same data
ggplot(filtered,aes(x=city_mpg,fill=as.factor(ncyl)))+geom_density(alpha=.3)## Warning: Removed 11 rows containing non-finite values (stat_density).
Compare Distribution via plots - highest mileage cars have 4 cylinders -
most of the 4 cylinders cars get better mileage than even the most
efficient 8 cylinders cars
Distribution of one variable - Marginal & Conditional Histograms
cars%>%
ggplot(aes(horsepwr))+geom_histogram()+ggtitle("Horse Power Distribution")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Highest power car between 200-300 which we cannot see clearly Filtering
affordable cars with horsepower < 25000 displaying affordable cars
with horsepower
cars%>%
filter(msrp<25000)%>%
ggplot(aes(horsepwr))+geom_histogram()+xlim(c(90,550))+ggtitle("Horse Power Distribution for msrp <25000")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 1 rows containing non-finite values (stat_bin).## Warning: Removed 2 rows containing missing values (geom_bar).
Now we can see the highest horsepower car in the less expensive range
just under 250 horsepwoer
#histogram of horsepower with bindwith of 3
cars%>%
ggplot(aes(horsepwr))+geom_histogram(binwidth=3)+ggtitle("Binwidth=3")
bindwith with = 30
cars%>%
ggplot(aes(horsepwr))+geom_histogram(binwidth=30)+ggtitle("Binwidth=30")
Boxplot for outliers
cars%>%
ggplot(aes(x=1,y=msrp))+geom_boxplot()
#excluding the outlier and construct the boxplot
cars2<-cars%>%
filter(msrp<100000)
cars2%>%
ggplot(aes(x=1,y=msrp))+geom_boxplot()
plot section
cars%>%
ggplot(aes(x=1,y=city_mpg))+geom_boxplot()## Warning: Removed 14 rows containing non-finite values (stat_boxplot).
cars%>%
ggplot(aes(city_mpg))+geom_density()## Warning: Removed 14 rows containing non-finite values (stat_density).
as we can see the plot, city_mpg has a unimodal-left skewed
cars%>%
ggplot(aes(x=1,y=width))+geom_boxplot()## Warning: Removed 28 rows containing non-finite values (stat_boxplot).
cars%>%
ggplot(aes(x=width))+geom_density()## Warning: Removed 28 rows containing non-finite values (stat_density).
3 variable in higher dimensions 3 varibale plotting
filtered%>%
ggplot(aes(x=hwy_mpg))+geom_histogram()+facet_grid(ncyl~suv)+ggtitle("hwy_mpg by ncyl and suv")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 11 rows containing non-finite values (stat_bin).
Across both SUVs and non-SUVs, mileage tends to decrease as the number
of cylinder increase
What is typical value for life expectacy?
head(life)## State County fips Year Female.life.expectancy..years.
## 1 Alabama Autauga County 1001 1985 77.0
## 2 Alabama Baldwin County 1003 1985 78.8
## 3 Alabama Barbour County 1005 1985 76.0
## 4 Alabama Bibb County 1007 1985 76.6
## 5 Alabama Blount County 1009 1985 78.9
## 6 Alabama Bullock County 1011 1985 75.1
## Female.life.expectancy..national..years.
## 1 77.8
## 2 77.8
## 3 77.8
## 4 77.8
## 5 77.8
## 6 77.8
## Female.life.expectancy..state..years. Male.life.expectancy..years.
## 1 76.9 68.1
## 2 76.9 71.1
## 3 76.9 66.8
## 4 76.9 67.3
## 5 76.9 70.6
## 6 76.9 66.6
## Male.life.expectancy..national..years. Male.life.expectancy..state..years.
## 1 70.8 69.1
## 2 70.8 69.1
## 3 70.8 69.1
## 4 70.8 69.1
## 5 70.8 69.1
## 6 70.8 69.1x <- head(round(life$Female.life.expectancy..years.),11)
x## [1] 77 79 76 77 79 75 77 77 77 78 77#mean = sum data/ total data
sum(x)/11## [1] 77.2#or
mean(x)## [1] 77.2#medianlibrary(gapminder)
str(gapminder)## tibble [1,704 × 6] (S3: tbl_df/tbl/data.frame)
## $ country : Factor w/ 142 levels "Afghanistan",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ continent: Factor w/ 5 levels "Africa","Americas",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ year : int [1:1704] 1952 1957 1962 1967 1972 1977 1982 1987 1992 1997 ...
## $ lifeExp : num [1:1704] 28.8 30.3 32 34 36.1 ...
## $ pop : int [1:1704] 8425333 9240934 10267083 11537966 13079460 14880372 12881816 13867957 16317921 22227415 ...
## $ gdpPercap: num [1:1704] 779 821 853 836 740 ...#reate dataset of 2007 data
gap2007<- filter(gapminder,year==2007)
#compute groupwise mean and median lifeexp
gap2007%>%
group_by(continent)%>%
summarize(mean(lifeExp),
median(lifeExp))## # A tibble: 5 × 3
## continent `mean(lifeExp)` `median(lifeExp)`
## <fct> <dbl> <dbl>
## 1 Africa 54.8 52.9
## 2 Americas 73.6 72.9
## 3 Asia 70.7 72.4
## 4 Europe 77.6 78.6
## 5 Oceania 80.7 80.7boxplot lifeExp for each continent
gap2007%>%
ggplot(aes(x=continent,y=lifeExp))+geom_boxplot()
Measure of variability In here, we want to know how much is the data
spread out from the middle
x## [1] 77 79 76 77 79 75 77 77 77 78 77#difference between each point and the mean
sum(x-mean(x))## [1] -0.0000000000000568so we can square the difference
sum((x-mean(x))^2)## [1] 13.6Variance divide by n-1;
sum((x-mean(x))^2)/(length(x)-1)## [1] 1.36#or
var(x)## [1] 1.36Standar Deviation a very useful metric
sqrt(sum((x-mean(x))^2)/(length(x)-1))## [1] 1.17#or
sd(x)## [1] 1.17Inter Quartile Range(IQR) is the middle 50% of the data not sensitive to the extreme values all other measure listed here are sensitive to extreme values
summary(x)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 75.0 77.0 77.0 77.2 77.5 79.0cat("interquartile : ")## interquartile :IQR(x)## [1] 0.5RANGE - max and min
max(x)## [1] 79min(x)## [1] 75diff(range(x))## [1] 4str(gap2007)## tibble [142 × 6] (S3: tbl_df/tbl/data.frame)
## $ country : Factor w/ 142 levels "Afghanistan",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ continent: Factor w/ 5 levels "Africa","Americas",..: 3 4 1 1 2 5 4 3 3 4 ...
## $ year : int [1:142] 2007 2007 2007 2007 2007 2007 2007 2007 2007 2007 ...
## $ lifeExp : num [1:142] 43.8 76.4 72.3 42.7 75.3 ...
## $ pop : int [1:142] 31889923 3600523 33333216 12420476 40301927 20434176 8199783 708573 150448339 10392226 ...
## $ gdpPercap: num [1:142] 975 5937 6223 4797 12779 ...#compute groupwise measure of spread
gap2007%>%
group_by(continent)%>%
summarize(sd(lifeExp),IQR(lifeExp),n())## # A tibble: 5 × 4
## continent `sd(lifeExp)` `IQR(lifeExp)` `n()`
## <fct> <dbl> <dbl> <int>
## 1 Africa 9.63 11.6 52
## 2 Americas 4.44 4.63 25
## 3 Asia 7.96 10.2 33
## 4 Europe 2.98 4.78 30
## 5 Oceania 0.729 0.516 2Generate overlaid density plots
gap2007%>%
ggplot(aes(x=lifeExp,fill=continent))+geom_density(alpha=0.3)
Choose measure for center and spread
#filtering Americas only
head(gap2007)## # A tibble: 6 × 6
## country continent year lifeExp pop gdpPercap
## <fct> <fct> <int> <dbl> <int> <dbl>
## 1 Afghanistan Asia 2007 43.8 31889923 975.
## 2 Albania Europe 2007 76.4 3600523 5937.
## 3 Algeria Africa 2007 72.3 33333216 6223.
## 4 Angola Africa 2007 42.7 12420476 4797.
## 5 Argentina Americas 2007 75.3 40301927 12779.
## 6 Australia Oceania 2007 81.2 20434176 34435.gap2007%>%
filter(continent=="Americas")%>%
summarize(mean(lifeExp),sd(lifeExp))## # A tibble: 1 × 2
## `mean(lifeExp)` `sd(lifeExp)`
## <dbl> <dbl>
## 1 73.6 4.44#for population
gap2007%>%
summarize(median(pop),IQR(pop))## # A tibble: 1 × 2
## `median(pop)` `IQR(pop)`
## <dbl> <dbl>
## 1 10517531 26702008.Shape & Transformations - center(covered) - spread or variability(covered) - shape - outliers
Transformations
gap2007%>%
ggplot(aes(x=pop))+geom_density()
#traansform the skewed pop variable
gap2007 <-gap2007%>%
mutate(log_pop=log(pop))
gap2007%>%
ggplot(aes(x=log_pop))+geom_density()
as we can see the plot, the shapes lookes like unimodal-symmetric
OutLiers
#filter for asia only and add column indicating outliers
str(gapminder)## tibble [1,704 × 6] (S3: tbl_df/tbl/data.frame)
## $ country : Factor w/ 142 levels "Afghanistan",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ continent: Factor w/ 5 levels "Africa","Americas",..: 3 3 3 3 3 3 3 3 3 3 ...
## $ year : int [1:1704] 1952 1957 1962 1967 1972 1977 1982 1987 1992 1997 ...
## $ lifeExp : num [1:1704] 28.8 30.3 32 34 36.1 ...
## $ pop : int [1:1704] 8425333 9240934 10267083 11537966 13079460 14880372 12881816 13867957 16317921 22227415 ...
## $ gdpPercap: num [1:1704] 779 821 853 836 740 ...gap_asia <- gap2007%>%
filter(continent=="Asia")%>%
mutate(is_outlier = lifeExp<50)
#removing outlier and create the boxplot
gap_asia%>%
filter(!is_outlier)%>%
ggplot(aes(x=1,y=lifeExp))+geom_boxplot()
CASE STUDY Introducing data -spam & num_char
library(ggplot2)
library(dplyr)
library(openintro)
email = read.csv("email.csv")
str(email)## 'data.frame': 3921 obs. of 21 variables:
## $ spam : int 0 0 0 0 0 0 0 0 0 0 ...
## $ to_multiple : int 0 0 0 0 0 0 1 1 0 0 ...
## $ from : int 1 1 1 1 1 1 1 1 1 1 ...
## $ cc : int 0 0 0 0 0 0 0 1 0 0 ...
## $ sent_email : int 0 0 0 0 0 0 1 1 0 0 ...
## $ time : chr "2012-01-01T06:16:41Z" "2012-01-01T07:03:59Z" "2012-01-01T16:00:32Z" "2012-01-01T09:09:49Z" ...
## $ image : int 0 0 0 0 0 0 0 1 0 0 ...
## $ attach : int 0 0 0 0 0 0 0 1 0 0 ...
## $ dollar : int 0 0 4 0 0 0 0 0 0 0 ...
## $ winner : chr "no" "no" "no" "no" ...
## $ inherit : int 0 0 1 0 0 0 0 0 0 0 ...
## $ viagra : int 0 0 0 0 0 0 0 0 0 0 ...
## $ password : int 0 0 0 0 2 2 0 0 0 0 ...
## $ num_char : num 11.37 10.5 7.77 13.26 1.23 ...
## $ line_breaks : int 202 202 192 255 29 25 193 237 69 68 ...
## $ format : int 1 1 1 1 0 0 1 1 0 1 ...
## $ re_subj : int 0 0 0 0 0 0 0 0 0 0 ...
## $ exclaim_subj: int 0 0 0 0 0 0 0 0 0 0 ...
## $ urgent_subj : int 0 0 0 0 0 0 0 0 0 0 ...
## $ exclaim_mess: int 0 1 6 48 1 1 1 18 1 0 ...
## $ number : chr "big" "small" "small" "small" ...email$spam## [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [75] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [112] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [149] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [186] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [223] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [260] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [297] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [334] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [371] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [408] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [445] 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [482] 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0
## [519] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [556] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [593] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [630] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [667] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [704] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [741] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [778] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [815] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [852] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [889] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [926] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [963] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1000] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1037] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1074] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1111] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1148] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1185] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1222] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1259] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1296] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1333] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1370] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1
## [1407] 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1
## [1444] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1
## [1481] 1 1 1 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1518] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1555] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1592] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1629] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1666] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1703] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1740] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1777] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1814] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1851] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1888] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1925] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1962] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [1999] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2036] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2073] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2110] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2147] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2184] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2221] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2258] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2295] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2332] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2369] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2406] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2443] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2480] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2517] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2554] 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2591] 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2628] 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2665] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2702] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2739] 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2776] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2813] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2850] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2887] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2924] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2961] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [2998] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3035] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3072] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3109] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3146] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3183] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3220] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3257] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3294] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3331] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3368] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3405] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3442] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3479] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3516] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3553] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3590] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3627] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3664] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3701] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3738] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [3775] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3812] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3849] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3886] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 0 1table(email$spam)##
## 0 1
## 3554 367email <- email %>%
mutate(spam = factor(ifelse(spam == 0, "not-spam", "spam")))
email %>%
mutate(log_num_char = log(num_char)) %>%
ggplot(aes(x = spam, y = log_num_char)) +
geom_boxplot()
The median length of not-spam emails is greater than that of spam
emails
#compute center and spread for exclaim mess by spam
email %>%
group_by(spam)%>%
summarize(median(exclaim_mess),IQR(exclaim_mess))## # A tibble: 2 × 3
## spam `median(exclaim_mess)` `IQR(exclaim_mess)`
## <fct> <dbl> <dbl>
## 1 not-spam 1 5
## 2 spam 0 1table(email$exclaim_mess)##
## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 1435 733 507 128 190 113 115 51 93 45 85 17 56 20 43 11
## 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
## 29 12 26 5 29 9 15 3 11 6 11 1 6 8 13 12
## 32 33 34 35 36 38 39 40 41 42 43 44 45 46 47 48
## 13 3 3 2 3 3 1 2 1 1 3 3 5 3 2 1
## 49 52 54 55 57 58 62 71 75 78 89 94 96 139 148 157
## 3 1 1 4 2 2 2 1 1 1 1 1 1 1 1 1
## 187 454 915 939 947 1197 1203 1209 1236
## 1 1 1 1 1 1 2 1 1#createplot for spam and exclaim mess
email%>%
mutate(log_exclaim_mess = log(exclaim_mess))%>%
ggplot(aes(x=log_exclaim_mess))+geom_histogram()+facet_wrap(~ spam)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 1435 rows containing non-finite values (stat_bin).
As we can see both plot, the most common value of exlcaim_mess is in
both classes of email is zero Even after transforming, the distribution
of exclaim_mess in both classes of email is right skeweed not-spam group
typically appears to be slightly higher than in the spam group Check-In1
Zero inflation in the exclaim_mess variable - you can analyze the two
part separately - or turn it into a categorical variable of a zero ,
not-zero Could make a barchart - Need to decide if you are more
interested in counts or proportions
Collapsing levels
table(email$image)##
## 0 1 2 3 4 5 9 20
## 3811 76 17 11 2 2 1 1#create plot for proportion of spam by image
email%>%
mutate(has_image = image>0)%>%
ggplot(aes(x=has_image,fill=spam))+geom_bar(position="fill")
An email without an image is more likely to be not-spam than spam
DATA INTEGRITY
#test if images count as attachments
sum(email$image>email$attach)## [1] 0There is no email with more images than attachments so these most be counted as attachments too
#within nonspam email, is the typical length of emails shorter for those that were sent to multiple people?
email%>%
filter(spam=="not-spam")%>%
group_by(to_multiple)%>%
summarize(median(num_char))## # A tibble: 2 × 2
## to_multiple `median(num_char)`
## <int> <dbl>
## 1 0 7.20
## 2 1 5.36Answer Question with chain YES
#Question 1
## For emails containing the word "dollar", does the typical spam email
## contain a greater number of occurences of the word than the typical non-spam email?
table(email$dollar)##
## 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
## 3175 120 151 10 146 20 44 12 35 10 22 10 20 7 14 5
## 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 32
## 23 2 14 1 10 7 12 7 7 3 7 1 5 1 1 2
## 34 36 40 44 46 48 54 63 64
## 1 2 3 3 2 1 1 1 3email%>%
filter(dollar>0)%>%
group_by(spam)%>%
summarize(median(dollar))## # A tibble: 2 × 2
## spam `median(dollar)`
## <fct> <dbl>
## 1 not-spam 4
## 2 spam 2Answer for Question no 1 : No,
#Question 2,
## If you encounter an email with greater than 10 occurrences of the word "dollar",
## is it more likely to be spam or not -spam?
email%>%
filter(dollar>0)%>%
ggplot(aes(x=spam))+geom_bar()
Answer for Question 2 Not-spam. Check-In2 Whats in a number?
levels(as.factor(email$number))## [1] "big" "none" "small"table(email$number)##
## big none small
## 545 549 2827#reorder levels
email$number<- factor(email$number,levels=c("none","small","big"))
#construct plot of number
ggplot(email,aes(x=number))+geom_bar()+facet_wrap(~ spam)
It is shown that email contains small number more likely to be not-spam
Emails contains a big number more likely to be not-spam Most common
number is a small one