diff --git a/R/ggplots.R b/R/ggplots.R index 0f3284f..76e6fa1 100644 --- a/R/ggplots.R +++ b/R/ggplots.R @@ -129,6 +129,7 @@ ggplotSamplesMDS <- function( #browser() RSq <- mdsObj$RSq[nDim] + GoF <- mdsObj$GoF[nDim] # margRSq <- rep(0., nDim) # @@ -153,28 +154,28 @@ ggplotSamplesMDS <- function( DF$stress <- mdsObj$spp xlabel <- paste0("Coord. ", projectionAxes[1]) - #if (projectionAxes[1] > 2) { - xlabel <- paste0( - xlabel, - #" (marg. R2 : ", - #round(100*margRSq[projectionAxes[1]], 2), - " (% var. : ", - round(100*explVar[projectionAxes[1]], 2), - "%)") - #} + + xlabel <- paste0( + xlabel, + #" (marg. R2 : ", + #round(100*margRSq[projectionAxes[1]], 2), + " (% var. : ", + round(100*explVar[projectionAxes[1]], 2), + "%)") ylabel <- paste0("Coord. ", projectionAxes[2]) - #if (projectionAxes[2] > 2) { - ylabel <- paste0( - ylabel, - #" (marg. R2 : ", - #round(100*margRSq[projectionAxes[2]], 2), - " (% var. : ", - round(100*explVar[projectionAxes[2]], 2), - "%)") - #} - - subtitle <- paste0("(Goodness of fit = ", round(RSq, 4),"; nDim = ", nDim, ")") + + ylabel <- paste0( + ylabel, + #" (marg. R2 : ", + #round(100*margRSq[projectionAxes[2]], 2), + " (% var. : ", + round(100*explVar[projectionAxes[2]], 2), + "%)") + + subtitle <- paste0("(Pseudo RSq = ", round(RSq, 4), + "; Goodness of Fit = ", round(GoF, 4), + "; nDim = ", nDim, ")") mainAesMapping <- ggplot2::aes( x = .data[["x"]], @@ -400,8 +401,10 @@ ggplotSamplesMDSShepard <- function( } RSq <- mdsObj$RSq[nDim] - subtitle <- paste0("(Goodness of fit = ", round(RSq, 4),"; nDim = ", nDim, ")") - subtitle <- paste0(subtitle,")") + GoF <- mdsObj$GoF[nDim] + subtitle <- paste0("(Pseudo RSq = ", round(RSq, 4), + "; Goodness of Fit = ", round(GoF, 4), + "; nDim = ", nDim, ")") xlabel <- "HD distances" ylabel <- "Proj. distances" diff --git a/R/stats.R b/R/stats.R index 0910c46..e5a4613 100644 --- a/R/stats.R +++ b/R/stats.R @@ -573,7 +573,14 @@ getChannelsSummaryStat <- function( #' - `spp` the stress per point obtained from the SMACOF algorithm, i.e. #' the contribution of each point to the stress loss function #' - `$RSq` R squares, for each d, from 1 to `nDim`: -#' the R square when taking all dims from 1 to d. +#' the (pseudo) R square when taking all dims from 1 to d. +#' - `$GoF` Goodness of fit, for each d, from 1 to `nDim`: +#' the goodness of fit indicator (b/w 0 and 1) when taking all dims from 1 to d. +#' Note pseudo R square and goodness of fit indicators are essentially the +#' same indicator, only the definition of total sum of squares differ: +#' - for pseudo RSq: TSS is calculated using the mean pairwise distance +#' as minimum +#' - for goodness of fit: TSS is calculated using 0 as minimum #' #' @importFrom stats as.dist dist #' @export @@ -683,7 +690,10 @@ computeMetricMDS <- function( scaleFactor <- sqrt(sum(delta^2, na.rm = TRUE)) / sqrt(N) proj <- proj * scaleFactor - computeRSquares <- function(distances, projections) { + computeRSquares <- function( + distances, + projections, + asInLinearRegression = TRUE) { delta <- as.dist(distances) nDim <- ncol(projections) @@ -697,8 +707,13 @@ computeMetricMDS <- function( }, FUN.VALUE = 0.) - #TSS <- sum((delta - mean(delta, na.rm = TRUE))^2) - TSS <- sum(delta^2) + if (asInLinearRegression) { + TSS <- sum((delta - mean(delta, na.rm = TRUE))^2) + } else { + TSS <- sum(delta^2) + } + + RSq <- 1-RSS/TSS @@ -707,7 +722,12 @@ computeMetricMDS <- function( RSq <- computeRSquares( distances = pwDist, - projections = proj) + projections = proj, + asInLinearRegression = TRUE) + GoF <- computeRSquares( + distances = pwDist, + projections = proj, + asInLinearRegression = FALSE) res$pwDist <- as.dist(pwDist) res$proj <- proj @@ -715,6 +735,7 @@ computeMetricMDS <- function( res$stress <- mdsRes$stress res$spp <- mdsRes$spp res$RSq <- RSq + res$GoF <- GoF res$mdsObj <- mdsRes class(res) <- "mdsRes" diff --git a/man/computeMetricMDS.Rd b/man/computeMetricMDS.Rd index f30b575..455b282 100644 --- a/man/computeMetricMDS.Rd +++ b/man/computeMetricMDS.Rd @@ -30,7 +30,14 @@ obtained from the SMACOF algorithm \item \code{spp} the stress per point obtained from the SMACOF algorithm, i.e. the contribution of each point to the stress loss function \item \verb{$RSq} R squares, for each d, from 1 to \code{nDim}: -the R square when taking all dims from 1 to d. +the (pseudo) R square when taking all dims from 1 to d. +\item \verb{$GoF} Goodness of fit, for each d, from 1 to \code{nDim}: +the goodness of fit indicator (b/w 0 and 1) when taking all dims from 1 to d. +Note pseudo R square and goodness of fit indicators are essentially the +same indicator, only the definition of total sum of squares differ: +\item for pseudo RSq: TSS is calculated using the mean pairwise distance +as minimum +\item for goodness of fit: TSS is calculated using 0 as minimum } } \description{ diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-no-point-labels.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-no-point-labels.svg index 0660dff..291625f 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-no-point-labels.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-no-point-labels.svg @@ -71,7 +71,7 @@ Agg D1 D2 -(Goodness of fit = 1; nDim = 4) +(Pseudo RSq = 1; Goodness of Fit = 1; nDim = 4) Multi Dimensional Scaling diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2-and-extvars.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2-and-extvars.svg index b6d00c1..6a4fb9c 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2-and-extvars.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2-and-extvars.svg @@ -79,7 +79,7 @@ Agg D1 D2 -(Goodness of fit = 1; nDim = 4) +(Pseudo RSq = 1; Goodness of Fit = 1; nDim = 4) Multi Dimensional Scaling diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2.svg index 1197365..c0996ab 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-1-and-2.svg @@ -68,7 +68,7 @@ Agg D1 D2 -(Goodness of fit = 1; nDim = 4) +(Pseudo RSq = 1; Goodness of Fit = 1; nDim = 4) Multi Dimensional Scaling diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4-and-extvars.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4-and-extvars.svg index b6ddab5..0b2261d 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4-and-extvars.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4-and-extvars.svg @@ -76,7 +76,7 @@ Agg D1 D2 -(Goodness of fit = 1; nDim = 4) +(Pseudo RSq = 1; Goodness of Fit = 1; nDim = 4) Multi Dimensional Scaling diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4.svg index b8d98f7..b9dd975 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-axes-3-and-4.svg @@ -65,7 +65,7 @@ Agg D1 D2 -(Goodness of fit = 1; nDim = 4) +(Pseudo RSq = 1; Goodness of Fit = 1; nDim = 4) Multi Dimensional Scaling diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-sizereflectingstress.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-sizereflectingstress.svg index b46971c..285208c 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-sizereflectingstress.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmds-with-sizereflectingstress.svg @@ -84,7 +84,7 @@ Agg D1 D2 -(Goodness of fit = 0.9996; nDim = 2) +(Pseudo RSq = 0.9984; Goodness of Fit = 0.9996; nDim = 2) Multi Dimensional Scaling diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-2-dimensions.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-2-dimensions.svg index 43dd50b..fc9d66b 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-2-dimensions.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-2-dimensions.svg @@ -59,7 +59,7 @@ 0.16 HD distances Proj. distances -(Goodness of fit = 0.9976; nDim = 2)) +(Pseudo RSq = 0.9909; Goodness of Fit = 0.9976; nDim = 2) Shepard with 2 dimensions diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-3-dimensions.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-3-dimensions.svg index 34c0c9f..1b8c1c7 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-3-dimensions.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-3-dimensions.svg @@ -59,7 +59,7 @@ 0.16 HD distances Proj. distances -(Goodness of fit = 0.9995; nDim = 3)) +(Pseudo RSq = 0.998; Goodness of Fit = 0.9995; nDim = 3) Shepard with 3 dimensions diff --git a/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-default-dim-nb.svg b/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-default-dim-nb.svg index fd4704f..6653d45 100644 --- a/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-default-dim-nb.svg +++ b/tests/testthat/_snaps/ggplots/ggplotsamplesmdsshepard-with-default-dim-nb.svg @@ -59,7 +59,7 @@ 0.16 HD distances Proj. distances -(Goodness of fit = 1; nDim = 4)) +(Pseudo RSq = 1; Goodness of Fit = 1; nDim = 4) Shepard with default nb of dimensions