
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)

        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@stats.uwo.ca> 
25-04-07 04:42 PM

To
rolf@math.unb.ca
cc
gyadav@ccilindia.co.in, r-help@stat.math.ethz.ch
Subject
Re: [R] regarding 3d Bar Plot






On 4/24/2007 9:38 AM, rolf@math.unb.ca wrote:
> gyadav@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 ...{{dropped}}

