R/panel.mysymbols.R

Defines functions panel.my.symbols

Documented in panel.my.symbols

panel.my.symbols <- function(x, y, symb, inches=1, polygon = FALSE,
                             ..., symb.plots=FALSE, subscripts, MoreArgs ) {
    if(symb.plots) {
        stop('self plotting symbols (symb.plots=TRUE) is not implemented yet')
    }

    dots <- list(...)
    tmp <- sapply(dots, is.null)
    dots[tmp] <- NULL
    if ( 'type' %in% names(dots) ) dots$type <- 'l'
    tmp.xlen <- length(x)

    if( (length(inches) != 1) && (length(inches) != tmp.xlen) ) {
        inches <- rep(inches[subscripts], length.out=tmp.xlen)
    }

    dots <- lapply(dots, function(x) {
        if( (length(x) != 1) && (length(x) != tmp.xlen) )  {
            x <- rep(x[subscripts], length.out=tmp.xlen)
        }
        x } )

    plotfun <- if( is.function(symb) ) {
        function(x,y,inches,polygon,symb, ...) {
            dots1 <- list(...)
            sargs <- setdiff(names(formals(symb)),'...')
            dots2 <- dots1[sargs]
            dots1[sargs] <- NULL
            symb2 <- xy.coords(do.call(symb,dots2))
            xx <- grid::convertWidth( grid::unit(symb2$x*inches/2, 'inches'),
                                 'native', TRUE )
            yy <- grid::convertHeight( grid::unit(symb2$y*inches/2, 'inches'),
                                 'native', TRUE )
            dots1$x <- x+xx
            dots1$y <- y+yy
            if(polygon) {
                do.call(lattice::lpolygon, dots1)
            } else {
                do.call(lattice::llines, dots1)
            }
        }
    } else {
        function(x,y,inches,polygon,symb, ...) {
            dots <- list(...)
            symb2 <- xy.coords(symb)
            xx <- grid::convertWidth( grid::unit(symb2$x*inches/2, 'inches'),
                                 'native', TRUE )
            yy <- grid::convertHeight( grid::unit(symb2$y*inches/2, 'inches'),
                                 'native', TRUE )
            dots$x <- x+xx
            dots$y <- y+yy
            if(polygon) {
                do.call(lattice::lpolygon, dots)
            } else {
                do.call(lattice::llines, dots)
            }
        }
    }

    funargs <- c(list(x=x, y=y, inches=inches, polygon=polygon),
                 dots)
    funargs$FUN <- plotfun
    if(missing(MoreArgs)) {
        funargs$MoreArgs <- list(symb=symb)
    } else {
        funargs$MoreArgs <- c(MoreArgs, list(symb=symb))
    }

    do.call(mapply, funargs)

    invisible(NULL)

}





### original code
if(FALSE) {

my.df <- data.frame( x=runif(10), y=runif(10) )

xyplot(y~x, my.df, panel=function(x,y,...) {
	xx <- grid::convertX( grid::unit(ms.male[,1]/5, 'inches'), 'native', TRUE )
	yy <- grid::convertY( grid::unit(ms.male[,2]/5, 'inches'), 'native', TRUE )

	xx <- c(xx,NA); yy <- c(yy, NA)

	llines( outer(xx, x, '+'), outer(yy, y, '+') )
	}

)

}

# convert and unit from grid package

Try the TeachingDemos package in your browser

Any scripts or data that you put into this service are public.

TeachingDemos documentation built on May 29, 2024, 5:59 a.m.