R/plotH-M.R

Defines functions plotMosaicplot plot_model_comparison_dotplot plotLoglik plotHistogram

Documented in plotHistogram plotLoglik plot_model_comparison_dotplot plotMosaicplot

# plotH -------------------------------------------------------------------

#' @rdname plotBoxplot
#' @export
plotHistogram <- function(object,
                          variables,
                          across = NULL,
                          across_subset = NULL,
                          relevel = NULL,
                          clrp = NULL,
                          clrp_adjust = NULL,
                          scales = "free_x",
                          nrow = NULL,
                          ncol = NULL,
                          method_gs = NULL,
                          normalize = NULL,
                          verbose = NULL,
                          ...){

  hlpr_assign_arguments(object)

  var_levels <- base::unique(variables)

  spata_df <-
    joinWithVariables(
      object = object,
      spata_df = getSpataDf(object),
      variables = variables,
      smooth = FALSE,
      normalize = normalize
    ) %>%
    dplyr::select(-barcodes, -sample)

  confuns::plot_histogram(
    df = spata_df,
    variables = var_levels,
    across = across,
    across.subset = across_subset,
    relevel = relevel,
    scales = scales,
    nrow = nrow,
    ncol = ncol,
    clrp = clrp,
    clrp.adjust = clrp_adjust,
    verbose = verbose,
    ...
  )

}





# plotI -------------------------------------------------------------------


#' @title Plot histology image
#'
#' @description Plots the histology image with `ggplot2`.
#'
#' @param unit Character value. Units of x- and y-axes. Defaults
#' to *'px'*. If a SI unit is specified, uses [`ggpLayerAxesSI()`] with
#' default parameters. Add the layer manually with `+ ggpLayerAxesSI(...)` for
#' more control.
#' @param ... Additional arguments given to `ggpLayerZoom()`.
#'
#' @inherit argument_dummy params
#' @inherit ggplot_dummy return
#'
#' @inheritSection section_dummy Distance measures
#' @inheritSection section_dummy Image visualization with ggplot2
#'
#' @export
#'
#' @inherit ggpLayerRect examples
#'
setGeneric(name = "plotImage", def = function(object, ...){

  standardGeneric(f = "plotImage")

})

#' @rdname plotImage
#' @export
setMethod(
  f = "plotImage",
  signature = "SPATA2",
  definition = function(object,
                        img_name = activeImage(object),
                        outline = FALSE,
                        by_section = TRUE,
                        fragments = TRUE,
                        line_alpha = 0.9,
                        line_color = "black",
                        line_size = 0.5,
                        line_type = "solid",
                        transform = TRUE,
                        img_alpha = 1,
                        scale_fct = 1,
                        xrange = NULL,
                        yrange = NULL,
                        ...){

    deprecated(...)

    getSpatialData(object) %>%
      plotImage(
        object = .,
        img_name = img_name,
        fragments = fragments,
        outline = outline,
        transform = transform,
        line_alpha = line_alpha,
        line_color = line_color,
        line_size = line_size,
        line_type = line_type,
        img_alpha = img_alpha,
        scale_fct = scale_fct,
        xrange = xrange,
        yrange = yrange,
        ...
      )

  }
)

#' @rdname plotImage
#' @export
setMethod(
  f = "plotImage",
  signature = "SpatialData",
  definition = function(object,
                        img_name = activeImage(object),
                        outline = FALSE,
                        by_section = TRUE,
                        fragments = TRUE,
                        line_alpha = 0.9,
                        line_color = "black",
                        line_size = 0.5,
                        line_type = "solid",
                        transform = TRUE,
                        img_alpha = 1,
                        scale_fct = 1,
                        xrange = NULL,
                        yrange = NULL,
                        unit = "px",
                        ...){

    out <-
      getHistoImage(object, img_name = img_name) %>%
      plotImage(
        object = .,
        by_section = by_section,
        fragments = fragments,
        outline = outline,
        transform = transform,
        line_alpha = line_alpha,
        line_color = line_color,
        line_size = line_size,
        line_type = line_type,
        img_alpha = img_alpha,
        scale_fct = scale_fct,
        xrange = xrange,
        yrange = yrange,
        ...
      )


    if(unit != "px"){

      out <-
        out +
        ggpLayerAxesSI(object, unit = unit)

    }

    return(out)

  }
)

