Three factor plotting using xyplot - r

I had a problem with ggplot that I am not able to solve, so maybe someone here can point out the reason. Sorry that I am not able to upload my dataset, but some data description can be found below. The output of the ggplot is shown below, except NO line, every other thing is OK.
> all.data<-read.table("D:/PAM/data/Rural_Recovery_Edit.csv",head=T,sep=",")
> all.data$Water<-factor(all.data$Water,labels=c("W30","W60","W90"))
> all.data$Polymer<-factor(all.data$Polymer,labels=c("PAM-0 ","PAM-10 ","PAM-40 "))
> all.data$Group<-factor(all.data$Group,labels=c("Day20","Day25","Day30"))
> dat<-data.frame(Waterconsump=all.data[,9],Water=all.data$Water,Polymer=all.data$Polymer,Age=all.data$Group)
> ggplot(dat,aes(x=Water,y=Waterconsump,colour=Polymer))+
+ stat_summary(fun.y=mean, geom="line",size=2)+
+ stat_summary(fun.ymin=min,fun.ymax=max,geom="errorbar")+#,position="dodge"
+ facet_grid(~Age)
> dim(dat)
[1] 108 4
> head(dat)
Waterconsump Water Polymer Age
1 10.5 W30 PAM-10 Day20
2 10.3 W30 PAM-10 Day20
3 10.1 W30 PAM-10 Day20
4 7.7 W30 PAM-10 Day20
5 8.6 W60 PAM-10 Day20
6 8.4 W60 PAM-10 Day20
> table(dat$Water)
W30 W60 W90
36 36 36
> table(dat$Polymer)
PAM-0 PAM-10 PAM-40
36 36 36
> table(dat$Age)
Day20 Day25 Day30
36 36 36
and, if I changed the geom into "bar", the output is OK.
below is the background for this Q
#
I would like to plot several variables that were subjected to the same, 3 factors. Using xyplot, I am able to plot 2 of them, within one figure. However, I have no idea how to include the third, and arrange the figure into N subplots (N equals the level number of the third factor).
So, my aims would be:
Plot the 3rd facotors, and split the plot into N subplots, where N is the levels of the 3rd factor.
Better to work as a function, as I need to plot a several variables.
Below is the example figure with only two factors, and my working example to plot 2 factors.
Thanks in advance~
Marco
library(reshape)
library(agricolae)
library(lattice)
yr<-gl(10,3,90:99)
trt<-gl(4,75,labels=c("A","B","C","D"))
third<-gl(3,100,lables=c("T","P","Q")) ### The third factor to split the figure in to 4 subplots
dat<-cbind(runif(300),runif(300,min=1,max=10),runif(300,min=100,max=200),runif(300,min=1000,max=1500))
colnames(dat)<-paste("Item",1:4,sep="-")
fac<-factor(paste(trt,yr,sep="-"))
dataov<-aov(dat[,1]~fac)
dathsd<-sort_df(HSD.test(dataov,'fac'),'trt')
trtplt<-gl(3,10,30,labels=c("A","B","C"))
yrplt<-factor(substr(dathsd$trt,3,4))
prepanel.ci <- function(x, y, ly, uy, subscripts, ...)
{
x <- as.numeric(x)
ly <- as.numeric(ly[subscripts])
uy <- as.numeric(uy[subscripts])
list(ylim = range(y, uy, ly, finite = TRUE))
}
panel.ci <- function(x, y, ly, uy, subscripts, pch = 16, ...)
{
x <- as.numeric(x)
y <- as.numeric(y)
ly <- as.numeric(ly[subscripts])
uy <- as.numeric(uy[subscripts])
panel.arrows(x, ly, x, uy, col = "black",
length = 0.25, unit = "native",
angle = 90, code = 3)
panel.xyplot(x, y, pch = pch, ...)
}
xyplot(dathsd$means~yrplt,group=trtplt,type=list("l","p"),
ly=dathsd$means-dathsd$std.err,
uy=dathsd$means+dathsd$std.err,
prepanel = prepanel.ci,
panel = panel.superpose,
panel.groups = panel.ci
)
!

