Go back to the Contents page.
Press Show to reveal the code chunks.
# Set seed for reproducibility
set.seed(1982)
# Set global options for all code chunks
knitr::opts_chunk$set(
# Disable messages printed by R code chunks
message = FALSE,
# Disable warnings printed by R code chunks
warning = FALSE,
# Show R code within code chunks in output
echo = TRUE,
# Include both R code and its results in output
include = TRUE,
# Evaluate R code chunks
eval = FALSE,
# Enable caching of R code chunks for faster rendering
cache = FALSE,
# Align figures in the center of the output
fig.align = "center",
# Enable retina display for high-resolution figures
retina = 2,
# Show errors in the output instead of stopping rendering
error = TRUE,
# Do not collapse code and output into a single block
collapse = FALSE
)
# Start the figure counter
fig_count <- 0
# Define the captioner function
captioner <- function(caption) {
fig_count <<- fig_count + 1
paste0("Figure ", fig_count, ": ", caption)
}library(MetricGraph)
library(ggplot2)
library(reshape2)
library(dplyr)
library(viridis)
library(plotly)
library(patchwork)
library(slackr)
source("keys.R")
slackr_setup(token = token) # token comes from keys.R## [1] "Successfully connected to Slack"
## python: /home/rierasl/miniconda3/envs/phdenv/bin/python
## libpython: /home/rierasl/miniconda3/envs/phdenv/lib/libpython3.11.so
## pythonhome: /home/rierasl/miniconda3/envs/phdenv:/home/rierasl/miniconda3/envs/phdenv
## version: 3.11.14 (main, Oct 21 2025, 18:31:21) [GCC 11.2.0]
## numpy: /home/rierasl/miniconda3/envs/phdenv/lib/python3.11/site-packages/numpy
## numpy_version: 2.4.2
##
## NOTE: Python version was forced by RETICULATE_PYTHON
capture.output(
knitr::purl(here::here("functionality1.Rmd"), output = here::here("functionality1.R")),
file = here::here("old/purl_log.txt")
)
source(here::here("functionality1.R"))Press the Show button below to reveal the code.
Below we plot the interval graph \(\Gamma_I = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1, v_2\}\) and \(\mathcal{E} = \{e_1\}\), where \(e_1\) is the edge connecting \(v_1\) and \(v_2\).
e1_ini_x <- 0; e1_ini_y <- 0; e1_ini_z <- 0
e1_fin_x <- 1; e1_fin_y <- 0; e1_fin_z <- 0
# Midpoint
xm1 <- (e1_fin_x + e1_ini_x)/2
ym1 <- (e1_fin_y + e1_ini_y)/2
zm1 <- (e1_fin_z + e1_ini_z)/2
# Direction vector
dx1 <- e1_fin_x - e1_ini_x
dy1 <- e1_fin_y - e1_ini_y
dz1 <- e1_fin_z - e1_ini_z
e2_ini_x <- 0; e2_ini_y <- 1; e2_ini_z <- 0
e2_fin_x <- 0; e2_fin_y <- 0; e2_fin_z <- 0
# Midpoint
xm2 <- (e2_fin_x + e2_ini_x)/2
ym2 <- (e2_fin_y + e2_ini_y)/2
zm2 <- (e2_fin_z + e2_ini_z)/2
# Direction vector
dx2 <- e2_fin_x - e2_ini_x
dy2 <- e2_fin_y - e2_ini_y
dz2 <- e2_fin_z - e2_ini_z
# for the circle
r <- 1/pi
cx <- 1 + r
cy <- 0
# parameter value where the cone will be placed
t0 <- 0
# position on the curve
x0 <- cx + r*cos(t0)
y0 <- cy + r*sin(t0)
z0 <- 0
# tangent vector (derivative)
dx <- -r*sin(t0)
dy <- r*cos(t0)
dz <- 0
sizeref <- 0.1n <- 60#333
graph <- gets.graph.interval(n = n)
notes_int <- list(annotations = list(
list(
x = 0, y = 0, z = 0,
text = TeX("v_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1, z = 0,
text = TeX("v_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 0.5, z = 0,
text = TeX("e_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))
layout_int <- list(xaxis = list(title = list(text = "x", font = list(color = colaxnn)), tickfont = list(color = colaxnn)),
yaxis = list(title = list(text = "y", font = list(color = colaxnn)), tickfont = list(color = colaxnn)),
zaxis = list(title = list(text = "z", font = list(color = colaxnn)), tickfont = list(color = colaxnn)),
camera = list(eye = list(x = 2.3,
y = 2.3,
z = 2.3),
center = list(x = 0,
y = 0,
z = 0)))
p11 <- graph$plot_function(rep(0,nrow(graph$mesh$V)),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "black")|>
config(mathjax = 'cdn') |>
add_trace(
type = "cone",
x = ym1,
y = xm1,
z = zm1,
u = dy1,
v = dx1,
w = dz1,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("green", "green")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(notes_int, layout_int),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
p11new <- graph$plot_function(rep(0,nrow(graph$mesh$V)),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "black")|>
config(mathjax = 'cdn') |>
add_trace(
type = "cone",
x = ym1,
y = xm1,
z = zm1,
u = dy1,
v = dx1,
w = dz1,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("green", "green")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(layout_int,
list(annotations = list(
list(
x = 0, y = 0, z = 0,
text = TeX("v_1 = 0"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1, z = 0,
text = TeX("v_2 = \\ell_{e_1}"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 0.5, z = 0,
text = TeX("e_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
p2int <- graph$plot_function(rep(0,nrow(graph$mesh$V)),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "black")|>
config(mathjax = 'cdn') |>
add_trace(
type = "cone",
x = xm2,
y = ym2,
z = zm2,
u = dx2,
v = dy2,
w = dz2,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("red", "red")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(layout_int,
list(annotations = list(
list(
x = 0, y = 0, z = 0,
text = TeX("v_1 = \\ell_{e_1}"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1, z = 0,
text = TeX("v_2 = 0"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 0.5, z = 0,
text = TeX("\\hat{e}_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
notes_int_dir <- list(annotations = list(
list(
x = 0, y = 1, z = 1,
text = TeX("\\partial_{e_1}f(v_2) = -f'_{e_1}(\\ell_{e_1})"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 1,
text = TeX("\\partial_{e_1}f(v_1) = f'_{e_1}(0)"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 0,
text = TeX("v_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1, z = 0,
text = TeX("v_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 0.5, z = 0,
text = TeX("e_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))
p_int_dir_der <- graph$plot_function(cos(2*pi*graph$mesh$V[,1]),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "red")|>
config(mathjax = 'cdn') |>
# arrow shaft
add_trace(
type = "scatter3d",
mode = "lines",
x = c(0, 0),
y = c(1, 0.75), # base point + vector
z = c(1, 1),
line = list(color = "#0000C8", width = 6),
showlegend = FALSE
) |>
# arrow tip
add_trace(
type = "cone",
x = 0,
y = 0.75,
z = 1,
u = dx2, # smaller than vector for tip size
v = dy2,
w = dz2,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("#0000C8", "#0000C8")),
cmin = 0,
cmax = 1
) |>
add_trace(
type = "scatter3d",
mode = "lines",
x = c(0, 0),
y = c(0, 0.25), # base point + vector
z = c(1, 1),
line = list(color = "#0000C8", width = 6),
showlegend = FALSE
) |>
add_trace(
type = "cone",
x = 0,
y = 0.25,
z = 1,
u = dy1,
v = dx1,
w = dz1,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("#0000C8", "#0000C8")),
cmin = 0,
cmax = 1
) |>
add_trace(
type = "cone",
x = ym1,
y = xm1,
z = zm1,
u = dy1,
v = dx1,
w = dz1,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("green", "green")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(notes_int_dir, layout_int, list(aspectratio = list(x = 1, y = 1, z = 1))),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
p_int_dir_der_exp <- graph$plot_function(exp(graph$mesh$V[,1]),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "red")|>
config(mathjax = 'cdn') |>
# arrow shaff
add_trace(
type = "scatter3d",
mode = "lines",
x = c(0, 0),
y = c(0, 0.25), # base point + vector
z = c(1, 1.25),
line = list(color = "#0000C8", width = 6),
showlegend = FALSE
) |>
add_trace(
type = "cone",
x = 0,
y = 0.25,
z = 1.25,
u = 0,
v = 0.25,
w = 0.25,
sizemode = "absolute",
sizeref = sizeref*1.5,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("#0000C8", "#0000C8")),
cmin = 0,
cmax = 1
) |>
# arrow shaff
add_trace(
type = "scatter3d",
mode = "lines",
x = c(0, 0),
y = c(1, 0.75), # base point + vector
z = c(exp(1), exp(1)*0.75),
line = list(color = "#0000C8", width = 6),
showlegend = FALSE
) |>
add_trace(
type = "cone",
x = 0,
y = 0.75,
z = exp(1)*0.75,
u = 0,
v = -0.25,
w = -0.25*exp(1),
sizemode = "absolute",
sizeref = sizeref*2.2,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("#0000C8", "#0000C8")),
cmin = 0,
cmax = 1
) |>
add_trace(
type = "cone",
x = ym1,
y = xm1,
z = zm1,
u = dy1,
v = dx1,
w = dz1,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("green", "green")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(layout_int, list(aspectratio = list(x = 1, y = 1, z = 1)),
list(annotations = list(
list(
x = 0, y = 1, z = exp(1),
text = TeX("\\partial_{e_1}f(v_2) = -f'_{e_1}(\\ell_{e_1})"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 1,
text = TeX("\\partial_{e_1}f(v_1) = f'_{e_1}(0)"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 0,
text = TeX("v_1=0"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1, z = 0,
text = TeX("v_2=\\ell_{e_1}"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 0.5, z = 0,
text = TeX("e_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
p_int_dir_der_exp_rev <- graph$plot_function(exp(graph$mesh$V[,1]),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "red")|>
config(mathjax = 'cdn') |>
# arrow shaff
add_trace(
type = "scatter3d",
mode = "lines",
x = c(0, 0),
y = c(0, 0.25), # base point + vector
z = c(1, 1.25),
line = list(color = "#0000C8", width = 6),
showlegend = FALSE
) |>
add_trace(
type = "cone",
x = 0,
y = 0.25,
z = 1.25,
u = 0,
v = 0.25,
w = 0.25,
sizemode = "absolute",
sizeref = sizeref*1.5,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("#0000C8", "#0000C8")),
cmin = 0,
cmax = 1
) |>
# arrow shaff
add_trace(
type = "scatter3d",
mode = "lines",
x = c(0, 0),
y = c(1, 0.75), # base point + vector
z = c(exp(1), exp(1)*0.75),
line = list(color = "#0000C8", width = 6),
showlegend = FALSE
) |>
add_trace(
type = "cone",
x = 0,
y = 0.75,
z = exp(1)*0.75,
u = 0,
v = -0.25,
w = -0.25*exp(1),
sizemode = "absolute",
sizeref = sizeref*2.2,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("#0000C8", "#0000C8")),
cmin = 0,
cmax = 1
) |>
add_trace(
type = "cone",
x = ym1,
y = xm1,
z = zm1,
u = -dy1,
v = -dx1,
w = -dz1,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("red", "red")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(layout_int, list(aspectratio = list(x = 1, y = 1, z = 1)),
list(annotations = list(
list(
x = 0, y = 1, z = exp(1),
text = TeX("\\partial_{\\hat{e}_1}g(v_2) = g'_{\\hat{e}_1}(0)"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 1,
text = TeX("\\partial_{\\hat{e}_1}g(v_1) = -g'_{e_1}(\\ell_{e_1})"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 0,
text = TeX("v_1 = \\ell_{e_1}"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1, z = 0,
text = TeX("v_2=0"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 0.5, z = 0,
text = TeX("\\hat{e}_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
save(p11new, file = here::here("data_files/interval_graph_with_coordinates.Rdata"))
save(p_int_dir_der_exp_rev, file = here::here("data_files/interval_graph_derivative_exp_rev.Rdata"))
save(p_int_dir_der_exp, file = here::here("data_files/interval_graph_derivative_exp.Rdata"))
save(p11, file = here::here("data_files/interval_graph.Rdata"))
save(p2int, file = here::here("data_files/interval_graph_flip_edge.Rdata"))
save(p_int_dir_der, file = here::here("data_files/interval_graph_derivative.Rdata"))Below we plot the circle graph \(\Gamma_C = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_2\}\) and \(\mathcal{E} = \{e_2\}\), where \(e_2\) is the edge connecting \(v_2\) to itself.
n <- 6#666
graph <- gets.graph.circle(n = n)
notes_cir <- list(annotations = list(
list(
x = 0, y = 1, z = 0,
text = TeX("v_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1 + 2/pi, z = 0,
text = TeX("e_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))
p22 <- graph$plot_function(rep(0,nrow(graph$mesh$V)),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "black") %>%
config(mathjax = 'cdn') %>%
add_trace(
type = "cone",
x = y0,
y = x0,
z = z0,
u = dy,
v = dx,
w = dz,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0,1), c("green","green")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(notes_cir, layout_int),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
save(p22, file = here::here("data_files/circle_graph.Rdata"))Below we plot the tadpole graph \(\Gamma_T = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1, v_2\}\) and \(\mathcal{E} = \{e_1, e_2\}\), where \(e_1\) is the edge connecting \(v_1\) and \(v_2\), and \(e_2\) is the edge connecting \(v_2\) to itself.
graph <- gets.graph.tadpole(h = 1/4)
notes_tad_1 <- list(annotations = list(
list(
x = 0, y = 0, z = 0,
text = TeX("v_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 1, z = 0,
text = TeX("v_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0, y = 0.5, z = 0,
text = TeX("e_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 1+2/pi, z = 0,
text = TeX("e_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))
p33 <- graph$plot_function(rep(0,nrow(graph$mesh$V)),
vertex_size = gsw,
type = "plotly",
line_width = gsw,
edge_width = gsw,
line_color = "black") |>
config(mathjax = 'cdn') |>
add_trace(
type = "cone",
x = ym1,
y = xm1,
z = zm1,
u = dy1,
v = dx1,
w = dz1,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0, 1), c("green", "green")),
cmin = 0,
cmax = 1
) |>
add_trace(
type = "cone",
x = y0,
y = x0,
z = z0,
u = dy,
v = dx,
w = dz,
sizemode = "absolute",
sizeref = sizeref,
showscale = FALSE,
showlegend = FALSE,
colorscale = list(c(0,1), c("green","green")),
cmin = 0,
cmax = 1
) |>
layout(font = list(family = "Palatino"),
scene = c(notes_tad_1, layout_int),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
save(p33, file = here::here("data_files/tadpole_graph.Rdata"))Below we plot the function \(f = \gamma\big|_\Gamma\) where \(\gamma(x,y) = e^{-x^2-y^2}\), together with a path on the graph that illustrates the geodesic distance between points \(s_1\) and \(s_2\).
graph_to_get_loc <- gets.graph.tadpole(h = 1/40)
loc <- graph_to_get_loc$get_mesh_locations()
A <- as.matrix(graph$fem_basis(loc))
A <- apply(A, 2, function(x) plotting.order(x, graph_to_get_loc))
A <- rbind(A, rep(NA, ncol(A))) # Add a row of NAs for the plotting
x_g <- graph_to_get_loc$mesh$V[, 1]
y_g <- graph_to_get_loc$mesh$V[, 2]
f_g <- exp(-x_g^2 - y_g^2)
x <- c(plotting.order(x_g, graph_to_get_loc), NA)
y <- c(plotting.order(y_g, graph_to_get_loc), NA)
f <- c(plotting.order(f_g, graph_to_get_loc), NA)
x_range <- range(x, na.rm = TRUE)*1.001
y_range <- range(y, na.rm = TRUE)*1.001
z_range <- c(0,1)notes1 <- list(annotations = list(
list(
x = 0, y = 0, z = 0,
text = TeX("v_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 1, y = 0, z = 0,
text = TeX("v_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0.5, y = 0, z = 0,
text = TeX("e_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 1+2/pi, y = 0, z = 0,
text = TeX("e_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0.25, y = 0, z = 0,
text = TeX("s_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 1+1/pi, y = 1/pi, z = 0,
text = TeX("s_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0.25, y = 0, z = 1,
text = TeX("f=\\gamma\\big|_\\Gamma"),
textangle = 0, ax = -40, ay = 0,
font = list(color = "rgb(0,0,200)", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))
# to plot the path
theta <- seq(from = pi/2, to = pi, length.out = 100)
SSTHETA <- seq(from = -pi, to = pi/2, length.out = 300)
SS1 <- data.frame(x = c(0, 0.25),
y = c(0,0),
z = c(0,0))
SS2 <- data.frame(x = 1+1/pi+cos(SSTHETA)/pi,
y = sin(SSTHETA)/pi,
z = rep(0, length(SSTHETA)))
df1 <- data.frame(x = c(0.25,1),
y = c(0,0),
z = c(0,0))
df2 <- data.frame(x = 1+1/pi+cos(theta)/pi,
y = sin(theta)/pi,
z = rep(0, length(theta)))
p1 <- plot_ly() |>
config(mathjax = 'cdn') |>
add_trace(x = 0, y = 0, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
add_trace(x = 1, y = 0, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
add_trace(x = 0.25, y = 0, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "red", symbol = 104),
showlegend = FALSE) |>
add_trace(x = 1+1/pi, y = 1/pi, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "red", symbol = 104),
showlegend = FALSE) |>
add_trace(data = SS1, x = ~x, y = ~y, z = ~z, mode = "lines", type = "scatter3d",
line = list(width = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
add_trace(data = SS2, x = ~x, y = ~y, z = ~z, mode = "lines", type = "scatter3d",
line = list(width = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
add_trace(data = df1, x = ~x, y = ~y, z = ~z, mode = "lines", type = "scatter3d",
line = list(width = gsw, color = "red", symbol = 104),
showlegend = FALSE) |>
add_trace(data = df2, x = ~x, y = ~y, z = ~z, mode = "lines", type = "scatter3d",
line = list(width = gsw, color = "red", symbol = 104),
showlegend = FALSE) |>
add_trace(x = x,
y = y,
z = f,
type = "scatter3d",
mode = "lines",
line = list(color = "rgb(0,0,200)", width = gsw),
showlegend = FALSE) |>
add_trace(x = rep(x, each = 3),
y = rep(y, each = 3),
z = unlist(lapply(f, function(zj) c(0, zj, NA))),
type = "scatter3d",
mode = "lines",
line = list(color = "lightgray", width = 0.5),
showlegend = FALSE) |>
layout(font = list(family = "Palatino"),
scene = c(tadpole.layout(x_range, y_range, z_range),notes1),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
save(p1, file = here::here("data_files/tadpole_graph_function.Rdata"))Below we plot the mesh of the tadpole graph.
df3 <- data.frame(x = graph$mesh$V[, 1],
y = graph$mesh$V[, 2],
z = rep(0, length(graph$mesh$V[, 1])))
df4 <- df3[6:nrow(df3), ]
notes2 <- list(annotations = list(
list(
x = 0, y = 0, z = 0,
text = TeX("v_1"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 1, y = 0, z = 0,
text = TeX("v_2"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[1,1], y = df4[1,2], z = 0,
text = TeX("x_1^{e_2}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[2,1], y = df4[2,2], z = 0,
text = TeX("x_2^{e_2}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[3,1], y = df4[3,2], z = 0,
text = TeX("x_3^{e_2}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[4,1], y = df4[4,2], z = 0,
text = TeX("x_4^{e_2}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[5,1], y = df4[5,2], z = 0,
text = TeX("x_5^{e_2}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[6,1], y = df4[6,2], z = 0,
text = TeX("x_6^{e_2}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[7,1], y = df4[7,2], z = 0,
text = TeX("x_7^{e_2}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0.25, y = 0, z = 0,
text = TeX("x_1^{e_1}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0.5, y = 0, z = 0,
text = TeX("x_2^{e_1}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 0.75, y = 0, z = 0,
text = TeX("x_3^{e_1}"),
textangle = 0, ax = 0, ay = -35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1)))
p2 <- plot_ly() |>
config(mathjax = 'cdn') |>
add_trace(x = x,
y = y,
z = x*0,
type = "scatter3d",
mode = "lines",
line = list(color = "black", width = gsw),
showlegend = FALSE) |>
add_trace(data = df3, x = ~x, y = ~y, z = ~z, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "gray", symbol = 104)) |>
add_trace(x = 0, y = 0, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
add_trace(x = 1, y = 0, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
layout(font = list(family = "Palatino"),
scene = c(tadpole.layout(x_range, y_range, z_range), notes2),
margin = list(l = 0, r = 0, b = 0, t = 0),
showlegend = FALSE,
font = list(family = "Palatino"))
save(p2, file = here::here("data_files/tadpole_graph_mesh.Rdata"))Let each edge \(e\in\mathcal{E}\) be subdivided into \(n_{e}\geq 2\) regular segments of length \(h_{e}\), and be delimited by the nodes \(0 = x_0^{e},x_1^{e},\dots,x_{n_{e}-1}^{e}, x_{n_{e}}^{e} = \ell_{e}\). For each \(j = 1,\dots,n_{e}-1\), we consider the following standard hat basis functions \[\begin{equation*} \varphi_j^{e}(x)=\begin{cases} 1-\dfrac{|x_j^{e}-x|}{h_{e}},&\text{ if }x_{j-1}^{e}\leq x\leq x_{j+1}^{e},\\ 0,&\text{ otherwise}. \end{cases} \end{equation*}\] For each \(e\in\mathcal{E}\), the set of hat functions \(\left\{\varphi_1^{e},\dots,\varphi_{n_{e}-1}^{e}\right\}\) is a basis for the space \[\begin{equation*} V_{h_{e}} = \left\{w\in H_0^1(e)\;\Big|\;\forall j = 0,1,\dots,n_{e}-1:w|_{[x_j^{e}, x_{j+1}^{e}]}\in\mathbb{P}^1\right\}, \end{equation*}\] where \(\mathbb{P}^1\) is the space of linear functions on \([0,\ell_{e}]\). For each vertex \(v\in\mathcal{V}\), we define \[\begin{equation*} \mathcal{N}_v = \left\{\bigcup_{e\in\left\{e\in\mathcal{E}_v: v = x_0^e\right\}}[v,x_1^e]\right\}\bigcup\left\{\bigcup_{e\in\left\{e\in\mathcal{E}_v: v = x^e_{n_e}\right\}}[x^e_{n_e-1},v]\right\}, \end{equation*}\] which is a star-shaped set with center at \(v\) and rays made of the segments contiguous to \(v\). On \(\mathcal{N}_v\), we define the hat functions as \[\begin{equation*} \phi_v(x)=\begin{cases} 1-\dfrac{|x_v^{e}-x|}{h_{e}},&\text{ if }x\in\mathcal{N}_v\cap e \text{ and }e\in\mathcal{E}_v,\\ 0,&\text{ otherwise}, \end{cases} \end{equation*}\] where \(x_v^e\) is either \(x_0^e\) or \(x_{n_e}^e\) depending on the edge direction and its parameterization. See (Arioli and Benzi 2018) for more. Figure 3 below provides an illustration of the system of basis functions \(\{\varphi_j^e, \phi_v\}\) together with the set \(\mathcal{N}_v\).
notes3 <- list(annotations = list(
list(
x = 0, y = 0, z = 1,
text = TeX("\\phi_{v_1}"),
textangle = 0, ax = 0, ay = -15,
font = list(color = "red", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 0,
text = TeX("\\mathcal{N}_{v_1}"),
textangle = 0, ax = 25, ay = 5,
font = list(color = "green", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 1, y = 0, z = 1,
text = TeX("\\phi_{v_2}"),
textangle = 0, ax = 0, ay = -15,
font = list(color = "red", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = 0, y = 0, z = 0,
text = TeX("v_1"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 1, y = 0, z = 0,
text = TeX("v_2"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = 1, y = 0, z = 0,
text = TeX("\\mathcal{N}_{v_2}"),
textangle = 0, ax = 40, ay = -10,
font = list(color = "green", size = gfsize),
arrowcolor = "rgba(0,0,0,0)"),
list(
x = df4[5,1], y = df4[5,2], z = 0,
text = TeX("x_5^{e_2}"),
textangle = 0, ax = 0, ay = 35,
font = list(color = "black", size = gfsize),
arrowcolor = "gray", arrowsize = 1, arrowwidth = 0.5, arrowhead = 1),
list(
x = df4[5,1], y = df4[5,2], z = 1,
text = TeX("\\varphi_5^{e_2}"),
textangle = 0, ax = 0, ay = -15,
font = list(color = "rgb(0,0,200)", size = gfsize),
arrowcolor = "rgba(0,0,0,0)")))
p3 <- plot_ly(
#width = 1500, height = 2000
) |>
config(mathjax = 'cdn') |>
add_trace(x = rep(x, times = graph$nV),
y = rep(y, times = graph$nV),
z = as.vector(A[, 1:graph$nV]),
type = "scatter3d",
mode = "lines",
line = list(color = "red", width = gsw),
showlegend = FALSE) |>
add_trace(x = rep(x, times = ncol(A) - graph$nV),
y = rep(y, times = ncol(A) - graph$nV),
z = as.vector(A[, (graph$nV+1):ncol(A)]),
type = "scatter3d",
mode = "lines",
line = list(color = "darkgray", width = gsw),
showlegend = FALSE) |>
add_trace(x = rep(x, each = 3),
y = rep(y, each = 3),
z = unlist(lapply(apply(A, 1, max, na.rm = TRUE), function(zj) c(0, zj, NA))),
type = "scatter3d",
mode = "lines",
line = list(color = "lightgray", width = 0.5),
showlegend = FALSE) |>
add_trace(x = x,
y = y,
z = as.vector(A[, 10]),
type = "scatter3d",
mode = "lines",
line = list(color = "rgb(0,0,200)", width = gsw),
showlegend = FALSE) |>
add_trace(x = x,
y = y,
z = x*0,
type = "scatter3d",
mode = "lines",
line = list(color = "black", width = gsw),
showlegend = FALSE) |>
add_trace(x = rep(x, times = graph$nV),
y = rep(y, times = graph$nV),
z = c(replace(rep(NA, nrow(A)), 1:11, 0),
replace(rep(NA, nrow(A)), c(31:51, 111:121), 0)),
type = "scatter3d",
mode = "lines",
line = list(color = "green", width = gsw),
showlegend = FALSE) |>
add_trace(x = df4[5,1], y = df4[5,2], z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "rgb(0,0,200)", symbol = 104),
showlegend = FALSE) |>
add_trace(x = 0, y = 0, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
add_trace(x = 1, y = 0, z = 0, mode = "markers", type = "scatter3d",
marker = list(size = gsw, color = "black", symbol = 104),
showlegend = FALSE) |>
layout(font = list(family = "Palatino"),
scene = c(tadpole.layout(x_range, y_range, z_range), notes3),
margin = list(l = 0, r = 0, b = 0, t = 0),
paper_bgcolor = "white", # the overall canvas background
plot_bgcolor = "white", # the area inside axes
showlegend = FALSE,
font = list(family = "Palatino"))
save(p3, file = here::here("data_files/tadpole_graph_basis_functions.Rdata"))
# combine_plotly_grid_pdf(list(p1,p2,p3), output_pdf = here::here("data_files/plotlypic/tadpole_graph_basis_functions.pdf"), ncol = 3)
# combine_plotly_pdf_single(p3, here::here("data_files/plotlypic/p3.pdf"))Figure 1: Interval graph \(\Gamma_I = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1, v_2\}\) and \(\mathcal{E} = \{e_1\}\).
Figure 2: Circle graph \(\Gamma_C = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1\}\) and \(\mathcal{E} = \{e_1\}\).
Figure 4: A function \(f=\gamma\big|_\Gamma\) on the tadpole graph, where \(\gamma(x,y) = e^{-x^2-y^2}\), together with a path that illustrates the geodesic distance between points \(s_1\) and \(s_2\).
Figure 5: Mesh nodes on the tadpole graph.
Figure 7: Interval graph \(\Gamma_I = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1, v_2\}\) and \(\mathcal{E} = \{e_1\}\).
Figure 8: Interval graph \(\Gamma_I = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1, v_2\}\) and \(\mathcal{E} = \{e_1\}\), where \(e_1\) is flipped.
Figure 9: Interval graph \(\Gamma_I = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1, v_2\}\) and \(\mathcal{E} = \{e_1\}\), where \(e_1\) is flipped.
Figure 10: Interval graph \(\Gamma_I = (\mathcal{V}, \mathcal{E})\) with \(\mathcal{V} = \{v_1, v_2\}\) and \(\mathcal{E} = \{e_1\}\), where \(e_1\) is flipped.
We used R version 4.5.2 (R Core Team 2025a) and the following R packages: cowplot v. 1.2.0 (Wilke 2025), ggmap v. 4.0.2 (Kahle and Wickham 2013), ggpubr v. 0.6.3 (Kassambara 2026), ggtext v. 0.1.2 (Wilke and Wiernik 2022), glue v. 1.8.0 (Hester and Bryan 2024), grid v. 4.5.2 (R Core Team 2025b), here v. 1.0.1 (Müller 2020), htmltools v. 0.5.8.1 (Cheng et al. 2024), INLA v. 25.11.22 (Rue, Martino, and Chopin 2009; Lindgren, Rue, and Lindström 2011; Martins et al. 2013; Lindgren and Rue 2015; De Coninck et al. 2016; Rue et al. 2017; Verbosio et al. 2017; Bakka et al. 2018; Kourounis, Fuchs, and Schenk 2018), inlabru v. 2.13.0 (Yuan et al. 2017; Bachl et al. 2019), knitr v. 1.50 (Xie 2014, 2015, 2025), latex2exp v. 0.9.8 (Meschiari 2026), Matrix v. 1.7.3 (Bates, Maechler, and Jagan 2025), MetricGraph v. 1.5.0.9000 (Bolin, Simas, and Wallin 2023a, 2023b, 2024, 2025; Bolin et al. 2024), OpenStreetMap v. 0.4.1 (Fellows and Stotz 2025), patchwork v. 1.3.1 (Pedersen 2025), plotly v. 4.11.0 (Sievert 2020), plotrix v. 3.8.14 (J 2006), pracma v. 2.4.4 (Borchers 2023), renv v. 1.1.7 (Ushey and Wickham 2026), reshape2 v. 1.4.4 (Wickham 2007), reticulate v. 1.44.1 (Ushey, Allaire, and Tang 2025), rmarkdown v. 2.30 (Xie, Allaire, and Grolemund 2018; Xie, Dervieux, and Riederer 2020; Allaire et al. 2025), rSPDE v. 2.5.2.9000 (Bolin and Kirchner 2020; Bolin and Simas 2023; Bolin, Simas, and Xiong 2024), scales v. 1.4.0 (Wickham, Pedersen, and Seidel 2025), sf v. 1.1.0 (E. Pebesma 2018; E. Pebesma and Bivand 2023), slackr v. 3.4.0 (Kaye et al. 2025), sp v. 2.2.1 (E. J. Pebesma and Bivand 2005; Bivand, Pebesma, and Gomez-Rubio 2013), tidyverse v. 2.0.0 (Wickham et al. 2019), tikzDevice v. 0.12.6 (Sharpsteen and Bracken 2023), viridis v. 0.6.5 (Garnier et al. 2024), xaringanExtra v. 0.8.0 (Aden-Buie and Warkentin 2024).