x <- array(list('no' ,60.33 ,'no' ,55.67 ,'no' ,63.33 ,'no' ,67.67 ,'no' ,59.67 ,'no' ,65.67 ,'no' ,64.33 ,'no' ,58.33 ,'no' ,60.00 ,'no' ,66.67 ,'no' ,66.33 ,'no' ,60.00 ,'no' ,58.00 ,'no' ,58.67 ,'no' ,62.33 ,'no' ,64.00 ,'no' ,66.33 ,'no' ,61.67 ,'no' ,6.33 ,'no' ,59.00 ,'no' ,58.00 ,'no' ,59.33 ,'no' ,60.33 ,'no' ,51.00 ,'no' ,51.00 ,'no' ,62.00 ,'no' ,64.00 ,'no' ,59.33 ,'no' ,60.00 ,'no' ,61.33 ,'no' ,56.00 ,'no' ,55.67 ,'no' ,64.00 ,'no' ,66.00 ,'no' ,56.33 ,'no' ,61.67 ,'no' ,69.00 ,'no' ,51.00 ,'no' ,58.00 ,'no' ,63.67 ,'no' ,64.00 ,'no' ,58.67 ,'no' ,60.33 ,'no' ,57.33 ,'no' ,63.67 ,'no' ,58.67 ,'no' ,65.67 ,'no' ,58.00 ,'no' ,58.67 ,'no' ,56.00 ,'no' ,65.33 ,'no' ,61.00 ,'no' ,64.33 ,'no' ,61.33 ,'no' ,63.67 ,'no' ,61.00 ,'no' ,55.00 ,'no' ,63.00 ,'no' ,49.33 ,'no' ,62.00 ,'no' ,56.00 ,'no' ,66.67 ,'no' ,57.33 ,'no' ,63.00 ,'no' ,59.33 ,'no' ,60.33 ,'no' ,58.67 ,'no' ,62.00 ,'no' ,65.67 ,'no' ,59.00 ,'no' ,63.67 ,'no' ,62.00 ,'no' ,62.33 ,'no' ,61.67 ,'no' ,48.33 ,'no' ,58.00 ,'no' ,56.33 ,'no' ,65.00 ,'no' ,61.67 ,'no' ,55.33 ,'no' ,63.67 ,'no' ,62.33 ,'no' ,51.00 ,'no' ,62.33 ,'no' ,56.67 ,'no' ,54.00 ,'no' ,64.67 ,'no' ,55.00 ,'no' ,60.00 ,'no' ,54.33 ,'no' ,68.67 ,'no' ,64.67 ,'no' ,60.67 ,'no' ,61.00 ,'no' ,63.00 ,'no' ,64.00 ,'no' ,64.00 ,'no' ,52.67 ,'no' ,70.33 ,'no' ,66.00 ,'no' ,49.00 ,'no' ,61.33 ,'no' ,49.67 ,'no' ,61.33 ,'no' ,60.67 ,'no' ,47.00 ,'no' ,59.67 ,'no' ,70.00 ,'no' ,54.67 ,'no' ,58.00 ,'no' ,62.67 ,'no' ,68.00 ,'no' ,60.67 ,'no' ,59.67 ,'no' ,63.67 ,'no' ,64.00 ,'no' ,62.00 ,'no' ,55.33 ,'no' ,63.33 ,'no' ,61.67 ,'no' ,62.00 ,'no' ,61.67 ,'no' ,3.00 ,'no' ,60.67 ,'no' ,67.33 ,'no' ,44.00 ,'no' ,61.33 ,'no' ,63.67 ,'no' ,59.33 ,'no' ,61.00 ,'no' ,57.67 ,'no' ,65.00 ,'no' ,58.00 ,'no' ,65.67 ,'no' ,54.33 ,'no' ,65.33 ,'no' ,63.67 ,'no' ,57.67 ,'no' ,65.67 ,'no' ,58.00 ,'no' ,66.00 ,'no' ,53.33 ,'no' ,61.00 ,'no' ,59.67 ,'no' ,64.67 ,'no' ,64.67 ,'no' ,63.33 ,'no' ,60.67 ,'no' ,53.67 ,'no' ,63.33 ,'no' ,61.67 ,'no' ,60.00 ,'no' ,57.00 ,'no' ,60.00 ,'no' ,64.00 ,'no' ,65.00 ,'no' ,58.33 ,'no' ,61.33 ,'no' ,53.67 ,'no' ,63.67 ,'no' ,55.33 ,'no' ,71.33 ,'no' ,59.33 ,'no' ,60.33 ,'no' ,43.67 ,'no' ,60.00 ,'no' ,60.00 ,'no' ,60.33 ,'no' ,61.33 ,'no' ,56.67 ,'no' ,61.67 ,'no' ,59.67 ,'no' ,59.67 ,'no' ,54.00 ,'no' ,58.67 ,'no' ,60.00 ,'no' ,47.00 ,'no' ,58.67 ,'no' ,61.00 ,'no' ,56.67 ,'no' ,4.33 ,'no' ,63.33 ,'no' ,56.67 ,'no' ,66.00 ,'no' ,54.67 ,'no' ,66.67 ,'no' ,66.67 ,'no' ,54.67 ,'no' ,47.00 ,'yes' ,57.47 ,'yes' ,59.67 ,'yes' ,62.60 ,'yes' ,64.87 ,'yes' ,57.13 ,'yes' ,67.80 ,'yes' ,69.60 ,'yes' ,62.53 ,'yes' ,62.60 ,'yes' ,64.60 ,'yes' ,62.20 ,'yes' ,59.47 ,'yes' ,61.93 ,'yes' ,59.13 ,'yes' ,59.67 ,'yes' ,66.27 ,'yes' ,69.60 ,'yes' ,64.73 ,'yes' ,62.80 ,'yes' ,70.07 ,'yes' ,64.67 ,'yes' ,60.87 ,'yes' ,62.93 ,'yes' ,59.73 ,'yes' ,66.20 ,'yes' ,67.33 ,'yes' ,62.40 ,'yes' ,64.13 ,'yes' ,59.73 ,'yes' ,66.47 ,'yes' ,72.07 ,'yes' ,61.80 ,'yes' ,63.53 ,'yes' ,63.13 ,'yes' ,64.67 ,'yes' ,61.47 ,'yes' ,51.53 ,'yes' ,56.33 ,'yes' ,57.67 ,'yes' ,66.53 ,'yes' ,56.67 ,'yes' ,61.33 ,'yes' ,61.27 ,'yes' ,65.07 ,'yes' ,62.40 ,'yes' ,55.00 ,'yes' ,60.13 ,'yes' ,64.40 ,'yes' ,61.93 ,'yes' ,41.87 ,'yes' ,63.33 ,'yes' ,64.27 ,'yes' ,67.13 ,'yes' ,70.73 ,'yes' ,59.53 ,'yes' ,64.07 ,'yes' ,63.73 ,'yes' ,63.27 ,'yes' ,58.80 ,'yes' ,69.93 ,'yes' ,47.20 ,'yes' ,61.87 ,'yes' ,65.00 ,'yes' ,58.80 ,'yes' ,67.47 ,'yes' ,62.40 ,'yes' ,70.73 ,'yes' ,59.60 ,'yes' ,65.47 ,'yes' ,70.67 ,'yes' ,57.87 ,'yes' ,70.07 ,'yes' ,60.40 ,'yes' ,67.60 ,'yes' ,63.60 ,'yes' ,71.07 ,'yes' ,65.80 ,'yes' ,63.67 ,'yes' ,62.13 ,'yes' ,62.80 ,'yes' ,64.67 ,'yes' ,36.33 ,'yes' ,61.40 ,'yes' ,63.73 ,'yes' ,58.07 ,'yes' ,65.93 ,'yes' ,71.67 ,'yes' ,58.93 ,'yes' ,63.87 ,'yes' ,64.67 ,'yes' ,63.47 ,'yes' ,64.67 ,'yes' ,61.27 ,'yes' ,72.73 ,'yes' ,64.47 ,'yes' ,64.80 ,'yes' ,59.53 ,'yes' ,64.00 ,'yes' ,65.80 ,'yes' ,61.00 ,'yes' ,54.20 ,'yes' ,66.07 ,'yes' ,62.00 ,'yes' ,54.73 ,'yes' ,66.00 ,'yes' ,66.00 ,'yes' ,66.00 ,'yes' ,66.80 ,'yes' ,68.67 ,'yes' ,59.00 ,'yes' ,66.00 ,'yes' ,62.93 ,'yes' ,63.53 ,'yes' ,68.67 ,'yes' ,63.00 ,'yes' ,66.73 ,'yes' ,68.73 ,'yes' ,63.07 ,'yes' ,61.47 ,'yes' ,58.20 ,'yes' ,55.47 ,'yes' ,62.60 ,'yes' ,69.53 ,'yes' ,66.20 ,'yes' ,64.60 ,'yes' ,67.60 ,'yes' ,59.87 ,'yes' ,53.87 ,'yes' ,58.27 ,'yes' ,61.60 ,'yes' ,59.13 ,'yes' ,61.40 ,'yes' ,61.60 ,'yes' ,70.73 ,'yes' ,64.67 ,'yes' ,64.07 ,'yes' ,63.00 ,'yes' ,60.73 ,'yes' ,62.67 ,'yes' ,65.60 ,'yes' ,65.80 ,'yes' ,58.40 ,'yes' ,64.07 ,'yes' ,56.20 ,'yes' ,62.87 ,'yes' ,71.47 ,'yes' ,70.73 ,'yes' ,66.60 ,'yes' ,62.80 ,'yes' ,70.47 ,'yes' ,63.33 ,'yes' ,72.73 ,'yes' ,64.20 ,'yes' ,66.73 ,'yes' ,66.73 ,'yes' ,17.60 ,'yes' ,61.60 ,'yes' ,61.00 ,'yes' ,59.73 ,'yes' ,63.67 ,'yes' ,61.93 ,'yes' ,65.00 ,'yes' ,64.67 ,'yes' ,73.00 ,'yes' ,66.73 ,'yes' ,60.13 ,'yes' ,66.27 ,'yes' ,68.87 ,'yes' ,59.80 ,'yes' ,68.60 ,'yes' ,58.33 ,'yes' ,68.80 ,'yes' ,58.27 ,'yes' ,68.07 ,'yes' ,66.00 ,'yes' ,64.20 ,'yes' ,69.87 ,'yes' ,66.00 ,'yes' ,55.93 ,'yes' ,65.67 ,'yes' ,62.87 ,'yes' ,59.80 ,'yes' ,62.40 ,'yes' ,65.67 ,'yes' ,65.07 ,'yes' ,60.47 ,'yes' ,63.67 ,'yes' ,52.33 ,'yes' ,68.80 ,'yes' ,67.47 ,'yes' ,57.47 ,'yes' ,64.27 ,'yes' ,72.87 ,'yes' ,71.67 ,'yes' ,52.67 ,'yes' ,62.67 ,'yes' ,66.93 ,'yes' ,63.53 ,'yes' ,67.07 ,'yes' ,62.60 ,'yes' ,57.80 ,'yes' ,66.87 ,'yes' ,67.53 ,'yes' ,70.80 ,'yes' ,65.47 ,'yes' ,57.67 ,'yes' ,37.93 ,'yes' ,59.40 ,'yes' ,59.53 ,'yes' ,66.53 ,'yes' ,55.07 ,'yes' ,62.40 ,'yes' ,70.67 ,'yes' ,63.73 ,'yes' ,66.00 ,'yes' ,65.20 ,'yes' ,60.13 ,'yes' ,61.67 ,'yes' ,60.80 ,'yes' ,71.53 ,'yes' ,70.80 ,'yes' ,60.33 ,'yes' ,63.20 ,'yes' ,66.53 ,'yes' ,64.67) ,dim=c(2 ,414) ,dimnames=list(c('PMent' ,'Exam') ,1:414)) y <- array(NA,dim=c(2,414),dimnames=list(c('PMent','Exam'),1:414)) for (i in 1:dim(x)[1]) { for (j in 1:dim(x)[2]) { y[i,j] <- as.numeric(x[i,j]) } } par5 = '2' par4 = '1' par3 = '0' par2 = 'FALSE' par1 = '3' ylab = 'Exam Score' xlab = 'Placement' main = 'Reddy-Moores Placement Data' par1 <- as.numeric(par1) # colour par2<- as.logical(par2) # notches par3<-as.numeric(par3) # percentage trim if(par3>45){par3<-45;warning('trim limited to 45%')} if(par3<0){par3<-0;warning('negative trim makes no sense. Trim is zero.')} par4 <- as.numeric(par4) #factor column par5 <- as.numeric(par5) # response column x <- t(x) x1<-as.numeric(x[,par5]) # response f1<-as.character(x[,par4]) # factor x2<-x1[f1=='no'] f2 <- f1[f1=='no'] lotrm<-as.integer(length(x2)*par3/100) hitrm<-as.integer(length(x2)*(100-par3)/100) srt<-order(x2,f2) trmx1<-x2[srt[lotrm:hitrm]] trmf1<-f2[srt[lotrm:hitrm]] x3<-x1[f1=='yes'] f3 <- f1[f1=='yes'] lotrm<-as.integer(length(x3)*par3/100) hitrm<-as.integer(length(x3)*(100-par3)/100) srt<-order(x3,f3) trmx2<-x3[srt[lotrm:hitrm]] trmf2<-f3[srt[lotrm:hitrm]] xtrm<-c(trmx1,trmx2) ftrm<-c(trmf1,trmf2) xtrm[1:6] ftrm[1:6] postscript(file="/var/www/rcomp/tmp/1k6bg1318927847.ps",horizontal=F,onefile=F,pagecentre=F,paper="special",width=8.3333333333333,height=5.5555555555556) r<-boxplot(xtrm~as.factor(ftrm), col=par1, notch=par2, main='Reddy and Moores Placements Data', xlab='Placement Student', ylab='Degree Grade') dev.off() #Note: the /var/www/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab load(file="/var/www/rcomp/createtable") a<-table.start() a<-table.row.start(a) a<-table.element(a,hyperlink('http://www.xycoon.com/overview.htm','Boxplot statistics','Boxplot overview'),6,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Placement',1,TRUE) a<-table.element(a,hyperlink('http://www.xycoon.com/lower_whisker.htm','lower whisker','definition of lower whisker'),1,TRUE) a<-table.element(a,hyperlink('http://www.xycoon.com/lower_hinge.htm','lower hinge','definition of lower hinge'),1,TRUE) a<-table.element(a,hyperlink('http://www.xycoon.com/central_tendency.htm','median','definitions about measures of central tendency'),1,TRUE) a<-table.element(a,hyperlink('http://www.xycoon.com/upper_hinge.htm','upper hinge','definition of upper hinge'),1,TRUE) a<-table.element(a,hyperlink('http://www.xycoon.com/upper_whisker.htm','upper whisker','definition of upper whisker'),1,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'no',1,TRUE) for (j in 1:5) { a<-table.element(a,r$stats[j,1]) } a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'yes',1,TRUE) for (j in 1:5) { a<-table.element(a,r$stats[j,2]) } a<-table.row.end(a) a<-table.end(a) table.save(a,file="/var/www/rcomp/tmp/2p6aj1318927847.tab") tr.mns<-tapply(x1,f1,mean, trim=par3/100) a<-table.start() a<-table.row.start(a) a<-table.element(a,hyperlink('http://www.xycoon.com/trimmed_mean.htm','Trimmed Mean Equation','Trimmed Mean'),2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'No Placement') a<-table.element(a,'Placement') a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,tr.mns[1]) a<-table.element(a,tr.mns[2]) a<-table.row.end(a) a<-table.end(a) table.save(a,file="/var/www/rcomp/tmp/3zj0y1318927847.tab") try(system("convert tmp/1k6bg1318927847.ps tmp/1k6bg1318927847.png",intern=TRUE))