Here is another way of doing it, using the magic of ggplot. Because ggplot will calculate summaries for you, I suspect it means you can skip the entire step of doing aov.
The key is that your data should be in single data.frame that you can pass to ggplot. Note that I have created new sample data to demonstrate.
library(ggplot2)
df <- data.frame(
value = runif(300),
yr = rep(1:10, each=3),
trt = rep(LETTERS[1:4], each=75),
third = rep(c("T", "P", "Q"), each=100)
)
ggplot(df, aes(x=yr, y=value, colour=trt)) +
stat_summary(fun.y=mean, geom="line", size=2) +
stat_summary(fun.ymin=min, fun.ymax=max, geom="errorbar") +
facet_grid(~third)
You can go one step further and produce facets in two dimensions:
ggplot(df, aes(x=yr, y=value, colour=trt)) +
stat_summary(fun.y=mean, geom="line", size=2) +
stat_summary(fun.ymin=min, fun.ymax=max, geom="errorbar") +
facet_grid(trt~third)

This gets pretty close, but I forget how to colour the error lines using the group variable in Lattice and Deepayan's book is at work.
## format a new data structure with all variables we want
dat <- data.frame(dathsd[, c(2,5)], treat = trtplt, yrplt = yrplt,
upr = dathsd$means + 2 * dathsd$std.err,
lwr = dathsd$means - 2 * dathsd$std.err)
## compute ylims
ylims <- range(dat$lwr, dat$upr)
ylims <- ylims + (c(-1,1) * (0.05 * diff(ylims)))
## plot
xyplot(means ~ yrplt, data = dat, group = treat, lwr = dat$lwr, upr = dat$upr,
type = c("p","l"), ylim = ylims,
panel = function(x, y, lwr, upr, ...) {
panel.arrows(x0 = x, y0 = lwr, x1 = x, y1 = upr,
angle = 90, code = 3, length = 0.05)
panel.xyplot(x, y, ...)
})
And produces:

Related

Match boxplot and labels colors according Tukey's significance letters in ggplot