#' @rdname plotImage
#' @export
setMethod(
  f = "plotImage",
  signature = "HistoImage",
  definition = function(object,
                        outline = FALSE,
                        by_section = TRUE,
                        fragments = TRUE,
                        line_alpha = 0.9,
                        line_color = "black",
                        line_size = 1,
                        line_type = "solid",
                        transform = TRUE,
                        img_alpha = 1,
                        scale_fct = 1,
                        xrange = NULL,
                        yrange = NULL,
                        display_subtitle = FALSE,
                        ...){

    layer_coord_equal <- ggplot2::coord_equal(expand = FALSE)
    layer_coord_equal$default <- TRUE

    if(base::isTRUE(display_subtitle)){

      subtitle <- object@name

    } else {

      subtitle <- NULL

    }

    out <-
      ggplot2::ggplot() +
      ggpLayerImage(
        object = object,
        transform = transform,
        scale_fct = scale_fct,
        img_alpha = img_alpha
      ) +
      theme_image() +
      layer_coord_equal +
      ggplot2::labs(
        subtitle = subtitle,
        x = "Width [pixel]",
        y = "Height [pixel]"
      )

    if(base::isTRUE(outline)){

      out <-
        out +
        ggpLayerTissueOutline(
          object = object,
          by_section = by_section,
          fragments = fragments,
          transform = transform,
          line_alpha = line_alpha,
          line_color = line_color,
          line_size = line_size,
          line_type = line_type,
          scale_fct = scale_fct
        )

    }

    if(!base::is.null(xrange) & !base::is.null(yrange)){

      out <-
        out +
        ggpLayerZoom(
          object = object,
          xrange = xrange,
          yrange = yrange,
          ...
        )

    }

    return(out)

  }
)

#' @rdname plotImage
#' @export
setMethod(
  f = "plotImage",
  signature = "Image",
  definition = function(object, scale_fct = 1, img_alpha = 1, ...){

    ggplot2::ggplot() +
      ggpLayerImage(object, scale_fct = scale_fct, img_alpha = img_alpha) +
      ggplot2::coord_equal() +
      theme_image()

  }
)


#' @title Plot image with R base plotting
#'
#' @description Plots the histology image as a raster.
#'
#' @inherit argument_dummy params
#'
#' @return A plot that is immediately plotted.
#'
setGeneric(name = "plotImageBase", def = function(object, ...){

  standardGeneric(f = "plotImageBase")

})

#' @rdname plotImageBase
#' @export
setMethod(
  f = "plotImageBase",
  signature = "SPATA2",
  definition = function(object, xrange = NULL, yrange = NULL, axes = FALSE, ...){

    img <- getImageRaster(object, xrange = xrange, yrange = yrange)

    coords_df <- getCoordsDf(object)

    if(base::is.numeric(xrange)){

      coords_df <- dplyr::filter(coords_df, dplyr::between(x = x, left = xrange[1], right = xrange[2]))

    }

    if(base::is.numeric(yrange)){

      coords_df <- dplyr::filter(coords_df, dplyr::between(x = y, left = yrange[1], right = yrange[2]))

    }

    if(!base::is.numeric(xrange)){

      xrange <- getImageRange(object)$x

    }

    if(!base::is.numeric(yrange)){

      yrange <- getImageRange(object)$y

    }

    graphics::plot.new()
    graphics::par(pty = "s", ...)
    graphics::plot(
      x = coords_df$x,
      y = coords_df$y,
      col = ggplot2::alpha("white", 0),
      axes = axes,
      xlab = NA_character_,
      ylab = NA_character_,
      xlim = xrange,
      ylim = yrange
    )

    graphics::rasterImage(
      image = img,
      xleft = xrange[1],
      xright = xrange[2],
      ybottom = yrange[1],
      ytop = yrange[2]
    )

  }
)

