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

  • 阿里云国际版折扣https://www.yundadi.com

  • 阿里云国际,腾讯云国际,低至75折。AWS 93折 免费开户实名账号 代冲值 优惠多多 微信号:monov8 飞机:@monov6
    • 编程教材 《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

  • 阿里云国际版折扣https://www.yundadi.com

  • 阿里云国际,腾讯云国际,低至75折。AWS 93折 免费开户实名账号 代冲值 优惠多多 微信号:monov8 飞机:@monov6