I am trying to match boxplot and labels colors according Tukey's significance letters in ggplot2 or ggboxplot
I don't know how to do it automatically or in a more elegant way using terrain.colors for example.
I have done it manually only to show what is my desired plot with boxplot and labels with the same colors as the Tukey's significance letters:
What I mean, is to have the "a", "b" and so on boxplots with the same color, both boxplots and letters. Something like this but using ggplot https://r-graph-gallery.com/84-tukey-test_files/figure-html/unnamed-chunk-3-1.png
your help will be very appreciated
Here is the script based on the accepted answer of this post: Is there a function to add AOV post-hoc testing results to ggplot2 boxplot?
library(plyr)
library(ggplot2)
library(multcompView)
set.seed(0)
lev <- gl(3, 10)
y <- c(rnorm(10), rnorm(10) + 0.1, rnorm(10) + 3)
d <- data.frame(lev=lev, y=y)
a <- aov(y~lev, data=d)
tHSD <- TukeyHSD(a, ordered = FALSE, conf.level = 0.95)
generate_label_df <- function(HSD, flev){
# Extract labels and factor levels from Tukey post-hoc
Tukey.levels <- HSD[[flev]][,4]
Tukey.labels <- multcompLetters(Tukey.levels)['Letters']
plot.labels <- names(Tukey.labels[['Letters']])
# Get highest quantile for Tukey's 5 number summary and add a bit of space to buffer between
# upper quantile and label placement
boxplot.df <- ddply(d, flev, function (x) max(fivenum(x$y)) + 0.2)
# Create a data frame out of the factor levels and Tukey's homogenous group letters
plot.levels <- data.frame(plot.labels, labels = Tukey.labels[['Letters']],
stringsAsFactors = FALSE)
# Merge it with the labels
labels.df <- merge(plot.levels, boxplot.df, by.x = 'plot.labels', by.y = flev, sort = FALSE)
return(labels.df)
}
#Generate ggplot
ggplot(d, aes(x=lev, y=y)) + geom_boxplot(fill = c("green", "green", "orange")) +
geom_text(data = generate_label_df(tHSD, 'lev'), colour = c("green","orange", "green"), aes(x = plot.labels, y = V1, label = labels )) +
scale_colour_manual(values=c("green", "green", "orange"))
Does this work for you? Find my comments below.
library(plyr)
library(ggplot2)
library(multcompView)
set.seed(0)
lev <- gl(3, 10)
y <- c(rnorm(10), rnorm(10) + 0.1, rnorm(10) + 3)
d <- data.frame(lev=lev, y=y)
a <- aov(y~lev, data=d)
tHSD <- TukeyHSD(a, ordered = FALSE, conf.level = 0.95)
generate_label_df <- function(HSD, flev){
# Extract labels and factor levels from Tukey post-hoc
Tukey.levels <- HSD[[flev]][,4]
Tukey.labels <- multcompLetters(Tukey.levels)['Letters']
plot.labels <- names(Tukey.labels[['Letters']])
# Get highest quantile for Tukey's 5 number summary and add a bit of space to buffer between
# upper quantile and label placement
boxplot.df <- ddply(d, flev, function (x) max(fivenum(x$y)) + 0.2)
# Create a data frame out of the factor levels and Tukey's homogenous group letters
plot.levels <- data.frame(plot.labels, labels = Tukey.labels[['Letters']],
stringsAsFactors = FALSE)
# Merge it with the labels
labels.df <- merge(plot.levels, boxplot.df, by.x = 'plot.labels', by.y = flev, sort = FALSE)
return(labels.df)
}
#############################
### new stuff starts here ###
#############################
label_df <- generate_label_df(tHSD, 'lev')
label_df$lev <- label_df$plot.labels
#Generate ggplot
lev_cols <- c("1" = "green", "2" = "green", "3" = "orange")
ggplot(d, aes(x = lev, y = y)) +
geom_boxplot(aes(fill = lev)) +
geom_text(
data = label_df,
aes(
x = plot.labels,
y = V1,
label = labels,
color = lev
)
) +
scale_color_manual(values = lev_cols) +
scale_fill_manual(values = lev_cols)
Created on 2022-10-14 with reprex v2.0.2
As you can see, you can tell different geoms_ in their aes() (!) that they should be colored according to e.g. the lev column. After doing that, you can define which of the levels in lev should have which color via a named vector c("Levelname1" = "Colorname1", ...) as we have here with lev_cols and provide it to scale_color_manual().
In this specific example, it was a bit more complex, because for geom_boxplot() we actually want different fill, while for geom_text() we want different color and thus we need both scale_color_manual() and scale_fill_manual(). Furthermore, the data you supply to the geom_text() does not have a column named lev, but I actually just made sure it does to keep it simple.
Bonus
FYI, you may also find the following alternative approach to get the compact letters display, as well as the alternative way to plot the results interesting. There's more on this here.
# extra -------------------------------------------------------------------
library(tidyverse)
library(emmeans)
library(multcomp)
library(multcompView)
set.seed(0)
lev <- gl(3, 10)
y <- c(rnorm(10), rnorm(10) + 0.1, rnorm(10) + 3)
d <- data.frame(lev = lev, y = y)
# This also gets you the letters ------------------------------------------
# fit model
model <- lm(y ~ lev, data = d)
# get (adjusted) y means per group
model_means <- emmeans(object = model,
specs = "lev")
# add letters to each mean
model_means_cld <- cld(object = model_means,
adjust = "Tukey",
Letters = letters,
alpha = 0.05)
#> Note: adjust = "tukey" was changed to "sidak"
#> because "tukey" is only appropriate for one set of pairwise comparisons
# show output
model_means_cld
#> lev emmean SE df lower.CL upper.CL .group
#> 2 -0.262 0.283 27 -0.982 0.457 a
#> 1 0.359 0.283 27 -0.361 1.079 a
#> 3 3.069 0.283 27 2.350 3.789 b
#>
#> Confidence level used: 0.95
#> Conf-level adjustment: sidak method for 3 estimates
#> P value adjustment: tukey method for comparing a family of 3 estimates
#> significance level used: alpha = 0.05
#> NOTE: If two or more means share the same grouping letter,
#> then we cannot show them to be different.
#> But we also did not show them to be the same.
# You may also like this plot ---------------------------------------------
ggplot() +
# general layout
theme_classic() +
theme(plot.caption = ggtext::element_textbox_simple()) +
# black data points
geom_point(
data = d,
aes(y = y, x = lev),
shape = 16,
alpha = 0.5,
position = position_nudge(x = -0.2)
) +
# black boxplot
geom_boxplot(
data = d,
aes(y = y, x = lev),
width = 0.05,
outlier.shape = NA,
position = position_nudge(x = -0.1)
) +
# red mean value
geom_point(
data = model_means_cld,
aes(y = emmean, x = lev),
size = 2,
color = "red"
) +
# red mean errorbar
geom_errorbar(
data = model_means_cld,
aes(ymin = lower.CL, ymax = upper.CL, x = lev),
width = 0.05,
color = "red"
) +
# red letters
geom_text(
data = model_means_cld,
aes(
y = emmean,
x = lev,
label = str_trim(.group)
),
position = position_nudge(x = 0.1),
hjust = 0,
color = "red"
) +
# caption
labs(
caption = "Black dots represent raw data. Red dots and error bars represent (estimated marginal) means ± 95% confidence interval per group. Means not sharing any letter are significantly different by the Tukey-test at the 5% level of significance."
)
Created on 2022-10-14 with reprex v2.0.2

