R/ordpart.R

Defines functions ordpart.dsvord ordpart

Documented in ordpart ordpart.dsvord

ordpart <- function(ord, ax = 1, ay = 2)
{
    UseMethod("ordpart")
}

ordpart.dsvord <- function(ord,ax=1,ay=2)
{
    set <- 0
    clust <- rep(0,nrow(ord$points))
    while (1) {
        set <- set + 1
        tmp <- locator(type='l',col=set+1)
        if (length(tmp$x) > 0) {
            x <- c(tmp$x,tmp$x[1])
            y <- c(tmp$y,tmp$y[1])
            lines(x,y,col=set+1)
            tmp <- pip(ord$points[,ax],ord$points[,ay],x,y)
            points(ord,as.logical(tmp),ax,ay,col=set+1)
            clust <- pmax(clust,tmp*set)
        } else {
            break
        }
    }
    out <- list()
    out$clustering <- clust
    class(out) <- 'clustering'
    attr(out,'call') <- match.call()
    attr(out,'timestamp') <- date()
    return(out)
}

pip <- function (x,y,polyx,polyy) 
{
    z <- rep(0,length(x))
    res <- .Fortran("pip",
        as.double(x),
        as.double(y),
        as.integer(z),
        as.double(polyx),
        as.double(polyy),
        as.integer(length(x)),
        as.integer(length(polyx)),
        PACKAGE='labdsv')
    return(res[[3]])
}

Try the labdsv package in your browser

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

labdsv documentation built on April 10, 2023, 5:08 p.m.