subselect.R
In subselect: Selecting Variable Subsets

### R code from vignette source 'subselect.Rnw'

###################################################
### code chunk number 1: subselect.Rnw:183-184
###################################################
library(subselect) 


###################################################
### code chunk number 2: subselect.Rnw:349-351
###################################################
rm.coef(mat=var(iris[,-5]),indices=c(3,4))



###################################################
### code chunk number 3: subselect.Rnw:354-356
###################################################
rm.coef(var(iris[,-5]),c(3,4))^2



###################################################
### code chunk number 4: subselect.Rnw:370-371
###################################################
rm.coef(var(iris[,-5]), indices=matrix(nrow=2,ncol=3,byrow=TRUE,c(1,2,3,1,2,4)))


###################################################
### code chunk number 5: subselect.Rnw:385-391
###################################################
subsets  <- array(data=c(3,2,0,0,0,0,1,1,2,2,3,4), dim=c(2,3,2))
colnames(subsets) <- paste("V",1:3,sep="")
rownames(subsets) <- paste("Solution",1:2)
dimnames(subsets)[[3]]<-paste("Size",c(1,3))
subsets
rm.coef(var(iris[,-5]),indices=subsets)


###################################################
### code chunk number 6: subselect.Rnw:479-481
###################################################
gcd.coef(var(iris[,-5]),ind=c(3,4),pcind=c(1,2))



###################################################
### code chunk number 7: subselect.Rnw:486-488
###################################################
gcd.coef(var(iris[,-5]),ind=c(1,2))



###################################################
### code chunk number 8: subselect.Rnw:554-556
###################################################
data(farm)
rv.coef(cor(farm),ind=c(2,37,57,59))


###################################################
### code chunk number 9: subselect.Rnw:564-565
###################################################
rv.coef(cor(farm), indices=matrix(nrow=2,ncol=4,byrow=TRUE,c(2,12,56,59,2,3,11,59)))


###################################################
### code chunk number 10: subselect.Rnw:819-820
###################################################
lmHmat(x=iris[,2:4], y=iris[,1])


###################################################
### code chunk number 11: subselect.Rnw:862-863
###################################################
ldaHmat(x=iris[,1:4], grouping=iris$Species)


###################################################
### code chunk number 12: subselect.Rnw:869-872
###################################################
attach(iris)
ldaHmat(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width)
detach(iris)


###################################################
### code chunk number 13: subselect.Rnw:932-940
###################################################
library(MASS)
data(crabs)
lFL <- log(crabs$FL) ; lRW <- log(crabs$RW); lCL <- log(crabs$CL); lCW <- log(crabs$CW)
C <- matrix(0.,nrow=2,ncol=4)
C[1,3] = C[2,4] = 1.
C
Hmat5 <- glhHmat(cbind(FL,RW,CL,CW,lFL,lRW,lCL,lCW) ~ sp*sex,C=C,data=crabs)
Hmat5


###################################################
### code chunk number 14: subselect.Rnw:985-989
###################################################
library(MASS)
data(Cars93)
CarsHmat <- lmHmat(x=Cars93[c(7:8,12:15,17:22,25)],y=Cars93[5])
ccr12.coef(mat=CarsHmat$mat, H=CarsHmat$H, r=CarsHmat$r, indices=c(4,5,10,11))


###################################################
### code chunk number 15: subselect.Rnw:1032-1034
###################################################
irisHmat <- ldaHmat(iris[1:4],iris$Species)
tau2.coef(irisHmat$mat,H=irisHmat$H,r=irisHmat$r,c(1,3))


###################################################
### code chunk number 16: subselect.Rnw:1073-1075
###################################################
irisHmat <- ldaHmat(iris[1:4],iris$Species)
xi2.coef(irisHmat$mat,H=irisHmat$H,r=irisHmat$r,c(1,3))


###################################################
### code chunk number 17: subselect.Rnw:1113-1115
###################################################
irisHmat <- ldaHmat(iris[1:4],iris$Species)
zeta2.coef(irisHmat$mat,H=irisHmat$H,r=irisHmat$r,c(1,3))


###################################################
### code chunk number 18: subselect.Rnw:1183-1188
###################################################
iris2sp <- iris[iris$Species != "setosa",]
modelfit <- glm(Species ~ Sepal.Length + Sepal.Width + Petal.Length +
Petal.Width, data=iris2sp, family=binomial)  
Hmat <- glmHmat(modelfit)
Hmat


###################################################
### code chunk number 19: subselect.Rnw:1231-1239
###################################################
library(MASS) 
lFL <- log(crabs$FL)
lRW <- log(crabs$RW)
lCL <- log(crabs$CL)
lCW <- log(crabs$CW)
logrfit <- glm(sex ~ FL + RW + CL + CW  + lFL + lRW + lCL + lCW,data=crabs,family=binomial)
lHmat <- glmHmat(logrfit) 
wald.coef(lHmat$mat,lHmat$H,indices=c(1,6,7),tolsym=1E-06)  


###################################################
### code chunk number 20: subselect.Rnw:1406-1408
###################################################
data(swiss)
eleaps(cor(swiss),nsol=3, criterion="RM")


###################################################
### code chunk number 21: subselect.Rnw:1426-1429
###################################################
data(swiss)
swiss.gcd <- eleaps(cor(swiss),kmin=2,kmax=3,exclude=6,include=1,nsol=3,criterion="gcd",pcindices=1:3)
swiss.gcd


###################################################
### code chunk number 22: subselect.Rnw:1436-1437
###################################################
rm.coef(mat=cor(swiss), indices=swiss.gcd$subsets)


###################################################
### code chunk number 23: subselect.Rnw:1448-1450
###################################################
irisHmat <- ldaHmat(iris[1:4],iris$Species)
eleaps(irisHmat$mat,kmin=2,kmax=3,H=irisHmat$H,r=irisHmat$r,crit="ccr12")


###################################################
### code chunk number 24: subselect.Rnw:1471-1481
###################################################
library(MASS)
data(Cars93)
Cars93.xgroup <- Cars93[,c(7:8,12:15,17:22,25)]
CarsHmat <- lmHmat(Cars93.xgroup,Cars93[,c(4,6)])
colnames(Cars93[,c(4,6)])
colnames(Cars93.xgroup)
#colnames(CarsHmat$mat)
Cars.eleaps <- eleaps(CarsHmat$mat, kmin=4, kmax=6, H=CarsHmat$H, r=CarsHmat$r, crit="zeta2", tolsym=1e-9)
Cars.eleaps$bestvalues
Cars.eleaps$bestsets


###################################################
### code chunk number 25: subselect.Rnw:1492-1496
###################################################
iris2sp <- iris[iris$Species != "setosa",]
logrfit <- glm(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width,iris2sp,family=binomial)
Hmat <- glmHmat(logrfit)
eleaps(Hmat$mat, H=Hmat$H, r=Hmat$r, criterion="Wald", nsol=3)


###################################################
### code chunk number 26: subselect.Rnw:1606-1608
###################################################
data(swiss)
anneal(cor(swiss),kmin=2,kmax=3,nsol=4,niter=10,criterion="RM")


###################################################
### code chunk number 27: subselect.Rnw:1613-1615
###################################################
data(farm)
anneal(cor(farm), kmin=6, nsol=5, criterion="rv")


###################################################
### code chunk number 28: subselect.Rnw:1632-1638
###################################################
library(ISwR)
cystfibrHmat <- lmHmat(pemax ~ age+sex+height+weight+bmp+fev1+rv+frc+tlc, data=cystfibr) 
colnames(cystfibrHmat$mat)
cystfibr.tau2 <- anneal(cystfibrHmat$mat, kmin=4, kmax=6, H=cystfibrHmat$H, r=cystfibrHmat$r, crit="tau2")  
cystfibr.tau2$bestvalues  
cystfibr.tau2$bestsets  


###################################################
### code chunk number 29: subselect.Rnw:1651-1652
###################################################
summary(lm(pemax ~ weight+bmp+fev1+rv, data=cystfibr))$r.squared


###################################################
### code chunk number 30: subselect.Rnw:1661-1662
###################################################
xi2.coef(mat=cystfibrHmat$mat, indices=cystfibr.tau2$bestsets,  H=cystfibrHmat$H, r=cystfibrHmat$r)


###################################################
### code chunk number 31: subselect.Rnw:1674-1681
###################################################
data(iris)
iris2sp <- iris[iris$Species != "setosa",]
logrfit <- glm(Species ~ Sepal.Length + Sepal.Width + Petal.Length + Petal.Width,iris2sp,family=binomial)
Hmat <- glmHmat(logrfit)
iris2p.Wald <- anneal(Hmat$mat,1,3,H=Hmat$H,r=1,nsol=5,criterion="Wald")
iris2p.Wald$bestsets
iris2p.Wald$bestvalues


###################################################
### code chunk number 32: subselect.Rnw:1811-1814
###################################################
farm.gcd <- genetic(cor(farm), kmin=10, crit="gcd")
farm.gcd$bestsets
farm.gcd$bestvalues


###################################################
### code chunk number 33: subselect.Rnw:1822-1823
###################################################
unique(farm.gcd$subsets)


###################################################
### code chunk number 34: subselect.Rnw:1835-1837
###################################################
dim(unique(genetic(cor(farm), kmin=10, crit="gcd")$subsets))
dim(unique(genetic(cor(farm), kmin=10, maxclone=0, crit="gcd")$subsets))


###################################################
### code chunk number 35: subselect.Rnw:1860-1867
###################################################
data(farm) 
farm.xgroup <- farm[,-c(1,2,3,4)]
farmHmat <- lmHmat(farm.xgroup,farm[,1:4])
colnames(farmHmat$mat)
farm.gen <- genetic(farmHmat$mat, kmin=4, kmax=6, H=farmHmat$H, r=farmHmat$r,crit="zeta2", maxclone=0, popsize=150)
farm.gen$bestvalues
farm.gen$bestsets


###################################################
### code chunk number 36: subselect.Rnw:1974-1980
###################################################
swiss.imp1 <- improve(mat=cor(swiss),kmin=2,kmax=3,nsol=4,criterion="GCD")
swiss.imp2 <- improve(cor(swiss),2,3,nsol=4,criterion="GCD",include=c(1),exclude=6)
swiss.imp1$bestvalues
swiss.imp1$bestsets
swiss.imp2$bestvalues
swiss.imp2$bestsets


###################################################
### code chunk number 37: subselect.Rnw:1992-1995
###################################################
data(iris)
irisHmat <- ldaHmat(iris[1:4],iris$Species)
improve(irisHmat$mat,kmin=2,kmax=3,H=irisHmat$H,r=irisHmat$r,crit="ccr12")


###################################################
### code chunk number 38: subselect.Rnw:2010-2018
###################################################
library(MASS)
data(crabs)
lFL <- log(crabs$FL) ; lRW <- log(crabs$RW); lCL <- log(crabs$CL); lCW <- log(crabs$CW)
C <- matrix(0.,nrow=2,ncol=4)
C[1,3] = C[2,4] = 1.
C
Hmat5 <- glhHmat(cbind(FL,RW,CL,CW,lFL,lRW,lCL,lCW) ~ sp*sex,C=C,data=crabs)
improve(mat=Hmat5$mat, kmin=4, nsol=3, H=Hmat5$H, r=Hmat5$r, crit="xi2",tolsym=1e-06)