Manually Set Scale of contour plot using geom_contour_filled

I would like manually adjust the scales of two contour plots such that each have the same scale even though they contain different ranges of values in the z-direction.
For instance, lets say that I want to make contour plots of z1 and z2:
x = 1:15
y = 1:15
z1 = x %*% t(y)
z2 = 50+1.5*(x %*% t(y))
data <- data.frame(
x = as.vector(col(z1)),
y = as.vector(row(z1)),
z1 = as.vector(z1),
z2 = as.vector(z2)
)
ggplot(data, aes(x, y, z = z1)) +
geom_contour_filled(bins = 8)
ggplot(data, aes(x, y, z = z2)) +
geom_contour_filled(bins = 8)
Is there a way I can manually adjust the scale of each plot such that each contain the same number of levels (in this case bins = 8), the minimum is the same for both (in this case min(z1)), and the max is the same for both (max(z2))?
One can manually define a vector of desired breaks points and then pass the vector to the "breaks" option in the geom_contour_filled() function.
In the below script, finds 8 break intervals between the grand minimum and the grand maximum of the dataset.
Also there are 2 functions defined to create the palette and label names for the legend.
#establish the min and max of scale
grandmin <- min(z1, z2)-1
grandmax <- max(z2, z2)
#define the number of breaks. In this case 8 +1
mybreaks <- seq(grandmin, ceiling(round(grandmax, 0)), length.out = 9)
#Function to return the dersired number of colors
mycolors<- function(x) {
colors<-colorRampPalette(c("darkblue", "yellow"))( 8 )
colors[1:x]
}
#Function to create labels for legend
breaklabel <- function(x){
labels<- paste0(mybreaks[1:8], "-", mybreaks[2:9])
labels[1:x]
}
ggplot(data, aes(x, y, z = z1)) +
geom_contour_filled(breaks= mybreaks, show.legend = TRUE) +
scale_fill_manual(palette=mycolors, values=breaklabel(8), name="Value", drop=FALSE) +
theme(legend.position = "right")
ggplot(data, aes(x, y, z = z2)) +
geom_contour_filled(breaks= mybreaks, show.legend = TRUE) +
scale_fill_manual(palette=mycolors, values=breaklabel(8), name="Value", drop=FALSE)

Considereing the number of the coordinate in the heatmap

I'm trying to make a heatmap considering the value of the point (variable 'x'). But when I run my code I only have the heatmap considering the points, and not its values.
Here is my code:
head(dengue)
lat long x
1 7791000 598157.0 156
2 7790677 598520.0 307
3 7790795 598520.0 153
4 7790153 598808.0 135
5 7790935 598813.0 1888
6 7790765 598881.7 1169
library(ggplot2)
library(ggsn)
hmap <- ggplot(dengue, aes(x=long, y=lat)) +
stat_density2d(aes(fill = ..level..), alpha=0.8, geom="polygon") +
geom_point(colour="red") +
geom_path(data=map.df,aes(x=long, y=lat,group=group), colour="grey50") +
scale_fill_gradientn(colours=rev(brewer.pal(5,"Spectral"))) +
coord_fixed() +
scalebar(location="bottomright",y.min=7781600.0, y.max=7812898.0,
x.min=597998.4, x.max=619721.2,
dist=2, transform = F,
st.dist=.04,dist_unit="km") +
blank() +
guides(fill=guide_legend(title=""))
north2(hmap, x=.7, y=.9, symbol=16)
And here is the map that I got:
Any hint on how can I make a heatmap considering the values of the points (variable 'x'), and not just its coordinates?
There was a post here that describes the adaptation of the MASS package's kde2d function to take into account the weights of points.
library(MASS)
kde2d.weighted <- function (x, y, w, h, n = 25, lims = c(range(x), range(y))) {
nx <- length(x)
if (length(y) != nx)
stop("data vectors must be the same length")
gx <- seq(lims[1], lims[2], length = n) # gridpoints x
gy <- seq(lims[3], lims[4], length = n) # gridpoints y
if (missing(h))
h <- c(bandwidth.nrd(x), bandwidth.nrd(y));
if (missing(w))
w <- numeric(nx)+1;
h <- h/4
ax <- outer(gx, x, "-")/h[1] # distance of each point to each grid point in x-direction
ay <- outer(gy, y, "-")/h[2] # distance of each point to each grid point in y-direction
z <- (matrix(rep(w,n), nrow=n, ncol=nx, byrow=TRUE)*matrix(dnorm(ax), n, nx)) %*% t(matrix(dnorm(ay), n, nx))/(sum(w) * h[1] * h[2]) # z is the density
return(list(x = gx, y = gy, z = z))
}
This is not natively embedded in ggplot2 as far as I'm aware, but you could preprocess your data outside ggplot to get the data you can put into stat_contour:
# Reading in your example data
zz <- " lat long x
1 7791000 598157.0 156
2 7790677 598520.0 307
3 7790795 598520.0 153
4 7790153 598808.0 135
5 7790935 598813.0 1888
6 7790765 598881.7 1169"
df <- read.table(text = zz)
# Doing the weighted 2d kde
wdf <- kde2d.weighted(df$lat, df$long, df$x)
wdf <- data.frame(lat = wdf$x[row(wdf$z)],
long = wdf$y[col(wdf$z)],
value = wdf$z[T])
# Plotting the result:
ggplot(df, aes(lat, long)) +
stat_contour(data = wdf, aes(z = value, fill = stat(level)), geom = "polygon") +
geom_text(aes(label = x)) # to show the weights
As you can see, the contours are a bit cut off at ugly points, but I suppose this could be amended by playing around with the lims argument of the kde2d.weighted().

