richter/GraphonSimulation
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

neuster Stand

Browse Source
This commit is contained in:
Niclas
2026-06-29 14:46:22 +02:00
parent 9d9d274487
commit 37d9682e27
3 changed files with 148 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
R/estimators.R
+5 -6
View File
@@ -7,9 +7,9 @@ source(here::here("R", "build_network.R"))
# Helper functions -------------------------------------------------------------
# helper function for wrapping the parameters of the Q_a creation function
# TODO rename this function
make_matrix_creation <- function(seed, n, K, matrix_X, fv, Fv, guard) {
make_matrix_creation <- function(seed, n, K, matrix_X, fv, Fv, guard, fX=NULL) {
function(a) {
compute_matrix(seed=seed, a, n=n, K=K, matrix_X = matrix_X, fv=fv, Fv=Fv, guard=guard)
compute_matrix(seed=seed, a, n=n, K=K, matrix_X = matrix_X, fv=fv, Fv=Fv, guard=guard, fX=fX)
}
}
@@ -200,7 +200,7 @@ calculate_edge_density <- function(adj_matrix) {
return(rho)
}
# test the estimator routines
seed <- 17L # 121L this seed works exceptionally well
seed <- 121L # 121L this seed works exceptionally well
set.seed(seed)
#X <- matrix(seq(-1, 1, length.out = 5), ncol = 1)
a <- 20
@@ -226,8 +226,8 @@ adj
# Q_a matrix
Qa <- compute_matrix(seed, a=a, n=n, K=K, fv=fv, Fv=Fv, guard=guard, matrix_X=X)
calc_Q_a <- make_matrix_creation(seed, n=n, K=K, matrix_X = X, fv=fv, Fv=Fv, guard=guard)
Qa2 <- compute_matrix(seed, a=a, n=n, K=K, fv=fv, Fv=Fv, guard=guard, matrix_X =X, fX= dnorm)
calc_Q_a <- make_matrix_creation(seed, n=n, K=K, matrix_X = X, fv=fv, Fv=Fv, guard=guard, fX=dnorm)
loss_func <- function(a) {
Q_a <- calc_Q_a(a)
@@ -236,7 +236,6 @@ loss_func <- function(a) {
norm(pinv_Qa %*% Q_a %*% adj %*% pinv_Qa %*% Q_a - adj, type="F")^2
}
plot_as <- seq(-10, 100, length.out=500)
loss_vals <- sapply(plot_as, loss_func)
plot(plot_as , loss_vals, type="b")