#1
##a
library(readxl)
medianhousehold <- read_excel("C:/Users/admin/Desktop/stat_midterm/data/MedianHousehold.xlsx")
frequency <- table(cut(medianhousehold$`Median Income (000's)` , right = F , breaks = seq(65,115,5)))
relativefrequency <- frequency/sum(frequency)
percentfrequency <- relativefrequency*100
tt <- cbind(frequency , relativefrequency , percentfrequency)
tt2 <- rbind(tt , colSums(tt))
tt2
##b
hist(medianhousehold$`Median Income (000's)`)
##c
#The distribution is skewed to the right.
##d
#New Jersey $110.7 thousand
#e
#Idaho $67.1 thousand
#2
##a
zoo <- read_excel("C:/Users/admin/Desktop/stat_midterm/data/zoo.xlsx")
zoo <- as.matrix(zoo)
names <- zoo[,1]
zoo = zoo[,-1]
as.numeric(zoo)
zoo <- matrix(as.numeric(zoo),5,4)
rownames(zoo) = names
names2 <- zoo[1,]
zoo <- zoo[-1,]
colnames(zoo) = names2
zoo <- as.data.frame(zoo)
data <- data.frame(
name=colnames(zoo),
value=as.numeric(zoo[4,])
)
barplot(height=data$value, names=data$name , ylim = c(320000,355000) , xpd = FALSE)
#Zoo attendance appears to be dropping over time.
##b
t(as.matrix(zoo))
newdata <- as.data.frame(t(as.matrix(zoo)))
barplot(t(newdata[,c(1:3)]) , beside = T , ylim = c(0,200000))
##c
#General attendance is increasing, but not enough to offset the decrease in member attendance.
#School membership appears fairly stable.
#3
##a
incomes <- c(49.4,52.4,53.4,51.3,52.1,48.7,52.1,52.2,64.5,51.6,46.5,52.9,52.5,51.2)
median(incomes)
##b
((median(incomes)-55)/55)*100
##c
quantile(incomes , type = 6)
##d
summary(incomes , quantile.type =6)
##e
mu <- mean(incomes)
sd <- sd(incomes)
z <- sort((incomes-mu)/sd)
z
#The last household income (64.5) has a z-score > 3 and is an outlier.
IQR_incomes <- IQR(incomes , type = 6)
Q1 <- quantile(incomes , probs = 0.25 ,type = 6)
Q3 <- quantile(incomes , probs = 0.75 ,type = 6)
lower_limit <- Q1-1.5*IQR_incomes
upper_limit <- Q3+1.5*IQR_incomes
sort(incomes)
#Using this approach, the first observation (46.5) and the last observation (64.5)
#would be consider outliers.
#The two approaches will not always provide the same results.
#4
##a
tarvel <- read_excel("C:/Users/admin/Desktop/stat_midterm/data/Travel.xlsx")
mu1 <- mean(tarvel$Rooms)
mu1
##b
mu2 <- mean(tarvel$`Cost/Night`)
mu2
##c
plot(tarvel$`Cost/Night` ~ tarvel$Rooms)
#It is difficult to see much of a relationship. When the number of rooms becomes
#larger, there is no indication that the cost per night increases. The cost per night may
#even decrease slightly.
##d
cor(tarvel$Rooms , tarvel$`Cost/Night`)
#There is evidence of a slightly negative linear association between the number of
#rooms and the cost per night for a double room. Although this is not a strong
#relationship, it suggests that the higher room rates tend to be associated with the
#smaller hotels.
#This tends to make sense when we think about the economies of scale for
#larger hotels. Many of the amenities-pools, equipment, spas, restaurants, and so
#on-exist for all hotels in the Travel + Leisure top 50 hotels in the world. The smaller
#hotels tend to charge more for their rooms. The larger hotels can spread their fixed
#costs over many rooms and may actually be able to charge less per night and still
#achieve nice profits. The larger hotels may also charge slightly less in an effort to
#obtain a higher occupancy rate. In any case, there is apparently a slightly negative
#linear association between the number of rooms and the cost per night for a double
#room at the top hotels.
#5
##a
data <- data.frame(wait_time_rating = 1:10 ,
number_of_garages = c(6,2,3,2,5,2,4,5,5,6))
N <- sum(data$number_of_garages)
data$probs <- data$number_of_garages/N
data
##b
11/40
##c
mu <- sum(data$wait_time_rating*data$probs)
mu
var <- sum((data$wait_time_rating-mu)^2*data$probs)
var
##d
#The probability of a new car dealership receiving an outstanding wait-time rating is 2/7
#=0.2857. For the remaining 40 ¡V 7 = 33 service providers, nine received an
#outstanding rating; this corresponds to a probability of 9/33 = .2727. For these
#results, there does not appear to be much difference between the probability that a
#new car dealership is rated outstanding compared to the same probability for other
#types of service providers.