2021-11-25 统计学-基于R（第四版）第八章课后习题记录及总结

最新推荐文章于 2022-04-18 19:44:04 发布

椰子鸡米花

最新推荐文章于 2022-04-18 19:44:04 发布

阅读量6.8k

点赞数 16

分类专栏： R语言学习文章标签： r语言统计学

本文链接：https://blog.csdn.net/m0_52461904/article/details/121541278

版权

R语言学习专栏收录该内容

14 篇文章 129 订阅

订阅专栏

先声明，本博客为个人作业不一定为标准答案，仅供参考

8.1 题目如下

（1）

H₀：α₁=α₂=α₃=α₄=0

H₁：α₁，α₂，α₃，α₄至少有一个不等于0

> example8_1<-read.csv("D:/作业/统计学R/《统计学—基于R》（第4版）—例题和习题数据（公开资源）/exercise/chap08/exercise8_1.csv")
> library(reshape2)
> example8_1<-melt(example8_1,variable.name = "机器",value.name = "装填量")//转换为长格式
> model_1w<-aov(装填量~机器,data=example8_1)
> summary(model_1w)
            Df   Sum Sq   Mean Sq F value Pr(>F)  
机器         3 0.005846 0.0019486   4.576 0.0135 *
Residuals   20 0.008517 0.0004258                 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

p=0.0135>0.01，不拒绝原假设，机器对装填量没有显著影响

（2）

> library(DescTools)
> EtaSq(model_1w,anova=T)
             eta.sq eta.sq.part          SS df           MS        F          p
机器      0.4070206   0.4070206 0.005845833  3 0.0019486111 4.575995 0.01348501
Residuals 0.5929794          NA 0.008516667 20 0.0004258333       NA         NA

装填量的误差有40.70%是由机器造成的

（3）

LSD方法：（任选一种方式即可）

第一种方式：

> library(DescTools)
> PostHocTest(model_1w,method="lsd")

  Posthoc multiple comparisons of means : Fisher LSD 
    95% family-wise confidence level

$机器
                    diff       lwr.ci       upr.ci   pval    
机器2-机器1 -0.015000000 -0.039852260  0.009852260 0.2225    
机器3-机器1 -0.043333333 -0.068185594 -0.018481073 0.0016 ** 
机器4-机器1 -0.016666667 -0.041518927  0.008185594 0.1772    
机器3-机器2 -0.028333333 -0.053185594 -0.003481073 0.0275 *  
机器4-机器2 -0.001666667 -0.026518927  0.023185594 0.8901    
机器4-机器3  0.026666667  0.001814406  0.051518927 0.0367 *  

---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

第二种方式：

> library(agricolae)
> LSD<-LSD.test(model_1w,"机器")
> LSD
$statistics
       MSerror Df    Mean        CV  t.value        LSD
  0.0004258333 20 4.00625 0.5150884 2.085963 0.02485226

$parameters
        test p.ajusted name.t ntr alpha
  Fisher-LSD      none   机器   4  0.05

$means
        装填量        std r      LCL      UCL  Min  Max    Q25   Q50    Q75
机器1 4.025000 0.01870829 6 4.007427 4.042573 4.00 4.05 4.0125 4.025 4.0375
机器2 4.010000 0.02280351 6 3.992427 4.027573 3.99 4.05 3.9925 4.005 4.0175
机器3 3.981667 0.02483277 6 3.964093 3.999240 3.95 4.02 3.9700 3.975 3.9950
机器4 4.008333 0.01471960 6 3.990760 4.025907 3.99 4.03 4.0000 4.005 4.0175

$comparison
NULL

$groups
        装填量 groups
机器1 4.025000      a
机器2 4.010000      a
机器4 4.008333      a
机器3 3.981667      b

attr(,"class")
[1] "group"

LSD方法显示，除机器3和机器1、机器3和机器2、机器4和机器3之间差异显著外，其余均不显著

HSD方法：（任选一种方式即可）

第一种方式：

> TukeyHSD(model_1w)
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = 装填量 ~ 机器, data = example8_1)

