1. 首頁
  2. 問答
  3. 矢量間的繪圖角

矢量間的繪圖角

2015-08-08 303 views
9

我現在正在尋找相當長一段時間來繪製兩個箭頭/線段之間的角度函數。例如： -矢量間的繪圖角

http://www.matrix44.net/cms/wp-content/uploads/2011/03/vector_dot_product.png

可以這樣很容易做到或做我必須找到一個半徑段的功能？我很驚訝我還沒有找到任何東西，因爲R通常都有一攬子計劃。

來源

2015-08-08 pthesling

+1

你是指「繪製角度」是什麼意思？你的意思是計算一個數值，或者圖形？你能舉出一個具體/可重複的例子嗎？ （如果你想要一張圖片並且不知道如何使用R來繪製它，你可以在線鏈接到一個相似的圖像或者繪製一張圖片併發布它的照片......） –

+0

我是新來的網站，比如我無法發佈圖片。但鏈接似乎工作：[鏈接]（http://www.matrix44.net/cms/wp-content/uploads/2011/03/vector_dot_product.png）。我正在談論阿爾法旁邊的這一段圓圈。 – pthesling

+2

查看'plotrix'包中的'draw.arc'。或'grid'包中的'grid.curve' – hrbrmstr

回答

6

plot

## helper variables and functions 
tau <- pi*2; 

circles <- function(x,y,r,fg,bg,lty,lwd,n.angle=2000,n.bg=2000,...) { 
    comb <- cbind(x,y,r); 
    angles <- seq(0,tau,len=n.angle); 
    if (!missing(fg) && !is.null(fg)) fg <- rep(fg,len=nrow(comb)); 
    if (!missing(bg) && !is.null(bg)) bg <- rep(bg,len=nrow(comb)); 
    if (!missing(lty) && !is.null(lty)) lty <- rep(lty,len=nrow(comb)); 
    if (!missing(lwd) && !is.null(lwd)) lwd <- rep(lwd,len=nrow(comb)); 
    for (i in seq_len(nrow(comb))) { 
     xc <- comb[i,'x']; 
     yc <- comb[i,'y']; 
     rc <- comb[i,'r']; 
     xs <- xc+rc*cos(angles); 
     ys <- yc+rc*sin(angles); 
     ## optional bg 
     if (!missing(bg) && !is.null(bg)) { 
      bgc <- bg[i]; 
      rs.bg <- seq(r,-r,len=n.bg); 
      xs.bg <- sqrt(rc^2 - rs.bg^2); 
      ys.bg <- yc+rs.bg; 
      segments(xc-xs.bg,ys.bg,xc+xs.bg,col=bgc,lty=1,lwd=1); 
     }; ## end if 
     args <- list(xs,ys); 
     if (!missing(fg)) if (is.null(fg)) args['col'] <- list(NULL) else args$col <- fg[i]; 
     if (!missing(lty)) if (is.null(lty)) args['lty'] <- list(NULL) else args$lty <- lty[i]; 
     if (!missing(lwd)) if (is.null(lwd)) args['lwd'] <- list(NULL) else args$lwd <- lwd[i]; 
     do.call(lines,c(args,...)); 
    }; ## end for 
}; ## end circles() 

radials <- function(x,y,a,r,...) { 
    comb <- cbind(x,y,a,r); 
    segments(comb[,'x'],comb[,'y'],comb[,'x']+comb[,'r']*cos(comb[,'a']),comb[,'y']+comb[,'r']*sin(comb[,'a']),...); 
}; ## end radials() 

