On 4/25/2007 7:56 AM, [EMAIL PROTECTED] wrote: > Hi Duncan > > I am restating the problem and thanks you for sending me such a good > function histogram in 3d. Thanks for that but i think my problem has been > misinterpreted. I just wanted a simple 3d bar Plot. Although I have not > written anything for R but i will surely like to contribute to R and if i > can assist someone in writing then it would be a great help to me. > > Problem was :-) > > I have data in a two dimensional table. each row of the data adds upto 100 > > ( hence they are percentages ). > it can be interpreted as like this A - I are the matches and P - X are > the players. Thus Player P scored 20% of the runs during this season in > Match C, 60% in Match D and remaining 20% in Match G. > > I want to plot 3-d bar plot, where X axis have players, Y axis have > Matches and Z axis as the percentage(0 - 100%) > Please help me in this regards. (Please note on my X and Y axes Numbers > are not there instead alphabets)
The plot.histogram function I sent does most of what you want. The hist3d function calculates the matrix of counts that it plots, and plot.histogram plots the resulting bar chart. Duncan Murdoch > > A B C D E F G H I > P 0 0 20 60 0 0 20 0 0 > Q 0 16.86747 26.907631 11.646586 0 > 12.449799 0.8032129 0 31.325301 > R 0 59.649123 10.526316 12.280702 0 0 > 1.754386 0 15.789474 > S 3.57909807 20.281556 33.404915 7.31329 0.584586 > 5.965163 1.1930327 0 27.678358 > T 0 0 0 0 0 0 0 0 0 > U 0 9.090909 27.272727 18.181818 0 > 36.363636 0 0 9.090909 > V 0 33.333333 33.333333 0 0 33.333333 > 0 0 0 > W 0 2.188184 1.094092 36.105033 0 > 44.420131 5.2516411 0 10.940919 > X 0.05994234 51.550409 16.304315 6.997668 0 > 17.383277 0.5994234 0.4741439 6.630821 > > > > Thanks in advance > -gaurav > > > > > Duncan Murdoch <[EMAIL PROTECTED]> > 25-04-07 04:42 PM > > To > [EMAIL PROTECTED] > cc > [EMAIL PROTECTED], r-help@stat.math.ethz.ch > Subject > Re: [R] regarding 3d Bar Plot > > > > > > > On 4/24/2007 9:38 AM, [EMAIL PROTECTED] wrote: >> [EMAIL PROTECTED] wrote: >> >>> I have data in a two dimensional table. each row of the data adds >>> upto 100 ( hence they are percentages ). it can be interpreted as >>> like this A - I are the matches and P - X are the players. Thus >>> Player P scored 20% of the runs during this season in Match C, 60% in >>> Match D and remaining 20% in Match G. >>> >>> I want to plot 3-d bar plot, where X axis have players, Y axis have >>> Matches and Z axis as the percentage(0 - 100%) Please help me in this >>> regards. >> <snip> >> >> Many years ago I picked up from the snews mailing list a >> suite of functions for plotting 2D barplots (barplots > with 2D >> bases) written by a chap named Colin Goodall, from (at > that >> time) the University of Bristol and/or from Penn State. >> >> I never actually did anything with this suite until >> recently. Seeing no replies to the enquiry about 3D >> histograms, I thought I'd try to get Goodal's code > running >> in R to see if it might solve guarav's problem. >> >> The trouble is, all the guts of the procedure, > *including* >> the plotting are done from within Fortran. The actual >> plotting seems to be done through a call to a subroutine >> ``segmtz'' which is a piece of Splus software that does > not >> exist in R. >> >> Is there an equivalent subroutine in R that could be > called? >> I dug around a bit but couldn't figure out what was going >> on. The function segments() simply calls >> .Internal(segments(.... >> >> I looked around a bit for corresponding C or Fortran code > but >> obviously didn't know how to look properly. >> >> I think that the Fortran code could be translated into > raw R >> and the call to segmtz changed to a call to segments() > --- >> but this would seem to be a lot of work. >> >> Can anyone suggest a reasonably simple way of replacing > the >> call to segmtz in the Fortran? > > I don't know how to do what you want, but I'd suggest working in R code > rather than Fortran. I did write a hist3d function for the djmrgl > package (based on hist), mostly to show off the graphics, but haven't > found it useful enough to port to rgl. Here's a quick port, not good > enough to use, but maybe it will give you a starting point. > > Duncan Murdoch > > > > > hist3d <- > function (x, y, xbreaks, ybreaks, freq= NULL, probability = !freq, > include.lowest= TRUE, > right= TRUE, > xlim = range(xbreaks), ylim = range(ybreaks), zlim = NULL, > xlab = xname, ylab = yname, zlab, > plot = TRUE, top = TRUE, nclass = NULL, ...) > { > if (!is.numeric(x) | !is.numeric(y)) > stop("`x' and `y' must be numeric") > xname <- deparse(substitute(x)) > yname <- deparse(substitute(y)) > n <- length(x <- x[!is.na(x)]) > use.xbr <- !missing(xbreaks) > if(use.xbr) { > if(!missing(nclass)) > warning("`nclass' not used when `xbreaks' specified") > } > else if(!is.null(nclass) && length(nclass) == 1) > xbreaks <- nclass > use.xbr <- use.xbr && (nB <- length(xbreaks)) > 1 > if(use.xbr) > xbreaks <- sort(xbreaks) > else { # construct vector of breaks > rx <- range(x) > nnb <- > if(missing(xbreaks)) 1 + log2(n) > else { # breaks = `nclass' > if (is.na(xbreaks) | xbreaks < 2) > stop("invalid number of xbreaks") > xbreaks > } > xbreaks <- pretty (rx, n = nnb, min.n=1, eps.corr = 2) > } > nxB <- length(xbreaks) > if(nxB <= 1) ##-- Impossible ! > stop(paste("hist3d: error, xbreaks=",format(xbreaks))) > > storage.mode(x) <- "double" > storage.mode(xbreaks) <- "double" > use.ybr <- !missing(ybreaks) > if(use.ybr) { > if(!missing(nclass)) > warning("`nclass' not used when `ybreaks' specified") > } > else if(!is.null(nclass) && length(nclass) == 1) > ybreaks <- nclass > use.ybr <- use.ybr && (nB <- length(ybreaks)) > 1 > if(use.ybr) > ybreaks <- sort(ybreaks) > else { # construct vector of breaks > ry <- range(y) > nnb <- > if(missing(ybreaks)) 1 + log2(n) > else { # breaks = `nclass' > if (is.na(ybreaks) | ybreaks < 2) > stop("invalid number of ybreaks") > ybreaks > } > ybreaks <- pretty (ry, n = nnb, min.n=1, eps.corr = 2) > } > nyB <- length(ybreaks) > if(nyB <= 1) ##-- Impossible ! > stop(paste("hist3d: error, ybreaks=",format(ybreaks))) > > storage.mode(y) <- "double" > storage.mode(ybreaks) <- "double" > counts <- table(cut(x,xbreaks),cut(y,ybreaks)) > if (sum(counts) < n) > stop("some data not counted; maybe breaks do not span range of > data") > xh <- diff(xbreaks) > if (!use.xbr && any(xh <= 0)) > stop("not strictly increasing `xbreaks'.") > yh <- diff(ybreaks) > if (!use.ybr && any(yh <= 0)) > stop("not strictly increasing `ybreaks'.") > if (is.null(freq)) { > freq <- if(!missing(probability)) > !as.logical(probability) > else if(use.xbr | use.ybr) { > ##-- Do frequencies if breaks are evenly spaced > (max(xh)-min(xh) < 1e-7 * mean(xh)) & (max(yh)-min(yh) < 1e-7 > * mean(yh)) > } else TRUE > } else if(!missing(probability) && any(probability == freq)) > stop("`probability' is an alias for `!freq', however they > differ.") > density <- counts/(n*outer(xh,yh)) > xmids <- 0.5 * (xbreaks[-1] + xbreaks[-nxB]) > ymids <- 0.5 * (ybreaks[-1] + ybreaks[-nyB]) > equidist <- (!use.xbr & !use.ybr) || (diff(range(xh)) < 1e-7 * > mean(yh)) & (diff(range(yh)) < 1e-7 * mean(yh)) > r <- structure(list(xbreaks = xbreaks, ybreaks = ybreaks, counts = > counts, > intensities = density, > density = density, xmids = xmids, ymids = ymids, > xname = xname, yname = yname, equidist = > equidist), > class="histogram3d") > if (plot) { > plot(r, freq = freq, > xlim = xlim, ylim = ylim, zlim = zlim, xlab = xlab, ylab = > ylab, zlab = zlab, > top = top, ...) > invisible(r) > } > else r > } > > plot.histogram3d <- > function (x, freq = equidist, col = 'gray', rgb = col, > main = paste("Histogram of", x$xname, "and", x$yname), > xlim = range(x$xbreaks), ylim = range(x$ybreaks), zlim = > NULL, > xlab = x$xname, ylab = x$yname, zlab, > axes = TRUE, box = TRUE, add = FALSE, > top = TRUE, ...) > { > if (!add) clear3d() > save <- par3d(skipRedraw = TRUE, ...) > on.exit(par3d(save)) > > equidist <- x$equidist > if(freq && !equidist) > warning("the AREAS in the plot are wrong -- rather use > `freq=FALSE'!") > > z <- if (freq) x$counts else x$density > nxB <- length(x$xbreaks) > nyB <- length(x$ybreaks) > > if(is.null(z) || 0 == nxB || 0 == nyB) stop("`x' is wrongly > structured") > > rgb <- matrix(rgb,nxB-1,nyB-1) > for (i in 1:(nyB-1)) { > keep <- z[,i] > 0 > quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-1], > x$xbreaks[-1], x$xbreaks[-nxB])[keep,])), > > as.double(t(cbind(rep(x$ybreaks[i],nxB-1),rep(x$ybreaks[i],nxB-1),rep(x$ybreaks[i+1],nxB-1),rep(x$ybreaks[i+1],nxB-1))[keep,])), > as.double(t(cbind(z[,i],z[,i],z[,i],z[,i])[keep,])), > col = t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,])) > quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-1], > x$xbreaks[-1], x$xbreaks[-nxB])[keep,])), > as.double(rep(rep(x$ybreaks[i],(nxB-1))[keep],4)), > as.double(t(cbind(rep(0,nxB-1), rep(0,nxB-1), z[,i], > z[,i])[keep,])), > col = > t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,])) > quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-1], > x$xbreaks[-1], x$xbreaks[-nxB])[keep,])), > as.double(rep(rep(x$ybreaks[i+1],(nxB-1))[keep],4)), > as.double(t(cbind(rep(0,nxB-1), rep(0,nxB-1), z[,i], > z[,i])[keep,])), > col = > t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,])) > quads3d(as.double(t(cbind(x$xbreaks[-nxB], x$xbreaks[-nxB], > x$xbreaks[-nxB], x$xbreaks[-nxB])[keep,])), > > as.double(t(cbind(rep(x$ybreaks[i],nxB-1),rep(x$ybreaks[i+1],nxB-1),rep(x$ybreaks[i+1],nxB-1),rep(x$ybreaks[i],nxB-1))[keep,])), > as.double(t(cbind(rep(0,nxB-1), rep(0,nxB-1), z[,i], > z[,i])[keep,])), > col = t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,])) > quads3d(as.double(t(cbind(x$xbreaks[-1], x$xbreaks[-1], > x$xbreaks[-1], x$xbreaks[-1])[keep,])), > > as.double(t(cbind(rep(x$ybreaks[i],nxB-1),rep(x$ybreaks[i+1],nxB-1),rep(x$ybreaks[i+1],nxB-1),rep(x$ybreaks[i],nxB-1))[keep,])), > as.double(t(cbind(rep(0,nxB-1), rep(0,nxB-1), z[,i], > z[,i])[keep,])), > col = > t(cbind(rgb[,i],rgb[,i],rgb[,i],rgb[,i])[keep,])) > } > if(!add) { > if(is.null(zlim)) > zlim <- range(z, 0) > if (missing(zlab)) > zlab <- if (!freq) "Density" else "Frequency" > title3d(main = main, xlab = xlab, ylab = ylab, zlab = zlab) > if(axes) { > axes3d() > } > if(box) { > box3d() > } > } > if (top) rgl.bringtotop() > invisible() > } > > > ============================================================================================ > DISCLAIMER AND CONFIDENTIALITY CAUTION: > > This message and any attachments with it (the "message") are confidential and > intended > solely for the addressees. Unauthorized reading, copying, dissemination, > distribution or > disclosure either whole or partial, is prohibited. If you receive this > message in error, > please delete it and immediately notify the sender. Communicating through > email is not > secure and capable of interception, corruption and delays. Anyone > communicating with The > Clearing Corporation of India Limited (CCIL) by email accepts the risks > involved and their > consequences. The internet can not guarantee the integrity of this message. > CCIL shall > (will) not therefore be liable for the message if modified. The recipient > should check this > email and any attachments for the presence of viruses. CCIL accepts no > liability for any > damage caused by any virus transmitted by this email. ______________________________________________ R-help@stat.math.ethz.ch mailing list https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code.