Skip to content

Instantly share code, notes, and snippets.

@drammock
Last active September 17, 2020 13:18
Show Gist options
  • Save drammock/db05be8e03a4f09e5a14973a7a6a5c2c to your computer and use it in GitHub Desktop.
Save drammock/db05be8e03a4f09e5a14973a7a6a5c2c to your computer and use it in GitHub Desktop.
quick-and-dirty implementation to find the overlap area of the convex hulls of vowel measurements
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]]
})
@pr-crypto
Copy link

Thanks for your replies. I will try it this weekend and hopefully report back my victory on Monday!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment