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

48	41	23	12	34	4.35
50	146	16	45	61	12.7
150	182	33	37	70	18.1
154	192	32	37	69	17.85
109	263	37	108	145	16.6
68	35	14	10	23	12.6
194	439	52	68	120	17.1
158	214	75	72	147	19.1
159	341	72	143	215	16.1
67	58	15	9	24	13.35
147	292	29	55	84	18.4
39	85	13	17	30	14.7
100	200	40	37	77	10.6
111	158	19	27	46	12.6
138	199	24	37	61	16.2
101	297	121	58	178	13.6
131	227	93	66	160	18.9
101	108	36	21	57	14.1
114	86	23	19	42	14.5
165	302	85	78	163	16.15
114	148	41	35	75	14.75
111	178	46	48	94	14.8
75	120	18	27	45	12.45
82	207	35	43	78	12.65
121	157	17	30	47	17.35
32	128	4	25	29	8.6
150	296	28	69	97	18.4
117	323	44	72	116	16.1
71	79	10	23	32	11.6
165	70	38	13	50	17.75
154	146	57	61	118	15.25
126	246	23	43	66	17.65
138	145	26	22	48	15.6
149	196	36	51	86	16.35
145	199	22	67	89	17.65
120	127	40	36	76	13.6
138	91	18	21	39	11.7
109	153	31	44	75	14.35
132	299	11	45	57	14.75
172	228	38	34	72	18.25
169	190	24	36	60	9.9
114	180	37	72	109	16
156	212	37	39	76	18.25
172	269	22	43	65	16.85
68	130	15	25	40	14.6
89	179	2	56	58	13.85
167	243	43	80	123	18.95
113	190	31	40	71	15.6
115	299	29	73	102	14.85
78	121	45	34	80	11.75
118	137	25	72	97	18.45
87	305	4	42	46	15.9
173	157	31	61	93	17.1
2	96	-4	23	19	16.1
162	183	66	74	140	19.9
49	52	61	16	78	10.95
122	238	32	66	98	18.45
96	40	31	9	40	15.1
100	226	39	41	80	15
82	190	19	57	76	11.35
100	214	31	48	79	15.95
115	145	36	51	87	18.1
141	119	42	53	95	14.6
165	222	21	29	49	15.4
165	222	21	29	49	15.4
110	159	25	55	80	17.6
118	165	32	54	86	13.35
158	249	26	43	69	19.1
146	125	28	51	79	15.35
49	122	32	20	52	7.6
90	186	41	79	120	13.4
121	148	29	39	69	13.9
155	274	33	61	94	19.1
104	172	17	55	72	15.25
147	84	13	30	43	12.9
110	168	32	55	87	16.1
108	102	30	22	52	17.35
113	106	34	37	71	13.15
115	2	59	2	61	12.15
61	139	13	38	51	12.6
60	95	23	27	50	10.35
109	130	10	56	67	15.4
68	72	5	25	30	9.6
111	141	31	39	70	18.2
77	113	19	33	52	13.6
73	206	32	43	75	14.85
151	268	30	57	87	14.75
89	175	25	43	69	14.1
78	77	48	23	72	14.9
110	125	35	44	79	16.25
220	255	67	54	121	19.25
65	111	15	28	43	13.6
141	132	22	36	58	13.6
117	211	18	39	57	15.65
122	92	33	16	50	12.75
63	76	46	23	69	14.6
44	171	24	40	64	9.85
52	83	14	24	38	12.65
62	119	23	29	53	11.9
131	266	12	78	90	19.2
101	186	38	57	96	16.6
42	50	12	37	49	11.2
152	117	28	27	56	15.25
107	219	41	61	102	11.9
77	246	12	27	40	13.2
154	279	31	69	100	16.35
103	148	33	34	67	12.4
96	137	34	44	78	15.85
154	130	41	21	62	14.35
175	181	21	34	55	18.15
57	98	20	39	59	11.15
112	226	44	51	96	15.65
143	234	52	34	86	17.75
49	138	7	31	38	7.65
110	85	29	13	43	12.35
131	66	11	12	23	15.6
167	236	26	51	77	19.3
56	106	24	24	48	15.2
137	135	7	19	26	17.1
86	122	60	30	91	15.6
121	218	13	81	94	18.4
149	199	20	42	62	19.05
168	112	52	22	74	18.55
140	278	28	85	114	19.1
88	94	25	27	52	13.1
168	113	39	25	64	12.85
94	84	9	22	31	9.5
51	86	19	19	38	4.5
48	62	13	14	27	11.85
145	222	60	45	105	13.6
66	167	19	45	64	11.7
85	82	34	28	62	12.4
109	207	14	51	65	13.35
63	184	17	41	58	11.4
102	83	45	31	76	14.9
162	183	66	74	140	19.9
128	85	24	24	48	17.75
86	89	48	19	68	11.2
114	225	29	51	80	14.6
164	237	-2	73	71	17.6
119	102	51	24	76	14.05
126	221	2	61	63	16.1
132	128	24	23	46	13.35
142	91	40	14	53	11.85
83	198	20	54	74	11.95
94	204	19	51	70	14.75
81	158	16	62	78	15.15
166	138	20	36	56	13.2
110	226	40	59	100	16.85
64	44	27	24	51	7.85
93	196	25	26	52	7.7
104	83	49	54	102	12.6
105	79	39	39	78	7.85
49	52	61	16	78	10.95
88	105	19	36	55	12.35
95	116	67	31	98	9.95
102	83	45	31	76	14.9
99	196	30	42	73	16.65
63	153	8	39	47	13.4
76	157	19	25	45	13.95
109	75	52	31	83	15.7
117	106	22	38	60	16.85
57	58	17	31	48	10.95
120	75	33	17	50	15.35
73	74	34	22	56	12.2
91	185	22	55	77	15.1
108	265	30	62	91	17.75
105	131	25	51	76	15.2
117	139	38	30	68	14.6
119	196	26	49	74	16.65
31	78	13	16	29	8.1

