-
-
Save drammock/db05be8e03a4f09e5a14973a7a6a5c2c to your computer and use it in GitHub Desktop.
library(phonR) # convexHullArea | |
library(sp) # SpatialPolygons, etc | |
library(rgeos) # gIntersection | |
data(indoVowels) | |
female_two <- indo[indo$subj == "F02",] | |
by_vowel <- split(female_two, female_two$vowel) | |
hull_indices <- sapply(by_vowel, function(df) with(df, chull(f1, f2))) | |
hulls <- sapply(names(by_vowel), function(v) by_vowel[[v]][hull_indices[[v]],], | |
simplify=FALSE) | |
matrices <- sapply(hulls, function(df) as.matrix(df[,c("f1", "f2")])) | |
closed_mats <- sapply(matrices, function(m) rbind(m, m[1,])) | |
polygons <- sapply(closed_mats, Polygon, hole=FALSE) | |
polygon_lists <- sapply(names(polygons), function(i) Polygons(polygons[i], ID=i)) | |
spatial_polygons <- sapply(names(polygon_lists), function(i) SpatialPolygons(polygon_lists[i])) | |
cmbns <- combn(names(by_vowel), 2) | |
overlap <- apply(cmbns, 2, function(i) gIntersection(spatial_polygons[[i[1]]], | |
spatial_polygons[[i[2]]])) | |
names(overlap) <- apply(cmbns, 2, paste, collapse="-") | |
overlap_area <- sapply(overlap, function(i) if (is.null(i)) {0} else {i@polygons[[1]]@area}) | |
hull_area <- with(indo, convexHullArea(f1, f2, group=vowel)) | |
voach <- sapply(names(overlap_area), function(i) { | |
v <- strsplit(i, '-', fixed=TRUE)[[1]] | |
min(hull_area[v]) / overlap_area[[i]] | |
}) |
I don't think there is an out-of-the-box way to make that plot with phonR. This gist computes the complete overlap of the 2 larger hulls, whereas that figure shows the (smaller) hull defined by the vowel tokens that are within the overlap area. It would be possible to use phonR to plot the 2 larger hulls, then use this code to find the overlap region, then find which vowel tokens are inside that region (using splancs::inpip()
I think?), then defining the new hull based on those points (using this gist again, up through line 10), and finally adding the new hull to the phonR plot using polygon()
. I'm writing all this from memory so don't be surprised if I got something wrong... Give it a go and let me know if you can't get it to work.
Thanks for your replies. I will try it this weekend and hopefully report back my victory on Monday!
Cheers!