I'm trying to add a picture (jpeg,png doesn't care) to a plot which is defined by the layout function. For example:
a<-c(1,2,3,4,5)
b<-c(2,4,8,16,32)
m <- matrix(c(1,1,1,1,2,3,2,3), nrow = 2, ncol = 4)
layout(m); hist(a);boxplot(a~b);plot(b~a)*
Instead of the histogram on position 1 I want to add an image (In my case it's a map)
I don't know how to deal with the jpeg package, maybe you can help me!
Regarding Rodrigo's comment, I created a function that should preserve the image's pixel aspect ratio (addImg).
addImg <- function(
obj, # an image file imported as an array (e.g. png::readPNG, jpeg::readJPEG)
x = NULL, # mid x coordinate for image
y = NULL, # mid y coordinate for image
width = NULL, # width of image (in x coordinate units)
interpolate = TRUE # (passed to graphics::rasterImage) A logical vector (or scalar) indicating whether to apply linear interpolation to the image when drawing.
){
if(is.null(x) | is.null(y) | is.null(width)){stop("Must provide args 'x', 'y', and 'width'")}
USR <- par()$usr # A vector of the form c(x1, x2, y1, y2) giving the extremes of the user coordinates of the plotting region
PIN <- par()$pin # The current plot dimensions, (width, height), in inches
DIM <- dim(obj) # number of x-y pixels for the image
ARp <- DIM[1]/DIM[2] # pixel aspect ratio (y/x)
WIDi <- width/(USR[2]-USR[1])*PIN[1] # convert width units to inches
HEIi <- WIDi * ARp # height in inches
HEIu <- HEIi/PIN[2]*(USR[4]-USR[3]) # height in units
rasterImage(image = obj,
xleft = x-(width/2), xright = x+(width/2),
ybottom = y-(HEIu/2), ytop = y+(HEIu/2),
interpolate = interpolate)
}
Example of use:
library(png)
myurl <- "https://upload.wikimedia.org/wikipedia/commons/thumb/e/e1/Jupiter_%28transparent%29.png/242px-Jupiter_%28transparent%29.png"
z <- tempfile()
download.file(myurl,z,mode="wb")
pic <- readPNG(z)
file.remove(z) # cleanup
dim(pic)
png("plot.png", width = 5, height = 4, units = "in", res = 400)
par(mar = c(3,3,0.5,0.5))
image(volcano)
addImg(pic, x = 0.3, y = 0.5, width = 0.2)
dev.off()
You need to read your png or jpeg file through the png and jpeg packages. Then, with the rasterImage function you can draw the image on a plot. Say that your file is myfile.jpeg, you can try this:
require(jpeg)
img<-readJPEG("myfile.jpeg")
#now open a plot window with coordinates
plot(1:10,ty="n")
#specify the position of the image through bottom-left and top-right coords
rasterImage(img,2,2,4,4)
The above code will draw the image between the (2,2) and (4,4) points.
Just wanted to offer an alternative solution from the builtin "grid" package called grid.raster
From what I can tell it acts very much like rasterImage, but takes in normalized units, "npc" --a bonus in my opinion, and preserves aspect ratio unless you set both width and height. For my purposes, i just set either/or and the image seems to scale perfectly.
library(png)
library(grid)
x11()
mypng = readPNG('homer.png')
image(volcano)
grid.raster(mypng, x=.3, y=.3, width=.25) # print homer in ll conrner
grid.raster(mypng, x=.9, y=.7, width=.5) # print bigger homer in ur corner
while(!is.null(dev.list())) Sys.sleep(1)
Related
How would I put a circle around certaiin variables in the following plot?
library(dagitty)
g = dagitty('dag{
A [pos="-1,0.5"]
W [pos="0.893,-0.422"]
X [adjusted,pos="0,-0.5"]
Y [pos="1,0.5"]
A -> Y
X -> A
X -> W
X -> Y
}')
png("mp.png", width = 500, height = 500,res=300)
plot(g)
dev.off()
In the web based tool you can indicate eg latent or adjusted and it changes the color of the circle, but this is not quite what I am looking for, although if it were possible to get these in the plot from R that would be sufficient, although I don't really like the way the variable is next to the circle in the web based version. I really wanted to circle observed variables and not circle unobserved ones.
I wrote a function which takes the points you want to circle as input, extracts the position of said points and circles them.
library(dagitty)
g = dagitty('dag{
A [pos="-1,0.5"]
W [pos="0.893,-0.422"]
X [adjusted,pos="0,-0.5"]
Y [pos="1,0.5"]
A -> Y
X -> A
X -> W
X -> Y
}')
circle_points <- function(points_to_circle, g) {
#few regexs to extract the points and the positions from "g"
#can surely be optimized, made nicer and more robust but it works for now
fsplit <- strsplit(g[1], "\\]")[[1]]
fsplit <- fsplit[-length(fsplit)]
fsplit <- substr(fsplit, 1, nchar(fsplit)-1)
fsplit[1] <- substr(fsplit[1], 6, nchar(fsplit))
vars <- sapply(regmatches(fsplit,
regexec("\\\n(.*?)\\s*\\[", fsplit)), "[", 2)
pos <- sub(".*pos=\\\"", "", fsplit)
#build dataframe with extracted information
res_df <- data.frame(vars = vars,
posx = sapply(strsplit(pos, ","), "[",1),
posy = sapply(strsplit(pos, ","), "[",2))
df_to_circle <- res_df[res_df$vars %in% points_to_circle,]
#y-position seems to be inverted and has to be multiplied by -1
points(c(as.numeric(df_to_circle$posx)),
c(as.numeric(df_to_circle$posy) * -1),
cex = 4)
}
plot(g)
circle_points(c("A", "Y"), g)
This results in:
You can of course work with the cex parameter, adding colors etc. It seems that the positioning of the circles is a bit off-centered so maybe manipulate the x and y positions in circle_points by a slim margin.
I did not find any information in dagitty, but bnlearn package can add circle/or other shape easily. But I just noticed you only want to add circle to observed traits rather than latent variables (better mentioned this in your title). Then my code might not be what you are looking for. I still attached the code here for your reference. Alternatively, you can distinguish observed/latent traits in different color. This can be easily done using bnlearn (https://www.bnlearn.com/examples/graphviz-plot/)
library(bnlearn)
tree = model2network("[X][W|X][A|X][Y|A:X]")
graphviz.plot(tree, main = "DAG structure", shape = "circle",
layout = "circo")
Is it possible to draw real solid circle with a radius in "user" coordinates?
I tried the following:
Polygons:
I don't want to use them because I need real circles in the resulting svg.
Segments
segments(x, y, x, y, lwd=px, lend=0)
With segments there is the problem that I don't find a way to specify the segment in "user" coordinates.
The resulting graph is at the end exported to PDF.
Update
I draw a graph with a lot of elements and the elements has a distinct width. The width of the elements depends on the width at the x-axis. If I don't use user coordinates the result in the PDF is not correct in dependence to the x-axis.
A Polygon is an approximation to a circle and if I use them the result e.g. PDF is very large and the performance is not good and memory usage is very high. I draw 10,000 circles and more on one graph.
I use the following code with the described performance problems:
circle <- function(x, y, r, col) {
edgeCount <- 50
intervals <- (1:edgeCount) / edgeCount * 2 * pi
for(i in 1:length(x)) {
polygon(r[i]*sin(intervals) + x[i], r[i]*cos(intervals) + y[i], col=col[i],border=NA)
}
}
If you're comfortable with using a wrapper for sp's SpatialLine object you can try the oceanmap package which has a quite useful function called SpatialCircle(). It essentially builds a circle via seq() and adjusts it for your center point coordinates x and y, and for your radius r. It's still a set of line segments (so not one curved line), but quite simple to use.
Result:
Code:
Pretty straightforward:
# Load libraries.
library(oceanmap)
# Generate plot window and data.
set.seed(1702)
plot.new()
plot.window(xlim = c(0, 20), ylim = c(0, 10),
asp = 1, xaxs = "i", yaxs = "i")
axis(1)
axis(2)
box()
n <- 1000
x <- runif(n, 0, 20)
y <- runif(n, 0, 10)
for (i in 1:n) {
circle <- SpatialCircle(x = x[i], y = y[i], r = 0.1, n = 1000)
lines(circle)
}
This also works with ggplot2 with some data wrangling.
Addendum: Precision of SpatialCircles
If you want to check out what n (precision) in the SpatialCircle() function really means, try the following:
nrow(circle#lines[[1]]#Lines[[1]]#coords)
Result:
[1] 1000
This means that the object has 1,000 coordinate pairs (x and y) through which a line can be drawn. Furthermore, this line will have 999 distinct line segments, as the first and the last coordinate pairs are always identical. Proof:
all.equal(circle#lines[[1]]#Lines[[1]]#coords[1, ],
circle#lines[[1]]#Lines[[1]]#coords[1000, ])
Result:
[1] TRUE
If found a solution myself with the help of Gregor2 which did lead me to the library "grid".
library(grid)
#draw frame using normal plot
plot(0, 0, cex=0)
margins <- par("mar")
#1: bottom 2:left 3:top 4:right
mb <- unit(margins[1], "lines")
ml <- unit(margins[2], "lines")
mt <- unit(margins[3], "lines")
mr <- unit(margins[4], "lines")
#create viewport equivalent to margins in par
pushViewport(viewport(x = ml, y = mb, width = unit(1, "npc") - ml - mr, height = unit(1, "npc") - mb - mt, just=c("left", "bottom"), clip=TRUE))
#draw circle in npc units (easily convertable to user units using grconvertX)
grid.draw(circleGrob(x=0.5, y=0.5, r=0.5, default.units="npc", gp=gpar(col="blue", fill="blue")))
popViewport()
I have a fairly complex problem that I don't really know where to start. I have a set of spatial points (X & Y) coordinates that also include information (Height).
set.seed(12345)
X = runif(100, 0, 45)
Y = runif(100, 0, 45)
Height = runif(100, 6, 9)
data <- data.frame("X" = X, "Y" = Y, "Height" = Height)
data$Radius_max = 1/3 * data$Height
The coordinates look something like this:
ggplot(data, aes(X, Y)) +
geom_point()
For each point, I need a buffer that is scaled by Height. The buffer is an equation that is scaled by height but is essentially a circular buffer similar to a cone. The following steps are what I've come up with to determine buffer size for each point:
Set bottom left point to radius_max.
Find the intersection of the radius at any given point relative to the next point.
Do this multiple times to refit a new radius for the intial point relative to new adjacent radii.
The reason for starting at an initial point is that each radii following will be constrained by the neighboring points (randomly generating points may or may not have this effect). No cone can be below another cone. Think trees. If possible, I would like to know the radius at 45 degree increments.
I'm ok with any solution and suspect there may be a way to do this with the spatial packages rather than doing some by hand. Where do I start?
I am not quite sure what you are after. Particularly the 45 degrees increments. Do you want the buffer to be circular? If so, perhaps the below is a solution.
Your example data
set.seed(12345)
X <- runif(100, 0, 45)
Y <- runif(100, 0, 45)
Height <- runif(100, 6, 9)
data <- data.frame("X" = X, "Y" = Y, "Height" = Height)
data$Radius_max <- 1/3 * data$Height
Possible solution
library(raster)
x <- pointDistance(data[,1:2], lonlat=FALSE)
diag(x) <- NA
mn <- apply(x, 1, min, na.rm=TRUE)
data$radius <- pmin(data$Radius_max, mn/2)
d <- SpatialPoints(data[, c('X', 'Y')], proj4string=CRS('+proj=utm +zone=1'))
b <- buffer(d, data$radius, dissolve=FALSE)
plot(b)
I'm loading bitmap images into R with dimensions that are roughly 17,000 X 17,000 pixels. I'd like to find a way to draw a circle with a radius (in pixels) of my choosing around the center of the picture and convert all pixels outside of the circle into NA's.
For example, if the radius desired was 500 pixels, all pixels within that distance (500) from the centroid would be kept as is. Any pixel farther than that distance (>= 501) from the centroid would be converted to an NA.
The bitmap images are made up entirely of 1's and 0's so here's a smaller example of what these images look like.
img=matrix(sample(c(1,0),1000000,replace=TRUE),ncol=1000,nrow=1000)
image(0:1000,0:1000,img)
This is a slight variation of the solution by eipi10. It does not use the "melt" function of the reshape package and rather uses subsetting the matrix directly:
# Number of rows and columns in image
nr = 200
nc = 100
# Create image values
set.seed(78)
img <- matrix(sample(c(1,0), nr*nc, prob=c(0.8, 1-0.8), replace=TRUE), ncol=nc, nrow=nr)
center <- c(median(1:nr), median(1:nc)) # center of image
r <- 40 # radius
# setting the matrix element inside the circle to value -1
img[(row(img) - center[1])^2 + (col(img) - center[2])^2 < r^2] <- -1
# plot image
par(mar = c(0, 0, 0, 0))
image(img, useRaster=TRUE, axes=FALSE)
I've created a fake image that's smaller than yours so that the code will run more quickly:
library(plotrix) # To draw a circle
library(reshape2) # For "melt" function
Create a fake image:
# Number of rows and columns in image
nr = 200
nc = 100
# Create image values
set.seed(78)
img = matrix(sample(c(1,0), nr*nc, prob=c(0.8, 1-0.8), replace=TRUE), ncol=nc, nrow=nr)
Now that we have our image, remove points outside the desired circle:
# melt matrix into "long" format
img = melt(id.var=1:nrow(img), img)
names(img) = c("rows","cols","z")
# Find center of image
center=c(median(1:nr), median(1:nc))
# Set desired radial distance from center
r=40
# Set values outside radius to -1 (or some value that can't otherwise appear in
# the matrix). You can set the value to NA, but then you won't be able to
# control the color of the excluded region (it will just be white).
img$z[sqrt((img$rows - center[1])^2 + (img$cols - center[2])^2) > r] = -1
# Plot image. Colors ordered from lowest (-1) to highest (1) value
image(1:nr, 1:nc, matrix(img$z, nrow=nr, byrow=FALSE), col=c("gray80", "green","red"))
# Draw a circle around the selected points
draw.circle(center[1], center[2], r, lwd=2)
I am trying to calculate the area generated (in orange) by an arbitrary point in the space. here are some example pictures of different possible scenarios:
So basically in all three pictures I want to be able to calculate the orange area that is generated from point by drawing a horizontal and vertical line from the point to the blue area. The idea is simple but actually implementing is very challenging. I am writing this code in R so any help with R code would be great. Also, for the third example, we can just assume that the orange area is bounded at x and y equal to 8. And, we also know the coordinates of the green points. Any suggestion greatly appreciated!
Oh an here is my code for generating the plots below:
x = c(1,3,5)
y = c(5,3,1)
point1 = c(2,4)
point2 = c(2,2)
point3 = c(0,0)
plot(x,y,type="n",xlim=c(0,8),ylim=c(0,8))
rect(point1[1],point1[2],max(x)+10,max(y)+10,col="orange",border=NA)
rect(x,y,max(x)+10,max(y)+10,col="lightblue",border=NA)
points(x,y,pch=21,bg="green")
points(point1[1],point1[2],pch=21,bg="blue")
box()
plot(x,y,type="n",xlim=c(0,8),ylim=c(0,8))
rect(point2[1],point2[2],max(x)+10,max(y)+10,col="orange",border=NA)
rect(x,y,max(x)+10,max(y)+10,col="lightblue",border=NA)
points(x,y,pch=21,bg="green")
points(point2[1],point2[2],pch=21,bg="blue")
box()
plot(x,y,type="n",xlim=c(0,8),ylim=c(0,8))
rect(point3[1],point3[2],max(x)+10,max(y)+10,col="orange",border=NA)
rect(x,y,max(x)+10,max(y)+10,col="lightblue",border=NA)
points(x,y,pch=21,bg="green")
points(point3[1],point3[2],pch=21,bg="blue")
box()
You're working much harder than necessary. pracma::polyarea will calculate the area of any polygon given the coordinates of all vertices.
Think about the entire plotting region as an unequal grid of rectangles, with x- and y-grid points at the x- and y-coordinates of the rectangle vertices you're plotting.
x <- c(1, 3, 5)
y <- c(5, 3, 1)
max.x <- max(x) + 10
max.y <- max(y) + 10
point <- c(0, 0)
x.grid <- sort(unique(c(x, point[1], max.x)))
x.grid
# [1] 0 1 3 5 15
y.grid <- sort(unique(c(y, point[2], max.y)))
y.grid
# [1] 0 1 3 5 15
We'll keep track of the grid rectangles we painted orange with the matrix orange:
orange <- matrix(FALSE, nrow=length(y.grid)-1, ncol=length(x.grid)-1)
We'll make a plotting function that labels cells in orange based on the passed rectangle, with (x1, y1) as lower left and (x2, y2) as upper right:
plot.rect <- function(x1, y1, x2, y2, value) {
x1.idx <- which(x.grid == x1)
y1.idx <- which(y.grid == y1)
x2.idx <- which(x.grid == x2)
y2.idx <- which(y.grid == y2)
orange[y1.idx:(y2.idx-1),x1.idx:(x2.idx-1)] <<- value
}
Then, let's plot our orange rectangle (filling in TRUE) followed by all the blue ones (filling in FALSE):
plot.rect(point[1], point[2], max.x, max.y, TRUE)
for (idx in 1:length(x)) {
plot.rect(x[idx], y[idx], max.x, max.y, FALSE)
}
Finally, let's compute the size of each grid rectangle, enabling the final size computation (the point I selected at the top corresponds to your third plot; since the plot extends up 15 and to the right 15, it appears to be working as intended):
sizes <- t(outer(diff(x.grid), diff(y.grid)))
area <- sum(orange * sizes)
area
# [1] 41