circle.segments <- function(x,y,r,a1,a2,fg,bg,lty,lwd,n.angle=2000,fg.chord,fg.arc,...) { 
    comb <- cbind(x,y,r,a1,a2); 
    if (!missing(fg) && !is.null(fg)) fg <- rep(fg,len=nrow(comb)); 
    if (!missing(fg.chord) && !is.null(fg.chord)) fg.chord <- rep(fg.chord,len=nrow(comb)) else if (missing(fg.chord) && !missing(fg)) fg.chord <- fg; 
    if (!missing(fg.arc) && !is.null(fg.arc)) fg.arc <- rep(fg.arc,len=nrow(comb)) else if (missing(fg.arc) && !missing(fg)) fg.arc <- fg; 
    if (!missing(bg) && !is.null(bg)) bg <- rep(bg,len=nrow(comb)); 
    if (!missing(lty) && !is.null(lty)) lty <- rep(lty,len=nrow(comb)); 
    if (!missing(lwd) && !is.null(lwd)) lwd <- rep(lwd,len=nrow(comb)); 
    for (i in seq_len(nrow(comb))) { 
     xc <- comb[i,'x']; 
     yc <- comb[i,'y']; 
     rc <- comb[i,'r']; 
     a1c <- comb[i,'a1']; 
     a2c <- comb[i,'a2']; 
     angles <- seq(a1c,a2c,len=n.angle); 
     tan.angles <- tan(angles); 
     xs <- xc+rc*cos(angles); 
     ys <- yc+rc*sin(angles); 
     x1 <- xs[1]; 
     y1 <- ys[1]; 
     x2 <- xs[length(xs)]; 
     y2 <- ys[length(ys)]; 
     ## optional bg 
     if (!missing(bg) && !is.null(bg)) { 
      bgc <- bg[i]; 
      xs.chord <- seq(x1,x2,len=n.angle); 
      ys.chord <- seq(y1,y2,len=n.angle); 
      segments(xs.chord,ys.chord,xs,ys,col=bg,lty=1,lwd=1); 
     }; ## end if 
     ## chord segment 
     args <- list(x1,y1,x2,y2); 
     if (!missing(fg.chord)) if (is.null(fg.chord)) args['col'] <- list(NULL) else args$col <- fg.chord[i]; 
     if (!missing(lty)) if (is.null(lty)) args['lty'] <- list(NULL) else args$lty <- lty[i]; 
     if (!missing(lwd)) if (is.null(lwd)) args['lwd'] <- list(NULL) else args$lwd <- lwd[i]; 
     do.call(segments,c(args,...)); 
     ## arc segment 
     args <- list(xs,ys); 
     if (!missing(fg.arc)) if (is.null(fg.arc)) args['col'] <- list(NULL) else args$col <- fg.arc[i]; 
     if (!missing(lty)) if (is.null(lty)) args['lty'] <- list(NULL) else args$lty <- lty[i]; 
     if (!missing(lwd)) if (is.null(lwd)) args['lwd'] <- list(NULL) else args$lwd <- lwd[i]; 
     do.call(lines,c(args,...)); 
    }; ## end for 
}; ## end circle.segments() 