A ggplot2 equivalent of the lines() function in basic plot

For reasons I won't go into I need to plot a vertical normal curve on a blank ggplot2 graph. The following code gets it done as a series of points with x,y coordinates
dfBlank <- data.frame()
g <- ggplot(dfBlank) + xlim(0.58,1) + ylim(-0.2,113.2)
hdiLo <- 31.88
hdiHi <- 73.43
yComb <- seq(hdiLo, hdiHi, length = 75)
xVals <- 0.79 - (0.06*dnorm(yComb, 52.65, 10.67))/0.05
dfVertCurve <- data.frame(x = xVals, y = yComb)
g + geom_point(data = dfVertCurve, aes(x = x, y = y), size = 0.01)
The curve is clearly discernible but is a series of points. The lines() function in basic plot would turn these points into a smooth line.
Is there a ggplot2 equivalent?
I see two different ways to do it.
geom_segment
The first uses geom_segment to 'link' each point with its next one.
hdiLo <- 31.88
hdiHi <- 73.43
yComb <- seq(hdiLo, hdiHi, length = 75)
xVals <- 0.79 - (0.06*dnorm(yComb, 52.65, 10.67))/0.05
dfVertCurve <- data.frame(x = xVals, y = yComb)
library(ggplot2)
ggplot() +
xlim(0.58, 1) +
ylim(-0.2, 113.2) +
geom_segment(data = dfVertCurve, aes(x = x, xend = dplyr::lead(x), y = y, yend = dplyr::lead(y)), size = 0.01)
#> Warning: Removed 1 rows containing missing values (geom_segment).
As you can see it just link the points you created. The last point does not have a next one, so the last segment is removed (See the warning)
stat_function
The second one, which I think is better and more ggplotish, utilize stat_function().
library(ggplot2)
f = function(x) .79 - (.06 * dnorm(x, 52.65, 10.67)) / .05
hdiLo <- 31.88
hdiHi <- 73.43
yComb <- seq(hdiLo, hdiHi, length = 75)
ggplot() +
xlim(-0.2, 113.2) +
ylim(0.58, 1) +
stat_function(data = data.frame(yComb), fun = f) +
coord_flip()
This build a proper function (y = f(x)), plot it. Note that it is build on the X axis and then flipped. Because of this the xlim and ylim are inverted.

topoplot in ggplot2 – 2D visualisation of e.g. EEG data

