experiments with the variance

R/singular_value_plot.R

@@ -59,6 +59,7 @@ expr_to_label <- function(expr) {
 #' @param curve_col Colour of the reference curve (default = `"red"`).
 #' @param curve_lwd Line width of the reference curve (default = 2).
 #' @param log_plot If True, then the y-axis is on a log scale.
+#' @param main_title Main title for the plot
 #' @return A list with the following components  
 #'   \item{K}{Integer vector `1:maxK`.}  
 #'   \item{sv}{Numeric vector of the smallest singular values for each `K`.}  
@@ -98,7 +99,8 @@ smallest_sv_sequence <- function(
     curve_to = NULL,
     curve_col = "red",
     curve_lwd = 2, 
-    log_plot = FALSE
+    log_plot = FALSE,
+    main_title = "Smallest singular value vs. K"
 ) {
   ## 1. Input validation =======================================================
   if (!is.numeric(a) || length(a) == 0) {
@@ -129,6 +131,9 @@ smallest_sv_sequence <- function(
   if (!inherits(curve_expr, "call") && !is.character(curve_expr)) {
     stop("`curve_expr` must be a call (e.g., quote(20/sqrt(x))) or a character string.")
   }
+  if (!is.character(main_title)){
+    stop("`main_title` must be a character vector.")
+  }
   
   ## 2. Prepare storage ========================================================
   K_vec <- seq_len(maxK)
@@ -147,6 +152,8 @@ smallest_sv_sequence <- function(
       guard = guard
     )
     
+    Q <- 1 /sqrt(n) * Q
+    
     sv_res <- compute_minmax_sv(Q)
     if (!is.list(sv_res) || is.null(sv_res$smallest_singular_value)) {
       stop("`compute_minmax_sv()` must return a list containing `$smallest_singular_value`.")
@@ -157,6 +164,7 @@ smallest_sv_sequence <- function(
   ## 4. Plotting (optional) ====================================================
   if (plot) {
     ## Basic scatter/line plot of the singular values
+    par(mar = c(5, 4, 4, 8))  # extra space on the right for the legend
     plot_args <- list(
       x = K_vec,
       y = smallest_sv,
@@ -165,17 +173,21 @@ smallest_sv_sequence <- function(
       col = "steelblue",
       xlab = "K subdivisions",
       ylab = "Smallest singular value of Q",
-      main = "Smallest singular value vs. K"
+      main = main_title
     )
     if (log_plot) plot_args$log <- "y"
     
     do.call(graphics::plot, plot_args)
-    # graphics::plot(
-    #   K_vec, smallest_sv,
-    #   type = "b", pch = 19, col = "steelblue",
-    #   xlab = "K subdivisions", ylab = "Smallest singular value of Q",
-    #   main = "Smallest singular value vs. K"
-    # )
+    # add legend. The par(xpd = ...) allows drawing outside of the plot region.
+    par(xpd = TRUE)
+    legend("topright",
+           inset=c(-0.2,0), 
+           legend=c("SV of Q"), 
+           col="steelblue", 
+           title="Legend",
+           pch = 16,
+           bty = "n")
+    par(xpd = FALSE)
     ## Add the reference curve if requested
     if (add_curve) {
       ## Determine sensible defaults for the curve limits
@@ -197,8 +209,8 @@ smallest_sv_sequence <- function(
       
       # add label with the curve expression
       label_txt <- expr_to_label(curve_expr)
-      x_pos <- curve_from + 0.9 * (curve_to - curve_from)
-      y_pos <- 0.9 * max(smallest_sv)
+      x_pos <- curve_from + 0.8 * (curve_to - curve_from)
+      y_pos <- 0.85 * max(smallest_sv)
       graphics::text(
         x = x_pos, y = y_pos,
         labels = label_txt,

R/singular_values.R

@@ -192,6 +192,9 @@ compute_matrix <- function(
 #' @export
 compute_minmax_sv <- function(M) {
   s <- svd(M, nu=0, nv=0)$d
+  
+  # just a check if we compute the right thing
+  # s <- sqrt(eigen(M %*% t(M), symmetric = TRUE, only.value=TRUE)$values)
 
   list(
     largest_singular_value  = max(s),