It is known that we'll use two dotted lines to express two lines are perpendicular (like the picture).
Is there any argument to express this symbol such as symbol="perpendicular"?
So far, I plot this symbol manually like code below.
plot(rnorm(10),type="n",xlim=c(-1,1),ylim=c(-1,1))
abline(h=0,v=0)
lines(c(0,0.1),c(0.1,0.1),lty=2)
lines(c(0.1,0.1),c(0,0.1),lty=2)
Custom function:
#Cutom function
myfunction <- function(x, y){
for(i in seq_along(x)){
lines(c(x[i], x[i]), c(0,y[i]), lty = 2)
lines(c(0, x[i]), c(y[i], y[i]), lty = 2)
}
}
plot(rnorm(10), type="n", xlim = c(-1,1), ylim = c(-1,1))
abline(h = 0, v = 0)
myfunction(x = c(0.1, 0.5, -0.3, -0.9),
y = c(0.5, -0.3, -0.9, 0.7))
First, thanks zx8754's answer. I enjoy the idea using custom function. However, in my real case the two lines are not parallel to x axis and y axis. Hence, I write another custom function,called perpendicular, instead. BTW, any recommend will be appreciated. The code and the result are below:
# Make an axuliarry line,perpendicular, from A to line OC
plot(rnorm(1),xlim=c(-7,7),ylim=c(-3,3),type="n",las=1,axes=F,xlab="",ylab="")
abline(0,-7/15,col="red",lwd=3)
arrows(0,0,-15/4,-1/4,lwd=2,col="red")
arrows(0,0,18,0,col="gray");arrows(0,0,-9,0,col="gray")
arrows(0,0,0,10,col="gray");arrows(0,0,0,-9,col="gray")
lines(c(-15/4,-218*15/1096),c(-1/4,218*7/1096),col="red",lty=3,lwd=3)
text(-15/4,-1/4,"A",cex=2)
text(-218*15/1096,218*7/1096,"C",cex=2)
text(0,0,"O",cex=2)
#make an perpendicilar symbol to emphasis that it is perpendicular
perpendicular(-218*15/1096,218*7/1096,-15/4,-1/4,0,0,0.3)
# Given any three points,connected with two lines, perpendicualr function can draw an shape in the oppisite direction.
# Note: When two lines are perpendicular,the output will be an perpendicular symbol!
# Definition of notation:
# (x,y) is the turning points of the shape.
# (x1,y1) and (x2,y2) are the other two points.
# k is the length, depending on how large shape you want.
perpendicular<-function(x,y,x1,y1,x2,y2,k){
#points(x,y,col="red",pch=16);points(x1,y1,pch=16);points(x2,y2,pch=16)
m1<-c(x1-x,y1-y);m2<-c(x2-x,y2-y) #two vector of the line
m1<-m1/sqrt(sum(m1^2));m2<-m2/sqrt(sum(m2^2)) #standardlized the vector
#construct the shape I want
xx1<-c(x,y)+k*m1
xx2<-c(x,y)+k*m2
xx3<-c(x,y)+k*(m1+m2)
lines(c(xx1[1],xx3[1]),c(xx1[2],xx3[2]),lty=2)
lines(c(xx2[1],xx3[1]),c(xx2[2],xx3[2]),lty=2)
}
Related
How can such a non-linear transformation be done?
here is the code to draw it
my.sin <- function(ve,a,f,p) a*sin(f*ve+p)
s1 <- my.sin(1:100, 15, 0.1, 0.5)
s2 <- my.sin(1:100, 21, 0.2, 1)
s <- s1+s2+10+1:100
par(mfrow=c(1,2),mar=rep(2,4))
plot(s,t="l",main = "input") ; abline(h=seq(10,120,by = 5),col=8)
plot(s*7,t="l",main = "output")
abline(h=cumsum(s)/10*2,col=8)
don't look at the vector, don't look at the values, only look at the horizontal grid, only the grid matters
####UPDATE####
I see that my question is not clear to many people, I apologize for that...
Here are examples of transformations only along the vertical axis, maybe now it will be more clear to you what I want
link Source
#### UPDATE 2 ####
Thanks for your answer, this looks like what I need, but I have a few more questions if I may.
To clarify, I want to explain why I need this, I want to compare vectors with each other that are non-linearly distorted along the horizontal axis .. Maybe there are already ready-made tools for this?
You mentioned that there are many ways to do such non-linear transformations, can you name a few of the best ones in my case?
how to make the function f() more non-linear, so that it consists, for example, not of one sinusoid, but of 10 or more. Тhe figure shows that the distortion is quite simple, it corresponds to one sinusoid
and how to make the function f can be changed with different combinations of sinusoids.
set.seed(126)
par(mar = rep(2, 4),mfrow=c(1,3))
s <- cumsum(rnorm(100))
r <- range(s)
gridlines <- seq(r[1]*2, r[2]*2, by = 0.2)
plot(s, t = "l", main = "input")
abline(h = gridlines, col = 8)
f <- function(x) 2 * sin(x)/2 + x
plot(s, t = "l", main = "input+new greed")
abline(h = f(gridlines), col = 8)
plot(f(s), t = "l", main = "output")
abline(h = f(gridlines), col = 8)
If I understand you correctly, you wish to map the vector s from the regular spacing defined in the first image to the irregular spacing implied by the second plot.
Unfortunately, your mapping is not well-defined, since there is no clear correspondence between the horizontal lines in the first image and the second image. There are in fact an infinite number of ways to map the first space to the second.
We can alter your example a bit to make it a bit more rigorous.
If we start with your function and your data:
my.sin <- function(ve, a, f, p) a * sin(f * ve + p)
s1 <- my.sin(1:100, 15, 0.1, 0.5)
s2 <- my.sin(1:100, 21, 0.2, 1)
s <- s1 + s2 + 10 + 1:100
Let us also create a vector of gridlines that we will draw on the first plot:
gridlines <- seq(10, 120, by = 2.5)
Now we can recreate your first plot:
par(mar = rep(2, 4))
plot(s, t = "l", main = "input")
abline(h = gridlines, col = 8)
Now, suppose we have a function that maps our y axis values to a different value:
f <- function(x) 2 * sin(x/5) + x
If we apply this to our gridlines, we have something similar to your second image:
plot(s, t = "l", main = "input")
abline(h = f(gridlines), col = 8)
Now, what we want to do here is effectively transform our curve so that it is stretched or compressed in such a way that it crosses the gridlines at the same points as the gridlines in the original image. To do this, we simply apply our mapping function to s. We can check the correspondence to the original gridlines by plotting our new curves with a transformed axis :
plot(f(s), t = "l", main = "output", yaxt = "n")
axis(2, at = f(20 * 1:6), labels = 20 * 1:6)
abline(h = f(gridlines), col = 8)
It may be possible to create a mapping function using the cumsum(s)/10 * 2 that you have in your original example, but it is not clear how you want this to correspond to the original y axis values.
Response to edits
It's not clear what you mean by comparing two vectors. If one is a non-linear deformation of the other, then presumably you want to find the underlying function that produces the deformation. It is possible to create a function that applies the deformation empirically simply by doing f <- approxfun(untransformed_vector, transformed_vector).
I didn't say there were many ways of doing non-linear transformations. What I meant is that in your original example, there is no correspondence between the grid lines in the original picture and the second picture, so there is an infinite choice for which gridines in the first picture correspond to which gridlines in the second picture. There is therefore an infinite choice of mapping functions that could be specified.
The function f can be as complicated as you like, but in this scenario it should at least be everywhere non-decreasing, such that any value of the function's output can be mapped back to a single value of its input. For example, function(x) x + sin(x)/4 + cos(3*(x + 2))/5 would be a complex but ever-increasing sinusoidal function.
I have a sitation in which I generate data from simulation and then would like to plot (heat map/contour/3d plot etc); however, for these, data needs to be interpolated using functions like interp. Here is the sample dataset.
Here is the piece of code I tried...
library(akima)
library(GA) # for persp3D; there exists another package for same function "fields"
data <- read.table(commandArgs()[3], header=T,sep="\t")
data <- na.omit(data)
qmax = max(data$q)
kmax = max(data$k)
x <- data$k_bike/kmax
y <- data$k_car/kmax
z <- data$q/qmax
matrix = interp(x,y,z)
persp3D(matrix ,nlevels=30, asp=1, xlim=c(0,1), ylim=c(0,1), color.palette=colorRampPalette(c("green3","yellow", "red"),space = "rgb") )
so the result is --
Now, due to interpolation, there are many points, which have red/orange color instead of green or so. For e.g, if I use levelplot of lattice
levelplot(z~x*y, xlim=c(0,1), ylim=c(0,1), col.regions=colorRampPalette(c("green3","yellow", "red"),space = "rgb") )
The outcome is --
Now, it is clearly visible that there are very few data points having zero (or almost zero) zvalue. Now, the problem is, with levelplot, I get artefacts (white color for missing data points) and I would like to have a better interpolation. Is there any other function to perform this?
I also tried contour plots as follows:
scale <- (qmax+10) / qmax * c(0.000, 0.01, 0.05, 0.10, 0.25, 0.5, 0.75, 1.0)
filled.contour(matrix, nlevels=30, asp=1, xlim=c(0,1), ylim=c(0,1), levels=scale,color.palette=colorRampPalette(c("green3","yellow", "red"),space = "rgb") )
and result is again (kind of wrong color indication).
In short -- I would like to have contour plot or 3d plot but with a
clear (or correct) color indication of zero (about zero) zvalue data
points similar to level plot.
I approached your question with deldir and rgl packages (they allow plotting of surfaces defined by irregular collections of points).
library(deldir); library(rgl)
# Below two lines require time depending on the machine power, be careful
dxyz <- deldir(x, y, z = z) # do Delaunay triangulation
mxyz <- as.mesh3d(dxyz) # convert it to triangle.mesh3d.obj
bgyr <- colorRampPalette(c("blue", "green", "yellow", "red")) # colour func
# use z values for colouring
plot3d(mxyz, col=bgyr(256)[cut(mxyz$vb[3,], 256)][mxyz$it], type="shade")
light3d() # if you want vivit colours
# another approach
# you can solve it by just increasing interp()'s arguments, nx and ny.
library(akima); library(lattice); library(dplyr)
df <- interp(x,y,z, nx=150, ny=150) %>% interp2xyz() %>% data.frame()
levelplot(z ~ x * y, df, xlim=c(0,1), ylim=c(0,1),
col.regions = colorRampPalette(c("green3", "yellow", "red"), space = "rgb"))
I need to use black and white color for my boxplots in R. I would like to colorfill the boxplot with lines and dots. For an example:
I imagine ggplot2 could do that but I can't find any way to do it.
Thank you in advance for your help!
I thought this was a great question and pondered if it was possible to do this in base R and to obtain the checkered look. So I put together some code that relies on boxplot.stats and polygon (which can draw angled lines). Here's the solution, which is really not ready for primetime, but is a solution that could be tinkered with to make more general.
boxpattern <-
function(y, xcenter, boxwidth, angle=NULL, angle.density=10, ...) {
# draw an individual box
bstats <- boxplot.stats(y)
bxmin <- bstats$stats[1]
bxq2 <- bstats$stats[2]
bxmedian <- bstats$stats[3]
bxq4 <- bstats$stats[4]
bxmax <- bstats$stats[5]
bleft <- xcenter-(boxwidth/2)
bright <- xcenter+(boxwidth/2)
# boxplot
polygon(c(bleft,bright,bright,bleft,bleft),
c(bxq2,bxq2,bxq4,bxq4,bxq2), angle=angle[1], density=angle.density)
polygon(c(bleft,bright,bright,bleft,bleft),
c(bxq2,bxq2,bxq4,bxq4,bxq2), angle=angle[2], density=angle.density)
# lines
segments(bleft,bxmedian,bright,bxmedian,lwd=3) # median
segments(bleft,bxmin,bright,bxmin,lwd=1) # min
segments(xcenter,bxmin,xcenter,bxq2,lwd=1)
segments(bleft,bxmax,bright,bxmax,lwd=1) # max
segments(xcenter,bxq4,xcenter,bxmax,lwd=1)
# outliers
if(length(bstats$out)>0){
for(i in 1:length(bstats$out))
points(xcenter,bstats$out[i])
}
}
drawboxplots <- function(y, x, boxwidth=1, angle=NULL, ...){
# figure out all the boxes and start the plot
groups <- split(y,as.factor(x))
len <- length(groups)
bxylim <- c((min(y)-0.04*abs(min(y))),(max(y)+0.04*max(y)))
xcenters <- seq(1,max(2,(len*(1.4))),length.out=len)
if(is.null(angle)){
angle <- seq(-90,75,length.out=len)
angle <- lapply(angle,function(x) c(x,x))
}
else if(!length(angle)==len)
stop("angle must be a vector or list of two-element vectors")
else if(!is.list(angle))
angle <- lapply(angle,function(x) c(x,x))
# draw plot area
plot(0, xlim=c(.97*(min(xcenters)-1), 1.04*(max(xcenters)+1)),
ylim=bxylim,
xlab="", xaxt="n",
ylab=names(y),
col="white", las=1)
axis(1, at=xcenters, labels=names(groups))
# draw boxplots
plots <- mapply(boxpattern, y=groups, xcenter=xcenters,
boxwidth=boxwidth, angle=angle, ...)
}
Some examples in action:
mydat <- data.frame(y=c(rnorm(200,1,4),rnorm(200,2,2)),
x=sort(rep(1:2,200)))
drawboxplots(mydat$y, mydat$x)
mydat <- data.frame(y=c(rnorm(200,1,4),rnorm(200,2,2),
rnorm(200,3,3),rnorm(400,-2,8)),
x=sort(rep(1:5,200)))
drawboxplots(mydat$y, mydat$x)
drawboxplots(mydat$y, mydat$x, boxwidth=.5, angle.density=30)
drawboxplots(mydat$y, mydat$x, # specify list of two-element angle parameters
angle=list(c(0,0),c(90,90),c(45,45),c(45,-45),c(0,90)))
EDIT: I wanted to add that one could also obtain dots as a fill by basically drawing a pattern of dots, then covering them a "donut"-shaped polygon, like so:
x <- rep(1:10,10)
y <- sort(x)
plot(y~x, xlim=c(0,11), ylim=c(0,11), pch=20)
outerbox.x <- c(2.5,0.5,10.5,10.5,0.5,0.5,2.5,7.5,7.5,2.5)
outerbox.y <- c(2.5,0.5,0.5,10.5,10.5,0.5,2.5,2.5,7.5,7.5)
polygon(outerbox.x,outerbox.y, col="white", border="white") # donut
polygon(c(2.5,2.5,7.5,7.5,2.5),c(2.5,2.5,2.5,7.5,7.5)) # inner box
But mixing that with angled lines in a single plotting function would be a bit difficult, and is generally a bit more challenging, but it starts to get you there.
I think it is hard to do this with ggplot2 since it dont use shading polygon(gris limitatipn). But you can use shading line feature in base plot, paramtered by density and angle arguments in some plot functions ( ploygon, barplot,..).
The problem that boxplot don't use this feature. So I hack it , or rather I hack bxp internally used by boxplot. The hack consist in adding 2 arguments (angle and density) to bxp function and add them internally in the call of xypolygon function ( This occurs in 2 lines).
my.bxp <- function (all.bxp.argument,angle,density, ...) {
.....#### bxp code
xypolygon(xx, yy, lty = boxlty[i], lwd = boxlwd[i],
border = boxcol[i],angle[i],density[i])
.......## bxp code after
xypolygon(xx, yy, lty = "blank", col = boxfill[i],angle[i],density[i])
......
}
Here an example. It should be noted that it is entirely the responsibility of the user to ensure
that the legend corresponds to the plot. So I add some code to rearrange the legend an the boxplot code.
require(stats)
set.seed(753)
(bx.p <- boxplot(split(rt(100, 4), gl(5, 20))))
layout(matrix(c(1,2),nrow=1),
width=c(4,1))
angles=c(60,30,40,50,60)
densities=c(50,30,40,50,30)
par(mar=c(5,4,4,0)) #Get rid of the margin on the right side
my.bxp(bx.p,angle=angles,density=densities)
par(mar=c(5,0,4,2)) #No margin on the left side
plot(c(0,1),type="n", axes=F, xlab="", ylab="")
legend("top", paste("region", 1:5),
angle=angles,density=densities)
Refer to the above plot. I have drawn the equations in excel and then shaded by hand. You can see it is not very neat. You can see there are six zones, each bounded by two or more equations. What is the easiest way to draw inequalities and shade the regions using hatched patterns ?
To build up on #agstudy's answer, here's a quick-and-dirty way to represent inequalities in R:
plot(NA,xlim=c(0,1),ylim=c(0,1), xaxs="i",yaxs="i") # Empty plot
a <- curve(x^2, add = TRUE) # First curve
b <- curve(2*x^2-0.2, add = TRUE) # Second curve
names(a) <- c('xA','yA')
names(b) <- c('xB','yB')
with(as.list(c(b,a)),{
id <- yB<=yA
# b<a area
polygon(x = c(xB[id], rev(xA[id])),
y = c(yB[id], rev(yA[id])),
density=10, angle=0, border=NULL)
# a>b area
polygon(x = c(xB[!id], rev(xA[!id])),
y = c(yB[!id], rev(yA[!id])),
density=10, angle=90, border=NULL)
})
If the area in question is surrounded by more than 2 equations, just add more conditions:
plot(NA,xlim=c(0,1),ylim=c(0,1), xaxs="i",yaxs="i") # Empty plot
a <- curve(x^2, add = TRUE) # First curve
b <- curve(2*x^2-0.2, add = TRUE) # Second curve
d <- curve(0.5*x^2+0.2, add = TRUE) # Third curve
names(a) <- c('xA','yA')
names(b) <- c('xB','yB')
names(d) <- c('xD','yD')
with(as.list(c(a,b,d)),{
# Basically you have three conditions:
# curve a is below curve b, curve b is below curve d and curve d is above curve a
# assign to each curve coordinates the two conditions that concerns it.
idA <- yA<=yD & yA<=yB
idB <- yB>=yA & yB<=yD
idD <- yD<=yB & yD>=yA
polygon(x = c(xB[idB], xD[idD], rev(xA[idA])),
y = c(yB[idB], yD[idD], rev(yA[idA])),
density=10, angle=0, border=NULL)
})
In R, there is only limited support for fill patterns and they can only be
applied to rectangles and polygons.This is and only within the traditional graphics, no ggplot2 or lattice.
It is possible to fill a rectangle or polygon with a set of lines drawn
at a certain angle, with a specific separation between the lines. A density
argument controls the separation between the lines (in terms of lines per inch)
and an angle argument controls the angle of the lines.
here an example from the help:
plot(c(1, 9), 1:2, type = "n")
polygon(1:9, c(2,1,2,1,NA,2,1,2,1),
density = c(10, 20), angle = c(-45, 45))
EDIT
Another option is to use alpha blending to differentiate between regions. Here using #plannapus example and gridBase package to superpose polygons, you can do something like this :
library(gridBase)
vps <- baseViewports()
pushViewport(vps$figure,vps$plot)
with(as.list(c(a,b,d)),{
grid.polygon(x = xA, y = yA,gp =gpar(fill='red',lty=1,alpha=0.2))
grid.polygon(x = xB, y = yB,gp =gpar(fill='green',lty=2,alpha=0.2))
grid.polygon(x = xD, y = yD,gp =gpar(fill='blue',lty=3,alpha=0.2))
}
)
upViewport(2)
There are several submissions on the MATLAB Central File Exchange that will produce hatched plots in various ways for you.
I think a tool that will come handy for you here is gnuplot.
Take a look at the following demos:
feelbetween
statistics
some tricks
I can't seem to wrap my mind arround how polygon() works. I've searched a lot but I cant seem to understand how polygon wants the x,y points and what do they represent.
Could someone please help me and explain how to shade for example the area between the red and blue line
curve(x/2, from=0 , to =1, col="darkblue")
curve(x/4, from=0 , to =1, add=T, col="darkred")
Thanks a lot
Because, in this case, there isn't really any curve to the line you could use something very simple (that highlights how polygon works).
x <- c(0,1,1,0)
y <- c(x[1:2]/2, x[3:4]/4)
polygon(x,y, col = 'green', border = NA)
Now, if you had a curve you'd need more vertices.
curve(x^2, from=0 , to =1, col="darkblue")
curve(x^4, from=0 , to =1, add=T, col="darkred")
x <- c(seq(0, 1, 0.01), seq(1, 0, -0.01))
y <- c(x[1:101]^2, x[102:202]^4)
polygon(x,y, col = 'green', border = NA)
(extend the range of that last curve and see how using similar code treats the crossing curves yourself)
To generalise the accepted answer.. if you have two curves (two vectors) f1(x1), f2(x2) which satisfy f1(x1) < f2(x2) for all x1,x2, then you can use
#' #brief Draws a polygon between two curves
#' #f1,f2 Vectors satisfying f1 < f2
#' #x1,x2 Respective domains of f1, f2
#' #... Arguments to ?polygon
ShadeBetween <- function(x1, x2, f1, f2, ...) {
polygon(c(x1, rev(x2)), c(f1, rev(f2)), ...)
}
For this specific example we have :
x <- seq(0,1,length=100)
matplot(x,cbind(x/2, x/4), type='l', col='white')
ShadeBetween(x,x, x/2, x/4, col='red')