circle.sectors <- function(x,y,r,a1,a2,fg,bg,lty,lwd,n.angle=2000,fg.a1,fg.a2,fg.arc,...) { 
    comb <- cbind(x,y,r,a1,a2); 
    if (!missing(fg) && !is.null(fg)) fg <- rep(fg,len=nrow(comb)); 
    if (!missing(fg.a1) && !is.null(fg.a1)) fg.a1 <- rep(fg.a1,len=nrow(comb)) else if (missing(fg.a1) && !missing(fg)) fg.a1 <- fg; 
    if (!missing(fg.a2) && !is.null(fg.a2)) fg.a2 <- rep(fg.a2,len=nrow(comb)) else if (missing(fg.a2) && !missing(fg)) fg.a2 <- fg; 
    if (!missing(fg.arc) && !is.null(fg.arc)) fg.arc <- rep(fg.arc,len=nrow(comb)) else if (missing(fg.arc) && !missing(fg)) fg.arc <- fg; 
    if (!missing(bg) && !is.null(bg)) bg <- rep(bg,len=nrow(comb)); 
    if (!missing(lty) && !is.null(lty)) lty <- rep(lty,len=nrow(comb)); 
    if (!missing(lwd) && !is.null(lwd)) lwd <- rep(lwd,len=nrow(comb)); 
    for (i in seq_len(nrow(comb))) { 
     xc <- comb[i,'x']; 
     yc <- comb[i,'y']; 
     rc <- comb[i,'r']; 
     a1c <- comb[i,'a1']; 
     a2c <- comb[i,'a2']; 
     angles <- seq(a1c,a2c,len=n.angle); 
     xs <- xc+rc*cos(angles); 
     ys <- yc+rc*sin(angles); 
     ## optional bg 
     if (!missing(bg) && !is.null(bg)) { 
      bgc <- bg[i]; 
      segments(xc,yc,xs,ys,col=bgc,lty=1,lwd=1); 
     }; ## end if 
     ## a1 segment 
     args <- list(xc,yc,xs[1],ys[1]); 
     if (!missing(fg.a1)) if (is.null(fg.a1)) args['col'] <- list(NULL) else args$col <- fg.a1[i]; 
     if (!missing(lty)) if (is.null(lty)) args['lty'] <- list(NULL) else args$lty <- lty[i]; 
     if (!missing(lwd)) if (is.null(lwd)) args['lwd'] <- list(NULL) else args$lwd <- lwd[i]; 
     do.call(segments,c(args,...)); 
     ## a2 segment 
     args <- list(xc,yc,xs[length(xs)],ys[length(ys)]); 
     if (!missing(fg.a2)) if (is.null(fg.a2)) args['col'] <- list(NULL) else args$col <- fg.a2[i]; 
     if (!missing(lty)) if (is.null(lty)) args['lty'] <- list(NULL) else args$lty <- lty[i]; 
     if (!missing(lwd)) if (is.null(lwd)) args['lwd'] <- list(NULL) else args$lwd <- lwd[i]; 
     do.call(segments,c(args,...)); 
     ## arc segment 
     args <- list(xs,ys); 
     if (!missing(fg.arc)) if (is.null(fg.arc)) args['col'] <- list(NULL) else args$col <- fg.arc[i]; 
     if (!missing(lty)) if (is.null(lty)) args['lty'] <- list(NULL) else args$lty <- lty[i]; 
     if (!missing(lwd)) if (is.null(lwd)) args['lwd'] <- list(NULL) else args$lwd <- lwd[i]; 
     do.call(lines,c(args,...)); 
    }; ## end for 
}; ## end circle.sectors() 

intersect.lines <- function(a1x,a1y,a2x,a2y,b1x,b1y,b2x,b2y) { 
    comb <- cbind(a1x,b1x,a2x,b2x,a1y,b1y,a2y,b2y); 
    comb <- array(comb,c(nrow(comb),2,2,2),dimnames=list(NULL,c('a','b'),NULL,c('x','y'))); 
    any.points <- any(comb[,'a',1,'x'] == comb[,'a',2,'x'] & comb[,'a',1,'y'] == comb[,'a',2,'y']) || any(comb[,'b',1,'x'] == comb[,'b',2,'x'] & comb[,'b',1,'y'] == comb[,'b',2,'y']); 
    any.points[is.na(any.points)] <- F; 
    if (any.points) stop('coincident 1 and 2 points.'); 
    m.a <- (comb[,'a',2,'y'] - comb[,'a',1,'y'])/(comb[,'a',2,'x'] - comb[,'a',1,'x']); 
    m.b <- (comb[,'b',2,'y'] - comb[,'b',1,'y'])/(comb[,'b',2,'x'] - comb[,'b',1,'x']); 
    b.a <- comb[,'a',1,'y'] - m.a*comb[,'a',1,'x']; 
    b.b <- comb[,'b',1,'y'] - m.b*comb[,'b',1,'x']; 
    a.inf <- is.infinite(m.a); 
    b.inf <- is.infinite(m.b); 
    parallel <- ifelse(a.inf,ifelse(b.inf,T,F),ifelse(b.inf,F,m.a == m.b)); 
    x1equal <- comb[,'a',1,'x'] == comb[,'b',1,'x']; 
    coincident <- ifelse(a.inf,ifelse(b.inf,x1equal,F),ifelse(b.inf,F,parallel & b.a == b.b)); 
    xi <- ifelse(coincident,Inf,ifelse(parallel,NaN,ifelse(a.inf,comb[,'a',1,'x'],ifelse(b.inf,comb[,'b',1,'x'],(b.b - b.a)/(m.a - m.b))))); 
    yi <- ifelse(coincident,Inf,ifelse(parallel,NaN,ifelse(a.inf,m.b*comb[,'a',1,'x'] + b.b,ifelse(b.inf,m.a*comb[,'b',1,'x'] + b.a,m.a*xi + b.a)))); 
    xi[is.na(yi) & !is.nan(yi)] <- NA; 
    yi[is.na(xi) & !is.nan(xi)] <- NA; 
    cbind(x=xi,y=yi); 
}; 

