https://jorryyang.gitee.io/rdata/
第一次作業(yè)：
題目：
請下載hw1_a和hw1_b兩個excel數(shù)據(jù)文件，完成以下任務:
1. 請將數(shù)據(jù)hw1_a和hw1_b分別讀入R，查看數(shù)據(jù)并指出各個變量的形式，最小值，最大值，中值，均值，標準差。
2. 結(jié)合上課我們所學的幾種數(shù)據(jù)join 的形式，將兩個數(shù)據(jù)集進行合并。對于每種數(shù)據(jù)合并的方式，請說明key, 并且報告合并后的數(shù)據(jù)樣本總行數(shù)。
3. 請篩選出hw1_a 中收入大于4000的樣本，并將此樣本和hw1_b 中Is_Default=1的樣本合并，你可以使用inner join的方式。這一問中你可以用pipe的書寫形式。
4. 在第2問的基礎上,請給出Income對Years_at_Employer的散點圖，你發(fā)現(xiàn)了哪些趨勢和現(xiàn)象?
5.在第4問的基礎上 按照Is_Default 增加一個維度，請展示兩變量在不同違約狀態(tài)的散點圖。請使用明暗程度作為區(qū)分方式
6. 對于第5問，請使用形狀作為另外一種區(qū)分方式。
7. 請找出各個列的缺失值，并刪除相應的行。請報告每一變量的缺失值個數(shù)，以及所有缺失值總數(shù)。
8. 找出Income中的極端值并濾掉對應行的數(shù)據(jù)
9. 將Income對數(shù)化，并畫出直方圖和density curve.
10. 以Income作為因變量，Years at Employer作為自變量，進行OLS回歸，寫出回歸的方程，并指出自變量系數(shù)是否在某一顯著性水平上顯著。同時，解釋你的結(jié)果(這一問你自己發(fā)揮可以找code解決)。
####### 1 ######
library(readxl)
hw1_a<-read_excel("hw1_a.xlsx",col_types=c("numeric", "numeric", "numeric",
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? "numeric", "numeric"))
hw1_b<-read_excel("hw1_b.xlsx")
str(hw1_a)
str(hw1_b)
summary(hw1_a)
summary(hw1_b)
sd(hw1_a$Income)
library(psych)
describe(hw1_a)
describe(hw1_b)
########? ? 2? ? #######
library(tidyverse)
hw1_a %>%
? inner_join(hw1_b,by="ID")
hw1_a %>%
? left_join(hw1_b,by="ID")
hw1_a %>%
? right_join(hw1_b,by="ID")
hw1_a %>%
? full_join(hw1_b,by="ID")
inner_join<-inner_join(hw1_a,hw1_b,by="ID")
(nrow(inner_join))
full_join<-full_join(hw1_a,hw1_b,by="ID")
(nrow(full_join))
#########? ? 3? ? ########
hw1_a1=filter(hw1_a,Income>40000)
hw1_b1=filter(hw1_b,Is_Default==1)
inner_join1<-inner_join(hw1_a1,hw1_b1,by="ID")
#########? 4? ? #########
ggplot(data=inner_join)+
? geom_point(mapping = aes(x=Years_at_Employer,y= Income))
########? ? 5? ? ############
ggplot(data=inner_join)+
? geom_point(mapping = aes(x=Years_at_Employer,y= Income,alpha=Is_Default))
ggplot(data=inner_join)+
? geom_point(mapping = aes(x=Years_at_Employer,y= Income,
? ? ? ? ? ? ? ? ? ? ? ? ? alpha=factor(Is_Default)))
########? ? 6? ? ##########
ggplot(data=inner_join)+
? geom_point(mapping = aes(x=Years_at_Employer,y= Income,
? ? ? ? ? ? ? ? ? ? ? ? ? shape=factor(Is_Default)))? ?
########? ? 7? ? #########
sum(is.na(full_join[2]))
sum(is.na(full_join[3]))
sum(is.na(full_join[4]))
sum(is.na(full_join[5]))
sum(is.na(full_join[6]))
sum(is.na(full_join[7]))
sum(is.na(full_join[8]))
sum(is.na(full_join))
full_join1=filter(full_join,!is.na(full_join[2]))
full_join1=filter(full_join1,!is.na(full_join1[3]))
full_join1=filter(full_join1,!is.na(full_join1[4]))
full_join1=filter(full_join1,!is.na(full_join1[5]))
full_join1=filter(full_join1,!is.na(full_join1[6]))
full_join1=filter(full_join1,!is.na(full_join1[7]))
full_join1=filter(full_join1,!is.na(full_join1[8]))
sum(is.na(full_join1))
########? 8? #########
quantile(hw1_a$Income,c(0.025,0.975))
hw1_a2=filter(hw1_a,Income>14168.81&Income<173030.92)
#######? 9? #########
inc<-hw1_a$Income
lninc<-log(inc)
hist(lninc,prob=T)
lines(density(lninc),col="blue")
#######? 10? #########
m1<-lm(Income~Years_at_Employer,data=hw1_a)
summary(m1)
第二次作業(yè)
問題1：
問題二：
給定數(shù)據(jù)，請完成以下任務，請給出code 和輸出結(jié)果。
（1） 請讀入數(shù)據(jù)，使用軟件分別給出price, marketshare，和brand的缺失值數(shù)量。請按照每一個brand, 將數(shù)據(jù)按照先marjetshare 后price 進行從高到低排序
（2）請按照brand 的種類，對price和marketshare 求均值。
（3） 請按照brand 的種類，對price和marketshare 畫散點圖。
（4） 請按照價格的均值，產(chǎn)生新的變量price_new, 低于均值為“低價格”，高于均值為“高價格”。 同樣對市場份額也是，產(chǎn)生變量marketshare_new, 數(shù)值為“低市場份額”和“高市場份額”
（5） 請估計模型，marketshare為Y，price為X.
（6） 請畫出（5）的擬合直線。
（7） 請隨機產(chǎn)生若干直線，驗證（5）的結(jié)果是最優(yōu)的
（8） 請估計模型，marketshare為Y，price和brand 為X.
######### 1(1) ############
get.root<-function(a,b,c){
? if(sign(b*b-4*a*c)==-1)
? {print("鏃犺В")
? ? return(c(NA,NA))
? } else
? ? return(c((-b+sqrt(b*b-4*a*c))/(2*a),(-b-sqrt(b*b-4*a*c))/(2*a)))
}
get.root(1,-4,4)
######### 1(2) #############
get.prob<-function(n){
? a=runif(n,min=1,max=5)
? b=rnorm(n,mean=3,sd=sqrt(10))
? c=rexp(n,rate=1)
? k=0
? for (i in 1:n) {
? ? if(sign(b[i]*b[i]-4*a[i]*c[i])==1|0)
? ? {k=k+1}
? }
? return(k/n)
}
get.prob(100000)
########## 2(1) ############
library(readxl)
library(tidyverse)
data<-read_xlsx("data for HW2.xlsx")
sum(is.na(data$price))
sum(is.na(data$marketshare))
sum(is.na(data$brand))
data1=filter(data,!is.na(data[1]))
data1=filter(data1,!is.na(data1[2]))
data1=filter(data1,!is.na(data1[3]))
data1=arrange(data1,desc(marketshare,price))
########### 2(2) ############
pricebars <- data1 %>%
? group_by(brand) %>%
? summarize(pricebar=mean(price))
pricebars
marketsharebars <- data1 %>%
? group_by(brand) %>%
? summarise(marketsharebar=mean(marketshare))
marketsharebars
######### 2(3) ################
ggplot(data=data1)+
? geom_point(mapping = aes(x=price,y=marketshare))+
? facet_wrap(~brand,nrow=2)
######## 2(4) ##########
price=data1$price
pricebar=mean(price)
price_new=ifelse(price>pricebar,"楂樹環(huán)鏍?","浣庝環(huán)鏍?")
marketshare=data1$marketshare
marketsharebar=mean(marketshare)
marketshare_new=ifelse(marketshare>marketsharebar,"楂樺競鍦轟喚棰?",
? ? ? ? ? ? ? ? ? ? ? "浣庡競鍦轟喚棰?")
data1=mutate(data1,price_new,marketshare_new)
######### 2(5) #########
m1=lm(marketshare~price,data=data1)
m1
summary(m1)
######### 2(6) #########
ggplot(data=data1)+
? geom_point(aes(x=price,y=marketshare))+
? geom_abline(data= m1,col= "blue")
######### 2(7) ##########
b0=runif(20000,-5,5)
b1=runif(20000,-5,5)
d<-NA
sum<-NA
n<-1
while(n<=20000){
? for(i in 1:24){
? ? d[i]<-(marketshare[i]-b0[n]-b1[n]*price[i])^2}
? sum[n]<-sum(d)
? n<-n+1
}
resi=m1$residuals
resi2=sum(resi^2)
check=sum(as.numeric(sum<resi2))
######## 2(8) #########
m2=lm(marketshare~price+brand,data=data1)
m2
summary(m2)
作業(yè)三：
問題 1：
A 和 B 約定在某籃球場見面。他倆都不太守時，出現(xiàn)時間服從均勻分布。他倆也都沒有
耐心， 每個人都會只等對方十分鐘就會離開。已知 A 到籃球場的時間為下午 4 點到 5
點之間。
(1) 如果 B 到達籃球場的時間也為下午 4 點到 5 點之間，模擬運行 50000 次，看看他
們成功相遇的概率。
(2) 對上一問的 50000 次模擬，用不同顏色在一張圖中展示成功相遇與否。
(3) B 應該如何選擇 4 點到 5 點之間的哪個時間段，來提升他們成功相遇的概率？ 用模
擬展示你的理由
問題 2：
請使用 nycflights13 和 pipe 語法
（1）從 flights 數(shù)據(jù)表中挑選出以下變量：(year, month, day, hour, origin, dep_delay,
distance, carrier)，將生產(chǎn)的新表保存為 flight1。
（2）從 weather 數(shù)據(jù)表中挑選出以下變量： (year, month, day, hour, origin, humid,
wind_speed)，將生產(chǎn)的新表保存為 weather1。
（3）將 flight1 表和 weather1 表根據(jù)共同變量進行內(nèi)連接，隨機抽取 100000 行數(shù)據(jù)，
將生產(chǎn)的結(jié)果保存為 flight_weather。 (提示：sample_n()函數(shù)，不用重復抽取)
（4）從 flight_weather 表中對三個出發(fā)機場按照平均出發(fā)延誤時間排降序，并將結(jié)果保
留在 longest_delay 表中。把結(jié)果展示出來。
（5）根據(jù)出發(fā)地（origin） 在同一個圖中畫出風速 wind_speed（x 軸）和出發(fā)延誤時間
dep_delay（y 軸） 的平滑曲線圖。
（6）根據(jù)不同出發(fā)地（origin）在平行的 3 個圖中畫出風速 wind_speed（x 軸）和出發(fā)
延誤時間 dep_delay（y 軸）的散點圖。
（7）根據(jù) flight_weather 表，畫出每個月航班數(shù)的直方分布圖，x 軸為月份，y 軸是每個
月份航班數(shù)所占的比例。
（8）根據(jù) flight_weather 表，畫出每個月航班距離的 boxplot 圖，x 軸為月份，y 軸為
航行距離, 根據(jù)的航行距離的中位數(shù)從低到高對 x 軸的月份進行重新排序。
問題3：
問題1：
n_Sim <- 50000
sim_meet <- tibble(
? A = runif(n_Sim, min = 0, max = 60),
? B = runif(n_Sim, min = 0, max = 60)
) %>%
? mutate(result = ifelse(abs(A - B) <= 10,
? ? ? ? ? ? ? ? ? ? ? ? "They meet", "They do not"))
p_meet <- sim_meet %>% count(result) %>%
? arrange(n) %>%
? mutate(percent = n / n_Sim)
p_meet
ggplot(data = sim_meet, aes(x = A, y = B, color = result)) +
? geom_point()
##最后一問就是學生不斷修改min = 10, max = 50
問題2：
[if !supportLists](1) [endif]從flights數(shù)據(jù)表中挑選出以下變量：(year, month, day, hour, origin, dep_delay, distance, carrier)，將生產(chǎn)的新表保存為 flight1。
library(tidyverse)
library(nycflights13)
flight1<-select(flights, year, month, day, hour, origin, dep_delay, distance, carrier)
(2) 從weather數(shù)據(jù)表中挑選出以下變量：(year, month, day, hour, origin, humid, wind_speed)，將生產(chǎn)的新表保存為 weather1。
weather1<-select(weather, year, month, day, hour, origin, humid, wind_speed)
(3) 將flight1表和weather1表根據(jù)共同變量進行內(nèi)連接，隨機抽取100000行數(shù)據(jù)，將生產(chǎn)的結(jié)果保存為flight_weather。(提示：sample_n()函數(shù)，不用重復抽取)
flight_weather <- inner_join(flight1, weather1) %>% sample_n(100000)
(4) 從flight_weather 表中對三個出發(fā)機場按照平均出發(fā)延誤時間排降序，并將結(jié)果保留在longest_delay 表中。把結(jié)果展示出來。
longest_delay<- flight_weather %>% group_by(origin) %>% summarise(ave_delay = mean(dep_delay, na.rm = TRUE)) %>% arrange(desc(ave_delay))
（5） 根據(jù)出發(fā)地（origin） 在同一個圖中畫出風速 wind_speed（x軸）和出發(fā)延誤時間dep_delay（y軸）的平滑曲線圖
ggplot(data = flight_weather)+geom_smooth(mapping = aes(x = wind_speed, y = dep_delay, linetype = origin))
（6） 根據(jù)不同出發(fā)地（origin） 在平行的3個圖中畫出風速 wind_speed（x軸）和出發(fā)延誤時間dep_delay（y軸）的散點圖。
ggplot(data = flight_weather) + geom_point(mapping = aes(x = wind_speed, y = dep_delay)) + facet_wrap(~origin,nrow = 1)
（7） 根據(jù)flight_weather表，畫出每個月航班數(shù)的直方分布圖，x軸為月份，y軸是每個月份航班數(shù)所占的比例。
ggplot(data=flight_weather)+geom_bar(mapping = aes(month, y=..prop.., group = 1) )
（8） 根據(jù)flight_weather表，畫出每個月航班距離的boxplot圖，x軸為月份，y軸為航行距離, 根據(jù)的航行距離的中位數(shù)從低到高對x軸的月份進行重新排序。
ggplot(data=flight_weather)+geom_boxplot(mapping = aes(x=reorder(month, distance, FUN=median), y=distance))
問題3：
###### (1) #######
(H <- function(p) -sum(p*log(p)))
###### (2) #######
(DKL <- function(p,q) sum( p*(log(p)-log(q)) ))
###### (3) #######
IB <- list()
IB[[1]] <- c( 0.2 , 0.2 , 0.2 , 0.2 , 0.2 )
IB[[2]] <- c( 0.8 , 0.1 , 0.05 , 0.025 , 0.025 )
IB[[3]] <- c( 0.05 , 0.15 , 0.7 , 0.05 , 0.05 )
purrr::map_dbl( IB , H )
[1] 1.6094379 0.7430039 0.9836003
###### (4) #######
Dm <- matrix( NA , nrow=3 , ncol=3 )
for ( i in 1:3 ) {
? for ( j in 1:3 ) {
? ? Dm[i,j] <- DKL( IB[[j]] , IB[[i]] )
? }
}
Dm
