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

210907	56	396	79	30	115	3
120982	56	297	58	28	109	4
176508	54	559	60	38	146	12
179321	89	967	108	30	116	2
123185	40	270	49	22	68	1
52746	25	143	0	26	101	3
385534	92	1562	121	25	96	0
33170	18	109	1	18	67	0
101645	63	371	20	11	44	0
149061	44	656	43	26	100	5
165446	33	511	69	25	93	0
237213	84	655	78	38	140	0
173326	88	465	86	44	166	7
133131	55	525	44	30	99	7
258873	60	885	104	40	139	3
180083	66	497	63	34	130	9
324799	154	1436	158	47	181	0
230964	53	612	102	30	116	4
236785	119	865	77	31	116	3
135473	41	385	82	23	88	0
202925	61	567	115	36	139	7
215147	58	639	101	36	135	0
344297	75	963	80	30	108	1
153935	33	398	50	25	89	5
132943	40	410	83	39	156	7
174724	92	966	123	34	129	0
174415	100	801	73	31	118	0
225548	112	892	81	31	118	5
223632	73	513	105	33	125	0
124817	40	469	47	25	95	0
221698	45	683	105	33	126	0
210767	60	643	94	35	135	3
170266	62	535	44	42	154	4
260561	75	625	114	43	165	1
84853	31	264	38	30	113	4
294424	77	992	107	33	127	2
101011	34	238	30	13	52	0
215641	46	818	71	32	121	0
325107	99	937	84	36	136	0
7176	17	70	0	0	0	0
167542	66	507	59	28	108	2
106408	30	260	33	14	46	1
96560	76	503	42	17	54	0
265769	146	927	96	32	124	2
269651	67	1269	106	30	115	10
149112	56	537	56	35	128	6
175824	107	910	57	20	80	0
152871	58	532	59	28	97	5
111665	34	345	39	28	104	4
116408	61	918	34	39	59	1
362301	119	1635	76	34	125	2
78800	42	330	20	26	82	2
183167	66	557	91	39	149	0
277965	89	1178	115	39	149	8
150629	44	740	85	33	122	3
168809	66	452	76	28	118	0
24188	24	218	8	4	12	0
329267	259	764	79	39	144	8
65029	17	255	21	18	67	5
101097	64	454	30	14	52	3
218946	41	866	76	29	108	1
244052	68	574	101	44	166	5
341570	168	1276	94	21	80	1
103597	43	379	27	16	60	1
233328	132	825	92	28	107	5
256462	105	798	123	35	127	0
206161	71	663	75	28	107	12
311473	112	1069	128	38	146	8
235800	94	921	105	23	84	8
177939	82	858	55	36	141	8
207176	70	711	56	32	123	8
196553	57	503	41	29	111	2
174184	53	382	72	25	98	0
143246	103	464	67	27	105	5
187559	121	717	75	36	135	8
187681	62	690	114	28	107	2
119016	52	462	118	23	85	5
182192	52	657	77	40	155	12
73566	32	385	22	23	88	6
194979	62	577	66	40	155	7
167488	45	619	69	28	104	2
143756	46	479	105	34	132	0
275541	63	817	116	33	127	4
243199	75	752	88	28	108	3
182999	88	430	73	34	129	6
135649	46	451	99	30	116	2
152299	53	537	62	33	122	0
120221	37	519	53	22	85	1
346485	90	1000	118	38	147	0
145790	63	637	30	26	99	5
193339	78	465	100	35	87	2
80953	25	437	49	8	28	0
122774	45	711	24	24	90	0
130585	46	299	67	29	109	5
112611	41	248	46	20	78	0
286468	144	1162	57	29	111	1
241066	82	714	75	45	158	0
148446	91	905	135	37	141	1
204713	71	649	68	33	122	1
182079	63	512	124	33	124	2
140344	53	472	33	25	93	6
220516	62	905	98	32	124	1
243060	63	786	58	29	112	4
162765	32	489	68	28	108	2
182613	39	479	81	28	99	3
232138	62	617	131	31	117	0
265318	117	925	110	52	199	10
85574	34	351	37	21	78	0
310839	92	1144	130	24	91	9
225060	93	669	93	41	158	7
232317	54	707	118	33	126	0
144966	144	458	39	32	122	0
43287	14	214	13	19	71	4
155754	61	599	74	20	75	4
164709	109	572	81	31	115	0
201940	38	897	109	31	119	0
235454	73	819	151	32	124	0
220801	75	720	51	18	72	1
99466	50	273	28	23	91	0
92661	61	508	40	17	45	1
133328	55	506	56	20	78	0
61361	77	451	27	12	39	0
125930	75	699	37	17	68	4
100750	72	407	83	30	119	0
224549	50	465	54	31	117	4
82316	32	245	27	10	39	4
102010	53	370	28	13	50	3
101523	42	316	59	22	88	0
243511	71	603	133	42	155	0
22938	10	154	12	1	0	0
41566	35	229	0	9	36	5
152474	65	577	106	32	123	0
61857	25	192	23	11	32	4
99923	66	617	44	25	99	0
132487	41	411	71	36	136	0
317394	86	975	116	31	117	1
21054	16	146	4	0	0	0
209641	42	705	62	24	88	5
22648	19	184	12	13	39	0
31414	19	200	18	8	25	0
46698	45	274	14	13	52	0
131698	65	502	60	19	75	0
91735	35	382	7	18	71	0
244749	95	964	98	33	124	2
184510	49	537	64	40	151	7
79863	37	438	29	22	71	1
128423	64	369	32	38	145	8
97839	38	417	25	24	87	2
38214	34	276	16	8	27	0
151101	32	514	48	35	131	2
272458	65	822	100	43	162	0
172494	52	389	46	43	165	0
108043	62	466	45	14	54	1
328107	65	1255	129	41	159	3
250579	83	694	130	38	147	0
351067	95	1024	136	45	170	3
158015	29	400	59	31	119	0
98866	18	397	25	13	49	0
85439	33	350	32	28	104	0
229242	247	719	63	31	120	4
351619	139	1277	95	40	150	4
84207	29	356	14	30	112	11
120445	118	457	36	16	59	0
324598	110	1402	113	37	136	0
131069	67	600	47	30	107	4
204271	42	480	92	35	130	0
165543	65	595	70	32	115	1
141722	94	436	19	27	107	0
116048	64	230	50	20	75	0
250047	81	651	41	18	71	0
299775	95	1367	91	31	120	9
195838	67	564	111	31	116	1
173260	63	716	41	21	79	3
254488	83	747	120	39	150	10
104389	45	467	135	41	156	5
136084	30	671	27	13	51	0
199476	70	861	87	32	118	2
92499	32	319	25	18	71	0
224330	83	612	131	39	144	1
135781	31	433	45	14	47	2
74408	67	434	29	7	28	4
81240	66	503	58	17	68	0
14688	10	85	4	0	0	0
181633	70	564	47	30	110	2
271856	103	824	109	37	147	1
7199	5	74	7	0	0	0
46660	20	259	12	5	15	0
17547	5	69	0	1	4	0
133368	36	535	37	16	64	1
95227	34	239	37	32	111	0
152601	48	438	46	24	85	2
98146	40	459	15	17	68	0
79619	43	426	42	11	40	3
59194	31	288	7	24	80	6
139942	42	498	54	22	88	0
118612	46	454	54	12	48	2
72880	33	376	14	19	76	0
65475	18	225	16	13	51	2
99643	55	555	33	17	67	1
71965	35	252	32	15	59	1
77272	59	208	21	16	61	2
49289	19	130	15	24	76	1
135131	66	481	38	15	60	0
108446	60	389	22	17	68	1
89746	36	565	28	18	71	3
44296	25	173	10	20	76	0
77648	47	278	31	16	62	0
181528	54	609	32	16	61	0
134019	53	422	32	18	67	0
124064	40	445	43	22	88	1
92630	40	387	27	8	30	4
121848	39	339	37	17	64	0
52915	14	181	20	18	68	0
81872	45	245	32	16	64	0
58981	36	384	0	23	91	7
53515	28	212	5	22	88	2
60812	44	399	26	13	52	0
56375	30	229	10	13	49	7
65490	22	224	27	16	62	3
80949	17	203	11	16	61	0
76302	31	333	29	20	76	0
104011	55	384	25	22	88	6
98104	54	636	55	17	66	2
67989	21	185	23	18	71	0
30989	14	93	5	17	68	0
135458	81	581	43	12	48	3
73504	35	248	23	7	25	0
63123	43	304	34	17	68	1
61254	46	344	36	14	41	1
74914	30	407	35	23	90	0
31774	23	170	0	17	66	1
81437	38	312	37	14	54	0
87186	54	507	28	15	59	0
50090	20	224	16	17	60	0
65745	53	340	26	21	77	0
56653	45	168	38	18	68	0
158399	39	443	23	18	72	0
46455	20	204	22	17	67	0
73624	24	367	30	17	64	0
38395	31	210	16	16	63	0
91899	35	335	18	15	59	0
139526	151	364	28	21	84	0
52164	52	178	32	16	64	0
51567	30	206	21	14	56	2
70551	31	279	23	15	54	0
84856	29	387	29	17	67	1
102538	57	490	50	15	58	1
86678	40	238	12	15	59	0
85709	44	343	21	10	40	0
34662	25	232	18	6	22	0
150580	77	530	27	22	83	0
99611	35	291	41	21	81	0
19349	11	67	13	1	2	0
99373	63	397	12	18	72	1
86230	44	467	21	17	61	0
30837	19	178	8	4	15	0
31706	13	175	26	10	32	0
89806	42	299	27	16	62	0
62088	38	154	13	16	58	1
40151	29	106	16	9	36	0
27634	20	189	2	16	59	0
76990	27	194	42	17	68	0
37460	20	135	5	7	21	0
54157	19	201	37	15	55	0
49862	37	207	17	14	54	0
84337	26	280	38	14	55	0
64175	42	260	37	18	72	0
59382	49	227	29	12	41	0
119308	30	239	32	16	61	0
76702	49	333	35	21	67	0
103425	67	428	17	19	76	1
70344	28	230	20	16	64	0
43410	19	292	7	1	3	0
104838	49	350	46	16	63	1
62215	27	186	24	10	40	0
69304	30	326	40	19	69	6
53117	22	155	3	12	48	3
19764	12	75	10	2	8	1
86680	31	361	37	14	52	2
84105	20	261	17	17	66	0
77945	20	299	28	19	76	0
89113	39	300	19	14	43	0
91005	29	450	29	11	39	3
40248	16	183	8	4	14	1
64187	27	238	10	16	61	0
50857	21	165	15	20	71	0
56613	19	234	15	12	44	1
62792	35	176	28	15	60	0
72535	14	329	17	16	64	0

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')
}