1triang.list <- function (object) 2{ 3 stopifnot(inherits(object,"deldir")) 4 io <- object$ind.orig 5 tlist <- prelimtlist(object) 6 if(nrow(tlist)==0) { 7 rslt <- list() 8 attr(rslt,"rw") <- object$rw 9 class(rslt) <- "triang.list" 10 return(rslt) 11 } 12 x <- object$summary[,"x"] 13 y <- object$summary[,"y"] 14 if("z" %in% colnames(object$summary)) { 15 z <- object$summary[,"z"] 16 haveZ <- TRUE 17 } else haveZ <- FALSE 18 xtri <- matrix(x[tlist], nrow(tlist), 3) 19 ytri <- matrix(y[tlist], nrow(tlist), 3) 20 if(haveZ) ztri <- matrix(z[tlist], nrow(tlist), 3) 21 ctri <- ytri - min(y) 22 dx <- cbind(xtri[, 2] - xtri[, 1], xtri[, 3] - xtri[, 2], 23 xtri[, 1] - xtri[, 3]) 24 zm <- cbind(ctri[, 1] + ctri[, 2], ctri[, 2] + ctri[, 3], 25 ctri[, 3] + ctri[, 1]) 26 negareas <- apply(dx * zm, 1, sum) 27 clockwise <- (negareas > 0) 28 if (any(clockwise)) { 29 xc <- xtri[clockwise,,drop=FALSE] 30 yc <- ytri[clockwise,,drop=FALSE] 31 tc <- tlist[clockwise,,drop=FALSE] 32 if(haveZ) zc <- ztri[clockwise,,drop=FALSE] 33 xtri[clockwise, ] <- xc[, c(1, 3, 2)] 34 ytri[clockwise, ] <- yc[, c(1, 3, 2)] 35 tlist[clockwise,] <- tc[, c(1, 3, 2)] 36 if(haveZ) ztri[clockwise, ] <- zc[, c(1, 3, 2)] 37 } 38 rslt <- list() 39 K <- 0 40 for(i in seq(length.out=nrow(xtri))) { 41 tmp <- .Fortran( 42 "intri", 43 x=as.double(xtri[i,]), 44 y=as.double(ytri[i,]), 45 u=as.double(x), 46 v=as.double(y), 47 n=as.integer(length(x)), 48 okay=integer(1), 49 PACKAGE="deldir" 50 ) 51 if(as.logical(tmp$okay)) { 52 tmp <- data.frame(ptNum=io[tlist[i,]],x=xtri[i,],y=ytri[i,]) 53 if(haveZ) tmp <- cbind(tmp,z=ztri[i,]) 54 K <- K+1 55 rslt[[K]] <- tmp 56 } 57 } 58 attr(rslt,"rw") <- object$rw 59 class(rslt) <- "triang.list" 60 rslt 61} 62"[.triang.list" <- function(x,i,...){ 63 y <- unclass(x)[i] 64 class(y) <- "triang.list" 65 attr(y,"rw") <- attr(x,"rw") 66y 67} 68