arrows.filled <- function(
    x1,y1,x2=x1,y2=y1,a=tau/32,al=a,ar=a,len=sqrt(diff(par('usr')[3:4])^2+diff(par('usr')[1:2])^2)/20,lenl=len,lenr=len,fg,bg,bgl,bgr,lty,lwd, 
    fg.mainline,lty.mainline,lwd.mainline, 
    fg.tipline,lty.tipline,lwd.tipline, 
    fg.lwing,lty.lwing,lwd.lwing, 
    fg.rwing,lty.rwing,lwd.rwing, 
    fg.lcross,lty.lcross,lwd.lcross, 
    fg.rcross,lty.rcross,lwd.rcross, 
    ... 
) { 
    comb <- cbind(x1,y1,x2,y2,al,ar,lenl,lenr); 
    if (!missing(fg) && !is.null(fg)) fg <- rep(fg,len=nrow(comb)); 
    if (!missing(lty) && !is.null(lty)) lty <- rep(lty,len=nrow(comb)); 
    if (!missing(lwd) && !is.null(lwd)) lwd <- rep(lwd,len=nrow(comb)); 
    if (!missing(fg.mainline) && !is.null(fg.mainline)) fg.mainline <- rep(fg.mainline,len=nrow(comb)) else if (missing(fg.mainline) && !missing(fg)) fg.mainline <- fg; 
    if (!missing(fg.tipline) && !is.null(fg.tipline)) fg.tipline <- rep(fg.tipline,len=nrow(comb)) else if (missing(fg.tipline) && !missing(fg)) fg.tipline <- fg; 
    if (!missing(fg.lwing) && !is.null(fg.lwing)) fg.lwing <- rep(fg.lwing,len=nrow(comb)) else if (missing(fg.lwing) && !missing(fg)) fg.lwing <- fg; 
    if (!missing(fg.rwing) && !is.null(fg.rwing)) fg.rwing <- rep(fg.rwing,len=nrow(comb)) else if (missing(fg.rwing) && !missing(fg)) fg.rwing <- fg; 
    if (!missing(fg.lcross) && !is.null(fg.lcross)) fg.lcross <- rep(fg.lcross,len=nrow(comb)) else if (missing(fg.lcross) && !missing(fg)) fg.lcross <- fg; 
    if (!missing(fg.rcross) && !is.null(fg.rcross)) fg.rcross <- rep(fg.rcross,len=nrow(comb)) else if (missing(fg.rcross) && !missing(fg)) fg.rcross <- fg; 
    if (!missing(lty.mainline) && !is.null(lty.mainline)) lty.mainline <- rep(lty.mainline,len=nrow(comb)) else if (missing(lty.mainline) && !missing(lty)) lty.mainline <- lty; 
    if (!missing(lty.tipline) && !is.null(lty.tipline)) lty.tipline <- rep(lty.tipline,len=nrow(comb)) else if (missing(lty.tipline) && !missing(lty)) lty.tipline <- lty; 
    if (!missing(lty.lwing) && !is.null(lty.lwing)) lty.lwing <- rep(lty.lwing,len=nrow(comb)) else if (missing(lty.lwing) && !missing(lty)) lty.lwing <- lty; 
    if (!missing(lty.rwing) && !is.null(lty.rwing)) lty.rwing <- rep(lty.rwing,len=nrow(comb)) else if (missing(lty.rwing) && !missing(lty)) lty.rwing <- lty; 
    if (!missing(lty.lcross) && !is.null(lty.lcross)) lty.lcross <- rep(lty.lcross,len=nrow(comb)) else if (missing(lty.lcross) && !missing(lty)) lty.lcross <- lty; 
    if (!missing(lty.rcross) && !is.null(lty.rcross)) lty.rcross <- rep(lty.rcross,len=nrow(comb)) else if (missing(lty.rcross) && !missing(lty)) lty.rcross <- lty; 
    if (!missing(lwd.mainline) && !is.null(lwd.mainline)) lwd.mainline <- rep(lwd.mainline,len=nrow(comb)) else if (missing(lwd.mainline) && !missing(lwd)) lwd.mainline <- lwd; 
    if (!missing(lwd.tipline) && !is.null(lwd.tipline)) lwd.tipline <- rep(lwd.tipline,len=nrow(comb)) else if (missing(lwd.tipline) && !missing(lwd)) lwd.tipline <- lwd; 
    if (!missing(lwd.lwing) && !is.null(lwd.lwing)) lwd.lwing <- rep(lwd.lwing,len=nrow(comb)) else if (missing(lwd.lwing) && !missing(lwd)) lwd.lwing <- lwd; 
    if (!missing(lwd.rwing) && !is.null(lwd.rwing)) lwd.rwing <- rep(lwd.rwing,len=nrow(comb)) else if (missing(lwd.rwing) && !missing(lwd)) lwd.rwing <- lwd; 
    if (!missing(lwd.lcross) && !is.null(lwd.lcross)) lwd.lcross <- rep(lwd.lcross,len=nrow(comb)) else if (missing(lwd.lcross) && !missing(lwd)) lwd.lcross <- lwd; 
    if (!missing(lwd.rcross) && !is.null(lwd.rcross)) lwd.rcross <- rep(lwd.rcross,len=nrow(comb)) else if (missing(lwd.rcross) && !missing(lwd)) lwd.rcross <- lwd; 
    if (!missing(bg) && !is.null(bg)) bg <- rep(bg,len=nrow(comb)); 
    if (!missing(bgl) && !is.null(bgl)) bgl <- rep(bgl,len=nrow(comb)) else if (missing(bgl) && !missing(bg)) bgl <- bg; 
    if (!missing(bgr) && !is.null(bgr)) bgr <- rep(bgr,len=nrow(comb)) else if (missing(bgr) && !missing(bg)) bgr <- bg; 
    for (i in seq_len(nrow(comb))) { 
     x1c <- comb[i,'x1']; 
     y1c <- comb[i,'y1']; 
     x2c <- comb[i,'x2']; 
     y2c <- comb[i,'y2']; 
     alc <- comb[i,'al']; 
     arc <- comb[i,'ar']; 
     if (alc <= 0 || alc >= tau/2) stop(paste0('arrow ',i,' has invalid left angle ',alc,'.')); 
     if (arc <= 0 || arc >= tau/2) stop(paste0('arrow ',i,' has invalid right angle ',alc,'.')); 
     lenlc <- comb[i,'lenl']; 
     lenrc <- comb[i,'lenr']; 
     beta <- atan2(y2c-y1c,x2c-x1c); 
     xl <- x2c - lenlc*cos(beta - alc); 
     yl <- y2c - lenlc*sin(beta - alc); 
     xr <- x2c - lenrc*sin(tau/4 - beta - arc); 
     yr <- y2c - lenrc*cos(tau/4 - beta - arc); 
     with(as.data.frame(intersect.lines(x1c,y1c,x2c,y2c,xl,yl,xr,yr)),{ e <- parent.env(environment()); e$xi <- x; e$yi <- y; }); 
     ## mainline 
     args <- list(x1c,y1c,xi,yi); 
     if (!missing(fg.mainline)) if (is.null(fg.mainline)) args['col'] <- list(NULL) else args$col <- fg.mainline[i]; 
     if (!missing(lty.mainline)) if (is.null(lty.mainline)) args['lty'] <- list(NULL) else args$lty <- lty.mainline[i]; 
     if (!missing(lwd.mainline)) if (is.null(lwd.mainline)) args['lwd'] <- list(NULL) else args$lwd <- lwd.mainline[i]; 
     do.call(segments,c(args,...)); 
     ## bg left 
     if (!missing(bgl) && !is.null(bgl)) { 
      bglc <- bgl[i]; 
      polygon(c(x2c,xl,xi),c(y2c,yl,yi),border=NA,col=bglc); 
     }; ## end if 
     ## bg right 
     if (!missing(bgr) && !is.null(bgr)) { 
      bgrc <- bgr[i]; 
      polygon(c(x2c,xr,xi),c(y2c,yr,yi),border=NA,col=bgrc); 
     }; ## end if 
     ## tipline -- only draw if at least one tipline arg was given 
     if (!missing(fg.tipline) || !missing(lty.tipline) || !missing(lwd.tipline)) { 
      args <- list(xi,yi,x2c,y2c); 
      if (!missing(fg.tipline)) if (is.null(fg.tipline)) args['col'] <- list(NULL) else args$col <- fg.tipline[i]; 
      if (!missing(lty.tipline)) if (is.null(lty.tipline)) args['lty'] <- list(NULL) else args$lty <- lty.tipline[i]; 
      if (!missing(lwd.tipline)) if (is.null(lwd.tipline)) args['lwd'] <- list(NULL) else args$lwd <- lwd.tipline[i]; 
      do.call(segments,c(args,...)); 
     }; ## end if 
     ## lwing 
     args <- list(x2c,y2c,xl,yl); 
     if (!missing(fg.lwing)) if (is.null(fg.lwing)) args['col'] <- list(NULL) else args$col <- fg.lwing[i]; 
     if (!missing(lty.lwing)) if (is.null(lty.lwing)) args['lty'] <- list(NULL) else args$lty <- lty.lwing[i]; 
     if (!missing(lwd.lwing)) if (is.null(lwd.lwing)) args['lwd'] <- list(NULL) else args$lwd <- lwd.lwing[i]; 
     do.call(segments,c(args,...)); 
     ## rwing 
     args <- list(x2c,y2c,xr,yr); 
     if (!missing(fg.rwing)) if (is.null(fg.rwing)) args['col'] <- list(NULL) else args$col <- fg.rwing[i]; 
     if (!missing(lty.rwing)) if (is.null(lty.rwing)) args['lty'] <- list(NULL) else args$lty <- lty.rwing[i]; 
     if (!missing(lwd.rwing)) if (is.null(lwd.rwing)) args['lwd'] <- list(NULL) else args$lwd <- lwd.rwing[i]; 
     do.call(segments,c(args,...)); 
     ## lcross 
     args <- list(xl,yl,xi,yi); 
     if (!missing(fg.lcross)) if (is.null(fg.lcross)) args['col'] <- list(NULL) else args$col <- fg.lcross[i]; 
     if (!missing(lty.lcross)) if (is.null(lty.lcross)) args['lty'] <- list(NULL) else args$lty <- lty.lcross[i]; 
     if (!missing(lwd.lcross)) if (is.null(lwd.lcross)) args['lwd'] <- list(NULL) else args$lwd <- lwd.lcross[i]; 
     do.call(segments,c(args,...)); 
     ## rcross 
     args <- list(xr,yr,xi,yi); 
     if (!missing(fg.rcross)) if (is.null(fg.rcross)) args['col'] <- list(NULL) else args$col <- fg.rcross[i]; 
     if (!missing(lty.rcross)) if (is.null(lty.rcross)) args['lty'] <- list(NULL) else args$lty <- lty.rcross[i]; 
     if (!missing(lwd.rcross)) if (is.null(lwd.rcross)) args['lwd'] <- list(NULL) else args$lwd <- lwd.rcross[i]; 
     do.call(segments,c(args,...)); 
    }; ## end for 
}; ## end arrows.filled() 

