Given 'n' images in a png/jpeg format and 'n' corresponding coordinates in 2 dimensions (x,y): I would like to plot these images at the given coordinates on a single plot. If I find the images to be too big, I would ideally like to plot them as a smaller/scaled version at the given coordinates. How can i achieve such a plot in R?
An example of how such a plot would look is given below:
xy <- data.frame(x=runif(10, 0, 100), y=runif(10, 0, 100))
require(png)
img <- readPNG(system.file("img", "Rlogo.png", package="png"))
thumbnails <- function(x, y, images, width = 0.1*diff(range(x)),
height = 0.1*diff(range(y))){
images <- replicate(length(x), images, simplify=FALSE)
stopifnot(length(x) == length(y))
for (ii in seq_along(x)){
rasterImage(images[[ii]], xleft=x[ii] - 0.5*width,
ybottom= y[ii] - 0.5*height,
xright=x[ii] + 0.5*width,
ytop= y[ii] + 0.5*height, interpolate=FALSE)
}
}
plot(xy, t="n")
thumbnails(xy[,1], xy[,2], img)
The my.symbols function along with ms.image function (both from the TeachingDemos package) can be used to plot with images.
Here is an example:
library(png)
flag.list <- lapply( list.files('flags/',pattern='png$', full=TRUE),
function(x) readPNG(x) )
library(TeachingDemos)
ms.flags <- function(ind,...) {
tmp <- array(0, dim=c(150,150,4) )
tmp[ 26:125, , 1:3] <- flag.list[[ind]]
tmp[ 26:125, , 4 ] <- 1
ms.image(tmp,...)
}
x <- rnorm(50)
y <- rnorm(50)
my.symbols(x,y, symb = ms.flags, ind=1:50, symb.plots=TRUE,
add=FALSE, xlim=c(-3,3), ylim=c(-3,3), inches=0.75)
the ggflags package provides a proof-of-principle example
library(ggflags)
set.seed(1234)
d <- data.frame(x=rnorm(50), y=rnorm(50),
country=sample(c("ar","fr", "nz", "gb", "es", "ca"), 50, TRUE),
stringsAsFactors = FALSE)
ggplot(d, aes(x=x, y=y, country=country, size=x)) +
geom_flag() +
scale_country()
Related
I wonder how to get data labels on lines in ggplot2 for contours. Thanks
require(grDevices) # for colours
x <- seq(-4*pi, 4*pi, len = 27)
y <- seq(-4*pi, 4*pi, len = 27)
r <- sqrt(outer(x^2, y^2, "+"))
rx <- range(x <- 10*1:nrow(volcano))
ry <- range(y <- 10*1:ncol(volcano))
ry <- ry + c(-1, 1) * (diff(rx) - diff(ry))/2
plot(
x = 0
, y = 0
, type = "n"
, xlim = rx
, ylim = ry
, xlab = ""
, ylab = ""
)
contour(
x = x
, y = y
, z = volcano
, add = TRUE
)
library(ggplot2)
library(reshape2)
volcano3d <- melt(volcano)
names(volcano3d) <- c("x", "y", "z")
# Basic plot
v <- ggplot(volcano3d, aes(x, y, z = z))
v + stat_contour()
using directlabels package and picking solution from this
# Basic plot
v <- ggplot(volcano3d, aes(x, y, z = z))
library(directlabels)
v2 <- v + stat_contour(aes(colour = ..level..))
direct.label(v2, method="bottom.pieces")
This is an old question already answered, but I do a lot of contour plots and I think that there is an easier and more versatile way to do this using the package metR (https://rdrr.io/github/eliocamp/metR/f/vignettes/Visualization-tools.Rmd). This package has the function geom_label_contour() that provides an easy way to plot labels of contours. Also provides a lot of functions to plot maps.
library(ggplot2)
library(reshape2)
library(metR)
volcano3d <- melt(volcano)
colnames(volcano3d) <- c('x','y','z')
ggplot(data = volcano3d, aes(x=x,y=y,z=z)) + geom_contour() +
geom_label_contour()
When we take the following example from ggplot2 docs
df <- data.frame(x = c(rnorm(100, 0, 3), rnorm(100, 0, 10)),
g = gl(2, 100))
library(ggplot2)
p <- ggplot(df, aes(x, colour = g)) +
stat_ecdf(geom = "step", na.rm = T) + # interchange point and step
theme_bw()
p
We can create a standard cdf plot. Now if we want to play with the plot in plotly, I obtain a very confusing image when I use the step command. See below. However, when I use the point command plotly behaves like it should. What is happening with the step command? Why can't I recreate the image from using ggplot only?
library(plotly)
ggplotly(p)
I found the solution here https://community.plotly.com/t/bug-with-ggplot2-stat-ecdf-function/1187/3.
You should reorder the dataframe along x.
df <- dplyr::arrange(df, x)
library(ggplot2)
p <- ggplot(df, aes(x, colour = g)) +
stat_ecdf(geom = "step", na.rm = T) +
theme_bw()
p
library(plotly)
ggplotly(p)
This can be solved using ecdf() function.
## ecdf function to get y and 1-y
rcdf <- function (x) {
cdf <- ecdf(x)
y1 <- cdf(x)
y <- unique(y1)
# xrcdf <- 1-y ## to get reverse cdf
xrcdf <- y ## to get cdf
}
ug <- unique(df$g)
ng <- length(ug)
xll <- min(df$x)
xul <- max(df$x)
adr <- data.frame(myxx=c(), myyy=c(), mygg=c())
lapply(1:ng, function(i){
ad2r <- subset(df, g==ug[i])
myx1 <- unique(ad2r$x)
myxx <- c(xll,myx1,xul) ## add lowest value - dummy to assign 100%
myy1 <- rcdf(ad2r$x)
# myyy <- c(1.0,myy1,0.0) ## add 100% to get reverse cdf
myyy <- c(0.0,myy1,1.0) ## add 0% to get cdf
mygg <- ug[i]
ad2rf <- data.frame(myxx,myyy,mygg)
adr <<- rbind(adr,ad2rf)
})
adf <- adr[order(adr$myxx),]
pp <- ggplot(data=adf,
aes_(x=adf$myxx, y=100*adf$myyy, col=adf$mygg, group=adf$mygg)) +
geom_step() +
labs(title="CDF", y = "Y", x = "X", col=NULL)
ppp <- ggplotly(pp, tooltip=c("x","y"))
ppp
This gives the following output:
CDF
I wanted to create a contour plot using the ggplot library. I checked the documentation on this topic, and found the code to get this done. Unfortunately the code uses the indexes of the matrix z storing the surface, as x and y. How do I change this to the actual value of x and y?
Below my code generating the contour plot.
objective_function <- function(vec) {
basin_function <- function(vec){
if(all(vec == 0)) {
return(0)
} else{
return(sum(exp(-2.0/vec^2)+sin(vec*pi*2)))
}
}
return(basin_function(vec))
}
objective_function_wrapper <- function(x_vec, y_vec) {
vec <-rbind(x_vec,y_vec)
return(apply(vec,2, objective_function))
}
plotSurf <-function(){
x <- y <-seq(from=-5, to =5, by=0.1)
z <- outer(x,y, objective_function_wrapper)
surf3d <- melt(z)
names(surf3d) <- c("x", "y", "z")
p1 <- ggplot(data=surf3d, aes(x=x, y=y, z=z))
p1 <- p1 + geom_tile(aes(fill=z))+stat_contour()
print(p1)
}
plotSurf()
You need to substitute the x- and y-values for the row and column numbers that are currently sitting in the "melt"-ed result of the outer call:
x <- y <-seq(from=-5, to =5, by=0.1)
z <- outer(x,y, objective_function_wrapper)
surf3d <- melt(z)
names(surf3d) <- c("x", "y", "z")
surf3d$x <- rep(x, ncol(z) ); surf3d$y <- rep(y, each=nrow(z) )
I have a big text file with a lot of rows. Every row corresponds to one vector.
This is the example of each row:
x y dx dy
99.421875 52.078125 0.653356799108 0.782479314511
First two columns are coordinates of the beggining of the vector. And two second columnes are coordinate increments (the end minus the start).
I need to make the picture of this vector field (all the vectors on one picture).
How could I do this?
Thank you
If there is a lot of data (the question says "big file"),
plotting the individual vectors may not give a very readable plot.
Here is another approach: the vector field describes a way of deforming something drawn on the plane;
apply it to a white noise image.
vector_field <- function(
f, # Function describing the vector field
xmin=0, xmax=1, ymin=0, ymax=1,
width=600, height=600,
iterations=50,
epsilon=.01,
trace=TRUE
) {
z <- matrix(runif(width*height),nr=height)
i_to_x <- function(i) xmin + i / width * (xmax - xmin)
j_to_y <- function(j) ymin + j / height * (ymax - ymin)
x_to_i <- function(x) pmin( width, pmax( 1, floor( (x-xmin)/(xmax-xmin) * width ) ) )
y_to_j <- function(y) pmin( height, pmax( 1, floor( (y-ymin)/(ymax-ymin) * height ) ) )
i <- col(z)
j <- row(z)
x <- i_to_x(i)
y <- j_to_y(j)
res <- z
for(k in 1:iterations) {
v <- matrix( f(x, y), nc=2 )
x <- x+.01*v[,1]
y <- y+.01*v[,2]
i <- x_to_i(x)
j <- y_to_j(y)
res <- res + z[cbind(i,j)]
if(trace) {
cat(k, "/", iterations, "\n", sep="")
dev.hold()
image(res)
dev.flush()
}
}
if(trace) {
dev.hold()
image(res>quantile(res,.6), col=0:1)
dev.flush()
}
res
}
# Sample data
van_der_Pol <- function(x,y, mu=1) c(y, mu * ( 1 - x^2 ) * y - x )
res <- vector_field(
van_der_Pol,
xmin=-3, xmax=3, ymin=-3, ymax=3,
width=800, height=800,
iterations=50,
epsilon=.01
)
image(-res)
You may want to apply some image processing to the result to make it more readable.
image(res > quantile(res,.6), col=0:1)
In your case, the vector field is not described by a function:
you can use the value of the nearest neighbour or some 2-dimensional interpolation
(e.g., from the akima package).
With ggplot2, you can do something like this :
library(grid)
df <- data.frame(x=runif(10),y=runif(10),dx=rnorm(10),dy=rnorm(10))
ggplot(data=df, aes(x=x, y=y)) + geom_segment(aes(xend=x+dx, yend=y+dy), arrow = arrow(length = unit(0.3,"cm")))
This is taken almost directly from the geom_segment help page.
OK, here's a base solution:
DF <- data.frame(x=rnorm(10),y=rnorm(10),dx=runif(10),dy=runif(10))
plot(NULL, type = "n", xlim=c(-3,3),ylim=c(-3,3))
arrows(DF[,1], DF[,2], DF[,1] + DF[,3], DF[,2] + DF[,4])
Here is a example from the R-Help of pracma-package.
library(pracma)
f <- function(x, y) x^2 - y^2
xx <- c(-1, 1); yy <- c(-1, 1)
vectorfield(f, xx, yy, scale = 0.1)
for (xs in seq(-1, 1, by = 0.25)) {
sol <- rk4(f, -1, 1, xs, 100)
lines(sol$x, sol$y, col="darkgreen")
}
You can use quiver also.
library(pracma)
xyRange <- seq(-1*pi,1*pi,0.2)
temp <- meshgrid(xyRange,xyRange)
u <- sin(temp$Y)
v <- cos(temp$X)
plot(range(xyRange),range(xyRange),type="n",xlab=expression(frac(d*Phi,dx)),ylab=expression(d*Phi/dy))
quiver(temp$X,temp$Y,u,v,scale=0.5,length=0.05,angle=1)
I have a matrix data here, and I visualized it with levelplot. The Plot is placed below. But I just couldn't put the values into the plot, I mean I read this question, but still couldn't figure it out.
How can I do that ? Thanks.
The problem with the code in the answer you linked to is that it only works when the objects in the levelplot's formula are named x, y, and z.
Here is an example that uses a more standard idiom for processing the arguments passed in to the custom panel function and so becomes more generally applicable:
library("lattice")
## Example data
x <- seq(pi/4, 5*pi, length.out=10)
y <- seq(pi/4, 5*pi, length.out=10)
grid <- expand.grid(X=x, Y=y)
grid$Z <- runif(100, -1, 1)
## Write a panel function (after examining 'args(panel.levelplot) to see what
## will be being passed on to the panel function by levelplot())
myPanel <- function(x, y, z, ...) {
panel.levelplot(x,y,z,...)
panel.text(x, y, round(z,1))
}
## Try it out
levelplot(Z ~ X*Y, grid, panel = myPanel)
mat <- read.csv("J_H2S1T6_PassTraffic.csv", header=F)
y <- as.numeric(mat[1,-1])
mat <- mat[-1,-1]
n <- dim(mat)[1]
Here a modification, I generate a new scale
x <- seq(min(y), max(y), length.out=n)
grid <- expand.grid(x=x, y=x)
mat <- as.matrix(mat)
dim(mat) <- c(n*n,1)
grid$z <- mat
Here the modification. I change the dimension of the matrix to a vector to put it in the grid .
mat <- as.matrix(mat)
dim(mat) <- c(n*n,1)
grid$z <- mat
p <- levelplot(z~x*y, grid,
panel=function(...) {
arg <- list(...)
panel.levelplot(...)
panel.text(arg$x, arg$y,arg$z)},
scales = list(y = list(at=y,labels=y),
x = list(at=y,labels=y)))
print(p)
Another option is to use layer() from latticeExtra. It allows you to overlay one plot on top of another, using the + operator familiar to ggplot2 enthusiasts:
library(latticeExtra)
## Applied to the example data in my other answer, this will produce
## an identical plot
levelplot(Z ~ X*Y, data = grid) +
layer(panel.text(X, Y, round(Z, 1)), data = grid)