R - image of a pixel matrix? - r

How would you you make an image from a matrix in R?
Matrix values would correspond to pixel intensity on image (although I am just interested in 0,1 values white or black at the moment.), while column and row numbers correspond to vertical and horizontal location on the image.
By make an image I mean display it on the screen and save it as a jpg.

You can display it on the screen easiest using 'image':
m = matrix(runif(100),10,10)
par(mar=c(0, 0, 0, 0))
image(m, useRaster=TRUE, axes=FALSE)
You can also have a look at the raster package...

Set up a plot with no margin:
par(mar = rep(0, 4))
Image the matrix with greyscale, like spacedman's answer but completely filling the device:
m = matrix(runif(100),10,10)
image(m, axes = FALSE, col = grey(seq(0, 1, length = 256)))
Wrap that in a call to png() to create the file:
png("simpleIm.png")
par(mar = rep(0, 4))
image(m, axes = FALSE, col = grey(seq(0, 1, length = 256)))
dev.off()
If you need to do this with spatial axes (defaults to [0,1] for X and Y) then use the image.default(x, y, z, ...) form where x and y give the central positions of the pixels in z. x and y can be of length dim(z) + 1 to give corner coordinates for that convention.
Centres of pixels (this is the default for image):
x <- seq(0, 1, length = nrow(m))
y <- seq(0, 1, length = ncol(m))
image(x, y, m, col = grey(seq(0, 1, length = 256)))
Corners of pixels (need 1 extra x and y, and 0 is now the very bottom left corner):
x <- seq(0, 1, length = nrow(m) + 1)
y <- seq(0, 1, length = ncol(m) + 1)
image(x, y, m, col = grey(seq(0, 1, length = 256)))
Note that from R 2.13 image.default gains an argument useRaster which uses the very efficient newish graphics function rasterImage rather than the old image which is effectively multiple calls to rect under the hood to draw every pixel as a polygon.

I do a matrix (where the vertical axis increases going down) one of two ways. Below is the first way using heatmap.2(). It has more control over how the numeric values are formatted in the plot (see the formatC statement below), but is a little harder to deal with when changing the layout.
library(gplots)
#Build the matrix data to look like a correlation matrix
x <- matrix(rnorm(64), nrow=8)
x <- (x - min(x))/(max(x) - min(x)) #Scale the data to be between 0 and 1
for (i in 1:8) x[i, i] <- 1.0 #Make the diagonal all 1's
#Format the data for the plot
xval <- formatC(x, format="f", digits=2)
pal <- colorRampPalette(c(rgb(0.96,0.96,1), rgb(0.1,0.1,0.9)), space = "rgb")
#Plot the matrix
x_hm <- heatmap.2(x, Rowv=FALSE, Colv=FALSE, dendrogram="none", main="8 X 8 Matrix Using Heatmap.2", xlab="Columns", ylab="Rows", col=pal, tracecol="#303030", trace="none", cellnote=xval, notecol="black", notecex=0.8, keysize = 1.5, margins=c(5, 5))

You can create a heatmap of the matrix.
library(pheatmap)
# Create a 10x10 matrix of random numbers
m = matrix(runif(100), 10, 10)
# Save output to jpeg
jpeg("heatmap.jpg")
pheatmap(m, cluster_row = FALSE, cluster_col = FALSE, color=gray.colors(2,start=1,end=0))
dev.off()
See ?pheatmap for more options.

Try levelplot:
library(lattice)
levelplot(matrix)