## basic plot outline 
par(xaxs='i',yaxs='i'); 
xlim <- c(0,8); 
ylim <- c(0,6); 
extra <- 0.5; 
plot(NA,xlim=xlim+extra*c(-1,1),ylim=ylim+extra*c(-1,1),axes=F,ann=F); 

## custom axes 
xtick <- 0:8; 
ytick <- 0:6; 
tick.len <- 0.06; 
tick.zeroadd <- 0.1; 
segments(xtick,0,xtick,-tick.len,lwd=2); 
segments(0,ytick,-tick.len,ytick,lwd=2); 
abline(h=0,lwd=2); 
abline(v=0,lwd=2); 
text(xtick[-1],-tick.len/2,xtick[-1],pos=1,font=2); 
text(xtick[1]+tick.zeroadd,-tick.len/2,xtick[1],pos=1,font=2); 
text(-tick.len/2,ytick[-1],ytick[-1],pos=2,font=2); 
text(-tick.len/2,ytick[1]+tick.zeroadd,ytick[1],pos=2,font=2); 

## define main points 
V1 <- c(2,5); 
V2 <- c(7,1); 

## circle sector with label 
V1.angle <- atan2(V1[2],V1[1]); 
V2.angle <- atan2(V2[2],V2[1]); 
sector.radius <- 2; 
circle.sectors(0,0,sector.radius,V1.angle,V2.angle,'#277A27','#E5EFE5',lwd=2); 
label.radius <- 1.1; 
label.angle <- mean(c(V1.angle,V2.angle)); 
text(label.radius*cos(label.angle),label.radius*sin(label.angle),'α',family='serif',cex=1.3,col='#277A27'); 