$机器
                    diff          lwr          upr     p adj
机器2-机器1 -0.015000000 -0.048346648  0.018346648 0.5982422
机器3-机器1 -0.043333333 -0.076679982 -0.009986685 0.0082001
机器4-机器1 -0.016666667 -0.050013315  0.016679982 0.5144408
机器3-机器2 -0.028333333 -0.061679982  0.005013315 0.1139540
机器4-机器2 -0.001666667 -0.035013315  0.031679982 0.9989889
机器4-机器3  0.026666667 -0.006679982  0.060013315 0.1470692

第二种方式：

> library(agricolae)
> HSD<-HSD.test(model_1w,"机器")
> HSD
$statistics
       MSerror Df    Mean        CV        MSD
  0.0004258333 20 4.00625 0.5150884 0.03334665

$parameters
   test name.t ntr StudentizedRange alpha
  Tukey   机器   4         3.958293  0.05

$means
        装填量        std r  Min  Max    Q25   Q50    Q75
机器1 4.025000 0.01870829 6 4.00 4.05 4.0125 4.025 4.0375
机器2 4.010000 0.02280351 6 3.99 4.05 3.9925 4.005 4.0175
机器3 3.981667 0.02483277 6 3.95 4.02 3.9700 3.975 3.9950
机器4 4.008333 0.01471960 6 3.99 4.03 4.0000 4.005 4.0175

$comparison
NULL

$groups
        装填量 groups
机器1 4.025000      a
机器2 4.010000     ab
机器4 4.008333     ab
机器3 3.981667      b

attr(,"class")
[1] "group"

HSD方法的p值显示，除机器3和机器1之间差异显著外，其余均不显著

（4）

H₀：装填量满足正态性

H₁：装填量不满足正态性

Shapiro-Wilk正态性检验：

> shapiro.test(example8_1$装填量)

	Shapiro-Wilk normality test

data:  example8_1$装填量
W = 0.97509, p-value = 0.7912

K-S正态性检验：

> ks.test(example8_1$装填量,"pnorm",mean(example8_1$装填量),sd(example8_1$装填量))

	One-sample Kolmogorov-Smirnov test

data:  example8_1$装填量
D = 0.10958, p-value = 0.9354
alternative hypothesis: two-sided

两种检验方式均有p>0.05，不拒绝原假设，可以认为满足正态性

H₀：装填量满足方差齐性

H₁：装填量不满足方差齐性

Bartlet方差齐性检验：

> bartlett.test(装填量~机器,data=example8_1)

	Bartlett test of homogeneity of variances

data:  装填量 by 机器
Bartlett's K-squared = 1.3927, df = 3, p-value = 0.7073

Levene方差齐性检验：

> install.packages("car")
> library(car)
> leveneTest(装填量~机器,data=example8_1)
Levene's Test for Homogeneity of Variance (center = median)
      Df F value Pr(>F)
group  3  0.3086 0.8189
      20

两种检验方式均有p>0.05，不拒绝原假设，可以认为满足方差齐性

8.2 题目如下

（1）

H₀：α₁=α₂=α₃=0

H₁：α₁，α₂，α₃至少有一个不等于0

> example8_2<-read.csv("D:/作业/统计学R/《统计学—基于R》（第4版）—例题和习题数据（公开资源）/exercise/chap08/exercise8_2.csv")
> library(reshape2)
> example8_2<-melt(example8_2,variable.name = "管理者",value.name = "满意度评分")
> model_2w<-aov(满意度评分~管理者,data=example8_2)
> summary(model_2w)
            Df Sum Sq Mean Sq F value   Pr(>F)    
管理者       2  30.33  15.167   12.52 0.000633 ***
Residuals   15  18.17   1.211                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

p=0.000633<0.05，拒绝原假设，管理者的水平不同会导致评分的显著差异

效应量如下：

> library(DescTools)
> EtaSq(model_2w,anova=T)
             eta.sq eta.sq.part       SS df        MS        F            p
