Logo Questions Linux Laravel Mysql Ubuntu Git Menu
HTML CSS JAVASCRIPT SQL PYTHON PHP BOOTSTRAP JAVA JQUERY R React Kotlin
 

Plot angle between vectors

Tags:

plot

r

angle

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.

like image 752
pthesling Avatar asked Aug 08 '15 14:08

pthesling

People also ask

How do you find the angle between two vectors on a graph?

To calculate the angle between two vectors in a 2D space: Find the dot product of the vectors. Divide the dot product by the magnitude of the first vector. Divide the resultant by the magnitude of the second vector.

How do you plot angles between two vectors in Matlab?

Gamma1 = 120;%Angle between z-axis and F2 [Degrees]. Theta1 = 45; %Angle of Theta1 in [Degrees]. Theta2 = 60;%Angle of Theta2 in [Degrees]. Vector1 = [-cosd(Theta2)*sind(Theta1), cosd(Theta2)*cosd(Theta1), sind(Theta2)]; %Direction vector of F1.

How do you find the angle between two vectors examples?

An easier way to find the angle between two vectors is the dot product formula(A.B=|A|x|B|xcos(X)) let vector A be 2i and vector be 3i+4j. As per your question, X is the angle between vectors so: A.B = |A|x|B|x cos(X) = 2i.

2 Answers

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');
like image 154
bgoldst Avatar answered Sep 27 '22 00:09

bgoldst

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:

Plot

like image 40
pthesling Avatar answered Sep 25 '22 00:09

pthesling
Sign in to Comment

Related questions

R crop raster data and set axis limits
log scale boxplots in R
How to use R's `browser()` function from command line when using `Rscript`
Select a subset of lists from list of lists
Shiny (R GUI) replaces < and > with &lt; and &gt; in tags$script
Knitr: redirect chunk code output to terminal
Non visible functions/methods in R -- how are they made?
fread in R imports a large .csv file as a data frame with one row
R Data table copy and modification alters original one [duplicate]
Retrieving the optimal number of clusters in R
R programming - How to create a 2 dimensional array of vectors which are of different lengths
aperm function not clear
RSelenium and findElements with inspect element use
How to add logo to each slide in ioslides in RStudio
Using := in data.table with paste()
Summarise over all columns
R - Converting Fractions in Text to Numeric
Retrieve choice name rather than value
cbind vs rbind with data.table
Converting UTC time to local standard time in R

Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!