#' @rdname plotImageBase
#' @export
setMethod(
  f = "plotImageBase",
  signature = "SpatialData",
  definition = function(object,
                        img_name = activeImage(object),
                        xrange = NULL,
                        yrange = NULL,
                        scale_fct = 1,
                        axes = TRUE,
                        ...){

    plotImageBase(
      object = getHistoImage(object, img_name = img_name),
      scale_fct = scale_fct,
      xrange = xrange,
      yrange = yrange,
      axes = axes,
    )


  }
)

#' @rdname plotImageBase
#' @export
setMethod(
  f = "plotImageBase",
  signature = "HistoImage",
  definition = function(object,
                        img_name = activeImage(object),
                        xrange = NULL,
                        yrange = NULL,
                        scale_fct = 1,
                        axes = TRUE,
                        ...){

    if(!base::is.null(xrange)){

      xrange <- as_pixel(input = xrange, object = object)

    }

    if(!base::is.null(yrange)){

      yrange <- as_pixel(input = yrange, object = object)

    }


    getImage(
      object = object,
      img_name = img_name,
      xrange = xrange,
      yrange = yrange
    ) %>%
      plotImageBase(
        object = .,
        xrange = xrange,
        yrange = yrange,
        scale_fct = scale_fct,
        axes = axes
      )

  }
)

#' @rdname plotImageBase
#' @export
setMethod(
  f = "plotImageBase",
  signature = "Image",
  definition = function(object,
                        scale_fct = 1,
                        xrange = NULL,
                        yrange = NULL,
                        axes = TRUE,
                        ...){

    # scale
    image <-
      scale_image(
        image = object,
        scale_fct = scale_fct
      )

    # get dims if not provided
    dims <- base::dim(image)

    # if specified xrange and yrange are not scaled!
    if(base::is.null(xrange)){

      xrange <- c(0, dims[1])

    }

    if(base::is.null(yrange)){

      yrange <- c(0, dims[2])

    }

    # plot
    graphics::plot.new()
    graphics::par(pty = "s", ...)
    graphics::plot(
      x = c(0, dims[1]),
      y = c(0, dims[2]),
      col = ggplot2::alpha("white", alpha = 0),
      xlab = NA_character_,
      ylab = NA_character_,
      xlim = xrange,
      ylim = yrange,
      axes = axes
    )

    graphics::rasterImage(
      image = image,
      xleft = 0,
      xright = dims[1],
      ybottom = 0,
      ytop = dims[2]
    )

  })


#' @title Plot pixel content
#'
#' @description Visualizes the results of [`identifyPixelContent()`].
#' \itemize{
#'  \item{`plotImageMask()`:}{ Distinguishes pixel in back- and foreground. Foreground being the tissue.}
#'  \item{`plotPixelContent():`}{ Visualizes the classification of each pixel in detail.}
#'  }
#'
#' @param clr_fg,clr_bg Character values. Color with which to display
#' foreground and background of the mask.
#' @param clr_artefact,clr_fragments,clr_tissue Character values. Colors
#' with which to display the content type if `type = FALSE`.
#' @inherit argument_dummy params
#' @inherit ggplot_dummy return
#'
#' @note Always plots the original justification of the image without
#' transformations.
#'
#' @export
#'
setGeneric(name = "plotImageMask", def = function(object, ...){

  standardGeneric(f = "plotImageMask")

})

#' @rdname plotImageMask
#' @export
setMethod(
  f = "plotImageMask",
  signature = "SPATA2",
  definition = function(object,
                        img_name = activeImage(object),
                        clr_fg = "black",
                        clr_bg = "white"){

    getSpatialData(object) %>%
      plotImageMask(object = ., img_name = img_name, clr_fg = clr_fg, clr_bg = clr_bg)

  }
)