Here's the second way (again, where the vertical axis increases going down). This method is easier to layout, but has less control over the format of the numeric values displayed in the plot.
library(plotrix)
#Build the matrix data to look like a correlation matrix
n <- 8
x <- matrix(runif(n*n), nrow=n)
xmin <- 0
xmax <- 1
for (i in 1:n) x[i, i] <- 1.0 #Make the diagonal all 1's
#Generate the palette for the matrix and the legend. Generate labels for the legend
palmat <- color.scale(x, c(1, 0.4), c(1, 0.4), c(0.96, 1))
palleg <- color.gradient(c(1, 0.4), c(1, 0.4), c(0.96, 1), nslices=100)
lableg <- c(formatC(xmin, format="f", digits=2), formatC(1*(xmax-xmin)/4, format="f", digits=2), formatC(2*(xmax-xmin)/4, format="f", digits=2), formatC(3*(xmax-xmin)/4, format="f", digits=2), formatC(xmax, format="f", digits=2))
#Set up the plot area and plot the matrix
par(mar=c(5, 5, 5, 8))
color2D.matplot(x, cellcolors=palmat, main=paste(n, " X ", n, " Matrix Using Color2D.matplot", sep=""), show.values=2, vcol=rgb(0,0,0), axes=FALSE, vcex=0.7)
axis(1, at=seq(1, n, 1)-0.5, labels=seq(1, n, 1), tck=-0.01, padj=-1)
#In the axis() statement below, note that the labels are decreasing. This is because
#the above color2D.matplot() statement has "axes=FALSE" and a normal axis()
#statement was used.
axis(2, at=seq(1, n, 1)-0.5, labels=seq(n, 1, -1), tck=-0.01, padj=0.7)
#Plot the legend
pardat <- par()
color.legend(pardat$usr[2]+0.5, 0, pardat$usr[2]+1, pardat$usr[2], paste(" ", lableg, sep=""), palleg, align="rb", gradient="y", cex=0.7)

With ggplot2:
library(tidyverse)
n <- 12
m <- matrix(rnorm(n*n),n,n)
rownames(m) <- colnames(m) <- 1:n
df <- as.data.frame(m) %>% gather(key='y', value='val')
df$y <- as.integer(df$y)
df$x <- rep(1:n, n)
ggplot(df, aes(x, y, fill= val)) +
geom_tile() +
geom_text(aes(x, y, label=round(val,2))) +
scale_fill_gradient(low = "white", high = "red") +
theme_bw()

Related

How to create/enhance my own radar/polar chart without additional packages in R?

I've been trying to create a combination of radar/polar chart of a given vector of polygon vertices, without packages, but just with base R, which I really struggle with. So far, with some help, I have reached the following point:
a <- a <- abs(rnorm(5, mean = 4, sd = 2))
names(a) <- LETTERS[1:5]
stars(matrix(a,nrow=1),axes=TRUE, scale=FALSE,col.lines="blue",radius=FALSE)
center <- c(x=2.1, y=2.1) #the starchart for some reason chooses this as a center
half <- seq(0, pi, length.out = 51)
angle=45
for (D in a) {
Xs <- D * cos(half); Ys <- D * sin(half)
lines(center["x"] + Xs, center["y"] + Ys, col = "gray", xpd = NA, lty="dashed")
lines(center["x"] + Xs, center["y"] - Ys, col = "gray", xpd = NA, lty="dashed")
}
which gives me something this:
What I would need to take further is:
center this mixed radar/polar chart at (0,0) and mark the center
color the polygon area transparently
add radii starting from the outermost circle and reaching the center through the polygon vertices
put the vector name labels on the ends of the radii on the outermost circle
So, the final result should look something like this:
I have experimented with the polygon(), symbols() functions and par() graphic parametres, but I am really struggling to combine them...My problem is that I don't understand how the stars() function plot coordinates selection relates to my input.
Did not liked the stars functions... so I made a full rondabout with polygon:
polar_chart <- function(values){
k <- length(values)
m <- max(values)
# initialise plot
plot(1, type="n", xlab="", ylab="", xlim=1.2*m*c(-1,1), ylim=1.2*m*c(-1,1))
# radial lines & letters
sapply(k:1, function(x){
text(1.1*m*cos(-(x-1)*2*pi/k + 2*pi/3), 1.1*m*sin(-(x-1)*2*pi/k + 2*pi/3),
LETTERS[x], cex = 0.75)
lines(c(0, m*cos((x-1)*2*pi/k + 2*pi/3)), c(0, m*sin((x-1)*2*pi/k + 2*pi/3)),
col = "grey",lty="dashed")
})
# circles
aux <- seq(2*pi + 0.1, 0, -0.1)
sapply(values, function(x) lines(x*cos(aux), x*sin(aux), col = "grey",lty="dashed"))
# polygon
x <- values*cos(-(1:k-1)*2*pi/k + 2*pi/3)
y <- values*sin(-(1:k-1)*2*pi/k + 2*pi/3)
polygon(c(x, x[1]),c(y, y[1]), col = "red", border = "blue", density = 50)
}
values <- abs(rnorm(5, mean = 4, sd = 2))
polar_chart(values)
And returns a plot like the following:

Using base R, how to create a "joy plot" (aka ridgeline plots), with many distributions on top of each other with vertical offset?

