[R] regarding 3d Bar Plot
Duncan Murdoch
murdoch at stats.uwo.ca
Wed Apr 25 15:15:56 CEST 2007
On 4/25/2007 7:56 AM, gyadav at ccilindia.co.in 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 <murdoch at stats.uwo.ca>
> 25-04-07 04:42 PM
>
> To
> rolf at math.unb.ca
> cc
> gyadav at ccilindia.co.in, r-help at stat.math.ethz.ch
> Subject
> Re: [R] regarding 3d Bar Plot
>
>
>
>
>
>
> On 4/24/2007 9:38 AM, rolf at math.unb.ca wrote:
>> gyadav at ccilindia.co.in 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.
More information about the R-help
mailing list