#' @rdname plotImageMask
#' @export
setMethod(
  f = "plotImageMask",
  signature = "SpatialData",
  definition = function(object,
                        img_name = activeImage(object),
                        clr_fg = "black",
                        clr_bg = "white"){

    getHistoImage(object, img_name = img_name) %>%
      plotImageMask(object = ., clr_fg = clr_fg, clr_bg = clr_bg)

  }
)

#' @rdname plotImageMask
#' @export
setMethod(
  f = "plotImageMask",
  signature = "HistoImage",
  definition = function(object,
                        clr_fg = "black",
                        clr_bg = "white"){

    pxl_df <-
      getPixelDf(object, content = TRUE, transform = FALSE) %>%
      dplyr::mutate(
        Mask = content != "background",
        MasK = base::as.character(Mask)
      )

    ggplot2::ggplot() +
      ggplot2::geom_raster(
        data = pxl_df,
        mapping = ggplot2::aes(x = width, y = height, fill = Mask)
      ) +
      ggplot2::scale_fill_manual(
        values = c("TRUE" = clr_fg, "FALSE" = clr_bg),
        guide = "none"
      ) +
      theme_image(panel.border = ggplot2::element_rect(color = "black")) +
      ggplot2::coord_equal(expand = FALSE) +
      ggplot2::labs(x = "Width [pixel]", y = "Height [pixel]")

  })


#' @title Plot histology images
#'
#' @description Plots all images registered the `SPATA2` object.
#'
#' @param img_names Character vector or `NULL`. If character, specifies the images
#' by name. If `NULL`, all images are plotted.
#' @param outline Logical value. If `TRUE`, all images are plotted with the outline
#' identified by `identifyTissueOutline(..., method = "image")`.
#' @param outline_ref Logical value. If `TRUE`, all images plotted with
#' the outline identified by `identifyTissueOutline(..., method = "image")` of the
#' reference image.
#' @param by_section Logical value. If `TRUE`, the default, the outline for every
#' tissue section identified is used.
#' @param line_color,line_color_ref Character value. The transparency for the outline if
#' `outline = TRUE` and/or `outline_ref = TRUE`.
#' @param line_color,line_color_ref Character value. The color for the outline if
#' `outline = TRUE` and/or `outline_ref = TRUE`.
#' @param line_size,line_size_ref Character value. The linewidth for the outline if
#' `outline = TRUE` and/or `outline_ref = TRUE`.
#' @param ... Additional arguments given to `plotImage()`.
#' @param transform Logical value. Should the instructions for image transformation
#' set with [`alignImage()`] be applied?
#' @inherit argument_dummy params
#'
#' @return A ggplot assembled with via `patchwork::wrap_plots()`.
#'
#' @inheritSection section_dummy Distance measures
#' @inheritSection section_dummy Image visualization with ggplot2
#'
#' @seealso [`getImageDirectories()`], [`identifyPixelContent()`], [`identifyTissueOutline()`]
#'
#' @examples
#' library(SPATA2)
#'
#' data("example_data")
#'
#' object <- example_data$object_UKF275T_diet
#'
#' plotImages(object)
#'
#' @export

setGeneric(name = "plotImages", def = function(object, ...){

  standardGeneric(f = "plotImages")

})

#' @rdname plotImages
#' @export
setMethod(
  f = "plotImages",
  signature = "SPATA2",
  definition = function(object,
                        img_names = getImageNames(object),
                        by_section = TRUE,
                        outline = FALSE,
                        outline_ref = FALSE,
                        fragments = TRUE,
                        line_alpha = line_alpha_ref*0.75,
                        line_alpha_ref = 1,
                        line_color = "black",
                        line_color_ref = "red",
                        line_size = 0.5,
                        line_size_ref = line_size * 1.5,
                        transform = TRUE,
                        img_alpha = 1,
                        against_ref = FALSE,
                        alignment_eval = FALSE,
                        ncol = NULL,
                        nrow = NULL,
                        verbose = TRUE){

    hlpr_assign_arguments(object)

    getSpatialData(object) %>%
      plotImages(
        object = .,
        img_names = img_names,
        ncol = ncol,
        nrow = nrow,
        image = TRUE,
        outline = outline,
        outline_ref = outline_ref,
        by_section = by_section,
        fragments = fragments,
        line_alpha = line_alpha,
        line_alpha_ref = line_alpha_ref,
        line_color = line_color,
        line_color_ref = line_color_ref,
        line_size = line_size,
        line_size_ref = line_size_ref,
        transform = transform,
        img_alpha = img_alpha,
        against_ref = against_ref,
        alignment_eval = alignment_eval,
        verbose = verbose
      )

  }
)

