R语言、03 案例3-3 亚太地区商学院、《商务与经济统计》案例题

  • 编程教材 《R语言实战·第2版》Robert I. Kabacoff

  • 课程教材《商务与经济统计·原书第13版》 (安德森)

P86、案例3-3 亚太地区商学院

image-20221017121956950


加载数据

已知数据集为csv文件,所以要按间隔符形式导入。并删除带缺省值的列。

  • 字符串替换函数 gsub(匹配内容,替换内容,操作对象)
  • 类型转换函数 as.numeric
# ^ 加载数据并删除带缺省值的列。
Asian <- read.table("./data/Asian.csv",
  header = TRUE, sep = ","
)
#  row.names = "Business.School",

res1 <- data.frame(Asian)
library(dplyr)
Asian <- res1 %>% select_if(~ !any(is.na(.)))

# ^ 数值字符串类型数据转数值类型数据
Asian$Local.Tuition.... <- gsub(",", "", Asian$Local.Tuition....)
Asian$Foreign.Tuitiion.... <- gsub(",", "", Asian$Foreign.Tuitiion....)
Asian$Starting.Salary.... <- gsub(",", "", Asian$Starting.Salary....)
Asian$Local.Tuition.... <- as.numeric(Asian$Local.Tuition....)
Asian$Foreign.Tuitiion.... <- as.numeric(Asian$Foreign.Tuitiion....)
Asian$Starting.Salary.... <- as.numeric(Asian$Starting.Salary....)

# ^ 描述性统计
print(summary(Asian))
View(Asian)

image-20221017125506184


根据描述统计量有什么见解

image-20221017125524460

  • 总共有25所商学院,每所商学院平均录取165人。最多录取数量商学院为印度管理学院,录取463人。最少录取数量商学院为麦夸里管理研究生院,录取12人。不同学校之间录取名额差异较大。
  • 所有商学院每个学院人数平均8人,最多的学院人数为19人,最少的学院人数为2人。可能部分商学院开设的学院数量比较多,有的比较少。
  • 本国学生平均学费为12375美元,外国学生平均学费16582美元。本国、外国学生最低学费和最高学费相同,分别是1000美元和33060美元。外国学生平均学费要比本国学生平均学费高一点。
  • 不同商学院国外学生平均比例为28%,最多国外学生占比为90%,最少国外学生占比为0%。可能部分商学院知名度比较高或者是国外学生录取门槛较低。
  • 不同商学院平均起薪为37292美元,最少起薪7000美元,最高起薪为87000美元。

本国学生和国外学生学费差别

# ^ 本国学生和国外学生学费差别
library(tidyverse)
data1 <- data.frame(Type = "Loacal", Tuition = Asian$Local.Tuition...., School = Asian$Business.School)
data2 <- data.frame(Type = "Foreign", Tuition = Asian$Foreign.Tuitiion...., School = Asian$Business.School)
data <- rbind(data1, data2)

x11()
ggplot(data, aes(x = School, y = Tuition, color = Type, shape = Type)) +
  geom_point(size = 3) +
  geom_line(mapping = aes(y = Tuition, group = Type, color = Type), stat = "identity", size = 1.3) +
  labs(x = "School", y = "Tuition") +
  scale_y_continuous(breaks = c(5000, 10000, 15000, 20000, 25000, 30000, 35000, 40000), limits = c(0, 40000)) +
  geom_hline(aes(yintercept = 0)) + # 加入一条平行于x轴的线,透明度(alpha)调成了65%
  ggtitle("本国学生学费 & 国外学生学费") +
  theme(
    axis.text.x = element_text(angle = 90, hjust = 1), # 把x轴标签调整为90度
    legend.title = element_blank(), # 设置图例标题为空
    legend.position = c(0.15, 0.9), # 设置图例的位置在左上角
    legend.text = element_text(size = 8), # 设置图例的文字大小为10号
    plot.caption = element_text(hjust = 0.5, size = 15), # 设置图标题位置
    axis.text = element_text(size = 8), # 设置图例的文字大小
    axis.title = element_text(size = 12, face = "bold"), # 设置轴标题文字大小和文字加粗
    plot.title = element_text(hjust = 0.5) # 标题文字居中
  )

image-20221017150055371

Local.Tuition.... Foreign.Tuitiion....
Min.   : 1000     Min.   : 1000
1st Qu.: 6146     1st Qu.: 9000
Median :11513     Median :17765
Mean   :12375     Mean   :16582
3rd Qu.:17172     3rd Qu.:22500
Max.   :33060     Max.   :33060

结合折线图和五数概括法可知

  • 本国学生平均学费为12375美元,外国学生平均学费16582美元。本国、外国学生最低学费和最高学费相同,分别是1000美元和33060美元。

  • 国外学生学费比本国学生学费要高。本国学生学费第一、二、三四分位数都比国外学生学费高。


工作经验要求与否与起薪差别

