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

210907	79	81	94	56	3	1418	112285
120982	58	55	103	56	4	869	84786
176508	60	50	93	54	12	1530	83123
179321	108	125	103	89	2	2172	101193
123185	49	40	51	40	1	901	38361
52746	0	37	70	25	3	463	68504
385534	121	63	91	92	0	3201	119182
33170	1	44	22	18	0	371	22807
101645	20	88	38	63	0	1192	17140
149061	43	66	93	44	5	1583	116174
165446	69	57	60	33	0	1439	57635
237213	78	74	123	84	0	1764	66198
173326	86	49	148	88	7	1495	71701
133131	44	52	90	55	7	1373	57793
258873	104	88	124	60	3	2187	80444
180083	63	36	70	66	9	1491	53855
324799	158	108	168	154	0	4041	97668
230964	102	43	115	53	4	1706	133824
236785	77	75	71	119	3	2152	101481
135473	82	32	66	41	0	1036	99645
202925	115	44	134	61	7	1882	114789
215147	101	85	117	58	0	1929	99052
344297	80	86	108	75	1	2242	67654
153935	50	56	84	33	5	1220	65553
132943	83	50	156	40	7	1289	97500
174724	123	135	120	92	0	2515	69112
174415	73	63	114	100	0	2147	82753
225548	81	81	94	112	5	2352	85323
223632	105	52	120	73	0	1638	72654
124817	47	44	81	40	0	1222	30727
221698	105	113	110	45	0	1812	77873
210767	94	39	133	60	3	1677	117478
170266	44	73	122	62	4	1579	74007
260561	114	48	158	75	1	1731	90183
84853	38	33	109	31	4	807	61542
294424	107	59	124	77	2	2452	101494
101011	30	41	39	34	0	829	27570
215641	71	69	92	46	0	1940	55813
325107	84	64	126	99	0	2662	79215
7176	0	1	0	17	0	186	1423
167542	59	59	70	66	2	1499	55461
106408	33	32	37	30	1	865	31081
96560	42	129	38	76	0	1793	22996
265769	96	37	120	146	2	2527	83122
269651	106	31	93	67	10	2747	70106
149112	56	65	95	56	6	1324	60578
175824	57	107	77	107	0	2702	39992
152871	59	74	90	58	5	1383	79892
111665	39	54	80	34	4	1179	49810
116408	34	76	31	61	1	2099	71570
362301	76	715	110	119	2	4308	100708
78800	20	57	66	42	2	918	33032
183167	91	66	138	66	0	1831	82875
277965	115	106	133	89	8	3373	139077
150629	85	54	113	44	3	1713	71595
168809	76	32	100	66	0	1438	72260
24188	8	20	7	24	0	496	5950
329267	79	71	140	259	8	2253	115762
65029	21	21	61	17	5	744	32551
101097	30	70	41	64	3	1161	31701
218946	76	112	96	41	1	2352	80670
244052	101	66	164	68	5	2144	143558
341570	94	190	78	168	1	4691	117105
103597	27	66	49	43	1	1112	23789
233328	92	165	102	132	5	2694	120733
256462	123	56	124	105	0	1973	105195
206161	75	61	99	71	12	1769	73107
311473	128	53	129	112	8	3148	132068
235800	105	127	62	94	8	2474	149193
177939	55	63	73	82	8	2084	46821
207176	56	38	114	70	8	1954	87011
196553	41	50	99	57	2	1226	95260
174184	72	52	70	53	0	1389	55183
143246	67	42	104	103	5	1496	106671
187559	75	76	116	121	8	2269	73511
187681	114	67	91	62	2	1833	92945
119016	118	50	74	52	5	1268	78664
182192	77	53	138	52	12	1943	70054
73566	22	39	67	32	6	893	22618
194979	66	50	151	62	7	1762	74011
167488	69	77	72	45	2	1403	83737
143756	105	57	120	46	0	1425	69094
275541	116	73	115	63	4	1857	93133
243199	88	34	105	75	3	1840	95536
182999	73	39	104	88	6	1502	225920
135649	99	46	108	46	2	1441	62133
152299	62	63	98	53	0	1420	61370
120221	53	35	69	37	1	1416	43836
346485	118	106	111	90	0	2970	106117
145790	30	43	99	63	5	1317	38692
193339	100	47	71	78	2	1644	84651
80953	49	31	27	25	0	870	56622
122774	24	162	69	45	0	1654	15986
130585	67	57	107	46	5	1054	95364
112611	46	36	73	41	0	937	26706
286468	57	263	107	144	1	3004	89691
241066	75	78	93	82	0	2008	67267
148446	135	63	129	91	1	2547	126846
204713	68	54	69	71	1	1885	41140
182079	124	63	118	63	2	1626	102860
140344	33	77	73	53	6	1468	51715
220516	98	79	119	62	1	2445	55801
243060	58	110	104	63	4	1964	111813
162765	68	56	107	32	2	1381	120293
182613	81	56	99	39	3	1369	138599
232138	131	43	90	62	0	1659	161647
265318	110	111	197	117	10	2888	115929
85574	37	71	36	34	0	1290	24266
310839	130	62	85	92	9	2845	162901
225060	93	56	139	93	7	1982	109825
232317	118	74	106	54	0	1904	129838
144966	39	60	50	144	0	1391	37510
43287	13	43	64	14	4	602	43750
155754	74	68	31	61	4	1743	40652
164709	81	53	63	109	0	1559	87771
201940	109	87	92	38	0	2014	85872
235454	151	46	106	73	0	2143	89275
220801	51	105	63	75	1	2146	44418
99466	28	32	69	50	0	874	192565
92661	40	133	41	61	1	1590	35232
133328	56	79	56	55	0	1590	40909
61361	27	51	25	77	0	1210	13294
125930	37	207	65	75	4	2072	32387
100750	83	67	93	72	0	1281	140867
224549	54	47	114	50	4	1401	120662
82316	27	34	38	32	4	834	21233
102010	28	66	44	53	3	1105	44332
101523	59	76	87	42	0	1272	61056
243511	133	65	110	71	0	1944	101338
22938	12	9	0	10	0	391	1168
41566	0	42	27	35	5	761	13497
152474	106	45	83	65	0	1605	65567
61857	23	25	30	25	4	530	25162
99923	44	115	80	66	0	1988	32334
132487	71	97	98	41	0	1386	40735
317394	116	53	82	86	1	2395	91413
21054	4	2	0	16	0	387	855
209641	62	52	60	42	5	1742	97068
22648	12	44	28	19	0	620	44339
31414	18	22	9	19	0	449	14116
46698	14	35	33	45	0	800	10288
131698	60	74	59	65	0	1684	65622
91735	7	103	49	35	0	1050	16563
244749	98	144	115	95	2	2699	76643
184510	64	60	140	49	7	1606	110681
79863	29	134	49	37	1	1502	29011
128423	32	89	120	64	8	1204	92696
97839	25	42	66	38	2	1138	94785
38214	16	52	21	34	0	568	8773
151101	48	98	124	32	2	1459	83209
272458	100	99	152	65	0	2158	93815
172494	46	52	139	52	0	1111	86687
108043	45	29	38	62	1	1421	34553
328107	129	125	144	65	3	2833	105547
250579	130	106	120	83	0	1955	103487
351067	136	95	160	95	3	2922	213688
158015	59	40	114	29	0	1002	71220
98866	25	140	39	18	0	1060	23517
85439	32	43	78	33	0	956	56926
229242	63	128	119	247	4	2186	91721
351619	95	142	141	139	4	3604	115168
84207	14	73	101	29	11	1035	111194
120445	36	72	56	118	0	1417	51009
324598	113	128	133	110	0	3261	135777
131069	47	61	83	67	4	1587	51513
204271	92	73	116	42	0	1424	74163
165543	70	148	90	65	1	1701	51633
141722	19	64	36	94	0	1249	75345
116048	50	45	50	64	0	946	33416
250047	41	58	61	81	0	1926	83305
299775	91	97	97	95	9	3352	98952
195838	111	50	98	67	1	1641	102372
173260	41	37	78	63	3	2035	37238
254488	120	50	117	83	10	2312	103772
104389	135	105	148	45	5	1369	123969
136084	27	69	41	30	0	1577	27142
199476	87	46	105	70	2	2201	135400
92499	25	57	55	32	0	961	21399
224330	131	52	132	83	1	1900	130115
135781	45	98	44	31	2	1254	24874
74408	29	61	21	67	4	1335	34988
81240	58	89	50	66	0	1597	45549
14688	4	0	0	10	0	207	6023
181633	47	48	73	70	2	1645	64466
271856	109	91	86	103	1	2429	54990
7199	7	0	0	5	0	151	1644
46660	12	7	13	20	0	474	6179
17547	0	3	4	5	0	141	3926
133368	37	54	57	36	1	1639	32755
95227	37	70	48	34	0	872	34777
152601	46	36	46	48	2	1318	73224
98146	15	37	48	40	0	1018	27114
79619	42	123	32	43	3	1383	20760
59194	7	247	68	31	6	1314	37636
139942	54	46	87	42	0	1335	65461
118612	54	72	43	46	2	1403	30080
72880	14	41	67	33	0	910	24094
65475	16	24	46	18	2	616	69008
99643	33	45	46	55	1	1407	54968
71965	32	33	56	35	1	771	46090
77272	21	27	48	59	2	766	27507
49289	15	36	44	19	1	473	10672
135131	38	87	60	66	0	1376	34029
108446	22	90	65	60	1	1232	46300
89746	28	114	55	36	3	1521	24760
44296	10	31	38	25	0	572	18779
77648	31	45	52	47	0	1059	21280
181528	32	69	60	54	0	1544	40662
134019	32	51	54	53	0	1230	28987
124064	43	34	86	40	1	1206	22827
92630	27	60	24	40	4	1205	18513
121848	37	45	52	39	0	1255	30594
52915	20	54	49	14	0	613	24006
81872	32	25	61	45	0	721	27913
58981	0	38	61	36	7	1109	42744
53515	5	52	81	28	2	740	12934
60812	26	67	43	44	0	1126	22574
56375	10	74	40	30	7	728	41385
65490	27	38	40	22	3	689	18653
80949	11	30	56	17	0	592	18472
76302	29	26	68	31	0	995	30976
104011	25	67	79	55	6	1613	63339
98104	55	132	47	54	2	2048	25568
67989	23	42	57	21	0	705	33747
30989	5	35	41	14	0	301	4154
135458	43	118	29	81	3	1803	19474
73504	23	68	3	35	0	799	35130
63123	34	43	60	43	1	861	39067
61254	36	76	30	46	1	1186	13310
74914	35	64	79	30	0	1451	65892
31774	0	48	47	23	1	628	4143
81437	37	64	40	38	0	1161	28579
87186	28	56	48	54	0	1463	51776
50090	16	71	36	20	0	742	21152
65745	26	75	42	53	0	979	38084
56653	38	39	49	45	0	675	27717
158399	23	42	57	39	0	1241	32928
46455	22	39	12	20	0	676	11342
73624	30	93	40	24	0	1049	19499
38395	16	38	43	31	0	620	16380
91899	18	60	33	35	0	1081	36874
139526	28	71	77	151	0	1688	48259
52164	32	52	43	52	0	736	16734
51567	21	27	45	30	2	617	28207
70551	23	59	47	31	0	812	30143
84856	29	40	43	29	1	1051	41369
102538	50	79	45	57	1	1656	45833
86678	12	44	50	40	0	705	29156
85709	21	65	35	44	0	945	35944
34662	18	10	7	25	0	554	36278
150580	27	124	71	77	0	1597	45588
99611	41	81	67	35	0	982	45097
19349	13	15	0	11	0	222	3895
99373	12	92	62	63	1	1212	28394
86230	21	42	54	44	0	1143	18632
30837	8	10	4	19	0	435	2325
31706	26	24	25	13	0	532	25139
89806	27	64	40	42	0	882	27975
62088	13	45	38	38	1	608	14483
40151	16	22	19	29	0	459	13127
27634	2	56	17	20	0	578	5839
76990	42	94	67	27	0	826	24069
37460	5	19	14	20	0	509	3738
54157	37	35	30	19	0	717	18625
49862	17	32	54	37	0	637	36341
84337	38	35	35	26	0	857	24548
64175	37	48	59	42	0	830	21792
59382	29	49	24	49	0	652	26263
119308	32	48	58	30	0	707	23686
76702	35	62	42	49	0	954	49303
103425	17	96	46	67	1	1461	25659
70344	20	45	61	28	0	672	28904
43410	7	63	3	19	0	778	2781
104838	46	71	52	49	1	1141	29236
62215	24	26	25	27	0	680	19546
69304	40	48	40	30	6	1090	22818
53117	3	29	32	22	3	616	32689
19764	10	19	4	12	1	285	5752
86680	37	45	49	31	2	1145	22197
84105	17	45	63	20	0	733	20055
77945	28	67	67	20	0	888	25272
89113	19	30	32	39	0	849	82206
91005	29	36	23	29	3	1182	32073
40248	8	34	7	16	1	528	5444
64187	10	36	54	27	0	642	20154
50857	15	34	37	21	0	947	36944
56613	15	37	35	19	1	819	8019
62792	28	46	51	35	0	757	30884
72535	17	44	39	14	0	894	19540

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