In mariosandovalmx/ggsmatr: Ggsmatr

library(testthat)

# Load already included functions if relevant
pkgload::load_all(export_all = FALSE)

# Run all this chunk in the console directly
# There already is a dataset in the "inst/" directory
# Make the dataset file available to the current Rmd during development
pkgload::load_all(path = here::here(), export_all = FALSE)

# You will be able to read your example data file in each of your function examples and tests as follows - see chunks below
datafile <- system.file("iris.csv", package = "ggsmatr")
iris <- read.csv(datafile, encoding = "UTF-8")

ggsmatr: Example using iris dataset

#' 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
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)

}

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")

# Test with your dataset in "inst/"
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)

test_that("ggsmatr works properly and show error if needed", {
 expect_visible(ggsmatr(data =  df.iris, groups = "Species", xvar =  "Sepal.Width", yvar = "Sepal.Length", sma.fit =  fit))
  expect_error(ggsmatr(data =  df.iris, groups = "Species", xvar =  "Sepal.Width", yvar = "Sepal.Length"))
})

# Keep eval=FALSE to avoid infinite loop in case you hit the knit button
# Execute in the console directly
fusen::inflate(flat_file = "dev/flat_full.Rmd", vignette_name = "ggsmatr example", check = TRUE)