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

210907	79	94	24188
120982	58	103	18273
176508	60	93	14130
179321	108	103	32287
123185	49	51	8654
52746	0	70	9245
385534	121	91	33251
33170	1	22	1271
101645	20	38	5279
149061	43	93	27101
165446	69	60	16373
237213	78	123	19716
173326	86	148	17753
133131	44	90	9028
258873	104	124	18653
180083	63	70	8828
324799	158	168	29498
230964	102	115	27563
236785	77	71	18293
135473	82	66	22530
202925	115	134	15977
215147	101	117	35082
344297	80	108	16116
153935	50	84	15849
132943	83	156	16026
174724	123	120	26569
174415	73	114	24785
225548	81	94	17569
223632	105	120	23825
124817	47	81	7869
221698	105	110	14975
210767	94	133	37791
170266	44	122	9605
260561	114	158	27295
84853	38	109	2746
294424	107	124	34461
101011	30	39	8098
215641	71	92	4787
325107	84	126	24919
7176	0	0	603
167542	59	70	16329
106408	33	37	12558
96560	42	38	7784
265769	96	120	28522
269651	106	93	22265
149112	56	95	14459
175824	57	77	14526
152871	59	90	22240
111665	39	80	11802
116408	34	31	7623
362301	76	110	11912
78800	20	66	7935
183167	91	138	18220
277965	115	133	19199
150629	85	113	19918
168809	76	100	21884
24188	8	7	2694
329267	79	140	15808
65029	21	61	3597
101097	30	41	5296
218946	76	96	25239
244052	101	164	29801
341570	94	78	18450
103597	27	49	7132
233328	92	102	34861
256462	123	124	35940
206161	75	99	16688
311473	128	129	24683
235800	105	62	46230
177939	55	73	10387
207176	56	114	21436
196553	41	99	30546
174184	72	70	19746
143246	67	104	15977
187559	75	116	22583
187681	114	91	17274
119016	118	74	16469
182192	77	138	14251
73566	22	67	3007
194979	66	151	16851
167488	69	72	21113
143756	105	120	17401
275541	116	115	23958
243199	88	105	23567
182999	73	104	13065
135649	99	108	15358
152299	62	98	14587
120221	53	69	12770
346485	118	111	24021
145790	30	99	9648
193339	100	71	20537
80953	49	27	7905
122774	24	69	4527
130585	67	107	30495
112611	46	73	7117
286468	57	107	17719
241066	75	93	27056
148446	135	129	33473
204713	68	69	9758
182079	124	118	21115
140344	33	73	7236
220516	98	119	13790
243060	58	104	32902
162765	68	107	25131
182613	81	99	30910
232138	131	90	35947
265318	110	197	29848
85574	37	36	6943
310839	130	85	42705
225060	93	139	31808
232317	118	106	26675
144966	39	50	8435
43287	13	64	7409
155754	74	31	14993
164709	81	63	36867
201940	109	92	33835
235454	151	106	24164
220801	51	63	12607
99466	28	69	22609
92661	40	41	5892
133328	56	56	17014
61361	27	25	5394
125930	37	65	9178
100750	83	93	6440
224549	54	114	21916
82316	27	38	4011
102010	28	44	5818
101523	59	87	18647
243511	133	110	20556
22938	12	0	238
41566	0	27	70
152474	106	83	22392
61857	23	30	3913
99923	44	80	12237
132487	71	98	8388
317394	116	82	22120
21054	4	0	338
209641	62	60	11727
22648	12	28	3704
31414	18	9	3988
46698	14	33	3030
131698	60	59	13520
91735	7	49	1421
244749	98	115	20923
184510	64	140	20237
79863	29	49	3219
128423	32	120	3769
97839	25	66	12252
38214	16	21	1888
151101	48	124	14497
272458	100	152	28864
172494	46	139	21721
108043	45	38	4821
328107	129	144	33644
250579	130	120	15923
351067	136	160	42935
158015	59	114	18864
98866	25	39	4977
85439	32	78	7785
229242	63	119	17939
351619	95	141	23436
84207	14	101	325
120445	36	56	13539
324598	113	133	34538
131069	47	83	12198
204271	92	116	26924
165543	70	90	12716
141722	19	36	8172
116048	50	50	10855
250047	41	61	11932
299775	91	97	14300
195838	111	98	25515
173260	41	78	2805
254488	120	117	29402
104389	135	148	16440
136084	27	41	11221
199476	87	105	28732
92499	25	55	5250
224330	131	132	28608
135781	45	44	8092
74408	29	21	4473
81240	58	50	1572
14688	4	0	2065
181633	47	73	14817
271856	109	86	16714
7199	7	0	556
46660	12	13	2089
17547	0	4	2658
133368	37	57	10695
95227	37	48	1669
152601	46	46	16267
98146	15	48	7768
79619	42	32	7252
59194	7	68	6387
139942	54	87	18715
118612	54	43	7936
72880	14	67	8643
65475	16	46	7294
99643	33	46	4570
71965	32	56	7185
77272	21	48	10058
49289	15	44	2342
135131	38	60	8509
108446	22	65	13275
89746	28	55	6816
44296	10	38	1930
77648	31	52	8086
181528	32	60	10737
134019	32	54	8033
124064	43	86	7058
92630	27	24	6782
121848	37	52	5401
52915	20	49	6521
81872	32	61	10856
58981	0	61	2154
53515	5	81	6117
60812	26	43	5238
56375	10	40	4820
65490	27	40	5615
80949	11	56	4272
76302	29	68	8702
104011	25	79	15340
98104	55	47	8030
67989	23	57	9526
30989	5	41	1278
135458	43	29	4236
73504	23	3	3023
63123	34	60	7196
61254	36	30	3394
74914	35	79	6371
31774	0	47	1574
81437	37	40	9620
87186	28	48	6978
50090	16	36	4911
65745	26	42	8645
56653	38	49	8987
158399	23	57	5544
46455	22	12	3083
73624	30	40	6909
38395	16	43	3189
91899	18	33	6745
139526	28	77	16724
52164	32	43	4850
51567	21	45	7025
70551	23	47	6047
84856	29	43	7377
102538	50	45	9078
86678	12	50	4605
85709	21	35	3238
34662	18	7	8100
150580	27	71	9653
99611	41	67	8914
19349	13	0	786
99373	12	62	6700
86230	21	54	5788
30837	8	4	593
31706	26	25	4506
89806	27	40	6382
62088	13	38	5621
40151	16	19	3997
27634	2	17	520
76990	42	67	8891
37460	5	14	999
54157	37	30	7067
49862	17	54	4639
84337	38	35	5654
64175	37	59	6928
59382	29	24	1514
119308	32	58	9238
76702	35	42	8204
103425	17	46	5926
70344	20	61	5785
43410	7	3	4
104838	46	52	5930
62215	24	25	3710
69304	40	40	705
53117	3	32	443
19764	10	4	2416
86680	37	49	7747
84105	17	63	5432
77945	28	67	4913
89113	19	32	2650
91005	29	23	2370
40248	8	7	775
64187	10	54	5576
50857	15	37	1352
56613	15	35	3080
62792	28	51	10205
72535	17	39	6095

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