Wessa.net

Send output to:

Method


# of (top) clusters to display


Horizontal


Triangle


Gender


Population


Year


Variables


Classification of...


Chart options


Title:
Label y-axis:
Label x-axis:

R Code
par9 <- 'variables' par8 <- 'COLLES actuals' par7 <- 'all' par6 <- 'all' par5 <- 'all' par4 <- 'FALSE' par3 <- 'FALSE' par2 <- 'ALL' par1 <- 'ward' x <- as.data.frame(read.table(file='http://www.wessa.net/download/utaut.csv',sep=',',header=T)) x$U25 <- 6-x$U25 if(par5 == 'female') x <- x[x$Gender==0,] if(par5 == 'male') x <- x[x$Gender==1,] if(par6 == 'prep') x <- x[x$Pop==1,] if(par6 == 'bachelor') x <- x[x$Pop==0,] if(par7 != 'all') { x <- x[x$Year==as.numeric(par7),] } cAc <- with(x,cbind( A1, A2, A3, A4, A5, A6, A7, A8, A9,A10)) cAs <- with(x,cbind(A11,A12,A13,A14,A15,A16,A17,A18,A19,A20)) cA <- cbind(cAc,cAs) cCa <- with(x,cbind(C1,C3,C5,C7, C9,C11,C13,C15,C17,C19,C21,C23,C25,C27,C29,C31,C33,C35,C37,C39,C41,C43,C45,C47)) cCp <- with(x,cbind(C2,C4,C6,C8,C10,C12,C14,C16,C18,C20,C22,C24,C26,C28,C30,C32,C34,C36,C38,C40,C42,C44,C46,C48)) cC <- cbind(cCa,cCp) cU <- with(x,cbind(U1,U2,U3,U4,U5,U6,U7,U8,U9,U10,U11,U12,U13,U14,U15,U16,U17,U18,U19,U20,U21,U22,U23,U24,U25,U26,U27,U28,U29,U30,U31,U32,U33)) cE <- with(x,cbind(BC,NNZFG,MRT,AFL,LPM,LPC,W,WPA)) cX <- with(x,cbind(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16,X17,X18)) if (par8=='ATTLES connected') x <- cAc if (par8=='ATTLES separate') x <- cAs if (par8=='ATTLES all') x <- cA if (par8=='COLLES actuals') x <- cCa if (par8=='COLLES preferred') x <- cCp if (par8=='COLLES all') x <- cC if (par8=='CSUQ') x <- cU if (par8=='Learning Activities') x <- cE if (par8=='Exam Items') x <- cX ncol <- length(x[1,]) for (jjj in 1:ncol) { x <- x[!is.na(x[,jjj]),] } par3 <- as.logical(par3) par4 <- as.logical(par4) if (par3 == TRUE){ dum = xlab xlab = ylab ylab = dum } if (par9=='variables') { x <- t(x) } else { ncol <- length(x[1,]) colnames(x) <- 1:ncol } hc <- hclust(dist(x),method=par1) d <- as.dendrogram(hc) str(d) mysub <- paste('Method: ',par1) bitmap(file='test1.png') if (par4 == TRUE){ plot(d,main=main,ylab=ylab,xlab=xlab,horiz=par3, nodePar=list(pch = c(1,NA), cex=0.8, lab.cex = 0.8),type='t',center=T, sub=mysub) } else { plot(d,main=main,ylab=ylab,xlab=xlab,horiz=par3, nodePar=list(pch = c(1,NA), cex=0.8, lab.cex = 0.8), sub=mysub) } dev.off() if (par2 != 'ALL'){ if (par3 == TRUE){ ylab = 'cluster' } else { xlab = 'cluster' } par2 <- as.numeric(par2) memb <- cutree(hc, k = par2) cent <- NULL for(k in 1:par2){ cent <- rbind(cent, colMeans(x[memb == k, , drop = FALSE])) } hc1 <- hclust(dist(cent),method=par1, members = table(memb)) de <- as.dendrogram(hc1) bitmap(file='test2.png') if (par4 == TRUE){ plot(de,main=main,ylab=ylab,xlab=xlab,horiz=par3, nodePar=list(pch = c(1,NA), cex=0.8, lab.cex = 0.8),type='t',center=T, sub=mysub) } else { plot(de,main=main,ylab=ylab,xlab=xlab,horiz=par3, nodePar=list(pch = c(1,NA), cex=0.8, lab.cex = 0.8), sub=mysub) } dev.off() str(de) } load(file='createtable') a<-table.start() a<-table.row.start(a) a<-table.element(a,'Summary of Dendrogram',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Label',header=TRUE) a<-table.element(a,'Height',header=TRUE) a<-table.row.end(a) num <- length(x[,1])-1 for (i in 1:num) { a<-table.row.start(a) a<-table.element(a,hc$labels[i]) a<-table.element(a,hc$height[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable1.tab') if (par2 != 'ALL'){ a<-table.start() a<-table.row.start(a) a<-table.element(a,'Summary of Cut Dendrogram',2,TRUE) a<-table.row.end(a) a<-table.row.start(a) a<-table.element(a,'Label',header=TRUE) a<-table.element(a,'Height',header=TRUE) a<-table.row.end(a) num <- par2-1 for (i in 1:num) { a<-table.row.start(a) a<-table.element(a,i) a<-table.element(a,hc1$height[i]) a<-table.row.end(a) } a<-table.end(a) table.save(a,file='mytable2.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