#' @rdname plotImages
#' @export
setMethod(
  f = "plotImages",
  signature = "SpatialData",
  definition = function(object,
                        img_names = NULL,
                        ncol = NULL,
                        nrow = NULL,
                        image = TRUE,
                        outline = FALSE,
                        outline_ref = FALSE,
                        by_section = TRUE,
                        fragments = TRUE,
                        line_alpha = line_alpha_ref*0.75,
                        line_alpha_ref = 1,
                        line_color = "black",
                        line_color_ref = "red",
                        line_size = 0.5,
                        line_size_ref = line_size * 1.5,
                        transform = TRUE,
                        img_alpha = 1,
                        against_ref = FALSE,
                        alignment_eval = FALSE,
                        verbose = TRUE){

    ref_name <- object@name_img_ref

    if(base::is.null(img_names)){

      img_names <- getImageNames(object)

    } else {

      confuns::check_one_of(
        input = img_names,
        against = getImageNames(object)
      )

    }

    if(base::isTRUE(against_ref) & !(ref_name %in% img_names)){

      img_names <- base::unique(c(img_names, ref_name))

    }

    image_list <-
      purrr::map(
        .x = img_names,
        .f = function(name){

          # adjust title
          if(name == getHistoImage(object)@name){

            if(name == ref_name){

              title_add <- "(Active Image, Reference Image)"

            } else {

              title_add <- "(Active Image)"

            }

            hist_img <- getHistoImage(object)

          } else if(name == ref_name) {

            title_add <- "(Reference Image)"

            hist_img <- getHistoImageRef(object)

          } else {

            hist_img <- getHistoImage(object, img_name = name)

            title_add <- ""

          }

          if(base::isTRUE(alignment_eval)){

            if(base::isTRUE(hist_img@aligned) & base::isTRUE(transform)){

              ares <- base::round(hist_img@overlap[[2]], digits = 2)*100

              title_add <- stringr::str_c(title_add, " - Aligned (", ares, "%)")

            } else if(base::isTRUE(transform) & name != ref_name){

              title_add <- stringr::str_c(title_add, " - Not aligned")

            } else {

              # title_add stays as is

            }

          }

          title <- stringr::str_c(hist_img@name, " ", title_add)

          p <-
            ggplot2::ggplot() +
            theme_image() +
            ggplot2::coord_equal(expand = FALSE) +
            ggplot2::labs(subtitle = title, x = NULL, y = NULL)

          transform_checked <- transform | name == ref_name

          # first add image
          if(base::isTRUE(image)){

            # ggpLayerImage loads the image if slot @image is empty
            p <-
              p +
              ggpLayerImage(
                object = hist_img,
                transform = transform_checked,
                img_alpha = img_alpha
              )

          }

          # second add reference outline in specified color
          if(base::isTRUE(outline_ref)){

            hist_img_ref <- getHistoImageRef(object)

            scale_fct <-
              compute_img_scale_fct(
                hist_img1 = hist_img_ref,
                hist_img2 = hist_img
              )

            p <-
              p +
              ggpLayerTissueOutline(
                object = hist_img_ref,
                by_section = by_section,
                fragments = fragments,
                line_alpha = line_alpha_ref,
                line_color = line_color_ref,
                line_size = line_size_ref,
                transform = TRUE, # no transformation needed as its the reference
                scale_fct = scale_fct
              )

          }

          # third add image outline allow normal outline of reference if needed
          if((base::isTRUE(outline) & name != ref_name) |
             (base::isTRUE(outline) & base::isFALSE(outline_ref) & name == ref_name)){

            if(containsTissueOutline(hist_img)){

              p <-
                p +
                ggpLayerTissueOutline(
                  object = hist_img,
                  by_section = by_section,
                  fragments = fragments,
                  line_alpha = line_alpha,
                  line_color = line_color,
                  line_size = line_size,
                  transform = transform_checked,
                  scale_fct = 1
                )

            } else {

              warning(glue::glue("No tissue outline identified for image '{hist_img@name}'."))

            }



          }

          return(p)

        }
      ) %>%
      purrr::set_names(nm = img_names)


    if(ref_name %in% img_names){

      image_list <- image_list[c(ref_name, img_names[img_names != ref_name])]

    }

    if(base::isTRUE(against_ref) && ref_name %in% img_names){

      p1 <- image_list[[ref_name]]
      p2 <-
        confuns::lselect(image_list, -{{ref_name}}) %>%
        patchwork::wrap_plots(ncol = ncol, nrow = nrow)

      out <- p1|p2

    } else {

      out <- patchwork::wrap_plots(image_list, ncol = ncol, nrow = nrow)

    }

    return(out)

  }
)

