adjust plots

scripts/plot_Qa_wrt_a.R

@@ -13,7 +13,7 @@ library(dplyr)
 a_grid <- seq(-20, 20, length.out = 200)
 
 # function which takes only a to compute Q_c
-make_matrix <- function(a) { compute_matrix(seed=4L,
+make_matrix <- function(a) { compute_matrix(seed=11513215L,
                               a= a,
                               n = 2,
                               K = 2,
@@ -46,17 +46,18 @@ ggplot(df_entries, aes(x = a, y = value, colour = entry, linetype = entry)) +
   theme_minimal()
 
 # Heat map for a single larger matrix ------------------------------------------
-
+# TODO Daten für 2x2 und 3x3 an Michael schicken
 # Choose a value of a
-a0 <- -10
-M0 <-  compute_matrix(seed=1L,
+a0 <- 2
+M0 <-  compute_matrix(seed=9L,
                       a= a0,
-                      n = 50,
-                      K = 50,
+                      n = 2,
+                      K = 2,
                       sample_X_fn = function(n) {matrix(rnorm(n), ncol = 1L)},
                       fv = function(x) {dnorm(x, mean=0, sd=1)},
                       Fv = function(x) {pnorm(x, mean=0, sd=1)},
                       guard = 1e-12)
+M0
 
 # Convert to a tidy data frame for ggplot
 df_heat <- as.data.frame(M0) %>%

scripts/plot_non_normal_X.qmd

@@ -76,14 +76,16 @@ for (a in as) {
 ```{r k = n^alpha plotting, rate = 1}
 # plot the results
 results01 |>
-  filter(param_a %in% c(0, 10, 20)) |>
+  filter(param_a %in% c(2, 6, 12) & param_alpha <= 0.12) |>
   mutate(param_a = as.factor(param_a),
          param_alpha = as.factor(param_alpha)) |>
   group_by(param_a, param_alpha) |>
   ggplot(aes(dim_n, ssv, col=param_a, shape=param_alpha, interaction(param_a, param_alpha))) +
   geom_point(size=1.5) +
   geom_line() +
-  geom_function(fun = function(x) {sqrt(x)}, colour="black") +
+  geom_line(aes(dim_n, sqrt(dim_n) / dim_k, shape=param_alpha), linetype = 2) +
+  geom_point(size=1.5) +
+  #geom_function(fun = function(x) {sqrt(x)}, colour="black") +
   #scale_y_log10() +
   theme_bw() +
   labs(x=latex2exp::TeX("$n$"),
@@ -135,14 +137,16 @@ for (a in as) {
 
 ```{r k = n^alpha plotting, rate = 3}
 results02 |>
-  filter(param_a %in% c(0, 10, 20)) |>
+  filter(param_a %in% c(0, 10, 20) & param_alpha < 0.12) |>
   mutate(param_a = as.factor(param_a),
          param_alpha = as.factor(param_alpha)) |>
   group_by(param_a, param_alpha) |>
   ggplot(aes(dim_n, ssv, col=param_a, shape=param_alpha, interaction(param_a, param_alpha))) +
   geom_point(size=1.5) +
   geom_line() +
-  geom_function(fun = function(x) {sqrt(x)}, colour="black") +
+  geom_line(aes(dim_n, sqrt(dim_n) / dim_k, shape=param_alpha), linetype = 2) +
+  geom_point(size=1.5) +
+  #geom_function(fun = function(x) {sqrt(x)}, colour="black") +
   #scale_y_log10() +
   theme_bw() +
   labs(x=latex2exp::TeX("$n$"),
@@ -203,7 +207,9 @@ results03 |>
   ggplot(aes(dim_n, ssv, col=param_a, shape=param_alpha, interaction(param_a, param_alpha))) +
   geom_point(size=1.5) +
   geom_line() +
-  geom_function(fun = function(x) {sqrt(x)}, colour="black") +
+  geom_line(aes(dim_n, sqrt(dim_n) / dim_k, shape=param_alpha), linetype = 2) +
+  geom_point(size=1.5) +
+  #geom_function(fun = function(x) {sqrt(x)}, colour="black") +
   #scale_y_log10() +
   theme_bw() +
   labs(x=latex2exp::TeX("$n$"),
@@ -259,14 +265,16 @@ for (a in as) {
 
 ```{r k = n^alpha plotting, U[0,1]}
 results04 |>
-  filter(param_a %in% c(0, 10, 20)) |>
+  filter(param_a %in% c(2, 10, 20) & param_alpha < 0.22 & param_alpha > 0.12) |>
   mutate(param_a = as.factor(param_a),
          param_alpha = as.factor(param_alpha)) |>
   group_by(param_a, param_alpha) |>
   ggplot(aes(dim_n, ssv, col=param_a, shape=param_alpha, interaction(param_a, param_alpha))) +
   geom_point(size=1.5) +
   geom_line() +
-  geom_function(fun = function(x) {sqrt(x)}, colour="black") +
+  geom_line(aes(dim_n, sqrt(dim_n) / dim_k, shape=param_alpha), linetype = 2) +
+  geom_point(size=1.5) +
+  #geom_function(fun = function(x) {sqrt(x)}, colour="black") +
   #scale_y_log10() +
   theme_bw() +
   labs(x=latex2exp::TeX("$n$"),
@@ -327,7 +335,9 @@ results05 |>
   ggplot(aes(dim_n, ssv, col=param_a, shape=param_alpha, interaction(param_a, param_alpha))) +
   geom_point(size=1.5) +
   geom_line() +
-  geom_function(fun = function(x) {sqrt(x)}, colour="black") +
+  geom_line(aes(dim_n, sqrt(dim_n) / dim_k, shape=param_alpha), linetype = 2) +
+  geom_point(size=1.5) +
+  #geom_function(fun = function(x) {sqrt(x)}, colour="black") +
   #scale_y_log10() +
   theme_bw() +
   labs(x=latex2exp::TeX("$n$"),
@@ -387,7 +397,9 @@ results06 |>
   ggplot(aes(dim_n, ssv * dim_k, col=param_a, shape=param_alpha, interaction(param_a, param_alpha))) +
   geom_point(size=1.5) +
   geom_line() +
-  geom_function(fun = function(x) {x^(0.5)}, colour="black") +
+  geom_line(aes(dim_n, sqrt(dim_n) / dim_k, shape=param_alpha), linetype = 2) +
+  geom_point(size=1.5) +
+  #geom_function(fun = function(x) {x^(0.5)}, colour="black") +
   #scale_y_log10() +
   theme_bw() +
   labs(x=latex2exp::TeX("$n$"),
@@ -422,3 +434,68 @@ results06 |>
 results <- list(results01, results02, results03, results04, results05, results06)
 save(results, file="results.RData")
 ```
+
+## Two dimensional example
+
+```{r k = n^alpha data generation with two dimensions, rate = 1}
+#| cache: true
+#| echo: false
+#| collapse: true
+ns <- seq(100, 1000, 100)
+a <- c(1, 1) / sqrt(2)
+a_norms <- seq(0, 20, 2)
+alphas <-  seq(0.1, 0.5, 0.1)
+
+set.seed(100)
+results07 <- data.frame(dim_n = integer(),
+                      dim_k = integer(),
+                      param_a = double(),
+                      param_alpha = double(),
+                      ssv = double())
+for (a_norm in a_norms) {
+  for (i in 1:length(ns)) {
+    for (j in 1:length(alphas)) {
+      n <- ns[i]
+      K <- floor(n^alphas[j])
+      if (!K > 0) next # skip if K is equal to zero
+      # use the default seed 1L
+      Q <- compute_matrix(seed=1L,
+                     a= a_norm * a,
+                     n = n,
+                     K = K,
+                     sample_X_fn = function(n) {matrix(rexp(2 * n), ncol = 2L)},
+                     fv = function(x) {dnorm(x, mean=0, sd=1)},
+                     Fv = function(x) {pnorm(x, mean=0, sd=1)},
+                     guard = 1e-12)
+      
+      ssv <- compute_minmax_sv(Q)[["smallest_singular_value"]]
+      
+      current_res <- data.frame(dim_n = n, dim_k = K, param_a = a_norm, param_alpha=alphas[j], ssv =ssv)
+      results07 <- rbind(results07, current_res)
+    }
+  }
+}
+```
+
+```{r k = n^alpha plotting, rate = 1}
+# plot the results
+results07 |>
+  filter(param_a %in% c(10, 20) & param_alpha < 0.12) |>
+  mutate(param_a = as.factor(param_a),
+         param_alpha = as.factor(param_alpha)) |>
+  group_by(param_a, param_alpha) |>
+  ggplot(aes(dim_n, ssv, col=param_a, shape=param_alpha, interaction(param_a, param_alpha))) +
+  geom_point(size=1.5) +
+  geom_line() +
+  geom_line(aes(dim_n, sqrt(dim_n) / dim_k, shape=param_alpha), linetype = 2) +
+  geom_point(size=1.5) +
+  #geom_function(fun = function(x) {sqrt(x)}, colour="black") +
+  #scale_y_log10() +
+  theme_bw() +
+  labs(x=latex2exp::TeX("$n$"),
+       y=latex2exp::TeX("Smallest singular value of $Q$"),
+       title=latex2exp::TeX("Smallest singular value of $Q$ with respect to $a$."),
+       subtitle = latex2exp::TeX(("Hyperparameter $k = n^{\\alpha}$. Black line is $\\sqrt{n}$, and $X \\sim Exp(1)$")),
+       colour=latex2exp::TeX("$a$"),
+       shape=latex2exp::TeX("$\\alpha$"))
+```