The type of plot I am trying to achieve in R seems to have been known as either as moving distribution, as joy plot or as ridgeline plot:
There is already a question in Stackoverflow whose recorded answer explains how to do it using ggplot: How to reproduce this moving distribution plot with R?
However, for learning purposes, I am trying to achieve the same using only base R plots (no lattice, no ggplot, no any plotting package).
In order to get started, I generated the following fake data to play with:
set.seed(2020)
shapes <- c(0.1, 0.5, 1, 2, 4, 5, 6)
dat <- lapply(shapes, function(x) rbeta(1000, x, x))
names(dat) <- letters[1:length(shapes)]
Then using mfrow I can achieve this:
par(mfrow=c(length(shapes), 1))
par(mar=c(1, 5, 1, 1))
for(i in 1:length(shapes))
{
values <- density(dat[[names(dat)[i]]])
plot(NA,
xlim=c(min(values$x), max(values$x)),
ylim=c(min(values$y), max(values$y)),
axes=FALSE,
main="",
xlab="",
ylab=letters[i])
polygon(values, col="light blue")
}
The result I get is:
Clearly, using mfrow (or even layout) here is not flexible enough and also does allow for the overlaps between the distributions.
Then, the question: how can I reproduce that type of plot using only base R plotting functions?
Here's a base R solution. First, we calculate all the density values and then manually offset off the y axis
vals <- Map(function(x, g, i) {
with(density(x), data.frame(x,y=y+(i-1), g))
}, dat, names(dat), seq_along(dat))
Then, to plot, we calculate the overall range, draw an empty plot, and the draw the densities (in reverse so they stack)
xrange <- range(unlist(lapply(vals, function(d) range(d$x))))
yrange <- range(unlist(lapply(vals, function(d) range(d$y))))
plot(0,0, type="n", xlim=xrange, ylim=yrange, yaxt="n", ylab="", xlab="Value")
for(d in rev(vals)) {
with(d, polygon(x, y, col="light blue"))
}
axis(2, at=seq_along(dat)-1, names(dat))
d = lapply(dat, function(x){
tmp = density(x)
data.frame(x = tmp$x, y = tmp$y)
})
d = lapply(seq_along(d), function(i){
tmp = d[[i]]
tmp$grp = names(d)[i]
tmp
})
d = do.call(rbind, d)
grp = unique(d$grp)
n = length(grp)
spcx = 5
spcy = 3
rx = range(d$x)
ry = range(d$y)
rx[2] = rx[2] + n/spcx
ry[2] = ry[2] + n/spcy
graphics.off()
plot(1, type = "n", xlim = rx, ylim = ry, axes = FALSE, ann = FALSE)
lapply(seq_along(grp), function(i){
x = grp[i]
abline(h = (n - i)/spcy, col = "grey")
axis(2, at = (n - i)/spcy, labels = grp[i])
polygon(d$x[d$grp == x] + (n - i)/spcx,
d$y[d$grp == x] + (n - i)/spcy,
col = rgb(0.5, 0.5, 0.5, 0.5))
})

Adding a third dimension on a 2D heatmap

I am wondering if you could help me out with the following question:
I have a correlation matrix and a third variable (continuous) for every possible pair in the correlation matrix.
Here is a toy example:
set.seed(1234)
x <- rnorm(1000,2,1)
y <- 0.1*x+rnorm(1000,1,1)
z <- y+rnorm(1000)
third.dimension <- c("(x,y)" = 0.3, "(x,z)" = 0.5, "(y,z)"= 1)
my.df <- data.frame(x,y,z)
First, I want to create a heatmap of that correlation matrix which I do with
heatmap(cor(my.df))
Next, I would like to have a coloured dot within each "cell" of the heatmap, depending on the value of the third dimension for the respective pair. Example - if the value is between 0 and 0.49, I have a black dot, if it is between 0.5 and 1, a grey dot etc.
Hence, where I have the correlation between z and y, say, I would have a grey dot painted in the corresponding "cell" of the correlation matrix.
Thanks in advance for the help!
This should work for you:
set.seed(1234)
x <- rnorm(1000,2,1)
y <- 0.1*x+rnorm(1000,1,1)
z <- y+rnorm(1000)
third.dimension <- c("(x,y)" = 0.3, "(x,z)" = 0.5, "(y,z)"= 1)
my.df <- data.frame(x,y,z)
# required function
val2col <- function(z, zlim, col = heat.colors(12), breaks){
if(!missing(breaks)){
if(length(breaks) != (length(col)+1)){stop("must have one more break than color")}
}
if(missing(breaks) & !missing(zlim)){
breaks <- seq(zlim[1], zlim[2], length.out=(length(col)+1))
}
if(missing(breaks) & missing(zlim)){
zlim <- range(z, na.rm=TRUE)
breaks <- seq(zlim[1], zlim[2], length.out=(length(col)+1))
}
CUT <- cut(z, breaks=breaks, include.lowest = TRUE)
colorlevels <- col[match(CUT, levels(CUT))] # assign colors to heights for each point
return(colorlevels)
}
# plot
COR <- list(
x = seq(ncol(my.df)),
y = seq(ncol(my.df)),
z = cor(my.df)
)
image(COR, xaxt="n", yaxt="n")
axis(1, at=COR$x, labels = names(my.df))
axis(2, at=COR$x, labels = names(my.df))
box()
COR$col <- val2col(c(COR$z), col = grey.colors(21), zlim=c(0,1))
points(expand.grid(x=COR$x, y=COR$y), col=COR$col, pch=16, cex=3)

