115 lines
2.1 KiB
R
115 lines
2.1 KiB
R
|
#-*- R -*-
|
||
|
|
|
||
|
|
## Script from Fourth Edition of `Modern Applied Statistics with S'
|
||
|
|
|
||
|
|
options(width=65, digits=5, height=9999)
|
||
|
|
pdf(file="ch01.pdf", width=8, height=6, pointsize=9)
|
||
|
|
|
||
|
|
# Chapter 1 Introduction
|
||
|
|
|
||
|
|
# 1.1 A quick overview of S
|
||
|
|
|
||
|
|
2 + 3
|
||
|
|
sqrt(3/4)/(1/3 - 2/pi^2)
|
||
|
|
|
||
|
|
library(MASS)
|
||
|
|
mean(chem)
|
||
|
|
m <- mean(chem); v <- var(chem)/length(chem)
|
||
|
|
m/sqrt(v)
|
||
|
|
|
||
|
|
std.dev <- function(x) sqrt(var(x))
|
||
|
|
t.test.p <- function(x, mu=0) {
|
||
|
|
n <- length(x)
|
||
|
|
t <- sqrt(n) * (mean(x) - mu) / std.dev(x)
|
||
|
|
2 * (1 - pt(abs(t), n - 1))
|
||
|
|
}
|
||
|
|
|
||
|
|
t.stat <- function(x, mu = 0) {
|
||
|
|
n <- length(x)
|
||
|
|
t <- sqrt(n) * (mean(x) - mu) / std.dev(x)
|
||
|
|
list(t = t, p = 2 * (1 - pt(abs(t), n - 1)))
|
||
|
|
}
|
||
|
|
z <- rnorm(300, 1, 2) # generate 300 N(1, 4) variables.
|
||
|
|
t.stat(z)
|
||
|
|
unlist(t.stat(z, 1)) # test mu=1, compact result
|
||
|
|
|
||
|
|
# 1.4 An introductory session
|
||
|
|
|
||
|
|
x <- rnorm(1000)
|
||
|
|
y <- rnorm(1000)
|
||
|
|
truehist(c(x,y+3), nbins=25)
|
||
|
|
|
||
|
|
# ?truehist
|
||
|
|
|
||
|
|
contour(dd <- kde2d(x,y))
|
||
|
|
image(dd)
|
||
|
|
|
||
|
|
x <- seq(1, 20, 0.5)
|
||
|
|
x
|
||
|
|
w <- 1 + x/2
|
||
|
|
y <- x + w*rnorm(x)
|
||
|
|
dum <- data.frame(x, y, w)
|
||
|
|
dum
|
||
|
|
rm(x, y, w)
|
||
|
|
|
||
|
|
fm <- lm(y ~ x, data=dum)
|
||
|
|
summary(fm)
|
||
|
|
fm1 <- lm(y ~ x, data = dum, weight = 1/w^2)
|
||
|
|
summary(fm1)
|
||
|
|
|
||
|
|
lrf <- loess(y ~ x, dum)
|
||
|
|
|
||
|
|
attach(dum)
|
||
|
|
plot(x, y)
|
||
|
|
lines(spline(x, fitted(lrf)), col = 2)
|
||
|
|
|
||
|
|
abline(0, 1, lty = 3, col = 3)
|
||
|
|
abline(fm, col = 4)
|
||
|
|
abline(fm1, lty = 4, col = 5)
|
||
|
|
|
||
|
|
plot(fitted(fm), resid(fm), xlab = "Fitted Values", ylab = "Residuals")
|
||
|
|
|
||
|
|
qqnorm(resid(fm))
|
||
|
|
qqline(resid(fm))
|
||
|
|
|
||
|
|
detach()
|
||
|
|
rm(fm,fm1,lrf,dum)
|
||
|
|
|
||
|
|
hills
|
||
|
|
# S: splom(~ hills)
|
||
|
|
pairs(hills)
|
||
|
|
|
||
|
|
# S: if(interactive()) brush(hills)
|
||
|
|
|
||
|
|
attach(hills)
|
||
|
|
plot(dist, time)
|
||
|
|
if(interactive()) identify(dist, time, row.names(hills))
|
||
|
|
abline(lm(time ~ dist))
|
||
|
|
# library(lqs)
|
||
|
|
abline(lqs(time ~ dist), lty=3, col=4)
|
||
|
|
detach()
|
||
|
|
|
||
|
|
if(interactive()){
|
||
|
|
plot(c(0,1), c(0,1), type="n")
|
||
|
|
xy <- locator(type = "p")
|
||
|
|
abline(lm(y ~ x, xy), col = 4)
|
||
|
|
abline(rlm(y ~ x, xy, method = "MM"), lty = 3, col = 3)
|
||
|
|
abline(lqs(y ~ x, xy), lty = 2, col = 2)
|
||
|
|
rm(xy)
|
||
|
|
}
|
||
|
|
|
||
|
|
attach(michelson)
|
||
|
|
search()
|
||
|
|
plot(Expt, Speed, main="Speed of Light Data", xlab="Experiment No.")
|
||
|
|
fm <- aov(Speed ~ Run + Expt)
|
||
|
|
summary(fm)
|
||
|
|
fm0 <- update(fm, . ~ . - Run)
|
||
|
|
anova(fm0, fm)
|
||
|
|
detach()
|
||
|
|
rm(fm, fm0)
|
||
|
|
|
||
|
|
1 - pf(4.3781, 4, 76)
|
||
|
|
qf(0.95, 4, 76)
|
||
|
|
|
||
|
|
# End of ch01
|