Im drawing a knn-classification plot in R using plot to plot the samples and contour to plot the lines that classify the plane.
Here is my code:
k<-1
datax<-rbind(matrix(rnorm(30,-1,5.25),15,2),matrix(rnorm(36,1,5.25),18,2))
datay<-rbind(matrix(1,15,1),matrix(0,18,1))
plot(datax[,1], datax[,2],pch = datay+1,axes=FALSE,ann=FALSE)
box()
n <- 1000
xp <- seq(length=n, from = min(datax[,1]), to = max(datax[,1]))
yp <- seq(length=n,from = min(datax[,2]) ,to = max(datax[,2]))
gr <- expand.grid(xp, yp)
library(class)
z <- as.numeric(knn(datax, gr, datay,k))-1
zM <- matrix(z, n, n, byrow = FALSE)
contour(xp, yp, zM, xlab="x",ylab="",nlevels = 1 ,lwd=2, add=TRUE, drawlabels =FALSE)
My question is: How can i color the enclosed areas in the plot? I tried filled.contour but there is no add parameter. I simply want the area where the classifier is = 0 white and where it classifies = 1 in blue. How should i do this?
thanks
Instead of contour, you can use contourLines to keep the coordinates of the edges of the contour lines and plot them with polygon.
plot(datax[,1], datax[,2],axes=FALSE,ann=FALSE, type="n")
box()
cL <- contourLines(xp, yp, zM,nlevels = 1)
lapply(cL,function(x)polygon(x$x,x$y,col="red"))
points(datax[,1], datax[,2],pch = datay+1)
However it is not perfect with contour lines that reach the edges of the plot (see the left lower corner of the second plot), so it will need some hand-made tuning:
Edit: In the case of nested contour lines, I don't think there is an easy way to deal with it but here is one way:
library(splancs)
ord <- sapply(lapply(cL,function(x)datay[inout(datax,cbind(x$x,x$y))]),
median) #Check what values are present in the polygon and
#take the most common one
plot(datax[,1], datax[,2],axes=FALSE,ann=FALSE, type="n")
box()
lapply(cL[ord==1],function(x)polygon(x$x,x$y,col="blue"))
lapply(cL[ord==0],function(x)polygon(x$x,x$y,col="white"))
points(datax[,1], datax[,2],pch = datay+1)
2nd Edit: There is of course also the possibility of using function image in your case:
image(xp, yp, zM, col=c("transparent","blue"))
points(datax[,1], datax[,2],pch = datay+1)
Related
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"))
Lets consider that I have five 2D-Matrices which describe the magnetic field at different z-Layers. A nice, smoothed version of a 2D-Surface plot can be obtained as follows:
data2_I<-matrix(c(1.0,1.0,0.6,0.6,0.7,0.9,0.9,0.5,0.5,0.5,0.7,0.9,0.9,0.6,0.3,0.4,0.7,0.9,0.9,0.7,0.5,0.5,0.6,0.9,0.9,0.7,0.6,0.6,1.0,1.0), nrow=5)
Z = as.vector(data2_I)
length(Z)
XY=data.frame(x=as.numeric(gl(5,1,30)),y=as.numeric(gl(5,6,30)))
t=Tps(XY,Z)
surface(t)
Now it would be great if I could get a 3D-plot where at different z-Positions these surfaces are plotted. Is there a possibility to do that?
I found an alternative approach: With the package rgl I and the function surface 3D I can stack several 3D-Surface plots within one open3d-window. Lets look at a small example:
library("rgl")
data2_I<-matrix(c(1.0,1.0,0.6,0.6,0.7,0.9,0.9,0.5,0.5,0.5,0.7,0.9,0.9,0.6,0.3,0.4,0.7,0.9,0.9,0.7,0.5,0.5,0.6,0.9,0.9,0.7,0.6,0.6,1.0,1.0), nrow=5)
data0_I<-matrix(c(1.0,1.0,0.6,0.6,0.7,0.9,0.9,0.5,0.5,0.5,0.7,0.9,0.9,0.6,0.3,0.4,0.7,0.9,0.9,0.7,0.5,0.5,0.6,0.9,0.9,0.7,0.6,0.6,1.0,1.0), nrow=5)
data1_I<-2*data0_I
data2_I<-1/data1_I
elv=0
offs=5*elv+1
z0 <- scale*data0_I
z1 <- scale*data1_I
z2 <- scale*data2_I
x <- 1:nrow(z0)
y <- 1:ncol(z0)
palette <- colorRampPalette(c("blue","green","yellow", "red"))
col.table <- palette(256)
open3d(windowRect=c(50,50,800,800))
surface3d(x, y, elv*z0, color = col.table[cut(z0, 256)], back = "lines")
surface3d(x, y, elv*z1+1*offs, color = col.table[cut(z1, 256)], back = "lines")
surface3d(x, y, elv*z2+2*offs, color = col.table[cut(z2, 256)], back = "lines")
axes3d()
aspect3d(1,1,2)
The variables offsand elv are included for cosmetic purposes: offs controls the space between two surface plots and elevation how the z-axes of the surface3d-plots should scale. As I wanted to have a 2D surface plot without any elevation I set it to zero.
I am graphing several n-edge polygons on the same plot. Let say:
1/ n=3: draw polygon with 3 edges, color it with "pink"
2/ n=6: draw polygon with 6 edges, will color with "grey". At this point, I see that the first polygon in step 1 is overlapped by this one. In this case, I just want to keep the "pink" color of the first polygon and color the rest "un-overlapped" area of 2nd polygon with "grey" color.
I have tried some code as follow, but it always display "grey" polygon, instead of "pink" and "grey" areas.
BTW, I also walked around this problem by "draw the 6-edge polygon (n=6) first, and then draw 3-edges polygon (n=3)". By changing the drawing order from the biggest polygon to the smallest one, I can keep the color of the biggest and smallest polygons at the end. However, I would like to do the steps as I mentioned at the beginning of this questions so that i can see the plotting areas are increasing when n (number of edges) keeps increasing.
If you have any suggestions, please advice me. Thank you very much!
cat("\014")
rm(list=ls())
#############################
# first polygon
#n=3
xx3=c(0,-3,3);xx3
yy3=c(1,1,-2);yy3
#plot each intersection /vertex of polygon n=3
plot (xx3, yy3,type = "p", xlim=c(-8,8), ylim=c(-8,8),col="blue",xlab = "x", ylab = "y")
# display value of each point above
text(xx3, yy3, paste("(",round(xx3, 2),"," ,round(yy3, 2), ")"),
cex=0.8,family="mono", font=1, adj=1.5, pos=3)
#fill the shade area
polygon(xx3, yy3, col = "pink", border = "pink")
title("Plot n-edge polygon")
#############################
# RUN untill this point and stop.
#And then run following part, you will see the 1st polygon is overlapping region
#and is fully overwrited by the second polygon.
#############################
# Second polygon
#n=6
par(new=TRUE)
xx=c(0,-15/11,-15/4,-45/11,-3, 3);xx
yy=c(1,20/11,5/2,20/11,1,-2);yy
#plot each intersection /vertex of polygon n=6
points(xx, yy,type = "p", col="blue",xlab = "x", ylab = "y")
# display value of each point above
text(xx, yy, paste("(",round(xx, 2),"," ,round(yy, 2), ")"),
cex=0.8,family="mono", font=1, adj=1.5, pos=3)
#fill the shade area
polygon(xx, yy, col = "grey", border = "grey")
#draw x=0,y=0
abline(a=0,b=0,v=0)
One possibility is to compute the difference between the current polygon (bigger), and the previous one (smaller). I don't know if there is some easy way to compute geometries other than using sp (spatial objects) and rgeos.
Here some code that uses the packages sp and rgeos packages. The approach consists to compute the polygonal difference, by means of spatial objects, and plot it. This might not be the most elegant way, but at least it will do what you want.
require(sp)
require(rgeos)
#test data
xx3=c(0,-3,3);xx3
yy3=c(1,1,-2);yy3
xx=c(-5,-5,5,5);xx
yy=c(-5,5,5,-5);yy
#create a SpatialPolygons object for n = 3
sp3 <- as.data.frame(cbind(xx3,yy3))
sp3 <- rbind(sp3, sp3[1,])
coordinates(sp3) <- c("xx3","yy3")
p3 <- Polygon(sp3)
ps3 <- Polygons(list(p3),1)
sps3 <- SpatialPolygons(list(ps3))
#create a SpatialPolygons object for n = 6
sp <- as.data.frame(cbind(xx,yy))
sp <- rbind(sp, sp[1,])
coordinates(sp) <- c("xx","yy")
p <- Polygon(sp)
ps <- Polygons(list(p),1)
sps <- SpatialPolygons(list(ps))
#compute the difference (with rgeos)
#between the current polygon (bigger) and the previous one (smaller)
spsdiff <- gDifference(sps, sps3)
For plotting the difference, 2 ways:
#Plotting 1: based on sp-plot
#===========
plot(sps, border="transparent") #to set some bigger extent
plot(sps3, add=T, col = "pink")
plot(spsdiff, add=T, col = "grey")
#Plotting 2: use polygon and polypath base functions
#===========
#preparing data for using polypath (polygons with hole)
polys <- spsdiff#polygons[[1]]#Polygons
coords <- do.call("rbind", lapply(polys, function(x){ if(x#hole) x#coords }))
holes <- do.call("rbind", lapply(polys,function(x){ if(!x#hole) rbind(rep(NA,2),x#coords) }))
poly.coords <- rbind(coords,holes)
#plot it
plot(xx, yy, col = "transparent")
polygon(xx3, yy3, col = "pink")
polypath(poly.coords[,1],poly.coords[,2],col="grey", rule="evenodd")
If you have to repeat this, you can re-use this code within a loop to iteratively plot the polygon differences.
Note: rgeos requires you to install the GEOS library on your machine
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