Construct the 2D model
Compute hexagonal grid configurations
To construct the model in the 2D space, first you need to decide
hexagonal grid configurations, which means that the number of bins along
the x and y axes. You can begin by calculating default number of bins
along the axes with default settings for hex_size,
buffer_x, and buffer_y.
Obtain bin centroids
Next, you need to hexagonally bins the 2D layout and obtain the bin centroids. Discussed in details in 3. Algorithm for binning data.
hb_obj <- hex_binning(data = s_curve_noise_umap_scaled, x = "UMAP1", y = "UMAP2",
num_bins_x = num_bins_x, num_bins_y = num_bins_y,
x_start = NA, y_start = NA, buffer_x = NA,
buffer_y = NA, hex_size = NA, col_start = "UMAP")
all_centroids_df <- as.data.frame(do.call(cbind, hb_obj$centroids))
counts_df <- as.data.frame(do.call(cbind, hb_obj$std_cts))After obtaining the hexagonal bin centroid coordinates
(all_centroids_df) and standard number of points within
each hexagon (counts_df), you can generate a data frame or
tibble which gives hexagonal ID, centroid coordinates and standard
counts where data exists.
df_bin_centroids <- extract_hexbin_centroids(centroids_df = all_centroids_df,
counts_df = counts_df)
glimpse(df_bin_centroids)
#> Rows: 10
#> Columns: 4
#> $ hexID <dbl> 2, 6, 7, 12, 13, 18, 24, 28, 29, 34
#> $ c_x <dbl> 0.1732051, 0.0000000, 0.3464102, 0.1732051, 0.5196152, 0.69…
#> $ c_y <dbl> -0.15, 0.15, 0.15, 0.45, 0.45, 0.75, 1.05, 1.35, 1.35, 1.65
#> $ std_counts <dbl> 0.2352941, 0.5294118, 0.4117647, 0.1764706, 0.3529412, 0.70…Remove low density hexagons
One of the parameters that you need to control is that the benchmark value to remove low density hexagons. The default value is the first quartile of the standardise counts.
benchmark_value_rm_lwd <- stats::quantile(df_bin_centroids$std_counts,
probs = c(0,0.25,0.5,0.75,1), names = FALSE)[2]
benchmark_value_rm_lwd
#> [1] 0.25There is two ways that you can follow after this. First, you can
remove the low density hexagons from df_bin_centroids and
proceed. Second, you can check whether is that actually reliable to
remove the identified low density hexagons by looking at their
neighboring bins and if so remove them and proceed. In here, let’s do
with second option.
Here, you need to obtain the low density hexagons.
df_bin_centroids_low <- df_bin_centroids |>
dplyr::filter(std_counts <= benchmark_value_rm_lwd)
glimpse(df_bin_centroids_low)
#> Rows: 3
#> Columns: 4
#> $ hexID <dbl> 2, 12, 29
#> $ c_x <dbl> 0.1732051, 0.1732051, 1.0392305
#> $ c_y <dbl> -0.15, 0.45, 1.35
#> $ std_counts <dbl> 0.2352941, 0.1764706, 0.2352941Next, check the neighboring bins of low-density hexagons and decide which should actually need to remove.
identify_rm_bins <- find_low_dens_hex(df_bin_centroids_all = df_bin_centroids,
num_bins_x = num_bins_x,
df_bin_centroids_low = df_bin_centroids_low)
identify_rm_bins
#> numeric(0)As you have seen, even though there are low density hexagons, it’s
not a good decision to remove them. Therefore, let’s use the same
df_bin_centroids as before.
Triangulate bin centroids
Then, you need to triangulate the bin centroids.
tr1_object <- tri_bin_centroids(hex_df = df_bin_centroids, x = "c_x", y = "c_y")
str(tr1_object)
#> List of 11
#> $ n : int 10
#> $ x : num [1:10] 0.173 0 0.346 0.173 0.52 ...
#> $ y : num [1:10] -0.15 0.15 0.15 0.45 0.45 0.75 1.05 1.35 1.35 1.65
#> $ nt : int 12
#> $ trlist: int [1:12, 1:9] 1 4 5 5 6 6 7 7 8 6 ...
#> ..- attr(*, "dimnames")=List of 2
#> .. ..$ : NULL
#> .. ..$ : chr [1:9] "i1" "i2" "i3" "j1" ...
#> $ cclist: num [1:12, 1:5] 1.73e-01 1.73e-01 3.46e-01 2.59e+15 3.46e-01 ...
#> ..- attr(*, "dimnames")=List of 2
#> .. ..$ : NULL
#> .. ..$ : chr [1:5] "x" "y" "r" "area" ...
#> $ nchull: int 6
#> $ chull : int [1:6] 2 1 7 9 10 8
#> $ narcs : int 21
#> $ arcs : int [1:21, 1:2] 3 2 1 3 4 3 5 1 5 6 ...
#> ..- attr(*, "dimnames")=List of 2
#> .. ..$ : NULL
#> .. ..$ : chr [1:2] "from" "to"
#> $ call : language interp::tri.mesh(x = hex_df[[rlang::as_string(rlang::sym(x))]], y = hex_df[[rlang::as_string(rlang::sym(y))]])
#> - attr(*, "class")= chr "triSht"To visualize the results, simply use geom_trimesh() and
provide the hexagonal bin centroid coordinates. This will display the
triangular mesh for you to examine.
trimesh <- ggplot(df_bin_centroids, aes(x = c_x, y = c_y)) +
geom_trimesh() +
coord_equal() +
xlab(expression(C[x]^{(2)})) + ylab(expression(C[y]^{(2)})) +
theme(axis.text = element_text(size = 5),
axis.title = element_text(size = 7))
trimesh
Create the wireframe in 2D
To build the wireframe in 2D, you’ll need to identify which vertices
are connected. You can obtain this by passing the triangular object to
the gen_edges function, which will provide information on
the existing edges and the connected vertices.
tr_from_to_df <- gen_edges(tri_object = tr1_object)
glimpse(tr_from_to_df)
#> Rows: 21
#> Columns: 6
#> $ from <int> 1, 2, 4, 3, 4, 6, 1, 4, 6, 8, 8, 1, 3, 1, 5, 5, 2, 7, 9, 2, 7
#> $ to <int> 3, 4, 5, 5, 6, 7, 7, 8, 8, 9, 10, 2, 4, 5, 6, 7, 8, 9, 10, 3, 8
#> $ x_from <dbl> 0.1732051, 0.0000000, 0.1732051, 0.3464102, 0.1732051, 0.692820…
#> $ y_from <dbl> -0.15, 0.15, 0.45, 0.15, 0.45, 0.75, -0.15, 0.45, 0.75, 1.35, 1…
#> $ x_to <dbl> 0.3464102, 0.1732051, 0.5196152, 0.5196152, 0.6928203, 0.866025…
#> $ y_to <dbl> 0.15, 0.45, 0.45, 0.45, 0.75, 1.05, 1.05, 1.35, 1.35, 1.35, 1.6…Remove long edges
Another important parameter in this algorithm is the benchmark value for removing long edges. To compute this value, you first need to generate the 2D Euclidean distance dataset for the edges.
distance_df <- cal_2d_dist(tr_coord_df = tr_from_to_df, start_x = "x_from",
start_y = "y_from", end_x = "x_to", end_y = "y_to",
select_vars = c("from", "to", "distance"))
glimpse(distance_df)
#> Rows: 21
#> Columns: 3
#> $ from <int> 1, 2, 4, 3, 4, 6, 1, 4, 6, 8, 8, 1, 3, 1, 5, 5, 2, 7, 9, 2, 7
#> $ to <int> 3, 4, 5, 5, 6, 7, 7, 8, 8, 9, 10, 2, 4, 5, 6, 7, 8, 9, 10, 3,…
#> $ distance <dbl> 0.3464102, 0.3464102, 0.3464102, 0.3464102, 0.6000000, 0.3464…Then, you can use the find_lg_benchmark() function to
compute a default benchmark value to remove long edges. However, this
default value may need adjustment for a better representation. In here,
used the benchmark value as \(0.75\).
benchmark <- find_lg_benchmark(distance_edges = distance_df,
distance_col = "distance")
benchmark
#> [1] 0.6To visualize the results, you can use vis_lg_mesh() and
vis_rmlg_mesh(). These functions enable you to observe the
wireframe in 2D obtained from the algorithm’s computations.
trimesh_coloured <- vis_lg_mesh(distance_edges = distance_df,
benchmark_value = 0.75,
tr_coord_df = tr_from_to_df,
distance_col = "distance") +
xlab(expression(C[x]^{(2)})) + ylab(expression(C[y]^{(2)})) +
theme(axis.text = element_text(size = 5),
axis.title = element_text(size = 7),
legend.position = "bottom",
legend.title = element_blank())
trimesh_coloured
trimesh_removed <- vis_rmlg_mesh(distance_edges = distance_df,
benchmark_value = 0.75,
tr_coord_df = tr_from_to_df,
distance_col = "distance") +
xlab(expression(C[x]^{(2)})) + ylab(expression(C[y]^{(2)})) +
theme(axis.text = element_text(size = 5),
axis.title = element_text(size = 7))
trimesh_removed