Re: [R] issues with gap.plot function

From: Ben Bolker <bolker_at_ufl.edu>
Date: Sat, 26 Jul 2008 18:59:25 +0000 (UTC)

Zheng Lu <zlu <at> umich.edu> writes:

>
>
> Dear all:
>
> I have the following codes:
>
> Xdata<-c(2,3,8,9,10)
> Ydata<-1:5
> gap.plot(Xdata, Ydata,gap=c(5,6),gap.axis="x",type="o")
>
> However, the type='o' seems only work on the first part of gap plot, the
second half of the plot always just
> points, you can not add lines on that part, any help will be highly
appreciated. I would like to have these
> two parts of the plot either both are points or both are lines or both are
overlaid of lines and points. Thank
> you very much.
>
> Zheng

 Xdata<-c(2,3,8,9,10)
Ydata<-1:5
gap.plot(Xdata, Ydata,gap=c(5,6),gap.axis="x",type="o")

  You can fix this problem by changing the function so that every instance of points() has a ... at the end -- for example:

my.gap.plot <-
function (x, y, gap, gap.axis = "y", xticlab, xtics = NA, yticlab,

    ytics = NA, col = rep(par("col"), length(x)), xlim, ylim,     pch = rep(1, length(x)), ...)
{

    if (missing(y) && !missing(x)) {

        y <- x
        x <- 1:length(y)

    }
    if (missing(gap))

        stop("gap must be specified")
    gapsize <- diff(gap)
    if (missing(xtics))

        xtics <- pretty(x)
    if (missing(ytics))

        ytics <- pretty(y)
    if (missing(xticlab))

        xticlab <- xtics
    if (missing(yticlab))

        yticlab <- ytics
    if (length(col) < length(y))

        col <- rep(col, length.out = length(y))     if (gap.axis == "y") {

        littleones <- which(y <= gap[1])
        if (length(gapsize) > 2) {
            middleones <- which(y >= gap[2] & y <= gap[3])
            bigones <- which(y >= gap[4])
            lostones <- sum(c(y > gap[1] & y < gap[2], y > gap[3] &
                y < gap[4]))
            if (missing(ylim))
                ylim <- c(min(y), max(y) - (gapsize[1] + gapsize[3]))
        }
        else {
            middleones <- NA
            bigones <- which(y >= gap[2])
            lostones <- sum(y > gap[1] & y < gap[2])
            if (missing(ylim))
                ylim <- c(min(y), max(y) - gapsize[1])
        }
        if (lostones)
            warning("some values of y will not be displayed")
        if (missing(xlim))
            xlim <- range(x)

    }
    else {
        littleones <- which(x <= gap[1])
        if (length(gapsize) > 2) {
            middleones <- which(x >= gap[2] & x <= gap[3])
            bigones <- which(x >= gap[4])
            lostones <- sum(c(x > gap[1] & x < gap[2], x > gap[3] &
                x < gap[4]))
            if (missing(xlim))
                xlim <- c(min(x), max(x) - (gapsize[1] + gapsize[3]))
        }
        else {
            middleones <- NA
            bigones <- which(x >= gap[2])
            lostones <- sum(x > gap[1] & x < gap[2])
            if (missing(xlim))
                xlim <- c(min(x), max(x) - gapsize[1])
        }
        if (lostones)
            warning("some values of x will not be displayed")
        if (missing(ylim))
            ylim <- range(y)

    }
    if (length(pch) < length(x))

        pch <- rep(pch, length.out = length(x))     plot(x[littleones], y[littleones], xlim = xlim, ylim = ylim,

        axes = FALSE, col = col[littleones], pch = pch[littleones],
        ...)

    box()
    if (gap.axis == "y") {
        if (!is.na(xtics[1]))
            axis(1, at = xtics, labels = xticlab)
        littletics <- which(ytics < gap[1])
        if (length(gapsize) > 2) {
            middletics <- which(ytics >= gap[2] & ytics <= gap[3])
            bigtics <- which(ytics >= gap[4])
            show.at <- c(ytics[littletics], ytics[middletics] -
                gapsize[1], ytics[bigtics] - (gapsize[1] + gapsize[3]))
            show.labels <- c(yticlab[littletics], yticlab[middletics],
                yticlab[bigtics])
        }
        else {
            bigtics <- which(ytics >= gap[2])
            show.at <- c(ytics[littletics], ytics[bigtics] -
                gapsize[1])
            show.labels <- c(ytics[littletics], yticlab[bigtics])
        }
        axis(2, at = show.at, labels = show.labels)
        axis.break(2, gap[1], style = "gap")
        if (length(gapsize) > 2) {
            axis.break(2, gap[3] - gapsize[1], style = "gap")
            points(x[middleones], y[middleones] - gapsize[1],
                col = col[middleones], pch = pch[middleones],...)
            points(x[bigones], y[bigones] - (gapsize[1] + gapsize[3]),
                col = col[bigones], pch = pch[bigones],...)
        }
        else points(x[bigones], y[bigones] - gapsize[1], col = col[bigones],
            pch = pch[bigones],...)

    }
    else {
        if (!is.na(ytics[1]))
            axis(2, at = ytics, labels = yticlab)
        littletics <- which(xtics < gap[1])
        if (length(gapsize) > 2) {
            middletics <- which(xtics >= gap[2] & xtics <= gap[3])
            bigtics <- which(xtics >= gap[4])
            show.at <- c(xtics[littletics], xtics[middletics] -
                gapsize[1], xtics[bigtics] - (gapsize[1] + gapsize[3]))
            show.labels <- c(xticlab[littletics], xticlab[middletics],
                xticlab[bigtics])
        }
        else {
            bigtics <- which(xtics >= gap[2])
            show.at <- c(xtics[littletics], xtics[bigtics] -
                gapsize[1])
            show.labels <- c(xticlab[littletics], xticlab[bigtics])
        }
        axis(1, at = show.at, labels = show.labels)
        axis.break(1, gap[1], style = "gap")
        if (length(gapsize) > 2) {
            axis.break(1, gap[3] - gapsize[1], style = "gap")
            points(x[middleones] - gapsize[1], y[middleones],
                col = col[middleones], pch = pch[middleones],...)
            points(x[bigones] - (gapsize[1] + gapsize[3]), y[bigones],
                col = col[bigones], pch = pch[bigones],...)
        }
        else points(x[bigones] - gapsize[1], y[bigones], col = col[bigones],
            pch = pch[bigones],...)

    }
}

my.gap.plot(Xdata, Ydata,gap=c(5,6),gap.axis="x",type="o")



R-help_at_r-project.org 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. Received on Sat 26 Jul 2008 - 19:08:58 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Sat 26 Jul 2008 - 21:33:00 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.

list of date sections of archive