R/ggsmatr.R

In mariosandovalmx/ggsmatr: Ggsmatr

# WARNING - Generated by {fusen} from /dev/flat_full.Rmd: do not edit by hand

#' ggsmatr 'ggplot2' based SMATR plots
#'
#' Create a scatter plot based on the coefficients from (Standardised) Major Axis Estimation fit.
#' @usage ggsmatr(data, groups , xvar , yvar, sma.fit)
#' @param data a dataframe.
#' @param groups group variable.
#' @param xvar x variable for drawing.
#' @param yvar y variable for drawing.
#' @param sma.fit an sma or ma object fitted in SMATR package.
#'
#' @return ggplot based plot of sma.
#' @export
#' @examples
#' datafile <- system.file("iris.csv", package = "ggsmatr")
#' df.iris <- read.csv(datafile, encoding = "UTF-8")
#' 
#' library(ggsmatr)
#' library(ggplot2)
#' library(smatr)
#' fit = sma(Sepal.Length ~ Sepal.Width + Species, 
#'           data = df.iris,shift=TRUE, elev.test=TRUE)
#' #
#' ggsmatr(data =  df.iris, groups = "Species", 
#'         xvar =  "Sepal.Width", yvar = "Sepal.Length", 
#'         sma.fit =  fit) + 
#' theme(legend.position = "top", legend.title=element_blank())+ 
#' ylab("Sepal.Length")+ 
#' xlab("Sepal.Width")+ 
#' theme(legend.position = "top")
#' 
#' 
ggsmatr <- function(data, groups, xvar, yvar, sma.fit){



  x.var <- rlang::sym(xvar)
  y.var <- rlang::sym(yvar)
  grp <- rlang::sym(groups)
  ngrps<- length(unique(data[[groups]]))

  # as factors, function from Tlamatini package
  as_factorALL<- function(dataframe){

    df<- dataframe
    df[sapply(df, is.character)] <- lapply(df[sapply(df, is.character)],
                                           as.factor)
    return(df)
  }

  data<- as_factorALL(data)
  # define colors
  grps.df = unique(data[[groups]])
  station_cols = scales::hue_pal()(length(grps.df))
  names(station_cols) <- unique(data[[groups]])

  fitsall <- sma.fit$groupsummary |> dplyr::select(group , r2, pval, Slope, Int)
  fitsall <- fitsall |>  dplyr::mutate_if(is.numeric, round, digits = 3)
  fitsall


  # extraer coeficientes de SMA, vars:  dataframe  groups   xvar
  bb <- data.frame(stats::coef(sma.fit))

  bb <- bb |>
    tibble::rownames_to_column(var = "group")

  # calcular minimo y maximo del eje x para cada sitio
  bb2 <- data |> 
    dplyr::select(groups, xvar) |>  
    dplyr::group_by(.data[[groups]]) |>
    dplyr::summarise(dplyr::across(.cols = xvar,
                                   .fns = list(min = min, max = max),
                                   .names = "{fn}_x"))
  names(bb2)[1] <- 'group'


  #unir dataframe
  bb3 <- base::merge(bb,bb2, by= "group")

  #calcular min y max de y con intercepto y elevacion
  bb4 <- bb3 |>
    dplyr::mutate(min_y = (slope*min_x) + elevation) |>
    dplyr::mutate(max_y = (slope*max_x) + elevation)
  data<- stats::na.omit(data)

  df.pl <- cbind(bb4, fitsall[,-1])

  print(df.pl[,c(1,8,9)])

  ggp <-  ggplot2::ggplot(data = data, ggplot2::aes(x = !! x.var,
                                                    y = !! y.var,
                                                    color= !! grp,
                                                    fill= !! grp)) +
    ggplot2::geom_point(size=2, alpha = 0.5) +
    ggplot2::geom_segment(data = df.pl ,ggplot2::aes(x= min_x, xend= max_x, y=min_y, yend=max_y, colour= group),inherit.aes = FALSE, size= 1)


  .GlobalEnv$ggp <- ggp


  return(ggp)

}