Can ggplot2 be used to produce a so-called topoplot (often used in neuroscience)?
Sample data:
label x y signal
1 R3 0.64924459 0.91228430 2.0261520
2 R4 0.78789621 0.78234410 1.7880972
3 R5 0.93169511 0.72980685 0.9170998
4 R6 0.48406513 0.82383895 3.1933129
Full sample data.
Rows represent individual electrodes. Columns x and y represent the projection into 2D space and the column signal is essentially the z-axis representing voltage measured at a given electrode.
stat_contour doesn't work, apparently due to unequal grid.
geom_density_2d only provides a density estimation of x and y.
geom_raster is one not fitted for this task or I must be using it incorrectly since it quickly runs out of memory.
Smoothing (like in the image on the right) and head contours (nose, ears) aren't necessary.
I want to avoid Matlab and transforming the data so that it fits this or that toolbox… Many thanks!
Update (26 January 2016)
The closest I've been able to get to my objective is via
library(colorRamps)
ggplot(channels, aes(x, y, z = signal)) + stat_summary_2d() + scale_fill_gradientn(colours=matlab.like(20))
which produces an image like this:
Update 2 (27 January 2016)
I've tried #alexforrence's approach with full data and this is the result:
It's a great start but there is a couple of issues:
The last call (ggplot()) takes about 40 seconds on an Intel i7 4790K while Matlab toolboxes manage to generate these almost instantly; my ‘emergency solution’ above takes about a second.
As you can see, the upper and lower border of the central part appear to be ‘sliced’ – I'm not sure what causes this but it could be the third issue.
I'm getting these warnings:
1: Removed 170235 rows containing non-finite values (stat_contour).
2: Removed 170235 rows containing non-finite values (stat_contour).
Update 3 (27 January 2016)
Comparison between two plots produced with different interp(xo, yo) and stat_contour(binwidth) values:
Ragged edges if one chooses low interp(xo, yo), in this case xo/yo = seq(0, 1, length = 100):
Here's a potential start:
First, we'll attach some packages. I'm using akima to do linear interpolation, though it looks like EEGLAB uses some sort of spherical interpolation here? (the data was a little sparse to try it).
library(ggplot2)
library(akima)
library(reshape2)
Next, reading in the data:
dat <- read.table(text = " label x y signal
1 R3 0.64924459 0.91228430 2.0261520
2 R4 0.78789621 0.78234410 1.7880972
3 R5 0.93169511 0.72980685 0.9170998
4 R6 0.48406513 0.82383895 3.1933129")
We'll interpolate the data, and stick that in a data frame.
datmat <- interp(dat$x, dat$y, dat$signal,
xo = seq(0, 1, length = 1000),
yo = seq(0, 1, length = 1000))
datmat2 <- melt(datmat$z)
names(datmat2) <- c('x', 'y', 'value')
datmat2[,1:2] <- datmat2[,1:2]/1000 # scale it back
I'm going to borrow from some previous answers. The circleFun below is from Draw a circle with ggplot2.
circleFun <- function(center = c(0,0),diameter = 1, npoints = 100){
r = diameter / 2
tt <- seq(0,2*pi,length.out = npoints)
xx <- center[1] + r * cos(tt)
yy <- center[2] + r * sin(tt)
return(data.frame(x = xx, y = yy))
}
circledat <- circleFun(c(.5, .5), 1, npoints = 100) # center on [.5, .5]
# ignore anything outside the circle
datmat2$incircle <- (datmat2$x - .5)^2 + (datmat2$y - .5)^2 < .5^2 # mark
datmat2 <- datmat2[datmat2$incircle,]
And I really liked the look of the contour plot in R plot filled.contour() output in ggpplot2, so we'll borrow that one.
ggplot(datmat2, aes(x, y, z = value)) +
geom_tile(aes(fill = value)) +
stat_contour(aes(fill = ..level..), geom = 'polygon', binwidth = 0.01) +
geom_contour(colour = 'white', alpha = 0.5) +
scale_fill_distiller(palette = "Spectral", na.value = NA) +
geom_path(data = circledat, aes(x, y, z = NULL)) +
# draw the nose (haven't drawn ears yet)
geom_line(data = data.frame(x = c(0.45, 0.5, .55), y = c(1, 1.05, 1)),
aes(x, y, z = NULL)) +
# add points for the electrodes
geom_point(data = dat, aes(x, y, z = NULL, fill = NULL),
shape = 21, colour = 'black', fill = 'white', size = 2) +
theme_bw()
With improvements mentioned in the comments (setting extrap = TRUE and linear = FALSE in the interp call to fill in gaps and do a spline smoothing, respectively, and removing NAs before plotting), we get:
mgcv can do spherical splines. This replaces akima (the chunk containing interp() isn't necessary).
library(mgcv)
spl1 <- gam(signal ~ s(x, y, bs = 'sos'), data = dat)
# fine grid, coarser is faster
datmat2 <- data.frame(expand.grid(x = seq(0, 1, 0.001), y = seq(0, 1, 0.001)))
resp <- predict(spl1, datmat2, type = "response")
datmat2$value <- resp

Resources