https://jorryyang.gitee.io/rdata/
第一次作业：
题目：
请下载hw1_a和hw1_b两个excel数据文件，完成以下任务:
1. 请将数据hw1_a和hw1_b分别读入R，查看数据并指出各个变量的形式，最小值，最大值，中值，均值，标准差。
2. 结合上课我们所学的几种数据join 的形式，将两个数据集进行合并。对于每种数据合并的方式，请说明key, 并且报告合并后的数据样本总行数。
3. 请筛选出hw1_a 中收入大于4000的样本，并将此样本和hw1_b 中Is_Default=1的样本合并，你可以使用inner join的方式。这一问中你可以用pipe的书写形式。
4. 在第2问的基础上,请给出Income对Years_at_Employer的散点图，你发现了哪些趋势和现象?
5.在第4问的基础上 按照Is_Default 增加一个维度，请展示两变量在不同违约状态的散点图。请使用明暗程度作为区分方式
6. 对于第5问，请使用形状作为另外一种区分方式。
7. 请找出各个列的缺失值，并删除相应的行。请报告每一变量的缺失值个数，以及所有缺失值总数。
8. 找出Income中的极端值并滤掉对应行的数据
9. 将Income对数化，并画出直方图和density curve.
10. 以Income作为因变量，Years at Employer作为自变量，进行OLS回归，写出回归的方程，并指出自变量系数是否在某一显著性水平上显著。同时，解释你的结果(这一问你自己发挥可以找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)
第二次作业
问题1：
问题二：
给定数据，请完成以下任务，请给出code 和输出结果。
（1） 请读入数据，使用软件分别给出price, marketshare，和brand的缺失值数量。请按照每一个brand, 将数据按照先marjetshare 后price 进行从高到低排序
（2）请按照brand 的种类，对price和marketshare 求均值。
（3） 请按照brand 的种类，对price和marketshare 画散点图。
（4） 请按照价格的均值，产生新的变量price_new, 低于均值为“低价格”，高于均值为“高价格”。 同样对市场份额也是，产生变量marketshare_new, 数值为“低市场份额”和“高市场份额”
（5） 请估计模型，marketshare为Y，price为X.
（6） 请画出（5）的拟合直线。
（7） 请随机产生若干直线，验证（5）的结果是最优的
（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,"楂樹环鏍?","浣庝环鏍?")
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)
作业三：
问题 1：
A 和 B 约定在某篮球场见面。他俩都不太守时，出现时间服从均匀分布。他俩也都没有
耐心， 每个人都会只等对方十分钟就会离开。已知 A 到篮球场的时间为下午 4 点到 5
点之间。
(1) 如果 B 到达篮球场的时间也为下午 4 点到 5 点之间，模拟运行 50000 次，看看他
们成功相遇的概率。
(2) 对上一问的 50000 次模拟，用不同颜色在一张图中展示成功相遇与否。
(3) B 应该如何选择 4 点到 5 点之间的哪个时间段，来提升他们成功相遇的概率？ 用模
拟展示你的理由
问题 2：
请使用 nycflights13 和 pipe 语法
（1）从 flights 数据表中挑选出以下变量：(year, month, day, hour, origin, dep_delay,
distance, carrier)，将生产的新表保存为 flight1。
（2）从 weather 数据表中挑选出以下变量： (year, month, day, hour, origin, humid,
wind_speed)，将生产的新表保存为 weather1。
（3）将 flight1 表和 weather1 表根据共同变量进行内连接，随机抽取 100000 行数据，
将生产的结果保存为 flight_weather。 (提示：sample_n()函数，不用重复抽取)
（4）从 flight_weather 表中对三个出发机场按照平均出发延误时间排降序，并将结果保
留在 longest_delay 表中。把结果展示出来。
（5）根据出发地（origin） 在同一个图中画出风速 wind_speed（x 轴）和出发延误时间
dep_delay（y 轴） 的平滑曲线图。
（6）根据不同出发地（origin）在平行的 3 个图中画出风速 wind_speed（x 轴）和出发
延误时间 dep_delay（y 轴）的散点图。
（7）根据 flight_weather 表，画出每个月航班数的直方分布图，x 轴为月份，y 轴是每个
月份航班数所占的比例。
（8）根据 flight_weather 表，画出每个月航班距离的 boxplot 图，x 轴为月份，y 轴为
航行距离, 根据的航行距离的中位数从低到高对 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数据表中挑选出以下变量：(year, month, day, hour, origin, dep_delay, distance, carrier)，将生产的新表保存为 flight1。
library(tidyverse)
library(nycflights13)
flight1<-select(flights, year, month, day, hour, origin, dep_delay, distance, carrier)
(2) 从weather数据表中挑选出以下变量：(year, month, day, hour, origin, humid, wind_speed)，将生产的新表保存为 weather1。
weather1<-select(weather, year, month, day, hour, origin, humid, wind_speed)
(3) 将flight1表和weather1表根据共同变量进行内连接，随机抽取100000行数据，将生产的结果保存为flight_weather。(提示：sample_n()函数，不用重复抽取)
flight_weather <- inner_join(flight1, weather1) %>% sample_n(100000)
(4) 从flight_weather 表中对三个出发机场按照平均出发延误时间排降序，并将结果保留在longest_delay 表中。把结果展示出来。
longest_delay<- flight_weather %>% group_by(origin) %>% summarise(ave_delay = mean(dep_delay, na.rm = TRUE)) %>% arrange(desc(ave_delay))
（5） 根据出发地（origin） 在同一个图中画出风速 wind_speed（x轴）和出发延误时间dep_delay（y轴）的平滑曲线图
ggplot(data = flight_weather)+geom_smooth(mapping = aes(x = wind_speed, y = dep_delay, linetype = origin))
（6） 根据不同出发地（origin） 在平行的3个图中画出风速 wind_speed（x轴）和出发延误时间dep_delay（y轴）的散点图。
ggplot(data = flight_weather) + geom_point(mapping = aes(x = wind_speed, y = dep_delay)) + facet_wrap(~origin,nrow = 1)
（7） 根据flight_weather表，画出每个月航班数的直方分布图，x轴为月份，y轴是每个月份航班数所占的比例。
ggplot(data=flight_weather)+geom_bar(mapping = aes(month, y=..prop.., group = 1) )
（8） 根据flight_weather表，画出每个月航班距离的boxplot图，x轴为月份，y轴为航行距离, 根据的航行距离的中位数从低到高对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