Overlay many plots with a different range of x

I would like to make a plot like the this image what I want, however I don't know how. I wrote the code below but I don't find a way to obtain the plot. The point here is to add density lines to my original plot (Relation Masa-SFR) the density is supposed to be every 0.3 in x. I mean one line from 7 to 7.3, the next one from 7.3 to 7.6 and so on. With the code below (continue until x=12), I obtain the this [plot][2]
plot(SFsl$MEDMASS, SFR_SalpToMPA,xlim= range(7:12),
ylim= range(-3:2.5),ylab="log(SFR(M(sun)/yr)",
xlab="log(M(star)/(M(sun)")
title("Relacion Masa-SFR")
par(new=TRUE)
FCUTsfrsl1=(SFsl$MEDMASS >= 7 & SFsl$MEDMASS <=7.3 &
SFR_SalpToMPA < 2 & SFR_SalpToMPA > -3)
x <- SFR_SalpToMPA[FCUTsfrsl1]
y <- density(x)
plot(y$y, y$x, type='l',ylim=range(-3:2.5), col="red",
ylab="", xlab="", axes=FALSE)
I did what you said but I obtained this plot, I don't know if I did something wrong
Since I don't have your data, I had to make some up. If this does what you want, I think you can adapt it to your actual data.
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y)
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values for density calc
for (i in 1:length(intx3)) {
xx <- seq(min(intx3[[i]]), max(intx3[[i]]), length.out = 512)
lines(xx, density(inty[[i]])$y, col = "red")
}
This produce the following image. You need to look closely but there is a separate density plot for each 0.3 unit interval.
EDIT Change the dimension that is used to compute the density
set.seed(7)
x <- runif(1000, 7, 12)
y <- runif(1000, -3, 3)
DF <- data.frame(x = x, y = y)
plot(DF$x, DF$y, xlim = c(7, 15))
# Cut the x axis into 0.3 unit segments, compute the density and plot
br <- seq(7, 12, 0.333)
intx <- cut(x, br) # intervals
intx2 <- as.factor(cut(x, br, labels = FALSE)) # intervals by code
intx3 <- split(x, intx) # x values
inty <- split(y, intx2) # corresponding y values
# This gives the density values in the horizontal direction (desired)
# This is the change, the above is unchanged.
for (i in 1:length(intx3)) {
yy <- seq(min(inty[[i]]), max(inty[[i]]), length.out = 512)
offset <- min(intx3[[i]])
lines(density(intx3[[i]])$y + offset, yy, col = "red")
}
Which gives:

How to make gradient color filled timeseries plot in R