## arrows 
arrows.filled(0,0,V1[1],V1[2],a=tau*12/360,len=0.25,lwd=2,bg='black'); 
arrows.filled(0,0,V2[1],V2[2],a=tau*12/360,len=0.25,lwd=2,bg='black'); 

## point circles 
circles(c(V1[1],V2[1]),c(V1[2],V2[2]),0.08,'black','blue'); 

## point labels 
text(V1[1]+0.03,V1[2]+0.2,sprintf('V1 = (%d,%d)',V1[1],V1[2]),pos=4,col='blue',font=2,family='sans'); 
text(V2[1]+0.05,V2[2]-0.2,sprintf('V2 = (%d,%d)',V2[1],V2[2]),pos=4,col='blue',font=2,family='sans');

來源

2015-08-08 20:48:02 bgoldst

+1

不挑剔，但箭頭是不是很像原來 – baptiste

+1

@baptiste：你是絕對正確的，它只有原來的99.99％:) – Maximilian

+1

箭頭的情況已被糾正。 – bgoldst

2

感謝bgoldst你的努力。我想用一個比較簡單的解決方案，它不一定重現上面的圖片中作出貢獻，但也許是有幫助的經驗不足的程序員和我一樣：

library(plotrix) 

# Creates empty plot and variables 
plot(1,type="n",axes=F,xlim=c(-0.1,1.2),ylim=c(-0.1,1.2),xlab="",ylab="") 
x1 = c(1,0) 
x2 = c(0.4,0.7) 

# X1 
arrows(0,0,x1[1],x1[2]) 
text(1,-0.05,expression(x[1]),cex=1.5) 

# X2 
arrows(0,0,x2[1],x2[2]) 
text(0.4,0.75,expression(x[2]),cex=1.5) 


alpha_angle= acos((x2%*%x1)/(sqrt(x2%*%x2)*sqrt(x1%*%x1))) 

draw.arc(0,0,0.15,angle2=alpha_angle) 

text(0.07,0.05,expression(alpha),cex=1.5)

這到底提供了以下情節：

Plot

來源

2015-08-10 09:55:50 pthesling

相關問題

 相關問題