2013-03-01 25 views
5

Sto utilizzando il pacchetto rgl per creare grafici 3D dei miei dati. Per alcuni motivi (biplani 3D PCA) ho bisogno di vettori - un segmento di linea con una freccia. E io sono bloccato, perché voglio avere coni 3D come teste di freccia.Come si disegna una freccia 3D in R?

In qualche modo, non posso avvolgere la mia mente senile sulla geometria del problema. Dico, voglio disegnare il vettore con

segments3d(rbind(c(0, 0, 0), c(3, 3, 3))) 

cioè un vettore dall'origine del sistema di coordinate utente di [3,3,3].

Mi piacerebbe creare un cono con la punta in [3,3,3]. La base del cono può essere formata con un cerchio. Disegnare un cerchio sul piano xz (perpendicolare al piano y) di raggio r è facile:

n <- 10 
sin.t <- sin(seq(0, 2 * pi, len= n)) 
cos.t <- cos(seq(0, 2 * pi, len= n)) 
r <- 0.1 
xv <- x + r * sin.t 
yv <- rep(y, n) 
zv <- z + r * cos.t 

ma come faccio ora trasformare questi punti tali che il cerchio è ora perpendicolare al vettore? E il suo centro 0.2 dalla punta lungo la direzione dei vettori? Una volta ottenuta questa trasformazione, disegnerò triangoli con la funzione triangles3d, ogni triangolo con un angolo sulla punta e due vertici all'interno dei punti del cerchio.

Questa è matematica di base, e so che a 18 anni non avrei alcun problema (o nemmeno un 28enne). Sarebbe gradito qualsiasi gancio (al contrario del pesce).

risposta

7

Nelle demo per rgl c'è una funzione cone3d. Prende la base e la punta separatamente. In ogni caso si potrebbe fare qualcosa di simile:

vec=rbind(c(0, 0, 0), c(3, 3, 3)) 
segments3d(vec) 


cone3d(base=vec[2,]-(vec[1,]+vec[2,]/6), 
    #this makes the head go 1/6th the length of the arrow 
     rad=0.5, 
     tip=vec[2,], 
     col="blue", 
     front="lines", 
     back="lines") 

Ecco la funzione cone3d:

cone3d <- function(base=c(0,0,0),tip=c(0,0,1),rad=1,n=30,draw.base=TRUE,qmesh=FALSE, 
        trans = par3d("userMatrix"), ...) { 
    ax <- tip-base 
    if (missing(trans) && !rgl.cur()) trans <- diag(4) 
    ### is there a better way? 
    if (ax[1]!=0) { 
    p1 <- c(-ax[2]/ax[1],1,0) 
    p1 <- p1/sqrt(sum(p1^2)) 
    if (p1[1]!=0) { 
     p2 <- c(-p1[2]/p1[1],1,0) 
     p2[3] <- -sum(p2*ax) 
     p2 <- p2/sqrt(sum(p2^2)) 
    } else { 
     p2 <- c(0,0,1) 
    } 
    } else if (ax[2]!=0) { 
    p1 <- c(0,-ax[3]/ax[2],1) 
    p1 <- p1/sqrt(sum(p1^2)) 
    if (p1[1]!=0) { 
     p2 <- c(0,-p1[3]/p1[2],1) 
     p2[3] <- -sum(p2*ax) 
     p2 <- p2/sqrt(sum(p2^2)) 
    } else { 
     p2 <- c(1,0,0) 
    } 
    } else { 
    p1 <- c(0,1,0); p2 <- c(1,0,0) 
    } 
    degvec <- seq(0,2*pi,length=n+1)[-1] 
    ecoord2 <- function(theta) { 
    base+rad*(cos(theta)*p1+sin(theta)*p2) 
    } 
    i <- rbind(1:n,c(2:n,1),rep(n+1,n)) 
    v <- cbind(sapply(degvec,ecoord2),tip) 
    if (qmesh) 
    ## minor kluge for quads -- draw tip twice 
    i <- rbind(i,rep(n+1,n)) 
    if (draw.base) { 
    v <- cbind(v,base) 
    i.x <- rbind(c(2:n,1),1:n,rep(n+2,n)) 
    if (qmesh) ## add base twice 
     i.x <- rbind(i.x,rep(n+2,n)) 
    i <- cbind(i,i.x) 
    } 
    if (qmesh) v <- rbind(v,rep(1,ncol(v))) ## homogeneous 
    if (!qmesh) 
    triangles3d(v[1,i],v[2,i],v[3,i],...) 
    else 
    return(rotate3d(qmesh3d(v,i,material=...), matrix=trans)) 
}  
Problemi correlati