管理者    0.6254296   0.6254296 30.33333  2 15.166667 12.52294 0.0006331423
Residuals 0.3745704          NA 18.16667 15  1.211111       NA           NA

评分的误差有62.54%是管理者不同造成的

（2）（这里就用一种方式了）

LSD方法：

> library(DescTools)
> PostHocTest(model_2w,method="lsd")

  Posthoc multiple comparisons of means : Fisher LSD 
    95% family-wise confidence level

$管理者
                           diff     lwr.ci     upr.ci    pval    
中层管理者-高层管理者  1.333333 -0.0209403  2.6876070 0.05321 .  
低层管理者-高层管理者 -1.833333 -3.1876070 -0.4790597 0.01132 *  
低层管理者-中层管理者 -3.166667 -4.5209403 -1.8123930 0.00016 ***

---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

LSD方法显示，除中层管理者和高层管理者之间的差异不显著外，其余均显著

HSD方法：

> TukeyHSD(model_2w)
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = 满意度评分 ~ 管理者, data = example8_2)

$管理者
                           diff       lwr       upr     p adj
中层管理者-高层管理者  1.333333 -0.317039  2.983706 0.1237560
低层管理者-高层管理者 -1.833333 -3.483706 -0.182961 0.0287632
低层管理者-中层管理者 -3.166667 -4.817039 -1.516294 0.0004519

HSD方法显示，除中层管理者和高层管理者之间的差异不显著外，其余均显著

（3）（这里就用一种方式了）

H₀：满意度评分满足正态性

H₁：满意度评分不满足正态性

Shapiro-Wilk正态性检验：

> shapiro.test(example8_2$满意度评分)

	Shapiro-Wilk normality test

data:  example8_2$满意度评分
W = 0.94141, p-value = 0.3063

p=0.3063>0.05，不拒绝原假设，可以认为满足正态性

H₀：满意度评分满足方差齐性

H₁：满意度评分不满足方差齐性

Levene方差齐性检验：

> library(car)
> leveneTest(满意度评分~管理者,data=example8_2)
Levene's Test for Homogeneity of Variance (center = median)
      Df F value Pr(>F)
group  2  1.3636 0.2857
      15

p=0.2857>0.05，不拒绝原假设，可以认为满足方差齐性

8.3 题目如下

（1）

H₀：α₁=α₂=α₃=0

H₁：α₁，α₂，α₃至少有一个不等于0

> example8_3<-read.csv("D:/作业/统计学R/《统计学—基于R》（第4版）—例题和习题数据（公开资源）/exercise/chap08/exercise8_3.csv")
> library(reshape2)
> example8_3<-melt(example8_3[2:4],variable.name = "企业",value.name = "电池平均寿命")
> model_3w<-aov(电池平均寿命~企业,data=example8_3)
> summary(model_3w)
            Df Sum Sq Mean Sq F value  Pr(>F)    
企业         2  615.6  307.80   17.07 0.00031 ***
Residuals   12  216.4   18.03                    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

p=0.00031<0.05，拒绝原假设，不同企业电池的平均寿命之间有显著差异

效应量如下：

> library(DescTools)
> EtaSq(model_3w,anova=T)
             eta.sq eta.sq.part    SS df        MS        F            p
企业      0.7399038   0.7399038 615.6  2 307.80000 17.06839 0.0003096019
Residuals 0.2600962          NA 216.4 12  18.03333       NA           NA

电池寿命的误差有73.99%是企业不同造成的

（2）

> TukeyHSD(model_3w)
  Tukey multiple comparisons of means
    95% family-wise confidence level

Fit: aov(formula = 电池平均寿命 ~ 企业, data = example8_3)

$企业
             diff        lwr       upr     p adj
企业B-企业A -14.4 -21.565255 -7.234745 0.0004622
企业C-企业A  -1.8  -8.965255  5.365255 0.7847311
企业C-企业B  12.6   5.434745 19.765255 0.0013991

HSD方法显示，除企业C和企业A之间差异不显著外，其余均显著

8.4 题目如下

（1）

检验品种：

