• QR Code (size=2)
• QR Code (size=3)
• QR Code (size=4)
• QR Code (size=5)
• QR Code (size=6)

92.3
95.5
92.5
89.6
84.3
76.3
80.7
96.3
81.0
82.9
90.3
74.8
70.1
86.7
86.4
89.9
88.1
78.8
81.1
85.4
82.6
80.3
81.2
68.0
67.4
91.3
94.9
82.8
88.6
73.1
76.7
93.2
84.9
83.8
93.5
91.9
69.6
87.0
90.2
82.7
91.4
74.6
76.1
87.1
78.4
81.3
99.3
71.0
73.2
95.6
84.0
90.8
93.6
80.9
84.4
97.3
83.5
88.8
100.7
69.4
74.6
96.6
96.6
93.1
91.8
85.7
79.1
91.3
84.2
85.8
94.6
77.1
76.5

95.5
98.7
115.9
110.4
109.5
92.3
102.1
112.8
110.2
98.9
119.0
104.3
98.8
109.4
170.3
118.0
116.9
111.7
116.8
116.1
114.8
110.8
122.8
104.7
86.0
127.2
126.1
114.6
127.8
105.2
113.1
161.0
126.9
117.7
144.9
119.4
107.1
142.8
126.2
126.9
179.2
105.3
114.8
125.4
113.2
134.4
150.0
100.9
101.8
137.7
138.7
135.4
153.8
119.5
123.3
166.4
137.5
142.2
167.0
112.3
120.6
154.9
153.4
156.2
175.8
131.7
130.1
161.1
128.2
140.3
174.9
111.8
136.6

n <- length(x)
c <- array(NA,dim=c(401))
l <- array(NA,dim=c(401))
mx <- 0
mxli <- -999
for (i in 1:401)
{
l[i] <- (i-201)/100
if (l[i] != 0)
{
x1 <- (x^l[i] - 1) / l[i]
} else {
x1 <- log(x)
}
c[i] <- cor(x1,y)
if (mx < abs(c[i]))
{
mx <- abs(c[i])
mxli <- l[i]
}
}
c
mx
mxli
if (mxli != 0)
{
x1 <- (x^mxli - 1) / mxli
} else {
x1 <- log(x)
}
r<-lm(y~x)
se <- sqrt(var(r$residuals))
r1 <- lm(y~x1)
se1 <- sqrt(var(r1$residuals))
bitmap(file='test1.png')
plot(l,c,main='Box-Cox Linearity Plot',xlab='Lambda',ylab='correlation')
grid()
dev.off()
bitmap(file='test2.png')
plot(x,y,main='Linear Fit of Original Data',xlab='x',ylab='y')
abline(r)
grid()
mtext(paste('Residual Standard Deviation = ',se))
dev.off()
bitmap(file='test3.png')
plot(x1,y,main='Linear Fit of Transformed Data',xlab='x',ylab='y')
abline(r1)
grid()
mtext(paste('Residual Standard Deviation = ',se1))
dev.off()
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Box-Cox Linearity Plot',2,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'# observations x',header=TRUE)
a<-table.element(a,n)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'maximum correlation',header=TRUE)
a<-table.element(a,mx)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'optimal lambda(x)',header=TRUE)
a<-table.element(a,mxli)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Residual SD (orginial)',header=TRUE)
a<-table.element(a,se)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Residual SD (transformed)',header=TRUE)
a<-table.element(a,se1)
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable.tab')