Skip to content

Commit 587c0bb

Browse files
sbgraves237sbgraves237
committed
restore script files
1 parent 2ca2449 commit 587c0bb

26 files changed

+5753
-0
lines changed

‎inst/.DS_Store

6 KB
Binary file not shown.

‎inst/scripts/afda-ch01.R

Lines changed: 179 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,179 @@
1+
###
2+
###
3+
### Ramsey & Silverman (2002) Applied Functional Data Analysis (Springer)
4+
###
5+
### ch. 1. Introduction
6+
###
7+
library(fda)
8+
##
9+
## Intro to ch. 2. Criminology
10+
##
11+
# p. 3, Figure 1.1. An individual in the criminology sample
12+
13+
# Data not available.
14+
15+
16+
17+
18+
19+
20+
21+
# p. 3-4, Figure 1.2. 413 subjects in the criminology study
22+
23+
# Data not available.
24+
25+
26+
27+
28+
29+
30+
31+
##
32+
## Intro to ch. 3. Nondurable goods index
33+
##
34+
# pp. 4-6, Figure 1.3. US nondurable goods index 1919-2000
35+
#durtime = (0:(ndur-1))./12 + 1919;
36+
ndur <- length(nondurables)
37+
durtime = (0:(ndur-1))/12 + 1919;
38+
lognondur = log10(nondurables);
39+
40+
plot(nondurables, xlab="Year", ylab="Nondurable goods index")
41+
plot(nondurables, log="y", xlab="Year",
42+
ylab="Nondurable goods index")
43+
44+
# pp. 5-6, Figure 1.4. Phase-plane plots for 1923 & 1996
45+
# smooth the log data with order 8 splines, knots at data points
46+
47+
# Fit smooth per sec. 3.6.
48+
goodsbasis <- create.bspline.basis(rangeval=c(1919,2000),
49+
nbasis=979, norder=8)
50+
51+
LfdobjNonDur = int2Lfd(4);
52+
53+
#goodsfdPar = fdPar(goodsbasis, LfdobjNonDur, lambda=1e-11)
54+
#lognondursmth = smooth.basis(durtime, coredata(lognondur), goodsfdPar);
55+
logNondurSm <- smooth.basisPar(argvals=index(nondurables),
56+
y=log10(coredata(nondurables)), fdobj=goodsbasis,
57+
Lfdobj=LfdobjNonDur, lambda=1e-11)
58+
59+
#str(lognondursmth)
60+
61+
nondur1964.1967 <- window(nondurables, 1964, 1967)
62+
63+
plot(log10(nondur1964.1967), type="p", axes=FALSE, xlab="Year",
64+
ylab=expression(paste(log[10], " nondurable goods index")) )
65+
axis(2)
66+
axis(1, 1964:1967)
67+
axis(1, seq(1964, 1967, by=0.5), labels=FALSE)
68+
69+
#durtimefine = linspace(1964,1967,101);
70+
durtimefine <- seq(1964, 1967, length=181)
71+
72+
#fit = eval.fd(durtimefine, lognondursmth);
73+
logNondurSm1964.67 = eval.fd(durtimefine, logNondurSm$fd);
74+
lines(durtimefine, logNondurSm1964.67)
75+
abline(v=1965:1966, lty=2)
76+
77+
##
78+
## Intro to ch. 4. Bone shapes in paleopathology
79+
##
80+
# pp. 6-7, Figure 1.5. Digital image of a femur
81+
# Data not available.
82+
83+
84+
85+
86+
87+
88+
89+
90+
91+
92+
93+
##
94+
## Intro to ch. 5. ADHD Reaction time
95+
##
96+
# pp. 7-8, Figure 1.6. Reaction time distributions for two children
97+
# Data not available.
98+
99+
100+
101+
102+
103+
104+
105+
106+
107+
108+
109+
##
110+
## Intro to ch. 6. Human growth
111+
##
112+
# pp. 8-9, Figure 1.7. Raw growth data for one individual
113+
with(growth, plot(age, hgtm[, 1], pch="+",
114+
ylab="Measured height (cm.)"))
115+
116+
##
117+
## Intro to ch. 7. Time warping handwriting and weather
118+
##
119+
# pp. 9-10, Figure 1.8, "fda" written by hand 20 times
120+
# Data not available.
121+
122+
# 'handwrit' is cursive; Figure 1.8 is print.
123+
plot(handwrit[, 1,], type="l")
124+
125+
#?????????????????????
126+
127+
128+
129+
130+
131+
132+
133+
134+
135+
##
136+
## Intro to ch. 8. Bone shapes and arthritis
137+
##
138+
# no data used in this intro
139+
140+
##
141+
## Intro to ch. 9. Test Items
142+
##
143+
# pp. 11-12. Figure 1.9. Probability of success on two test questions
144+
# Data not available.
145+
146+
147+
148+
149+
150+
151+
152+
153+
154+
155+
##
156+
## Intro to ch. 10. Lip acceleration
157+
##
158+
# no data used in this intro
159+
160+
##
161+
## Intro to ch. 11. Handwriting printed characters
162+
##
163+
# no data used in this intro
164+
165+
##
166+
## Intro to ch. 12. Juggling
167+
##
168+
# p. 14. Figure 1.10. A juggling cycle
169+
# Data not available.
170+
171+
172+
173+
174+
175+
176+
177+
178+
179+