H₀：αi=0(i=1,2,...,5)

H₁：αi至少有一个不等于0

检验施肥方案：

H₀：βj=0(j=1,2,...,5)

H₁：βj至少有一个不等于0

检验交互效应：

H₀：γij=0(i,j=1,2,...,5)

H₁：γij至少有一个不等于0(i,j=1,2,...,5)

> example8_4<-read.csv("D:/作业/统计学R/《统计学—基于R》（第4版）—例题和习题数据（公开资源）/exercise/chap08/exercise8_4.csv")
> library(reshape2)
> example8_4<-melt(example8_4,id.vars = "品种",variable.name = "施肥方案",value.name="产量")
> model_4w<-aov(产量~品种+施肥方案+品种:施肥方案,data=example8_4)
> summary(model_4w)
              Df Sum Sq Mean Sq F value   Pr(>F)    
品种           1 16.002  16.002  28.537 0.000176 ***
施肥方案       3 18.181   6.060  10.808 0.000999 ***
品种:施肥方案  3  4.237   1.412   2.519 0.107483    
Residuals     12  6.729   0.561                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

品种和施肥方案对产量影响显著，交互效应不显著

（2）效应量分析：

> library(DescTools)
> EtaSq(model_4w,anova=T)
                  eta.sq eta.sq.part       SS df       MS         F            p
品种          0.35442807   0.7039758 16.00225  1 16.00225 28.537227 0.0001758746
施肥方案      0.40269549   0.7298729 18.18150  3  6.06050 10.807847 0.0009985623
品种:施肥方案 0.09383825   0.3863621  4.23675  3  1.41225  2.518502 0.1074825400
Residuals     0.14903820          NA  6.72900 12  0.56075        NA           NA

品种因子单独解释了产量误差的35.44%，施肥方案因子单独解释了产量误差的40.26%，交互效应因子单独解释了产量误差的9.38%

在排除施肥方案和交互效应的影响后，品种因子解释了产量误差的70.39%；在排除品种和交互效应的影响后，施肥方案因子解释了产量误差的72.98%；在排除品种和施肥方案的影响后，交互效应因子解释了产量误差的38.63%

8.5 题目如下

（1）

检验路段：

H₀：αi=0(i=1,2,...,5)

H₁：αi至少有一个不等于0

检验时段：

H₀：βj=0(j=1,2,...,5)

H₁：βj至少有一个不等于0

检验交互效应：

H₀：γij=0(i,j=1,2,...,5)

H₁：γij至少有一个不等于0(i,j=1,2,...,5)

> example8_5<-read.csv("D:/作业/统计学R/《统计学—基于R》（第4版）—例题和习题数据（公开资源）/exercise/chap08/exercise8_5.csv")
> library(reshape2)
> example8_5<-melt(example8_5,id.vars = "时段",variable.name = "路段",value.name="行车时间")
> model_5w<-aov(行车时间~时段+路段+时段:路段,data=example8_5)
> summary(model_5w)
            Df Sum Sq Mean Sq F value   Pr(>F)    
时段         1 288.30  288.30  70.331 1.36e-08 ***
路段         2 180.51   90.26  22.018 3.71e-06 ***
时段:路段    2   0.02    0.01   0.003    0.997    
Residuals   24  98.38    4.10                     
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

时段和路段对行车时间的影响显著，交互效应不显著

（2）效应量分析：

> library(DescTools)
> EtaSq(model_5w,anova=T)
                eta.sq  eta.sq.part       SS df         MS            F            p
时段      5.082696e-01 0.7455777387 288.3000  1 288.300000 70.331368164 1.355779e-08
路段      3.182453e-01 0.6472503358 180.5147  2  90.257333 22.018459036 3.711926e-06
时段:路段 4.231172e-05 0.0002438925   0.0240  2   0.012000  0.002927424 9.970772e-01
Residuals 1.734428e-01           NA  98.3800 24   4.099167           NA           NA

像上面那道题那样分析就好了，懒得写了

本次记录就到这~~美美洗澡去，下次见