The following code replicates the output seen on the web page. I use Plotly in part because this is what I use on the actual website and because I like the interactive plots it makes. Note that in these plots you can zoom, hover over data points, turn on and off layers, etc. The plots themselves can also be done in a library like ggplot or even in base (though the ternary plots require a library to do it in ggplot). See also my R code on GitHub for making these plots and more.
This code is based on downloading the processed demo data provided on the web site. It is written in rMarkdown using RStudio.
# Load the processed data created by this web site (see buttons at the bottom of the page)
# And set a color based on one of the columns. Change this here to recolor your output
# by a different column.
data = read.csv('data/orientations.csv') %>%
mutate(Color = Layer)
data_benn = read.csv('data/benn_data.csv') %>%
rename(Color = X)
fig = data %>% plot_ly()
for (color in unique(data$Color)) {
fig <- fig %>% add_trace(
type = 'scatterpolar',
r = data$r[data$Color == color],
theta = data$bearing[data$Color == color],
mode = 'markers',
name = color
)
}
fig <- fig %>% layout(
title = 'Schmidt Diagram (lower hemisphere)',
polar = list(radialaxis = c(0,1),
angularaxis = list(direction = 'clockwise'),
hovermode = 'closest')
)
fig
# Code modified from https://plotly.com/r/ternary-plots/
# axis layout
axis <- function(title) {
list(
title = title,
titlefont = list(
size = 20
),
tickfont = list(
size = 15
),
tickcolor = 'rgba(0,0,0,0)',
ticklen = 5
)
}
fig <- data_benn %>% plot_ly()
for (color in unique(data_benn$Color)) {
fig <- fig %>% add_trace(
type = 'scatterternary',
mode = 'markers',
a = data_benn$Isotrophy[data_benn$Color == color],
b = data_benn$Residual[data_benn$Color == color],
c = data_benn$Elongation[data_benn$Color == color],
text = color,
name = color,
marker = list(
line = list('width' = 2)
)
)
}
fig <- fig %>% layout(
title = "Benn Diagram",
ternary = list(
sum = 1,
aaxis = axis('Isotrophy'),
baxis = axis('Planar'),
caxis = axis('Elongation')
)
)
fig
bin_bearings = function(bearings) {
return(table(cut(bearings, breaks = seq(0, 360, by = 10))))
}
fig = plot_ly(type = 'barpolar')
for (color in unique(data$Color)) {
fig <- fig %>% add_trace(
type = 'barpolar',
r = bin_bearings(data$bearing[data$Color == color]),
name = color
)
}
fig <- fig %>% layout(
title = 'Rose Diagram Bearings',
polar = list(barmode = 'overlay',
bargap = 0,
angularaxis = list(direction = 'clockwise'),
hovermode = 'closest')
)
fig
bin_plunge = function(bearings) {
return(table(cut(bearings, breaks = seq(0, 90, by = 5))))
}
fig = plot_ly(type = 'barpolar')
for (color in unique(data$Color)) {
fig <- fig %>% add_trace(
type = 'barpolar',
r = bin_plunge(data$plunge[data$Color == color]),
name = color
)
}
fig <- fig %>% layout(
title = 'Rose Diagram',
polar = list(barmode = 'overlay',
bargap = 0,
sector = c(0,90),
hovermode = 'closest')
)
fig
# You have to do this little trick to fool Plotly into breaking the two point shots
# into a series of line segments. Basically you insert an empty spot between each
# artifact. Note I also pad the text labels (see below) so they stay in sync.
pad_points = function(point1, point2) {
return(c(rbind(point1, point2, rep(NA, length(point1)))))
}
# Change this to scatter3d to have a 3d plot
fig = plot_ly(type = 'scatter', mode = 'lines')
for (color in unique(data$Color)) {
fig <- fig %>% add_trace(
# Change these to YZ or XZ to get profiles
x = pad_points(data$X1[data$Color == color], data$X2[data$Color == color]),
y = pad_points(data$Y1[data$Color == color], data$Y2[data$Color == color]),
text = pad_points(data$Squid[data$Color == color], data$Squid[data$Color == color]),
name = color,
mode = 'lines'
)
}
fig <- fig %>% layout(
title = 'Plan view',
hovermode = 'closest',
xaxis = list(title = 'X',
showgrid = TRUE,
zeroline = FALSE),
yaxis = list(title = 'Y',
showgrid = TRUE,
zeroline = FALSE,
scaleanchor = 'x',
scaleratio = 1)
)
fig