R version 2.9.0 (2009-04-17) Copyright (C) 2009 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > x <- array(list(2,3,4,4,4,2,2,4,4,2,3,3,4,3,5,4,4,2,5,4,2,4,4,3,4,4,4,2,4,2,2,2,3,2,2,1,5,2,5,4,2,4,4,2,3,4,2,2,3,4,3,1,1,2,2,1,3,3,2,3,5,2,3,4,4,3,4,2,2,4,1,1,3,2,2,4,4,5,4,2,4,4,2,2,4,3,5,4,2,3,3,4,1,1,2,4,3,3,2,1,4,2,2,4,4,4,2,2,2,2,2,1,5,2,3,2,4,1,2,2,2,2,4,4,4,4,2,2,3,4,1,2,4,2,3,4,2,4,1,4,4,2,3,2,4,4,2,4,2,4,2,3,2,4,1,4,3,4,5,3,4,4,2,2,5,2,2,2,2,4,5,2,4,4,4,4,3,4,1,4,4,4,4,4,3,4,5,1,3,2,2,2,3,4,5,2,4,4,2,4,4,4,4,2,2,3,3,4,2,2,4,4,2,2,5,4,2,2,4,3,3,2,4,2,4,2,5,2,4,2,4,4,5,4,3,4,3,4,3,4,2,2,3,2,2,4,2,1,1,3,3,2,3,2,2,1,2,4,3,4,3,4,2,4,1,1,4,2,2,4,2,4,3,2,4,2,4,4,4,4,2,4,4,4,3,3,2,4,2,4,2,2,1,2,3,4,4,4,4,2,2,2,1,1),dim=c(2,152),dimnames=list(c('Talk','Driver'),1:152)) > y <- array(NA,dim=c(2,152),dimnames=list(c('Talk','Driver'),1:152)) > for (i in 1:dim(x)[1]) + { + for (j in 1:dim(x)[2]) + { + y[i,j] <- as.numeric(x[i,j]) + } + } > par2 = 'No' > par1 = '1' > #'GNU S' R Code compiled by R2WASP v. 1.0.44 () > #Author: Dr. Ian E. Holliday > #To cite this work: Ian E. Holliday, 2009, YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/ > #Source of accompanying publication: > #Technical description: > library(rpart) > library(partykit) Loading required package: grid Loading required package: mvtnorm > par1 <- as.numeric(par1) > autoprune <- function ( tree, method='Minimum CV'){ + xerr <- tree$cptable[,'xerror'] + cpmin.id <- which.min(xerr) + if (method == 'Minimum CV Error plus 1 SD'){ + xstd <- tree$cptable[,'xstd'] + errt <- xerr[cpmin.id] + xstd[cpmin.id] + cpSE1.min <- which.min( errt < xerr ) + mycp <- (tree$cptable[,'CP'])[cpSE1.min] + } + if (method == 'Minimum CV') { + mycp <- (tree$cptable[,'CP'])[cpmin.id] + } + return (mycp) + } > conf.multi.mat <- function(true, new) + { + if ( all( is.na(match( levels(true),levels(new) ) )) ) + stop ( 'conflict of vector levels') + multi.t <- list() + for (mylev in levels(true) ) { + true.tmp <- true + new.tmp <- new + left.lev <- levels (true.tmp)[- match(mylev,levels(true) ) ] + levels(true.tmp) <- list ( mylev = mylev, all = left.lev ) + levels(new.tmp) <- list ( mylev = mylev, all = left.lev ) + curr.t <- conf.mat ( true.tmp , new.tmp ) + multi.t[[mylev]] <- curr.t + multi.t[[mylev]]$precision <- + round( curr.t$conf[1,1] / sum( curr.t$conf[1,] ), 2 ) + } + return (multi.t) + } > x <- t(y) > k <- length(x[1,]) > n <- length(x[,1]) > x1 <- cbind(x[,par1], x[,1:k!=par1]) > mycolnames <- c(colnames(x)[par1], colnames(x)[1:k!=par1]) > colnames(x1) <- mycolnames #colnames(x)[par1] > m <- rpart(as.data.frame(x1)) > par2 [1] "No" > if (par2 != 'No') { + mincp <- autoprune(m,method=par2) + print(mincp) + m <- prune(m,cp=mincp) + } > m$cptable CP nsplit rel error xerror xstd 1 0.05468126 0 1.0000000 1.0129408 0.08051968 2 0.01000000 1 0.9453187 0.9669055 0.08586580 > postscript(file="/var/www/html/rcomp/tmp/1xfzi1293217316.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > plot(as.party(m),tp_args=list(id=FALSE)) > dev.off() null device 1 > postscript(file="/var/www/html/rcomp/tmp/2xfzi1293217316.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > plotcp(m) > dev.off() null device 1 > cbind(y=m$y,pred=predict(m),res=residuals(m)) y pred res 1 2 3.107914 -1.1079137 2 4 3.107914 0.8920863 3 4 3.107914 0.8920863 4 2 3.107914 -1.1079137 5 4 3.107914 0.8920863 6 3 3.107914 -0.1079137 7 4 3.107914 0.8920863 8 5 3.107914 1.8920863 9 4 3.107914 0.8920863 10 5 3.107914 1.8920863 11 2 3.107914 -1.1079137 12 4 3.107914 0.8920863 13 4 3.107914 0.8920863 14 4 3.107914 0.8920863 15 4 3.107914 0.8920863 16 2 3.107914 -1.1079137 17 3 3.107914 -0.1079137 18 2 2.153846 -0.1538462 19 5 3.107914 1.8920863 20 5 3.107914 1.8920863 21 2 3.107914 -1.1079137 22 4 3.107914 0.8920863 23 3 3.107914 -0.1079137 24 2 3.107914 -1.1079137 25 3 3.107914 -0.1079137 26 3 2.153846 0.8461538 27 1 3.107914 -2.1079137 28 2 2.153846 -0.1538462 29 3 3.107914 -0.1079137 30 2 3.107914 -1.1079137 31 5 3.107914 1.8920863 32 3 3.107914 -0.1079137 33 4 3.107914 0.8920863 34 4 3.107914 0.8920863 35 2 3.107914 -1.1079137 36 1 2.153846 -1.1538462 37 3 3.107914 -0.1079137 38 2 3.107914 -1.1079137 39 4 3.107914 0.8920863 40 4 3.107914 0.8920863 41 4 3.107914 0.8920863 42 2 3.107914 -1.1079137 43 4 3.107914 0.8920863 44 5 3.107914 1.8920863 45 2 3.107914 -1.1079137 46 3 3.107914 -0.1079137 47 1 2.153846 -1.1538462 48 2 3.107914 -1.1079137 49 3 3.107914 -0.1079137 50 2 2.153846 -0.1538462 51 4 3.107914 0.8920863 52 2 3.107914 -1.1079137 53 4 3.107914 0.8920863 54 2 3.107914 -1.1079137 55 2 3.107914 -1.1079137 56 2 2.153846 -0.1538462 57 5 3.107914 1.8920863 58 3 3.107914 -0.1079137 59 4 2.153846 1.8461538 60 2 3.107914 -1.1079137 61 2 3.107914 -1.1079137 62 4 3.107914 0.8920863 63 4 3.107914 0.8920863 64 2 3.107914 -1.1079137 65 3 3.107914 -0.1079137 66 1 3.107914 -2.1079137 67 4 3.107914 0.8920863 68 3 3.107914 -0.1079137 69 2 3.107914 -1.1079137 70 1 3.107914 -2.1079137 71 4 3.107914 0.8920863 72 3 3.107914 -0.1079137 73 4 3.107914 0.8920863 74 2 3.107914 -1.1079137 75 2 3.107914 -1.1079137 76 2 3.107914 -1.1079137 77 2 3.107914 -1.1079137 78 1 3.107914 -2.1079137 79 3 3.107914 -0.1079137 80 5 3.107914 1.8920863 81 4 3.107914 0.8920863 82 2 3.107914 -1.1079137 83 5 3.107914 1.8920863 84 2 3.107914 -1.1079137 85 2 3.107914 -1.1079137 86 5 3.107914 1.8920863 87 4 3.107914 0.8920863 88 4 3.107914 0.8920863 89 3 3.107914 -0.1079137 90 1 3.107914 -2.1079137 91 4 3.107914 0.8920863 92 4 3.107914 0.8920863 93 3 3.107914 -0.1079137 94 5 2.153846 2.8461538 95 3 3.107914 -0.1079137 96 2 3.107914 -1.1079137 97 3 3.107914 -0.1079137 98 5 3.107914 1.8920863 99 4 3.107914 0.8920863 100 2 3.107914 -1.1079137 101 4 3.107914 0.8920863 102 4 3.107914 0.8920863 103 2 3.107914 -1.1079137 104 3 3.107914 -0.1079137 105 2 3.107914 -1.1079137 106 4 3.107914 0.8920863 107 2 3.107914 -1.1079137 108 5 3.107914 1.8920863 109 2 3.107914 -1.1079137 110 4 3.107914 0.8920863 111 3 3.107914 -0.1079137 112 4 3.107914 0.8920863 113 4 3.107914 0.8920863 114 5 3.107914 1.8920863 115 4 3.107914 0.8920863 116 4 3.107914 0.8920863 117 5 3.107914 1.8920863 118 3 3.107914 -0.1079137 119 3 3.107914 -0.1079137 120 3 3.107914 -0.1079137 121 2 3.107914 -1.1079137 122 3 3.107914 -0.1079137 123 2 3.107914 -1.1079137 124 2 2.153846 -0.1538462 125 1 3.107914 -2.1079137 126 3 3.107914 -0.1079137 127 3 3.107914 -0.1079137 128 2 2.153846 -0.1538462 129 2 3.107914 -1.1079137 130 3 3.107914 -0.1079137 131 3 3.107914 -0.1079137 132 2 3.107914 -1.1079137 133 1 2.153846 -1.1538462 134 4 3.107914 0.8920863 135 2 3.107914 -1.1079137 136 2 3.107914 -1.1079137 137 3 3.107914 -0.1079137 138 4 3.107914 0.8920863 139 4 3.107914 0.8920863 140 4 3.107914 0.8920863 141 2 3.107914 -1.1079137 142 4 3.107914 0.8920863 143 3 3.107914 -0.1079137 144 2 3.107914 -1.1079137 145 2 3.107914 -1.1079137 146 2 3.107914 -1.1079137 147 1 3.107914 -2.1079137 148 3 3.107914 -0.1079137 149 4 3.107914 0.8920863 150 4 3.107914 0.8920863 151 2 3.107914 -1.1079137 152 1 2.153846 -1.1538462 > myr <- residuals(m) > myp <- predict(m) > postscript(file="/var/www/html/rcomp/tmp/3xfzi1293217316.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) > op <- par(mfrow=c(2,2)) > plot(myr,ylab='residuals') > plot(density(myr),main='Residual Kernel Density') > plot(myp,myr,xlab='predicted',ylab='residuals',main='Predicted vs Residuals') > plot(density(myp),main='Prediction Kernel Density') > par(op) > dev.off() null device 1 > > #Note: the /var/www/html/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab > load(file="/var/www/html/rcomp/createtable") > > a<-table.start() > a<-table.row.start(a) > a<-table.element(a,'Model Performance',6,TRUE) > a<-table.row.end(a) > a<-table.row.start(a) > a<-table.element(a,'#',header=TRUE) > a<-table.element(a,'Complexity',header=TRUE) > a<-table.element(a,'split',header=TRUE) > a<-table.element(a,'relative error',header=TRUE) > a<-table.element(a,'CV error',header=TRUE) > a<-table.element(a,'CV S.D.',header=TRUE) > a<-table.row.end(a) > for (i in 1:length(m$cptable[,1])) { + a<-table.row.start(a) + a<-table.element(a,i,header=TRUE) + a<-table.element(a,round(m$cptable[i,'CP'],3)) + a<-table.element(a,m$cptable[i,'nsplit']) + a<-table.element(a,round(m$cptable[i,'rel error'],3)) + a<-table.element(a,round(m$cptable[i,'xerror'],3)) + a<-table.element(a,round(m$cptable[i,'xstd'],3)) + a<-table.row.end(a) + } > a<-table.end(a) > table.save(a,file="/var/www/html/rcomp/tmp/4t6f91293217316.tab") > > try(system("convert tmp/1xfzi1293217316.ps tmp/1xfzi1293217316.png",intern=TRUE)) character(0) > try(system("convert tmp/2xfzi1293217316.ps tmp/2xfzi1293217316.png",intern=TRUE)) character(0) > try(system("convert tmp/3xfzi1293217316.ps tmp/3xfzi1293217316.png",intern=TRUE)) character(0) > > > proc.time() user system elapsed 0.985 0.534 2.259