Send output to:
Browser Blue - Charts White
Browser Black/White
CSV
Data X:
1 1 55 65 34 62 75 1320.9677420.96774 1 1 1 62 65 45 76 74 -2-2.63158-2.63158 2 1 0 67 65 45 53 65 1222.6415122.64151 2 1 1 45 61 64 34.9180334.918033 0 1 0 53 62 33 56 80 2442.8571442.85714 0 1 1 37 66 40 65 81 1624.6153824.61538 1 1 1 55 48 36 63 63 0 0 0 1 1 0 62 60 32 69 76 710.1449310.14493 0 1 0 53 58 44 43 67 2455.8139555.81395 0 1 0 40 52 46 82 85 33.6585373.658537 0 1 1 52 62 83 2133.8709733.87097 1 1 0 44 58 35 56 75 1933.9285733.92857 0 1 0 67 66 38 71 71 0 0 0 2 1 0 70 60 39 47 65 1838.2978738.29787 1 1 1 60 58 35 65 66 11.5384621.538462 1 1 0 66 60 40 67 64 -3-4.47761-4.47761 3 1 0 32 60 33 67 84 1725.3731325.37313 0 1 1 63 63 42 54 79 25 46.2963 46.2963 1 1 0 60 61 38 53 72 1935.8490635.84906 0 1 0 34 58 32 81 88 78.6419758.641975 0 1 0 50 57 31 48 64 1633.3333333.33333 0 1 0 55 62 43 60 64 46.6666676.666667 1 1 1 62 61 34 61 67 69.8360669.836066 1 1 1 64 45 40 77 80 33.8961043.896104 1 1 0 39 53 42 49 51 24.0816334.081633 0 1 0 48 56 36 51 83 32 62.7451 62.7451 0 1 0 49 58 34 54 70 1629.6296329.62963 0 1 1 54 57 35 66 63 -3-4.54545-4.54545 1 1 0 56 56 35 61 70 9 14.7541 14.7541 0 1 0 57 65 39 56 82 2646.4285746.42857 1 1 0 28 32 65 85 93 89.4117659.411765 0 1 0 50 65 44 68 87 1927.9411827.94118 0 1 0 40 65 36 66 74 812.1212112.12121 0 1 0 49 50 38 52 66 1426.9230826.92308 1 1 0 65 57 37 45 57 1226.6666726.66667 2 1 1 30 65 31 65 104 39 60 60 0 1 1 64 62 88 2641.9354841.93548 3 1 0 60 58 38 64 76 12 18.75 18.75 3 1 0 64 65 45 53 64 1120.7547220.75472 2 1 0 72 56 41 51 54 35.8823535.882353 3 1 1 56 75 42 44 51 715.9090915.90909 0 1 1 63 59.84 44 62 58 -4-6.45161-6.45161 1 1 1 52 68.31 36 60 81 21 35 35 0 1 1 58 70.98 35 50 74 24 48 48 1 1 1 64 65.7 35 58 76 1831.0344831.03448 1 1 1 59 59.19 46 48 51 3 6.25 6.25 0 1 1 38 74.72 33 43 68 2558.1395358.13953 1 1 1 44 75.05 36 57 81 2442.1052642.10526 0 1 1 57 62.33 32 62 90 2845.1612945.16129 1 1 1 58 59.44 41 43 73 3069.7674469.76744 0 1 0 64 68.17 41 52 75 2344.2307744.23077 2 1 0 56 73.1 39 55 79 2443.6363643.63636 1 1 1 32 56.17 37 61 85 2439.3442639.34426 0 1 0 56 62.91 42 63 90 2742.8571442.85714 2 1 0 60 58.54 41 59 86 2745.7627145.76271 1 1 0 50 58.49 31 55 79 2443.6363643.63636 1 1 0 52 74.24 40 54 72 1833.3333333.33333 2 1 0 60 64.72 43 60 68 813.3333313.33333 1 1 0 38 65.28 34 63 87 2438.0952438.09524 0 1 1 75 59.56 43 57 75 1831.5789531.57895 3 1 0 62 66.47 28 57 78 2136.8421136.84211 2 1 0 65 59.17 34 51 65 1427.4509827.45098 2 1 0 60 77.44 37 54 77 2342.5925942.59259 0 1 0 27 62.32 38 56 60 47.1428577.142857 0 1 1 60 59.46 40 44 49 511.3636411.36364 0 1 1 37 63.58 34 68 76 811.7647111.76471 1 1 1 59 63.65 32 62 105 4369.3548469.35484 3 1 0 55 60.33 42 59 85 26 44.0678 44.0678 1 1 1 54 66.92 44 51 63 1223.5294123.52941 1 1 1 39 74.04 38 54 84 3055.5555655.55556 0 1 0 44 72.86 37 54 73 1935.1851935.18519 0 1 1 47 69.96 41 60 65 58.3333338.333333 1 1 0 54 62.04 41 62 79 1727.4193527.41935 2 1 1 44 65.99 40 57 70 1322.8070222.80702 0 0 1 46 60 49 46 57 1123.9130423.91304 0 0 0 52 58 61 35.1724145.172414 0 0 0 65 60 34 48 66 18 37.5 37.5 3 0 1 65 65 48 57 71 14 24.5614 24.5614 4 0 1 48 55 44 65 73 812.3076912.30769 1 0 0 53 50 37 54 77 2342.5925942.59259 0 0 1 47 50 31 60 76 1626.6666726.66667 0 0 1 56 59 35 61 69 813.1147513.11475 0 0 0 57 65 31 48 72 24 50 50 0 0 1 59 64 43 43 57 1432.5581432.55814 0 0 1 56 64.19 38 59 72 13 22.0339 22.0339 1 0 1 52 77.97 43 73 74 11.3698631.369863 0 0 1 62 63.83 43 73 65 -8-10.9589-10.9589 2 0 1 47 63.26 27 70 75 57.1428577.142857 0 0 1 66 61.22 41 55 66 11 20 20 1 0 1 58 73.26 41 56 56 0 0 0 3 0 1 58 64.97 38 64 87 23 35.9375 35.9375 0 0 0 60 60.35 42 51 74 2345.0980445.09804 1 0 0 40 75.84 38 53 78 2547.1698147.16981 0 0 1 61 73.88 41 53 80 27 50.9434 50.9434 1 0 1 59 64.03 40 40 68 28 70 70 0 0 1 64 70.41 43 49 64 1530.6122430.61224 2 0 0 62 74.91 40 42 51 921.4285721.42857 2 0 1 64 54.83 41 61 73 1219.6721319.67213 0 0 1 61 59.19 40 64 57 -7-10.9375-10.9375 3 0 0 60 64.7 34 57 63 610.5263210.52632 0 0 1 77 68.87 40 52 62 1019.2307719.23077 5 0 0 63 59.3 34 49 59 1020.4081620.40816 1 0 0 62 60.68 35 53 52 -1-1.88679-1.88679 0 0 0 70 64.68 38 52 62 1019.2307719.23077 1 0 0 57 75 45 56 61 58.9285718.928571 3 0 1 74 69.81 37 57 62 5 8.77193 8.77193 3 0 1 59 69.69 47 69 67 -2-2.89855-2.89855 0 0 1 67 69.49 39 60 71 1118.3333318.33333 2 0 0 55 60.78 40 58 70 1220.6896620.68966 0 0 1 53 64.84 46 54 59 59.2592599.259259 0 0 1 65 60.92 42 45 54 9 20 20 0
Names of X columns:
tak 1, nRF 1, crWiek EF LA - AP średnia EKG po różnica % % 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