Plot angle between vectors

Question

I am searching for quite a while already now for a function that plots the angle between two arrows / line segments. e.g.:

_{(source: matrix44.net)}

Can this be done easily or do I have to find the function of a segment of a radius? I am surprised that I didn't find anything yet, since R usually has a package for everything.

Fancie

what do you mean by "plots the angle"? Do you mean computing a numeric value, or something graphical? Can you give a concrete/reproducible example? (if you want a picture and don't know how to use R to draw it, you can link to a similar image online or draw a picture and post a photo of it ...) – Smarmy

I am new to the site, such that I couldn't post a picture. But a link seems to work: link. I am talking about this segment of a circle next to alpha. – Fancie

take a look at draw.arc in the plotrix package. or grid.curve in the grid package – Arkhangelsk

Thanks a lot. draw.arc does the job. – Fancie

@Arkhangelsk That should be an answer :) – Bermuda

Answer 1

## 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');

Trashy

not to be picky but the arrows aren't quite like the original – Polky

@baptiste: you are absolutely right, its only 99.99% like the original :) – Subdebutante

The arrow situation has been rectified. – Trashy

Answer 2

Thanks bgoldst for your effort. I would like to contribute with a rather easy solution that not necessarily reproduces the picture above, but is maybe helpful for less experienced programmers like me:

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)

In the end this gives the following plot:

Fancie

Answer 3

Just a follow-up to pthesling's answer: This one only works if one of the vectors is a multiple of (1,0). A more general approach to plot the angle between any pair of vectors would work as follows:

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

# X1
arrows(0,0,x1[1],x1[2])
text(0.62,0.18,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_angle1= acos((x1%*%x0)/(sqrt(x1%*%x1)*sqrt(x0%*%x0)))
alpha_angle2= acos((x2%*%x0)/(sqrt(x2%*%x2)*sqrt(x0%*%x0)))


draw.arc(0,0,0.15,angle1=alpha_angle1,angle2=alpha_angle2)

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

Link to picture

Cronk