Export some utility functions for use in Pmetrics family of packages

R/PMupdate.R → Archived/PMupdate.R

@@ -27,20 +27,20 @@ PMupdate <- function(force = F) {
  cat("You have the most current version of Pmetrics.\n")
  return(invisible(FALSE))
  } else {
- # check for devtools
- devtools_installed <- requireNamespace("devtools")
- if (!devtools_installed) {
- cat("The devtools package is required to install from github.\n")
+ # check for remotes
+ remotes_installed <- requireNamespace("remotes", quietly = TRUE)
+ if (!remotes_installed) {
+ cat("The remotes package is required to install from github.\n")
  cat(paste0(
- "Enter ", crayon::blue("<1>"), " to install devtools or ",
+ "Enter ", crayon::blue("<1>"), " to install remotes or ",
  crayon::blue("<2>"), " to abort.\n"
  ))
  ans <- ""
  while (ans != "1" & ans != "2") {
  ans <- readline("Response: ")
  }
  if (ans == "1") {
- install.packages("devtools")
+ install.packages("remotes")
  } else {
  cat("Pmetrics update aborted.\n")
  return(invisible(FALSE))
@@ -74,7 +74,7 @@ PMupdate <- function(force = F) {
  # update
  OS <- getOS()
  if (OS != 2) { # Mac/Linux
- Pmetrics_installed <- tryCatch(devtools::install_github(repo = "LAPKB/Pmetrics", force = force),
+ Pmetrics_installed <- tryCatch(remotes::install_github(repo = "LAPKB/Pmetrics", force = force),
  error = function(e) -1
  )
  if (Pmetrics_installed != -1) {
@@ -85,9 +85,9 @@ PMupdate <- function(force = F) {
  cat(paste0(crayon::blue("NOTE: "), "Windows is unable to update loaded packages.\nPlease do the following.\n"))
  cat("\n1. Paste the following into the R console: detach(\"package:Pmetrics\", unload = TRUE)\n")
  if (force) {
- cat("2. Paste the following into the R console: devtools::install_packages(repo = \"LAPKB/Pmetrics\", force = T)\n")
+ cat("2. Paste the following into the R console: remotes::install_packages(repo = \"LAPKB/Pmetrics\", force = T)\n")
  } else {
- cat("2. Paste the following into the R console: devtools::install_packages(repo = \"LAPKB/Pmetrics\")\n")
+ cat("2. Paste the following into the R console: remotes::install_packages(repo = \"LAPKB/Pmetrics\")\n")
  }
  cat("3. Allow Rstudio to restart session.\n")
  cat("4. Rstudio will complete installation.\n")

DESCRIPTION

@@ -17,6 +17,7 @@ Description: Parametric and non-parametric
 Authors@R: c(
  person("Michael", "Neely", email = "[email protected]", role = c("aut", "cre")),
  person("Julián", "Otálvaro", email = "[email protected]", role = "aut"),
+ person("Markus", "Hovd", email = "", role = "ctb"),
  person("Walter", "Yamada", email = "", role= "ctb"),
  person("Alan", "Schumitzky", email = "", role = "ctb"),
  person("Rong", "Chen", email = "", role = "ctb"),
@@ -40,7 +41,6 @@ Imports:
  lifecycle,
  lubridate,
  magrittr,
- npde,
  openxlsx,
  pander,
  plotly,
@@ -58,13 +58,13 @@ Imports:
  tidyr,
  utils
 Suggests:
- curl,
  data.table,
  devtools,
  ggpubr,
  htmltools,
  knitr,
  mclust,
+ npde,
  pandoc,
  patchwork,
  PmetricsData,

NAMESPACE

@@ -98,16 +98,18 @@ export(ab_line)
 export(add_shapes)
 export(add_smooth)
 export(additive)
-export(build_model)
-export(build_plot)
 export(combination)
 export(covariate)
 export(editPMoptions)
 export(errorPoly)
 export(export_plotly)
 export(fixed)
-export(getPMdata)
+export(getCov)
+export(getDefaultColors)
+export(getFixedColNames)
+export(getFixedColNum)
 export(getPMoptions)
+export(getPalettes)
 export(makeAUC)
 export(makeCov)
 export(makeCycle)

R/PMconfig.R

@@ -17,6 +17,20 @@ getBits <- function() {
  }
 }
 
+# getFixedColNames ------------------------------------------------------------------
+
+#' @title Names of fixed columns 
+#' @description
+#' `r lifecycle::badge("stable")`
+#'
+#' Returns the names of fixed columns (non-covariate) in Pmetrics data objects.
+#' @return A vector of fixed column names: 
+#' `c("id", "evid", "time", "dur", "dose", "addl", "ii", "input", "out", "outeq", "c0", "c1", "c2", "c3")`
+#' 
+#' @export
+#' @examples
+#' getFixedColNames()
+#' @author Michael Neely
 getFixedColNames <- function() {
  # set current names of fixed columns in data file
 
@@ -26,6 +40,20 @@ getFixedColNames <- function() {
  )
 }
 
+
+# getFixedColNum ------------------------------------------------------------------
+
+#' @title Number of fixed columns 
+#' @description
+#' `r lifecycle::badge("stable")`
+#'
+#' Returns the number of fixed columns (non-covariate) in Pmetrics data objects.
+#' @return An integer with the number of fixed columns.
+#' 
+#' @export
+#' @examples
+#' getFixedColNum()
+#' @author Michael Neely
 getFixedColNum <- function() {
  # set current number of fixed columns in data file
  length(getFixedColNames())

R/PMutilities.R

@@ -1804,8 +1804,28 @@ makePMmatrixBlock <- function(mdata) {
 
 # getCov ------------------------------------------------------------------
 
-# function to get covariate information from PMmatrix object
+#' @title Extract covariate information 
+#' @description
+#' `r lifecycle::badge("stable")`
+#'
+#' Extracts covariate information from a Pmetrics data objects.
+#' @details
+#' When given a [PM_data] or *PMmatrix* object, will return a list 
+#' with the number of covariates, their names, and the starting and
+#' ending column numbers 
+#' @param mdata A [PM_data] or *PMmatrix* object
+#' @return A list with named items: *ncov, covnames, covstart, covend*.
+#' 
+#' @export
+#' @examples
+#' library(PmetricsData)
+#' getCov(dataEx)
+#' @author Michael Neely
+
 getCov <- function(mdata) {
+ if(inherits(mdata, "PM_data")){
+ mdata <- mdata$data
+ }
  nfixed <- getFixedColNum()
  ncolData <- ncol(mdata)
  ncov <- ncolData - nfixed
@@ -1849,35 +1869,38 @@ getOSname <- function() {
 
 # check for installed packages --------------------------------------------
 
-checkRequiredPackages <- function(pkg, repos = "CRAN") {
+checkRequiredPackages <- function(pkg, repos = "CRAN", quietly = TRUE) {
  managePkgs <- function(thisPkg) {
- # if (length(grep(thisPkg, installed.packages()[, 1])) == 0) {
- # install.packages(thisPkg, dependencies = T)
- # }
- if (requireNamespace(thisPkg, quietly = T)) {
+ if (requireNamespace(thisPkg, quietly = TRUE)) {
  return("ok") # package is installed
  } else { # package is not installed
  cat(paste0("The package ", thisPkg, " is required and will be installed.\n"))
  if (repos == "CRAN") {
-  install.packages(thisPkg, dependencies = T, quiet = T) # try to install
+ install.packages(thisPkg, dependencies = TRUE, verbose = FALSE, quiet = TRUE) # try to install
  } else {
- devtools::install_github(repos)
+ tryCatch(remotes::install_github(repos), error = function(e) FALSE)
  }
- if (requireNamespace(thisPkg, quietly = T)) { # check again
+ if (requireNamespace(thisPkg, quietly = TRUE)) { # check again
  return("ok") # now it is installed and ok
  } else {
  return(thisPkg)
  } # nope, still didn't install
  }
  }
 
- pkg %>%
+ msg <- pkg %>%
  map_chr(managePkgs) %>%
- keep(~ . != "ok") %>%
- map_chr(~ if (length(.) > 0) {
- stop(paste("The following required packages did not successfully install: ", ., sep = "", collapse = ", "))
- })
- return(invisible())
+ keep(~ . != "ok")
+
+ if(length(msg)>0){
+ if(!quietly){cat(crayon::red("\nError:"), "The following packages needed for this function did not install:",
+ paste(msg, collapse = ", "))
+ }
+ return(invisible(FALSE))
+ }
+ else {
+ return(invisible(TRUE)) #all packages present or installed
+ }
 }
 
 
@@ -1988,20 +2011,3 @@ weighted_median <- function(values, weights) {
  return(median_value)
 }
 
-
-#' @title Get Pmetrics package example data 
-#' @description
-#' `r lifecycle::badge("stable")`
-#'
-#' Get the data and examples for the Pmetrics package.
-#'
-#' @details
-#' This function installs the **PmetricsData** package available on github. 
-#' The repository URL is [https://github.com/LAPKB/PmetricsData](https://github.com/LAPKB/PmetricsData). These data
-#' are used in all Pmetrics examples.
-#'
-#' @export
-getPMdata <- function(){
- remotes::install_github("LAPKB/PmetricsData")
- requireNamespace("PmetricsData")
-}