# plotL -------------------------------------------------------------------



#' @title Plot Bayes Space logliks
#'
#' @description Visualizes the results of `BayesSpace::qTune()` to determine
#' the optimal number of clusters.
#'
#' @inherit argument_dummy params
#' @inherit ggplot_dummy return
#'
#' @details For this function to work the results of [`runBayesSpaceClustering()`]
#' are required.
#'
#' @examples
#' library(SPATA2)
#'
#' data("example_data")
#'
#' object <- example_data$object_UKF275T_diet
#'
#' # this might take some time...
#' object <- runBayesSpaceClustering(object, name = "bspace", qs = 3:15)
#'
#' plotLoglik(object)
#'
#' @export
#'
plotLoglik <- function(object, elbow = TRUE){

  ma <- getAssay(object, assay_name = "transcriptomics")

  df <- ma@analysis$bayes_space$logliks

  if(purrr::is_empty(df)){

    stop("No logliks found. Use `runBayesSpaceClustering()` first.")

  }

  if(base::isTRUE(elbow)){

    elbow_add_on <- ggplot2::geom_vline(xintercept = find_elbow_point(df))

  } else {

    elbow_add_on <- NULL

  }

  ggplot2::ggplot(data = df, mapping = ggplot2::aes(x = q, y = -loglik)) +
    elbow_add_on +
    ggplot2::geom_path() +
    ggplot2::geom_point() +
    ggplot2::theme_minimal()

}

# plotM -------------------------------------------------------------------