library(party)
library(Hmisc)
par1 <- as.numeric(par1)
par3 <- as.numeric(par3)
x <- data.frame(t(y))
is.data.frame(x)
x <- x[!is.na(x[,par1]),]
k <- length(x[1,])
n <- length(x[,1])
colnames(x)[par1]
x[,par1]
if (par2 == 'kmeans') {
cl <- kmeans(x[,par1], par3)
print(cl)
clm <- matrix(cbind(cl$centers,1:par3),ncol=2)
clm <- clm[sort.list(clm[,1]),]
for (i in 1:par3) {
cl$cluster[cl$cluster==clm[i,2]] <- paste('C',i,sep='')
}
cl$cluster <- as.factor(cl$cluster)
print(cl$cluster)
x[,par1] <- cl$cluster
}
if (par2 == 'quantiles') {
x[,par1] <- cut2(x[,par1],g=par3)
}
if (par2 == 'hclust') {
hc <- hclust(dist(x[,par1])^2, 'cen')
print(hc)
memb <- cutree(hc, k = par3)
dum <- c(mean(x[memb==1,par1]))
for (i in 2:par3) {
dum <- c(dum, mean(x[memb==i,par1]))
}
hcm <- matrix(cbind(dum,1:par3),ncol=2)
hcm <- hcm[sort.list(hcm[,1]),]
for (i in 1:par3) {
memb[memb==hcm[i,2]] <- paste('C',i,sep='')
}
memb <- as.factor(memb)
print(memb)
x[,par1] <- memb
}
if (par2=='equal') {
ed <- cut(as.numeric(x[,par1]),par3,labels=paste('C',1:par3,sep=''))
x[,par1] <- as.factor(ed)
}
table(x[,par1])
colnames(x)
colnames(x)[par1]
x[,par1]
if (par2 == 'none') {
m <- ctree(as.formula(paste(colnames(x)[par1],' ~ .',sep='')),data = x)
}
load(file='createtable')
if (par2 != 'none') {
m <- ctree(as.formula(paste('as.factor(',colnames(x)[par1],') ~ .',sep='')),data = x)
if (par4=='yes') {
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'10-Fold Cross Validation',3+2*par3,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'',1,TRUE)
a<-table.element(a,'Prediction (training)',par3+1,TRUE)
a<-table.element(a,'Prediction (testing)',par3+1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Actual',1,TRUE)
for (jjj in 1:par3) a<-table.element(a,paste('C',jjj,sep=''),1,TRUE)
a<-table.element(a,'CV',1,TRUE)
for (jjj in 1:par3) a<-table.element(a,paste('C',jjj,sep=''),1,TRUE)
a<-table.element(a,'CV',1,TRUE)
a<-table.row.end(a)
for (i in 1:10) {
ind <- sample(2, nrow(x), replace=T, prob=c(0.9,0.1))
m.ct <- ctree(as.formula(paste('as.factor(',colnames(x)[par1],') ~ .',sep='')),data =x[ind==1,])
if (i==1) {
m.ct.i.pred <- predict(m.ct, newdata=x[ind==1,])
m.ct.i.actu <- x[ind==1,par1]
m.ct.x.pred <- predict(m.ct, newdata=x[ind==2,])
m.ct.x.actu <- x[ind==2,par1]
} else {
m.ct.i.pred <- c(m.ct.i.pred,predict(m.ct, newdata=x[ind==1,]))
m.ct.i.actu <- c(m.ct.i.actu,x[ind==1,par1])
m.ct.x.pred <- c(m.ct.x.pred,predict(m.ct, newdata=x[ind==2,]))
m.ct.x.actu <- c(m.ct.x.actu,x[ind==2,par1])
}
}
print(m.ct.i.tab <- table(m.ct.i.actu,m.ct.i.pred))
numer <- 0
for (i in 1:par3) {
print(m.ct.i.tab[i,i] / sum(m.ct.i.tab[i,]))
numer <- numer + m.ct.i.tab[i,i]
}
print(m.ct.i.cp <- numer / sum(m.ct.i.tab))
print(m.ct.x.tab <- table(m.ct.x.actu,m.ct.x.pred))
numer <- 0
for (i in 1:par3) {
print(m.ct.x.tab[i,i] / sum(m.ct.x.tab[i,]))
numer <- numer + m.ct.x.tab[i,i]
}
print(m.ct.x.cp <- numer / sum(m.ct.x.tab))
for (i in 1:par3) {
a<-table.row.start(a)
a<-table.element(a,paste('C',i,sep=''),1,TRUE)
for (jjj in 1:par3) a<-table.element(a,m.ct.i.tab[i,jjj])
a<-table.element(a,round(m.ct.i.tab[i,i]/sum(m.ct.i.tab[i,]),4))
for (jjj in 1:par3) a<-table.element(a,m.ct.x.tab[i,jjj])
a<-table.element(a,round(m.ct.x.tab[i,i]/sum(m.ct.x.tab[i,]),4))
a<-table.row.end(a)
}
a<-table.row.start(a)
a<-table.element(a,'Overall',1,TRUE)
for (jjj in 1:par3) a<-table.element(a,'-')
a<-table.element(a,round(m.ct.i.cp,4))
for (jjj in 1:par3) a<-table.element(a,'-')
a<-table.element(a,round(m.ct.x.cp,4))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable3.tab')
}
}
m
bitmap(file='test1.png')
plot(m)
dev.off()
bitmap(file='test1a.png')
plot(x[,par1] ~ as.factor(where(m)),main='Response by Terminal Node',xlab='Terminal Node',ylab='Response')
dev.off()
if (par2 == 'none') {
forec <- predict(m)
result <- as.data.frame(cbind(x[,par1],forec,x[,par1]-forec))
colnames(result) <- c('Actuals','Forecasts','Residuals')
print(result)
}
if (par2 != 'none') {
print(cbind(as.factor(x[,par1]),predict(m)))
myt <- table(as.factor(x[,par1]),predict(m))
print(myt)
}
bitmap(file='test2.png')
if(par2=='none') {
op <- par(mfrow=c(2,2))
plot(density(result$Actuals),main='Kernel Density Plot of Actuals')
plot(density(result$Residuals),main='Kernel Density Plot of Residuals')
plot(result$Forecasts,result$Actuals,main='Actuals versus Predictions',xlab='Predictions',ylab='Actuals')
plot(density(result$Forecasts),main='Kernel Density Plot of Predictions')
par(op)
}
if(par2!='none') {
plot(myt,main='Confusion Matrix',xlab='Actual',ylab='Predicted')
}
dev.off()
if (par2 == 'none') {
detcoef <- cor(result$Forecasts,result$Actuals)
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Goodness of Fit',2,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Correlation',1,TRUE)
a<-table.element(a,round(detcoef,4))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'R-squared',1,TRUE)
a<-table.element(a,round(detcoef*detcoef,4))
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'RMSE',1,TRUE)
a<-table.element(a,round(sqrt(mean((result$Residuals)^2)),4))
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable1.tab')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Actuals, Predictions, and Residuals',4,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'#',header=TRUE)
a<-table.element(a,'Actuals',header=TRUE)
a<-table.element(a,'Forecasts',header=TRUE)
a<-table.element(a,'Residuals',header=TRUE)
a<-table.row.end(a)
for (i in 1:length(result$Actuals)) {
a<-table.row.start(a)
a<-table.element(a,i,header=TRUE)
a<-table.element(a,result$Actuals[i])
a<-table.element(a,result$Forecasts[i])
a<-table.element(a,result$Residuals[i])
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable.tab')
}
if (par2 != 'none') {
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Confusion Matrix (predicted in columns / actuals in rows)',par3+1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'',1,TRUE)
for (i in 1:par3) {
a<-table.element(a,paste('C',i,sep=''),1,TRUE)
}
a<-table.row.end(a)
for (i in 1:par3) {
a<-table.row.start(a)
a<-table.element(a,paste('C',i,sep=''),1,TRUE)
for (j in 1:par3) {
a<-table.element(a,myt[i,j])
}
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable2.tab')
}