‎inst/scripts/afda-ch02.R

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
###
2+
###
3+
### Ramsey & Silverman (2002) Applied Functional Data Analysis (Springer)
4+
###
5+
### ch. 2. Life Course Data in Criminology
6+
###
7+
library(fda)
8+
9+
# Data not available.

‎inst/scripts/afda-ch03.R

Lines changed: 152 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,152 @@
1+
###
2+
###
3+
### Ramsey & Silverman (2002) Applied Functional Data Analysis (Springer)
4+
###
5+
### ch. 3. Nondurable Goods Index
6+
###
7+
library(fda)
8+
##
9+
## sec. 3.1. Introduction
10+
##
11+
# pp. 41-42, Figure 3.1. US monthly nondurable good manufacturing
12+
13+
plot(nondurables)
14+
15+
##
16+
## sec. 3.2. Transformation and smoothing
17+
##
18+
# p. 43, Figure 3.2. US nondurable goods production, log scale
19+
20+
plot(log10(nondurables))
21+
22+
nondur1929 <- window(nondurables, 1929, 1930)
23+
max1929 <- max(nondur1929)
24+
max1929t <- which(nondur1929==max1929)
25+
26+
library(zoo)
27+
(Max1929 <- index(nondur1929)[max1929t])
28+
# function 'index' is in 'zoo'
29+
text(Max1929, log10(max1929)+.01, "Stock market crash", 0, srt=90)
30+
31+
restrMoney <- window(nondurables, 1928, 1940)
32+
maxRestr <- max(restrMoney)
33+
maxRestr.t <- which(restrMoney==maxRestr)
34+
(MaxRestr <- mean(index(restrMoney)[maxRestr.t]))
35+
text(MaxRestr, log10(maxRestr)+.01,
36+
"Restriction of money supply", 0, srt=90)
37+
38+
endVietnam <- (1975+4/12)
39+
endVN <- min(window(nondurables, 1975, 1976))
40+
text(endVietnam, log10(endVN)-0.01, "End of Vietnam War", 1,
41+
srt=90)
42+
43+
(nondurFit <- lm(log10(nondurables)~index(nondurables)) )
44+
abline(nondurFit, lty=3)
45+
46+
# p. 44, Figure 3.3. log nondurable goods index 1964 to 1967
47+
48+
# Fit smooth per sec. 3.6.
49+
goodsbasis <- create.bspline.basis(rangeval=c(1919,2000),
50+
nbasis=979, norder=8)
51+
52+
LfdobjNonDur = int2Lfd(4);
53+
54+
#goodsfdPar = fdPar(goodsbasis, LfdobjNonDur, lambda=1e-11)
55+
#lognondursmth = smooth.basis(durtime, coredata(lognondur), goodsfdPar);
56+
logNondurSm <- smooth.basisPar(argvals=index(nondurables),
57+
y=log10(coredata(nondurables)), fdobj=goodsbasis,
58+
Lfdobj=LfdobjNonDur, lambda=1e-11)
59+
60+
#str(lognondursmth)
61+
62+
nondur1964.1967 <- window(nondurables, 1964, 1967)
63+
64+
plot(log10(nondur1964.1967), type="p", axes=FALSE, xlab="Year",
65+
ylab=expression(paste(log[10], " nondurable goods index")) )
66+
axis(2)
67+
axis(1, 1964:1967)
68+
axis(1, seq(1964, 1967, by=0.5), labels=FALSE)
69+
70+
#durtimefine = linspace(1964,1967,101);
71+
durtimefine <- seq(1964, 1967, length=181)
72+
73+
#fit = eval.fd(durtimefine, lognondursmth);
74+
logNondurSm1964.67 = eval.fd(durtimefine, logNondurSm$fd);
75+
lines(durtimefine, logNondurSm1964.67)
76+
abline(v=1965:1966, lty=2)
77+
78+
##
79+
## sec. 3.3. Phase-plane plots
80+
##
81+
82+
#p. 45-46. Figure 3.4. Phase-plane plot of sin(2*pi*t)
83+
84+
sin. <- expression(sin(2*pi*x))
85+
D.sin <- D(sin., "x")
86+
D2.sin <- D(D.sin, "x")
87+
88+
op <- par(pty="s")
89+
# square plot region so we get a circle not an ellipse
90+
with(data.frame(x=seq(0, 1, length=46)),
91+
plot(eval(D.sin), eval(D2.sin), type="l",
92+
xlim=c(-10, 10), ylim=c(-50, 50),
93+
xlab="Velocity", ylab="Acceleration") )
94+
pi.2 <- (2*pi)
95+
#lines(x=c(-pi.2,pi.2), y=c(0,0), lty=3)
96+
abline(h=0, lty="longdash")
97+
pi.2.2 <- pi.2^2
98+
lines(x=c(0,0), y=c(-pi.2.2, pi.2.2), lty="longdash")
99+
100+
text(c(0,0), c(-47, 47), rep("no kinetic, max potential", 2))
101+
text(c(-8.5,8.5), c(0,0), rep("max kinetic\nno potential", 2))
102+
par(op)
103+
104+
##
105+
## sec. 3.4. Nondurable goods cycles
106+
##
107+
# Applied Functional Data Analysis, p. 56, sec. 3.6
108+
# "Our final choice for lambda was 10^(-9.5)
109+
lam9.5 <- 10^(-9.5)
110+
goodsfdPar9.5 = fdPar(goodsbasis, LfdobjNonDur, lam9.5);
111+
#lognondursmth = smooth_basis(durtime, lognondur, goodsfdPar);
112+
lognondursm9.5 = smooth.basis(durtime, coredata(lognondur), goodsfdPar9.5);
113+
114+
# p. 47, Figure 3.5. Nondurable phase-plane plot, 1964
115+
##*** Need to add xlim and ylim to the following
116+
## to match the plots in the book.
117+
118+
phaseplanePlot(1964, logNondurSm$fd)
119+
120+
# pp. 48-49, Figure 3.6. Nondurable phase-plane plots, 1929-1931
121+
phaseplanePlot(1929, logNondurSm$fd)
122+
phaseplanePlot(1930, logNondurSm$fd)
123+
phaseplanePlot(1931, logNondurSm$fd)
124+
125+
# pp. 48, 50, Figure 3.7. Nondurable phase-plane plots, 1937-1938, 1943
126+
phaseplanePlot(1937, logNondurSm$fd)
127+
phaseplanePlot(1938, logNondurSm$fd)
128+
phaseplanePlot(1939, logNondurSm$fd)
129+
130+
# pp. 48, 51, Figure 3.8. Nondurable phase-plane plots, 1974-76
131+
phaseplanePlot(1974, logNondurSm$fd)
132+
phaseplanePlot(1975, logNondurSm$fd)
133+
phaseplanePlot(1976, logNondurSm$fd)
134+
135+
# pp. 52-53, Figure 3.9. Nondurable phase-plane plots, 1996-1998
136+
phaseplanePlot(1996, logNondurSm$fd)
137+
phaseplanePlot(1997, logNondurSm$fd)
138+
phaseplanePlot(1998, logNondurSm$fd)
139+
140+
# p. 53, Figure 3.10. Nondurable phase-plane plot, 1997, larger scale
141+
phaseplanePlot(1997, logNondurSm$fd)
142+
143+
##
144+
## sec. 3.5. What have we seen?
145+
##
146+
# All discussion, no data analysis in this section
147+
148+
##
149+
## sec. 3.6. Smoothing data for phase-plane plots
150+
##
151+
# All discussion, no data analysis in this section
152+

‎inst/scripts/afda-ch04.R

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
###
2+
###
3+
### Ramsey & Silverman (2002) Applied Functional Data Analysis (Springer)
4+
###
5+
### ch. 4. Bone shapes and arthritis
6+
###
7+
8+
# data not available

‎inst/scripts/afda-ch05.R

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
###
2+
###
3+
### Ramsey & Silverman (2002) Applied Functional Data Analysis (Springer)
4+
###
5+
### ch. 5. Modeling reaction-time distributions
6+
###
7+
8+
# data not available

0 commit comments

Comments
 (0)