# ^ 工作经验与起薪的差别
b <- aggregate(
  x = Asian$Starting.Salary...., # @ 聚合变量
  by = list(Asian$Work.Experience), # @ 分组依据
  FUN = summary, # @ 聚合函数
)
print(b)
  Group.1   x.Min. x.1st Qu. x.Median   x.Mean x.3rd Qu.   x.Max.
1      No  7100.00   7425.00  7500.00 24583.33  25125.00 87000.00
2     Yes  7000.00  23900.00 46600.00 41305.26  53750.00 71400.00

通过五数概括法,可知不要求工作经验的平均起薪24583.33美元,要求工作经验的平均起薪41305美元,比前者要来得高。


英语测试要求与否与起薪差别

# ^ 工作经验与起薪的差别
c <- aggregate(
  x = Asian$Starting.Salary...., # @ 聚合变量
  by = list(Asian$English.Test), # @ 分组依据
  FUN = summary, # @ 聚合函数
)
print(c)
  Group.1   x.Min. x.1st Qu. x.Median   x.Mean x.3rd Qu.   x.Max.
1      No  7000.00   7500.00 31000.00 33623.53  55000.00 71400.00
2     Yes 16000.00  37300.00 44950.00 45087.50  49800.00 87000.00

通过五数概括法,可知

  • 不要求英语测试的最低起薪为7000美元,要求英语测试的最低起薪为16000美元。

  • 不要求英语测试的平均起薪为33623美元,要求工作经验的平均起薪45087美元,比前者要来得高。

  • 不要求英语测试的起薪第一、二四分位数比要求英语测试的第一、二四分位数低,但不要求英语测试的起薪第三四分位数(55000)却比要求英语测试的第三四分位数(49800)高。


起薪与学费关系

# ^ 起薪与学费关系的散点图
png(file = "Asian_scatterplot_1.png")
plot(
  x = Asian$Starting.Salary...., y = Asian$Local.Tuition....,
  xlab = "起薪",
  ylab = "本国学生学费",
  xlim = c(6000, 88000),
  ylim = c(0, 31000),
  main = "起薪与本国学生学费关系的散点图"
)
# ^ ?~? 符号相当于 y~x
m1 <- lm(Local.Tuition.... ~ Starting.Salary...., data = Asian) # @ 建立回归模型
abline(m1, lwd = 3, col = "darkorange")
dev.off()

png(file = "Asian_scatterplot_2.png")
plot(
  x = Asian$Starting.Salary...., y = Asian$Foreign.Tuitiion....,
  xlab = "起薪",
  ylab = "外国学生学费",
  xlim = c(6000, 88000),
  ylim = c(0, 31000),
  main = "起薪与外国学生学费关系的散点图"
)
m2 <- lm(Foreign.Tuitiion.... ~ Starting.Salary...., data = Asian) # @ 建立回归模型
abline(m2, lwd = 3, col = "darkorange")
dev.off()

image-20221017140806696

从两幅图中可知,学生学费和起薪呈正相关,本国学生学费和起薪的相关系数为0.79,外国学生学费和起薪的相关系数为0.67。


其他图形-起薪频率分组

# ^起薪频率分组
typeTable3 <- within(Asian, {
  group1 <- NA
  group1[Starting.Salary.... >= 7000 & Starting.Salary.... < 23000] <- "[7000~23000)"
  group1[Starting.Salary.... >= 23000 & Starting.Salary.... < 39000] <- "[23000~39000)"
  group1[Starting.Salary.... >= 39000 & Starting.Salary.... < 55000] <- "[39000~55000)"
  group1[Starting.Salary.... >= 55000 & Starting.Salary.... < 71000] <- "[55000~71000)"
  group1[Starting.Salary.... >= 71000 & Starting.Salary.... <= 87000] <- "[71000~87000]"
})
typeTable4 <- table(typeTable3$group1)
typeTable4 <- prop.table(typeTable4) * 100
# @ 默认按字符串排序,重新排列表格列
typeTable4 <- typeTable4[c(4, 1, 2, 3, 5)]
print(as.data.frame(typeTable4))
png(file = "Asian_barplot.png")
par(mar = c(10, 4, 4, 0))
barplot(typeTable4,
  main = "起薪频率分组条形图",
  xlab = "", ylab = "频率", las = 2, col = rainbow(25)
)
dev.off()
           Var1 Freq
1  [7000~23000)   36
2 [23000~39000)   12
3 [39000~55000)   28
4 [55000~71000)   16
5 [71000~87000]    8

image-20221017135502509

从图中可知起薪分组频率分布形态适度右偏。[7000~23000)区间薪水居多,其次是是[39000~55000]区间。


资料

ggplot2折线图

ggplot2 line plot : Quick start guide - R software and data visualization - Easy Guides - Wiki - STHDA

posted @ 2022-10-18 20:06  小能日记  阅读(20)  评论(0编辑  收藏  举报