#' @title Plot Model Comparison Dotplot
#'
#' @description Overview dotplot to compare screening results of selected models.
#'
#' @param data Output of `spatialAnnotationScreening()` or `spatialTrajectoryScreening()`
#'   in the form of `screening_results@results`.
#' @param model_remove (Optional) A character vector specifying models to remove from the plot.
#' @param scale_factor A numeric value to scale the point sizes. Default is 1.
#' @param pt_size The size of the points in the plot. Default is 0.1.
#' @param label_vars The number of top variables to label for each model. Default is 2.
#' @param label_size The size of the labels. Default is 4.
#' @param threshold_pval The p-value threshold for coloring points. Default is 0.05.
#' @param label_color The color of labels. Default is "#4d4d4d".
#' @param x_label The label for the x-axis. Default is "Gene-model correlation".
#'
#' @return A dotplot comparing model screening results.
#'
#' @examples
#' # Example usage:
#' pl <- plot_model_comparison_dotplot(screening_1@results, model_remove = c("peak"), label_vars = 3)
#' pl + coord_cartesian(xlim = c(0.5, 1))
#'
#' @keywords internal
#'
plot_model_comparison_dotplot <- function(data,
                                          eval = "mae",
                                          pval = "p_value",
                                          model_subset = NULL,
                                          model_remove = NULL,
                                          scale_factor = 1,
                                          pt_size = 1.5,
                                          label_vars = 2,
                                          label_size = 4,
                                          threshold_pval = 0.05,
                                          label_color = "#4d4d4d"
                                          ) {

  data <- data[data$corr >= 0,]

  # Scale point size based on p-values
  max_size <- scale_factor * max(-log10(data[[pval]]))

  if(!base::is.null(model_remove)){

    data <- data[!base::grepl(paste(model_remove, collapse = "|"), data$models), ]

  }

  if(!base::is.null(model_subset)){

    data <- dplyr::filter(data, stringr::str_detect(models, pattern = model_subset))

  }

  # Select top variables to label for each model

  data <-
    dplyr::group_by(data, variables) %>%
    dplyr::slice_min(!!rlang::sym(eval), n = 1)

  labeled_data <-
    dplyr::group_by(data, models) %>%
    dplyr::slice_min(!!rlang::sym(eval), n = label_vars, with_ties = FALSE)

  ggplot2::ggplot(
    data = data,
    mapping = ggplot2::aes(x = .data[[eval]], y = reorder(models, -log10(.data[[pval]])))
    ) +
    ggplot2::geom_point(
      data = data,
      size = pt_size,
      color = dplyr::if_else(data[[pval]] < threshold_pval, "#ff7256", "grey50")
    ) +
    ggplot2::scale_color_manual(values = c("grey50", "#ff7256"), labels = c(paste0(">= ", threshold_pval), paste0("< ", threshold_pval))) +
    ggplot2::scale_size_continuous(range = c(pt_size, max_size)) +
    #ggplot2::scale_x_continuous(limits = c(0,1)) +
    ggplot2::labs(x = eval, y = "Model") +
    ggplot2::theme_minimal() +
    ggplot2::guides(size = guide_legend(override.aes = list(size = c(pt_size, mean(c(pt_size, max_size)), max_size)))) + # Adjust dot size in legend
    ggplot2::theme(panel.grid.major.y = element_blank()) +
    ggrepel::geom_text_repel(
      data = labeled_data,
      mapping = ggplot2::aes(label = ifelse(((.data[[eval]] >= 0)), variables, '')),
      color = label_color,
      size = label_size
      )
}


#' @title Plot mosaic plot
#'
#' @description Plots a mosaic plot of two grouping variables.
#'
#' @param grouping Character value. The grouping variable that is
#' plotted on the x-axis.
#' @param fill_by Character value. The grouping variable that is used to
#' fill the mosaic.
#'
#' @inherit confuns::plot_mosaic params
#' @inherit argument_dummy params
#' @inherit plotBarchart params return
#'
#' @examples
#' library(SPATA2)
#'
#' data("example_data")
#'
#' object <- example_data$object_UKF275T_diet
#'
#' plotMosaicPlot(object, grouping = "seurat_clusters", fill_by = "bayes_space")
#'
#' @export
#'
plotMosaicplot <- function(object,
                           grouping,
                           fill_by,
                           clrp = NULL,
                           clrp_adjust = NULL,
                           ...){

  require(ggmosaic)

  deprecated(...)

  hlpr_assign_arguments(object)

  confuns::check_one_of(
    input = c(grouping, fill_by),
    against = getGroupingOptions(object),
    suggest = TRUE
  )

  df <- getMetaDf(object)

  confuns::plot_mosaic(
    df = df,
    x = grouping,
    fill.by = fill_by,
    clrp = clrp,
    clrp.adjust = clrp_adjust
  ) +
    ggplot2::theme(
      panel.background = ggplot2::element_blank(),
      axis.ticks.y = ggplot2::element_blank(),
      axis.text.y = ggplot2::element_blank(),
      axis.title.y = ggplot2::element_blank()
    ) +
    ggplot2::labs(
      x = grouping,
      fill = fill_by
    )

}
theMILOlab/SPATA2 documentation built on Feb. 8, 2025, 11:41 p.m.