How to fill area under and above (sp)line with gradient color?
This example has been drawn in Inkscape - BUT I NEED vertical gradient - NOT horizontal.
Interval from zero to positive == from white to red.
Interval from zero to negative == from white to red.
Is there any package which could do this?
I fabricated some source data....
set.seed(1)
x<-seq(from = -10, to = 10, by = 0.25)
data <- data.frame(value = sample(x, 25, replace = TRUE), time = 1:25)
plot(data$time, data$value, type = "n")
my.spline <- smooth.spline(data$time, data$value, df = 15)
lines(my.spline$x, my.spline$y, lwd = 2.5, col = "blue")
abline(h = 0)
And here's an approach in base R, where we fill the entire plot area with rectangles of graduated colour, and subsequently fill the inverse of the area of interest with white.
shade <- function(x, y, col, n=500, xlab='x', ylab='y', ...) {
# x, y: the x and y coordinates
# col: a vector of colours (hex, numeric, character), or a colorRampPalette
# n: the vertical resolution of the gradient
# ...: further args to plot()
plot(x, y, type='n', las=1, xlab=xlab, ylab=ylab, ...)
e <- par('usr')
height <- diff(e[3:4])/(n-1)
y_up <- seq(0, e[4], height)
y_down <- seq(0, e[3], -height)
ncolor <- max(length(y_up), length(y_down))
pal <- if(!is.function(col)) colorRampPalette(col)(ncolor) else col(ncolor)
# plot rectangles to simulate colour gradient
sapply(seq_len(n),
function(i) {
rect(min(x), y_up[i], max(x), y_up[i] + height, col=pal[i], border=NA)
rect(min(x), y_down[i], max(x), y_down[i] - height, col=pal[i], border=NA)
})
# plot white polygons representing the inverse of the area of interest
polygon(c(min(x), x, max(x), rev(x)),
c(e[4], ifelse(y > 0, y, 0),
rep(e[4], length(y) + 1)), col='white', border=NA)
polygon(c(min(x), x, max(x), rev(x)),
c(e[3], ifelse(y < 0, y, 0),
rep(e[3], length(y) + 1)), col='white', border=NA)
lines(x, y)
abline(h=0)
box()
}
Here are some examples:
xy <- curve(sin, -10, 10, n = 1000)
shade(xy$x, xy$y, c('white', 'blue'), 1000)
Or with colour specified by a colour ramp palette:
shade(xy$x, xy$y, heat.colors, 1000)
And applied to your data, though we first interpolate the points to a finer resolution (if we don't do this, the gradient doesn't closely follow the line where it crosses zero).
xy <- approx(my.spline$x, my.spline$y, n=1000)
shade(xy$x, xy$y, c('white', 'red'), 1000)
Here's one approach, which relies heavily on several R spatial packages.
The basic idea is to:
Plot an empty plot, the canvas onto which subsequent elements will be laid down. (Doing this first also lets you retrieve the user coordinates of the plot, needed in subsequent steps.)
Use a vectorized call to rect() to lay down a background wash of color. Getting the fiddly details of the color gradient is actually the trickiest part of doing this.
Use topology functions in rgeos to find first the closed rectangles in your figure, and then their complement. Plotting the complement with a white fill over the background wash covers up the color everywhere except within the polygons, just what you want.
Finally, use plot(..., add=TRUE), lines(), abline(), etc. to lay down whatever other details you'd like the plot to display.
library(sp)
library(rgeos)
library(raster)
library(grid)
## Extract some coordinates
x <- my.spline$x
y <- my.spline$y
hh <- 0
xy <- cbind(x,y)
## Plot an empty plot to make its coordinates available
## for next two sections
plot(data$time, data$value, type = "n", axes=FALSE, xlab="", ylab="")
## Prepare data to be used later by rect to draw the colored background
COL <- colorRampPalette(c("red", "white", "red"))(200)
xx <- par("usr")[1:2]
yy <- c(seq(min(y), hh, length.out=100), seq(hh, max(y), length.out=101))
## Prepare a mask to cover colored background (except within polygons)
## (a) Make SpatialPolygons object from plot's boundaries
EE <- as(extent(par("usr")), "SpatialPolygons")
## (b) Make SpatialPolygons object containing all closed polygons
SL1 <- SpatialLines(list(Lines(Line(xy), "A")))
SL2 <- SpatialLines(list(Lines(Line(cbind(c(0,25),c(0,0))), "B")))
polys <- gPolygonize(gNode(rbind(SL1,SL2)))
## (c) Find their difference
mask <- EE - polys
## Put everything together in a plot
plot(data$time, data$value, type = "n")
rect(xx[1], yy[-201], xx[2], yy[-1], col=COL, border=NA)
plot(mask, col="white", add=TRUE)
abline(h = hh)
plot(polys, border="red", lwd=1.5, add=TRUE)
lines(my.spline$x, my.spline$y, col = "red", lwd = 1.5)
Another possibility which uses functions from grid and gridSVG packages.
We start by generating additional data points by linear interpolation, according to methods described by #kohske here. The basic plot will then consist of two separate polygons, one for negative values and one for positive values.
After the plot has been rendered, grid.ls is used to show a list of grobs, i.e. all building block of the plot. In the list we will (among other things) find two geom_area.polygons; one representing the polygon for values <= 0, and one for values >= 0.
The fill of the polygon grobs is then manipulated using gridSVG functions: custom color gradients are created with linearGradient, and the fill of the grobs are replaced using grid.gradientFill.
The manipulation of grob gradients is nicely described in chapter 7 in the MSc thesis of Simon Potter, one of the authors of the gridSVG package.
library(grid)
library(gridSVG)
library(ggplot2)
# create a data frame of spline values
d <- data.frame(x = my.spline$x, y = my.spline$y)
# create interpolated points
d <- d[order(d$x),]
new_d <- do.call("rbind",
sapply(1:(nrow(d) -1), function(i){
f <- lm(x ~ y, d[i:(i+1), ])
if (f$qr$rank < 2) return(NULL)
r <- predict(f, newdata = data.frame(y = 0))
if(d[i, ]$x < r & r < d[i+1, ]$x)
return(data.frame(x = r, y = 0))
else return(NULL)
})
)
# combine original and interpolated data
d2 <- rbind(d, new_d)
d2
# set up basic plot
ggplot(data = d2, aes(x = x, y = y)) +
geom_area(data = subset(d2, y <= 0)) +
geom_area(data = subset(d2, y >= 0)) +
geom_line() +
geom_abline(intercept = 0, slope = 0) +
theme_bw()
# list the name of grobs and look for relevant polygons
# note that the exact numbers of the grobs may differ
grid.ls()
# GRID.gTableParent.878
# ...
# panel.3-4-3-4
# ...
# areas.gTree.834
# geom_area.polygon.832 <~~ polygon for negative values
# areas.gTree.838
# geom_area.polygon.836 <~~ polygon for positive values
# create a linear gradient for negative values, from white to red
col_neg <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(1, "npc"), y1 = unit(0, "npc"))
# replace fill of 'negative grob' with a gradient fill
grid.gradientFill("geom_area.polygon.832", col_neg, group = FALSE)
# create a linear gradient for positive values, from white to red
col_pos <- linearGradient(col = c("white", "red"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
# replace fill of 'positive grob' with a gradient fill
grid.gradientFill("geom_area.polygon.836", col_pos, group = FALSE)
# generate SVG output
grid.export("myplot.svg")
You could easily create different colour gradients for positive and negative polygons. E.g. if you want negative values to run from white to blue instead, replace col_pos above with:
col_pos <- linearGradient(col = c("white", "blue"),
x0 = unit(1, "npc"), x1 = unit(1, "npc"),
y0 = unit(0, "npc"), y1 = unit(1, "npc"))
This is a terrible way to trick ggplot into doing what you want. Essentially, I make a giant grid of points that are under the curve. Since there is no way of setting a gradient within a single polygon, you have to make separate polygons, hence the grid. It will be slow if you set the pixels too low.
gen.bar <- function(x, ymax, ypixel) {
if (ymax < 0) ypixel <- -abs(ypixel)
else ypixel <- abs(ypixel)
expand.grid(x=x, y=seq(0,ymax, by = ypixel))
}
# data must be in x order.
find.height <- function (x, data.x, data.y) {
base <- findInterval(x, data.x)
run <- data.x[base+1] - data.x[base]
rise <- data.y[base+1] - data.y[base]
data.y[base] + ((rise/run) * (x - data.x[base]))
}
make.grid.under.curve <- function(data.x, data.y, xpixel, ypixel) {
desired.points <- sort(unique(c(seq(min(data.x), max(data.x), xpixel), data.x)))
desired.points <- desired.points[-length(desired.points)]
heights <- find.height(desired.points, data.x, data.y)
do.call(rbind,
mapply(gen.bar, desired.points, heights,
MoreArgs = list(ypixel), SIMPLIFY=FALSE))
}
xpixel = 0.01
ypixel = 0.01
library(scales)
grid <- make.grid.under.curve(data$time, data$value, xpixel, ypixel)
ggplot(grid, aes(xmin = x, ymin = y, xmax = x+xpixel, ymax = y+ypixel,
fill=abs(y))) + geom_rect()
The colours aren't what you wanted, but it is probably too slow for serious use anyway.

Resources