Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
skutecznosc;RF 1. cryo 0 ;Wiek;EF;LA - AP;średnia przed;EKG po;różnica;%;niew serc;nadcisni;płec;wiek>65;wiek>75;udar;ch.naczyn;cukrzyca;chdsvasc 1;1;55;65;34;62;75;13;20.96774194;0;1;0;0;0;0;0;0;1 1;1;62;65;45;76;74;-2;-2.631578947;0;1;1;0;0;0;0;0;2 1;0;67;65;45;53;65;12;22.64150943;0;1;0;1;0;0;0;0;2 1;1;45;;;61;64;3;4.918032787;0;0;0;0;0;0;0;0;0 1;0;53;62;33;56;80;24;42.85714286;0;0;0;0;0;0;0;0;0 1;1;37;66;40;65;81;16;24.61538462;0;1;0;0;0;0;0;0;1 1;1;55;48;36;63;63;0;0;0;1;0;0;0;0;0;0;1 1;0;62;60;32;69;76;7;10.14492754;0;0;0;0;0;0;0;0;0 1;0;53;58;44;43;67;24;55.81395349;0;0;0;0;0;0;0;0;0 1;0;40;52;46;82;85;3;3.658536585;0;0;0;0;0;0;0;0;0 1;1;52;;;62;83;21;33.87096774;0;1;0;0;0;0;0;0;1 1;0;44;58;35;56;75;19;33.92857143;0;0;0;0;0;0;0;0;0 1;0;67;66;38;71;71;0;0;0;1;0;1;0;0;0;0;2 1;0;70;60;39;47;65;18;38.29787234;0;1;0;0;0;0;0;0;1 1;1;60;58;35;65;66;1;1.538461538;0;1;0;0;0;0;0;0;1 1;0;66;60;40;67;64;-3;-4.47761194;0;1;0;1;0;0;0;1;3 1;0;32;60;33;67;84;17;25.37313433;0;0;0;0;0;0;0;0;0 1;1;63;63;42;54;79;25;46.2962963;0;1;0;0;0;0;0;0;1 1;0;60;61;38;53;72;19;35.8490566;0;0;0;0;0;0;0;0;0 1;0;34;58;32;81;88;7;8.641975309;0;0;0;0;0;0;0;0;0 1;0;50;57;31;48;64;16;33.33333333;0;0;0;0;0;0;0;0;0 1;0;55;62;43;60;64;4;6.666666667;0;1;0;0;0;0;0;0;1 1;1;62;61;34;61;67;6;9.836065574;0;0;0;0;0;0;0;1;1 1;1;64;45;40;77;80;3;3.896103896;0;1;0;0;0;0;0;0;1 1;0;39;53;42;49;51;2;4.081632653;0;0;0;0;0;0;0;0;0 1;0;48;56;36;51;83;32;62.74509804;0;0;0;0;0;0;0;0;0 1;0;49;58;34;54;70;16;29.62962963;0;0;0;0;0;0;0;0;0 1;1;54;57;35;66;63;-3;-4.545454545;0;1;0;0;0;0;0;0;1 1;0;56;56;35;61;70;9;14.75409836;0;0;0;0;0;0;0;0;0 1;0;57;65;39;56;82;26;46.42857143;0;1;0;0;0;0;0;0;1 1;0;28;32;65;85;93;8;9.411764706;0;0;0;0;0;0;0;0;0 1;0;50;65;44;68;87;19;27.94117647;0;0;0;0;0;0;0;0;0 1;0;40;65;36;66;74;8;12.12121212;0;0;0;0;0;0;0;0;0 1;0;49;50;38;52;66;14;26.92307692;0;0;0;0;0;1;0;0;1 1;0;65;57;37;45;57;12;26.66666667;0;1;0;1;0;0;0;0;2 1;1;30;65;31;65;104;39;60;0;0;0;0;0;0;0;0;0 1;1;64;;;62;88;26;41.93548387;1;1;1;0;0;0;0;0;3 1;0;60;58;38;64;76;12;18.75;0;1;1;0;0;0;0;1;3 1;0;64;65;45;53;64;11;20.75471698;0;1;1;0;0;0;0;0;2 1;0;72;56;41;51;54;3;5.882352941;0;1;0;1;0;0;1;0;3 1;1;56;75;42;44;51;7;15.90909091;0;0;0;0;0;0;0;0;0 1;1;63;60;44;62;58;-4;-6.451612903;0;1;0;0;0;0;0;0;1 1;1;52;68;36;60;81;21;35;0;0;0;0;0;0;0;0;0 1;1;58;71;35;50;74;24;48;0;0;0;0;0;0;1;0;1 1;1;64;66;35;58;76;18;31.03448276;0;0;1;0;0;0;0;0;1 1;1;59;59;46;48;51;3;6.25;0;0;0;0;0;0;0;0;0 1;1;38;75;33;43;68;25;58.13953488;0;1;0;0;0;0;0;0;1 1;1;44;75;36;57;81;24;42.10526316;0;0;0;0;0;0;0;0;0 1;1;57;62;32;62;90;28;45.16129032;0;0;1;0;0;0;0;0;1 1;1;58;59;41;43;73;30;69.76744186;0;0;0;0;0;0;0;0;0 1;0;64;68;41;52;75;23;44.23076923;0;1;1;0;0;0;0;0;2 1;0;56;73;39;55;79;24;43.63636364;0;1;0;0;0;0;0;0;1 1;1;32;56;37;61;85;24;39.3442623;0;0;0;0;0;0;0;0;0 1;0;56;63;42;63;90;27;42.85714286;0;1;0;0;0;0;0;1;2 1;0;60;59;41;59;86;27;45.76271186;0;1;0;0;0;0;0;0;1 1;0;50;58;31;55;79;24;43.63636364;0;0;1;0;0;0;0;0;1 1;0;52;74;40;54;72;18;33.33333333;0;1;0;0;0;0;0;1;2 1;0;60;65;43;60;68;8;13.33333333;0;1;0;0;0;0;0;0;1 1;0;38;65;34;63;87;24;38.0952381;0;0;0;0;0;0;0;0;0 1;1;75;60;43;57;75;18;31.57894737;0;1;1;1;0;0;0;0;3 1;0;62;66;28;57;78;21;36.84210526;0;1;1;0;0;0;0;0;2 1;0;65;59;34;51;65;14;27.45098039;0;1;1;0;0;0;0;0;2 1;0;60;77;37;54;77;23;42.59259259;0;0;0;0;0;0;0;0;0 1;0;27;62;38;56;60;4;7.142857143;0;0;0;0;0;0;0;0;0 1;1;60;59;40;44;49;5;11.36363636;0;0;0;0;0;0;0;0;0 1;1;37;64;34;68;76;8;11.76470588;0;1;0;0;0;0;0;0;1 1;1;59;64;32;62;105;43;69.35483871;0;1;1;0;0;0;0;1;3 1;0;55;60;42;59;85;26;44.06779661;0;1;0;0;0;0;0;0;1 1;1;54;67;44;51;63;12;23.52941176;0;1;0;0;0;0;0;0;1 1;1;39;74;38;54;84;30;55.55555556;0;0;0;0;0;0;0;0;0 1;0;44;73;37;54;73;19;35.18518519;0;0;0;0;0;0;0;0;0 1;1;47;70;41;60;65;5;8.333333333;0;1;0;0;0;0;0;0;1 1;0;54;62;41;62;79;17;27.41935484;0;1;0;0;0;0;1;0;2 1;1;44;66;40;57;70;13;22.80701754;0;0;0;0;0;0;0;0;0 0;1;46;60;49;46;57;11;23.91304348;0;0;0;0;0;0;0;0;0 0;0;52;;;58;61;3;5.172413793;0;0;0;0;0;0;0;0;0 0;0;65;60;34;48;66;18;37.5;0;1;0;1;0;0;1;0;3 0;1;65;65;48;57;71;14;24.56140351;0;1;0;1;0;0;1;1;4 0;1;48;55;44;65;73;8;12.30769231;0;1;0;0;0;0;0;0;1 0;0;53;50;37;54;77;23;42.59259259;0;0;0;0;0;0;0;0;0 0;1;47;50;31;60;76;16;26.66666667;0;0;0;0;0;0;0;0;0 0;1;56;59;35;61;69;8;13.1147541;0;0;0;0;0;0;0;0;0 0;0;57;65;31;48;72;24;50;0;0;0;0;0;0;0;0;0 0;1;59;64;43;43;57;14;32.55813953;0;0;0;0;0;0;0;0;0 0;1;56;64;38;59;72;13;22.03389831;0;1;0;0;0;0;0;0;1 0;1;52;78;43;73;74;1;1.369863014;0;0;0;0;0;0;0;0;0 0;1;62;64;43;73;65;-8;-10.95890411;0;1;1;0;0;0;0;0;2 0;1;47;63;27;70;75;5;7.142857143;0;0;0;0;0;0;0;0;0 0;1;66;61;41;55;66;11;20;0;0;0;1;0;0;0;0;1 0;1;58;73;41;56;56;0;0;0;1;1;0;0;0;0;1;3 0;1;58;65;38;64;87;23;35.9375;0;0;0;0;0;0;0;0;0 0;0;60;60;42;51;74;23;45.09803922;0;1;0;0;0;0;0;0;1 0;0;40;76;38;53;78;25;47.16981132;0;0;0;0;0;0;0;0;0 0;1;61;74;41;53;80;27;50.94339623;0;1;0;0;0;0;0;0;1 0;1;59;64;40;40;68;28;70;0;0;0;0;0;0;0;0;0 0;1;64;70;43;49;64;15;30.6122449;0;1;0;0;0;0;1;0;2 0;0;62;75;40;42;51;9;21.42857143;0;1;0;0;0;0;1;0;2 0;1;64;55;41;61;73;12;19.67213115;0;0;0;0;0;0;0;0;0 0;1;61;59;40;64;57;-7;-10.9375;0;1;1;0;0;0;0;1;3 0;0;60;65;34;57;63;6;10.52631579;0;0;0;0;0;0;0;0;0 0;1;77;69;40;52;62;10;19.23076923;0;1;1;1;0;0;1;1;5 0;0;63;59;34;49;59;10;20.40816327;0;1;0;0;0;0;0;0;1 0;0;62;61;35;53;52;-1;-1.886792453;0;0;0;0;0;0;0;0;0 0;0;70;65;38;52;62;10;19.23076923;0;0;0;1;0;0;0;0;1 0;0;57;75;45;56;61;5;8.928571429;0;1;1;0;0;0;0;1;3 0;1;74;70;37;57;62;5;8.771929825;0;1;1;1;0;0;0;0;3 0;1;59;70;47;69;67;-2;-2.898550725;0;0;0;0;0;0;0;0;0 0;1;67;69;39;60;71;11;18.33333333;0;0;1;1;0;0;0;0;2 0;0;55;61;40;58;70;12;20.68965517;0;0;0;0;0;0;0;0;0 0;1;53;65;46;54;59;5;9.259259259;0;0;0;0;0;0;0;0;0 0;1;65;61;42;45;54;9;20;0;0;0;0;0;0;0;0;0
Names of X columns:
skutecznosc;RF 1, cryo 0 ;Wiek;EF;LA - AP;średnia przed;EKG po;różnica;%;niew serc;nadcisni;płec;wiek>65;wiek>75;udar;ch.naczyn;cukrzyca;chdsvasc
Chart options
R Code
library(brglm) roc.plot <- function (sd, sdc, newplot = TRUE, ...) { sall <- sort(c(sd, sdc)) sens <- 0 specc <- 0 for (i in length(sall):1) { sens <- c(sens, mean(sd >= sall[i], na.rm = T)) specc <- c(specc, mean(sdc >= sall[i], na.rm = T)) } if (newplot) { plot(specc, sens, xlim = c(0, 1), ylim = c(0, 1), type = 'l', xlab = '1-specificity', ylab = 'sensitivity', main = 'ROC plot', ...) abline(0, 1) } else lines(specc, sens, ...) npoints <- length(sens) area <- sum(0.5 * (sens[-1] + sens[-npoints]) * (specc[-1] - specc[-npoints])) lift <- (sens - specc)[-1] cutoff <- sall[lift == max(lift)][1] sensopt <- sens[-1][lift == max(lift)][1] specopt <- 1 - specc[-1][lift == max(lift)][1] list(area = area, cutoff = cutoff, sensopt = sensopt, specopt = specopt) } roc.analysis <- function (object, newdata = NULL, newplot = TRUE, ...) { if (is.null(newdata)) { sd <- object$fitted[object$y == 1] sdc <- object$fitted[object$y == 0] } else { sd <- predict(object, newdata, type = 'response')[newdata$y == 1] sdc <- predict(object, newdata, type = 'response')[newdata$y == 0] } roc.plot(sd, sdc, newplot, ...) } hosmerlem <- function (y, yhat, g = 10) { cutyhat <- cut(yhat, breaks = quantile(yhat, probs = seq(0, 1, 1/g)), include.lowest = T) obs <- xtabs(cbind(1 - y, y) ~ cutyhat) expect <- xtabs(cbind(1 - yhat, yhat) ~ cutyhat) chisq <- sum((obs - expect)^2/expect) P <- 1 - pchisq(chisq, g - 2) c('X^2' = chisq, Df = g - 2, 'P(>Chi)' = P) } x <- as.data.frame(t(y)) r <- brglm(x) summary(r) rc <- summary(r)$coeff try(hm <- hosmerlem(y[1,],r$fitted.values),silent=T) try(hm,silent=T) bitmap(file='test0.png') ra <- roc.analysis(r) dev.off() te <- array(0,dim=c(2,99)) for (i in 1:99) { threshold <- i / 100 numcorr1 <- 0 numfaul1 <- 0 numcorr0 <- 0 numfaul0 <- 0 for (j in 1:length(r$fitted.values)) { if (y[1,j] > 0.99) { if (r$fitted.values[j] >= threshold) numcorr1 = numcorr1 + 1 else numfaul1 = numfaul1 + 1 } else { if (r$fitted.values[j] < threshold) numcorr0 = numcorr0 + 1 else numfaul0 = numfaul0 + 1 } } te[1,i] <- numfaul1 / (numfaul1 + numcorr1) te[2,i] <- numfaul0 / (numfaul0 + numcorr0) } bitmap(file='test1.png') op <- par(mfrow=c(2,2)) plot((1:99)/100,te[1,],xlab='Threshold',ylab='Type I error', main='1 - Specificity') plot((1:99)/100,te[2,],xlab='Threshold',ylab='Type II error', main='1 - Sensitivity') plot(te[1,],te[2,],xlab='Type I error',ylab='Type II error', main='(1-Sens.) vs (1-Spec.)') plot((1:99)/100,te[1,]+te[2,],xlab='Threshold',ylab='Sum of Type I & II error', main='(1-Sens.) + (1-Spec.)') par(op) dev.off() load(file='createtable') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Coefficients of Bias-Reduced Logistic Regression',5,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Variable',header=TRUE) a<-table.element(a,'Parameter',header=TRUE) a<-table.element(a,'S.E.',header=TRUE) a<-table.element(a,'t-stat',header=TRUE) a<-table.element(a,'2-sided p-value',header=TRUE) a<-table.row.end(a) for (i in 1:length(rc[,1])) { a<-table.row.start(a) a<-table.element(a,labels(rc)[[1]][i],header=TRUE) a<-table.element(a,rc[i,1]) a<-table.element(a,rc[i,2]) a<-table.element(a,rc[i,3]) a<-table.element(a,2*(1-pt(abs(rc[i,3]),r$df.residual))) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Summary of Bias-Reduced Logistic Regression',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Deviance',1,TRUE) a<-table.element(a,r$deviance) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Penalized deviance',1,TRUE) a<-table.element(a,r$penalized.deviance) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Residual Degrees of Freedom',1,TRUE) a<-table.element(a,r$df.residual) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'ROC Area',1,TRUE) a<-table.element(a,ra$area) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Hosmer–Lemeshow test',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Chi-square',1,TRUE) phm <- array('NA',dim=3) for (i in 1:3) { try(phm[i] <- hm[i],silent=T) } a<-table.element(a,phm[1]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Degrees of Freedom',1,TRUE) a<-table.element(a,phm[2]) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'P(>Chi)',1,TRUE) a<-table.element(a,phm[3]) 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,'Fit of Logistic Regression',4,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Index',1,TRUE) a<-table.element(a,'Actual',1,TRUE) a<-table.element(a,'Fitted',1,TRUE) a<-table.element(a,'Error',1,TRUE) a<-table.row.end(a) for (i in 1:length(r$fitted.values)) { a<-table.row.start(a) a<-table.element(a,i,1,TRUE) a<-table.element(a,y[1,i]) a<-table.element(a,r$fitted.values[i]) a<-table.element(a,y[1,i]-r$fitted.values[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable2.tab') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Type I & II errors for various threshold values',3,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Threshold',1,TRUE) a<-table.element(a,'Type I',1,TRUE) a<-table.element(a,'Type II',1,TRUE) a<-table.row.end(a) for (i in 1:99) { a<-table.row.start(a) a<-table.element(a,i/100,1,TRUE) a<-table.element(a,te[1,i]) a<-table.element(a,te[2,i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable3.tab')
Compute
Summary of computational transaction
Raw Input
view raw input (R code)
Raw Output
view raw output of R engine
Computing time
0 seconds
R Server
Big Analytics Cloud Computing Center
Click here to blog (archive) this computation