svMisc/0000755000176200001440000000000014715413575011532 5ustar liggesuserssvMisc/tests/0000755000176200001440000000000014614131727012666 5ustar liggesuserssvMisc/tests/testthat/0000755000176200001440000000000014715413575014534 5ustar liggesuserssvMisc/tests/testthat/test-capture_all.R0000644000176200001440000000235114614404624020121 0ustar liggesuserstest_that("capture_all() produces correct outputs", { expr1 <- parse(text = "1+1") res1 <- "[1] 2\n" expect_true(is.na(capture_all(NA))) expect_error(capture_all(1), "expr must be an expression or NA", fixed = TRUE) expect_error(capture_all("1+1"), "expr must be an expression or NA", fixed = TRUE) expect_error(capture_all(TRUE), "expr must be an expression or NA", fixed = TRUE) expect_error(capture_all(NULL), "argument is of length zero", fixed = TRUE) expect_error(capture_all(logical(0)), "argument is of length zero", fixed = TRUE) }) #test_that("capture_all() splits outputs with split = TRUE", { #expect_identical(capture_all(expr1, echo = FALSE, split = TRUE), res1) #expect_identical(capture_all(expr1, echo = FALSE, split = FALSE), res1) #expect_identical(capture_all(expr1, echo = FALSE, split = c(TRUE, FALSE)), # res1) #expect_identical(capture_all(expr1, echo = FALSE, split = logical(0)), res1) #expect_identical(capture_all(expr1, echo = FALSE, split = NULL), res1) #expect_identical(capture_all(expr1, echo = FALSE, split = "TRUE"), res1) #expect_identical(capture_all(expr1, echo = FALSE, split = 1), res1) #expect_identical(capture_all(expr1, echo = FALSE, split = NA), res1) #}) svMisc/tests/testthat/test-temp_env.R0000644000176200001440000000173114614426621017445 0ustar liggesuserstest_that("temp_env() creates and retrieves the temporary environment", { tenv <- temp_env() expect_type(tenv, "environment") expect_false(is.na(match("SciViews:TempEnv", search()))) expect_identical(tenv, temp_env()) }) test_that("Variables management in temp_env()", { temp_var <- "test_variable___" expect_false(exists_temp(temp_var)) assign_temp(temp_var, 1:3) expect_true(exists_temp(temp_var)) expect_identical(get_temp(temp_var), 1:3) expect_error(exists_temp(), "argument \"x\" is missing, with no default", fixed = TRUE) # Replace or not variables in TempEnv assign_temp(temp_var, 4:5, replace.existing = FALSE) expect_identical(get_temp(temp_var), 1:3) assign_temp(temp_var, 4:5, replace.existing = TRUE) expect_identical(get_temp(temp_var), 4:5) # Remove variables in TempEnv (silently, if not there) expect_true(delete_temp(temp_var)) expect_false(exists_temp(temp_var)) expect_false(delete_temp("non_existing_variable___")) }) svMisc/tests/testthat/test-parse_text.R0000644000176200001440000000224614614405221020001 0ustar liggesuserstest_that("parse_text() parse expressions like parse(text = ...)", { # Single expression expr <- "1+1" res <- as.character(parse(text = expr)) expect_identical(as.character(parse_text(expr)), res) # Multiple expressions expr <- "1+1; ls()" res <- as.character(parse(text = expr)) #expect_identical(as.character(parse_text(expr)), res) expr <- c("1+1", "ls()") res <- as.character(parse(text = expr)) #expect_identical(as.character(parse_text(expr)), res) }) test_that("parse_text() works with wrong expressions", { # NA on incomplete expressions expr <- "1 +" expect_true(is.na(parse_text(expr))) expr <- "1+)" expect_s3_class(parse_text(expr), "try-error") # Captures the error message for a wrong expression get_error_msg <- function(text) { res <- try(parse(text = text), silent = TRUE) if (inherits(res, "try-error")) { res <- sub("^.*:", "", as.character(res)) res <- sub("\n$", "", res) return(res) } else return("") # This is not supposed to happen! } # TODO: for some reasons this does not work as expected... expr <- "1+)" #expect_identical(as.character(parse_text(expr)), get_error_msg(expr)) }) svMisc/tests/testthat.R0000644000176200001440000000061014614403750014644 0ustar liggesusers# This file is part of the standard setup for testthat. # It is recommended that you do not modify it. # # Where should you do additional test configuration? # Learn more about the roles of various files in: # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview # * https://testthat.r-lib.org/articles/special-files.html library(testthat) library(svMisc) test_check("svMisc") svMisc/tests/spelling.R0000644000176200001440000000024214614403667014631 0ustar liggesusersif (requireNamespace('spelling', quietly = TRUE)) spelling::spell_check_test(vignettes = TRUE, error = FALSE, skip_on_cran = TRUE) svMisc/MD50000644000176200001440000001061614715413575012046 0ustar liggesusersede1faaa28edd1e33505443f617bc592 *DESCRIPTION d67d28e682bc742862f59a3d798a2a34 *NAMESPACE 0ef7742ae53fb800c98974a1adbc0070 *NEWS.md 43671d15e48e162688409162da026c3e *R/about.R 8beb007bda678f667eeb4184c210e9dd *R/add_actions.R e1d9e1924bd9b782ebdac7b30c707b18 *R/aka.R 82f42f95988e94cfe003775e844fcd4e *R/batch.R 78ad36d5388ea1b28c8460a7d8e31200 *R/capture_all.R e6475841507ae1778e81a771848d981b *R/compare_r_version.R f2b076c720fc63fefe77a07683739eeb *R/completion.R 453c5a1b885946d751d3f70be56dd8dd *R/cut_quantile.R 2baee1fd44148c9f56d7e0f270adee3c *R/def.R 0c3fa12a0922d41bdea3439097a84681 *R/describe_function.R 151501289060bc0e68d0ace868d1a011 *R/file_edit.R 4741276fe8b304b513b02d1b03163b81 *R/gui_cmd.R 4a15c22305933b0600b158ae9ef04be8 *R/install.R c93c71deffc788279c3cabaf142eda5e *R/is_xxx.R 2e221c17b949a6c39ec8dbb2aa4e53d8 *R/list_methods.R 2d1160710b1861becf8df493fb026bf9 *R/obj_browse.R 4163ab412ee113c43f5e96aa5c07385d *R/package.R 28b5d2e5de7cd3fe3ac94cd39a8f26f6 *R/parse_text.R 9e20d37de0627755c9d07056c7d956b0 *R/pcloud.R 4578198c0cbd583f3697b5a70a2268d8 *R/pkgMan.R 996298a66069a348e21e211e77fa6815 *R/progress.R 2651902728564e9ae665d73a396e5a22 *R/rbenchmark.R 59d69190fd83696e0589b9bacadc34e1 *R/rjson.R a4cdb7e20e3d298171143aa0f6b9732c *R/search_web.R f711c84d0b9cb036d8ea682a2d4f601b *R/section.R 8d172c94d74a702f004a89ce76e16284 *R/source_clipboard.R 694c4211d9afb89d377090588c3c9dae *R/subsettable.R d383804622090f84f67616707ec97c13 *R/svMisc-internal.R 968d116e396e7288c611f89f6b9a7507 *R/svMisc-package.R c5011e44c036bc4fa2e2213ad363b2cd *R/system_file.R 5bf17270ed7c5baa2863086411f95c82 *R/temp_env.R 67b5ef6d0bae333416d258a55734d307 *R/temp_var.R b62c263a06eb1834e8f9ffcb45d61931 *build/vignette.rds 1003fdbb5d77c3c4d5a2d35480c36c40 *inst/CITATION 96cd796d06e3e3bea2467be6d51a7473 *inst/WORDLIST 93f9b1db2eeed68dcd8381924b0e208f *inst/doc/svMisc.R efa047532d734ae3ea22ea8e3daa5928 *inst/doc/svMisc.Rmd d3808618118fc587fa23b381418ba177 *inst/doc/svMisc.html bc8ce29013655d138b3b9755cb89b4ae *inst/doc/temporary_environment.R 2b12b1dc50b3dff01cd7b66480e4c3bb *inst/doc/temporary_environment.Rmd 8c7dffa920c4b5b3dc93a2789dcbe8ec *inst/doc/temporary_environment.html 4f804fb8a2fd2afb04e83d1a5e7f2d77 *inst/figures/svMisc.png c0ce3fc6b13b7e987aeb65e73a45e1b6 *inst/po/fr/LC_MESSAGES/R-svMisc.mo 73a3c611eb28af58f02c2efddf12025d *man/Install.Rd fbb6c429a864399e66b6dcb95b2774fa *man/about.Rd a2e3a45e43a74629f19c152f55c0fca6 *man/add_actions.Rd 26ff90a2d377dd115656fa95b4592603 *man/aka.Rd b95d55d5d4422aa15779032d7a876729 *man/batch.Rd a64528ee7f690158db487b6dce479ce0 *man/capture_all.Rd 39d69248f7312fd54e7aee9df7b1df33 *man/compare_r_version.Rd cab0fafe703aca111633d3923ca8809b *man/completion.Rd ee267ead92d3d35a85bd7d672876468a *man/cut_quantile.Rd bce1ca26de95739cc179739321a3a611 *man/def.Rd c82f8232c37c945f1fdbe17b6289ad60 *man/describe_function.Rd 4f804fb8a2fd2afb04e83d1a5e7f2d77 *man/figures/logo.png fa8d5e42fa21a86e89527e1e16f5d4f0 *man/file_edit.Rd a1247dd9d255a9e9dd57dc5f27d33689 *man/gui_cmd.Rd 258791a68e09f343083522ec2ba18dcc *man/is_help.Rd 8d25f7584427dbb27aeffacb6c357539 *man/list_methods.Rd ab756a952b70facf41e28cf636e9a8cd *man/obj_browse.Rd 4708e432178223216548f5a94ca96791 *man/package.Rd cd99ec26235bb15de4c516fd0f2f89ac *man/parse_text.Rd e276f9225949e4098535ef8be03846fa *man/pcloud.Rd 034f637922400b2bcc8126a90fab2a06 *man/pkgman_describe.Rd bbb7b6382e74fb09dce24bbeeb6fd4d1 *man/progress.Rd e0ce9335cc76b8e735ad82127685ab4a *man/rbenchmark.Rd 109d5c8377ec464ef1ca01030e8fde9b *man/search_web.Rd ff8559cb36b057ea675dfc77ad8f0950 *man/section.Rd 8a5dacbd61625a9e31481ab3a2f436a3 *man/source_clipboard.Rd 14b91f30b114df29eb1e4d30a422110e *man/subsettable.Rd 32c0409e1d7a6488d79c597611ced733 *man/svMisc-package.Rd f65fedfa345982fc755ee0f4f29602de *man/system_file.Rd 07a84494e6a0307d006f01415ded01a6 *man/temp_env.Rd acc5eedd357ce9ee721b673df16a04e8 *man/temp_var.Rd 3ebc7989206d448982d8a768561f836a *man/to_rjson.Rd d5ef98bfc49fc3f0ba53c53d0df477a3 *po/R-fr.po dddfb01fb9cb2a1a94f8606dd5791bed *po/R-svMisc.pot 8e1b2c37a4d07e22fa6ee05df09223e5 *tests/spelling.R 776286e2d0063f476e6434b98e951d8c *tests/testthat.R f55ea7a8676c1a553c526228e7657276 *tests/testthat/test-capture_all.R f016c5bc33d81aaad0bb11ef31727a94 *tests/testthat/test-parse_text.R 2d5820de213a60a67134dd6da8db2883 *tests/testthat/test-temp_env.R efa047532d734ae3ea22ea8e3daa5928 *vignettes/svMisc.Rmd 2b12b1dc50b3dff01cd7b66480e4c3bb *vignettes/temporary_environment.Rmd svMisc/po/0000755000176200001440000000000014614131727012142 5ustar liggesuserssvMisc/po/R-fr.po0000644000176200001440000002007214614131727013311 0ustar liggesusers# Translation of R-svMisc.pot to French # Copyright (C) 2005 The R Foundation # This file is distributed under the same license as the svMisc R package. # Philippe Grosjean , 2005-2009. # msgid "" msgstr "" "Project-Id-Version: R 2.6.0\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2009-01-22 15:56\n" "PO-Revision-Date: 2009-01-22 16:33+0100\n" "Last-Translator: Philippe Grosjean \n" "Language-Team: French \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" msgid "'obj' should inherit from 'list'" msgstr "'obj' doit un objet 'list'" msgid "Data you add in actions must be a named character vector" msgstr "Les données que vous ajoutez dans les actions doivent être des vecteurs de chaînes de caractères nommées" msgid "'obj' should inherit from 'character'" msgstr "'obj' doit être un objet 'character'" msgid "Icons map you add must be a named character vector" msgstr "Le mappage des icônes que vous ajoutez doit être un vecteur de chaînes de caractères nommées" msgid "must be a list!" msgstr "doit être une liste!" msgid "'type' could be only 'google', 'archive' or 'wiki', currently!" msgstr "'type' ne peut être que 'google', 'archive' ou 'wiki', pour l'instant !" msgid "'f' must ba a character string!" msgstr "'f' doit être une chaîne de caractères !" msgid "Impossible to create the Object Browser 'path' directory!" msgstr "Impossible de créer le répertoire pour lexplorateur d'objets" msgid "'value' must be numeric!" msgstr "'value' doit être numérique !" msgid "'max.value' must be numeric or NULL!" msgstr "'max.value' doit être numérique ou NULL !" msgid "Progress:" msgstr "Progression :" msgid "on" msgstr "sur" msgid "'x' must be character string(s)!" msgstr "'x' doit une chaîne de caractères, ou un vecteur de chaînes de caractères !" msgid "" "Load...\n" "Load R objects" msgstr "" "Charger...\n" "Charger des objets R : load()" msgid "" "Source...\n" "Source R code" msgstr "" "Sourcer...\n" "Sourcer du code R : source()" msgid "" "Save as...\n" "Save to a file" msgstr "" "Sauver sous...\n" "Sauver dans un fichier" msgid "" "Import...\n" "Import data in R" msgstr "" "Importer...\n" "Importer des données dans R : import()" msgid "" "Export...\n" "Export data to a file" msgstr "" "Exporter...\n" "Exporter des données vers un fichier : export()" msgid "" "Report...\n" "Prepare a report for this object" msgstr "" "Reporter...\n" "Preparer un rapport pour cet objet : report()" msgid "" "Set Working dir...\n" "Change current R working directory" msgstr "" "Changer le répertoire de travail...\n" "Changer le répertoire de travail courant : setwd()" msgid "" "Print or show\n" "Print or show the content of the object" msgstr "" "Visualiser...\n" "Visualiser le contenu de l'objet : print() ou show()" msgid "" "<<>>()\n" "Apply method <<>>() to the object" msgstr "" "<<>>()\n" "Appliquer la méthode <<>>() à l'objet" msgid "" "Names\n" "Names of variables contained in the object" msgstr "" "Noms\n" "Nom des variables contenues dans l'objet : names()" msgid "" "Str\n" "Compact str() representation of an object" msgstr "" "Str\n" "Représentation compacte de l'objet : str()" msgid "" "Help\n" "Help on an object" msgstr "" "Aide\n" "Aide sur un objet" msgid "" "Example\n" "Run examples for this object" msgstr "" "Exemple\n" "Exacuter les exemples pour cet objet : example()" msgid "" "Edit\n" "Edit an object" msgstr "" "Editer\n" "Editer un objet : edit()" msgid "" "Fix\n" "Fix an R object" msgstr "" "Réparer\n" "Réparer un objet R" msgid "" "Remove\n" "Remove (permanently!) one or several objects from memory" msgstr "" "Effacer\n" "Effacer (de manière permanente !) un ou plusieurs objets de la mémoire" msgid "" "Require <<>>\n" "Require the package <<>>" msgstr "" "Requière le <<>>\n" "Requiérir le package <<>>" msgid "" "Require (compact)\n" "Compact require one or several R packages" msgstr "" "Requiérir (forme compacte)\n" "Requiérir un ou plusieurs packages (forme compacte)" msgid "" "Attach\n" "Attach an object to the search path" msgstr "" "Attacher\n" "Attacher un objet au chemin de recherche de R" msgid "" "Detach\n" "Detach an object or package from the search path" msgstr "" "Détacher\n" "Détacher un objet ou un package du chemin de recherche" msgid "" "Detach and unload\n" "Detach a package from the search path and unload it" msgstr "" "Détacher et décharger\n" "Détacher un package du chemin de recherche et le décharger de la mémoire" msgid "" "Reattach\n" "Reattach an object to the search path" msgstr "" "Réattacher\n" "Réattacher un objet au chemin de recherche" msgid "" "Package info\n" "Show detailed information for this package" msgstr "" "Package info\n" "Afficher des informations détaillées sur ce package" msgid "" "View (default)\n" "Default view for this object" msgstr "" "Voir (défaut)\n" "Vue par défaut de l'objet" msgid "" "View <<>>\n" "Display a '<<>>' view for this object" msgstr "" "Voir <<>>\n" "Afficher une vue '<<>>' pour cet objet" msgid "" "Copy (default)\n" "Copy this object to the clipboard (default format)" msgstr "" "Copier (défaut)\n" "Copier cet objet vers le presse-papier (format par défaut)" msgid "" "Copy <<>>\n" "Copy this object to the clipboard in '<<>>' format" msgstr "" "Copier @@@type>>>\n" "Copier cet objet vers le presse-papier" msgid "" "Functions\n" "Generic functions and methods" msgstr "" "Fonctions\n" "Fonctions génériques et méthodes" msgid "" "View\n" "View the object" msgstr "" "Voir\n" "Voir cet objet" msgid "" "Copy\n" "Copy the object to the clipboard" msgstr "" "Copier\n" "Copier l'objet vers le presse-papier" msgid "'strip' must be a 'svStripbar' object" msgstr "'strip' doit être un objet 'svStripbar'" msgid "'widgets' must be 'menu', 'item', 'sep' or 'space'" msgstr "'widgets' doit être 'menu', 'item', 'sep' ou 'space'" #~ msgid "" #~ "Package or bundle '%s' was not found in %s. Would you like to install it " #~ "now?" #~ msgstr "" #~ "Le package ou le bundle '%s' est introuvable dans %s. Voulez-vous " #~ "l'installer maintenant ?" #~ msgid "Missing package or bundle '%s' was neither installed nor loaded" #~ msgstr "Package ou bundle '%s' manquant non installé, ni chargé" #~ msgid "Local Repository" #~ msgstr "Entrepot local" #~ msgid "Local Zip File" #~ msgstr "Fichier zip local" #~ msgid "Select the directory PACKAGES description file" #~ msgstr "Sélectionnez le fichier de description PACKAGES" #~ msgid "Packages description" #~ msgstr "Description de packages" #~ msgid "file:" #~ msgstr "fichier :" #~ msgid "" #~ "The repository '%s' does not appear to be a valid repository.\n" #~ "Would you like to try another repository?" #~ msgstr "" #~ "L'entrepot '%s' ne semble pas être un entrepot valide.\n" #~ "Voulez-vous essayer un autre entrepot ?" #~ msgid "" #~ "The package '%s' was not found in the selected repository (%s).\n" #~ "Would you like to try another repository?" #~ msgstr "" #~ "Le package '%s' est introuvable dans l'entrepot sélectionné (%s).\n" #~ "Voulez-vous essayer un autre entrepot ?" #~ msgid "" #~ "The selected file name does not contain the package name '%s'. Would you " #~ "like to select a different file instead?" #~ msgstr "" #~ "Le fichier sélectionné ne contient pas le package '%s'. Voulez-vous " #~ "sélectionner un autre fichier à la place ?" #~ msgid "" #~ "The selected file name does not end with '.zip'. Would you like to select " #~ "a different file instead?" #~ msgstr "" #~ "Le fichier sélectionné n'a pas une extension '.zip'. Voulez-vous " #~ "sélectionner un autre fichier à la la place ?" #~ msgid "The package or bundle was not found on %s" #~ msgstr "Le package ou bundle est introuvable dans %s" #~ msgid "Impossible to send the command: %s" #~ msgstr "Impossible d'envoyer la commande : %s" #~ msgid "bad argument" #~ msgstr "argument erroné" #~ msgid "'f' is not an existing function!" #~ msgstr "'f' n'est pas une fonction existante !" svMisc/po/R-svMisc.pot0000644000176200001440000000605514614131727014337 0ustar liggesusersmsgid "" msgstr "" "Project-Id-Version: R 2.3.0\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2009-01-22 15:56\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "'obj' should inherit from 'list'" msgstr "" msgid "Data you add in actions must be a named character vector" msgstr "" msgid "'obj' should inherit from 'character'" msgstr "" msgid "Icons map you add must be a named character vector" msgstr "" msgid "must be a list!" msgstr "" msgid "'type' could be only 'google', 'archive' or 'wiki', currently!" msgstr "" msgid "'f' must ba a character string!" msgstr "" msgid "Impossible to create the Object Browser 'path' directory!" msgstr "" msgid "'value' must be numeric!" msgstr "" msgid "'max.value' must be numeric or NULL!" msgstr "" msgid "Progress:" msgstr "" msgid "on" msgstr "" msgid "'x' must be character string(s)!" msgstr "" msgid "Load...\nLoad R objects" msgstr "" msgid "Source...\nSource R code" msgstr "" msgid "Save as...\nSave to a file" msgstr "" msgid "Import...\nImport data in R" msgstr "" msgid "Export...\nExport data to a file" msgstr "" msgid "Report...\nPrepare a report for this object" msgstr "" msgid "Set Working dir...\nChange current R working directory" msgstr "" msgid "Print or show\nPrint or show the content of the object" msgstr "" msgid "<<>>()\nApply method <<>>() to the object" msgstr "" msgid "Names\nNames of variables contained in the object" msgstr "" msgid "Str\nCompact str() representation of an object" msgstr "" msgid "Help\nHelp on an object" msgstr "" msgid "Example\nRun examples for this object" msgstr "" msgid "Edit\nEdit an object" msgstr "" msgid "Fix\nFix an R object" msgstr "" msgid "Remove\nRemove (permanently!) one or several objects from memory" msgstr "" msgid "Require <<>>\nRequire the package <<>>" msgstr "" msgid "Require (compact)\nCompact require one or several R packages" msgstr "" msgid "Attach\nAttach an object to the search path" msgstr "" msgid "Detach\nDetach an object or package from the search path" msgstr "" msgid "Detach and unload\nDetach a package from the search path and unload it" msgstr "" msgid "Reattach\nReattach an object to the search path" msgstr "" msgid "Package info\nShow detailed information for this package" msgstr "" msgid "View (default)\nDefault view for this object" msgstr "" msgid "View <<>>\nDisplay a '<<>>' view for this object" msgstr "" msgid "Copy (default)\nCopy this object to the clipboard (default format)" msgstr "" msgid "Copy <<>>\nCopy this object to the clipboard in '<<>>' format" msgstr "" msgid "Functions\nGeneric functions and methods" msgstr "" msgid "View\nView the object" msgstr "" msgid "Copy\nCopy the object to the clipboard" msgstr "" msgid "'strip' must be a 'svStripbar' object" msgstr "" msgid "'widgets' must be 'menu', 'item', 'sep' or 'space'" msgstr "" svMisc/R/0000755000176200001440000000000014614131727011725 5ustar liggesuserssvMisc/R/completion.R0000755000176200001440000005221714614131727014233 0ustar liggesusers#' Get a completion list for a R code fragment #' #' @description Returns names of objects/arguments/namespaces matching a code #' fragment. #' #' @param code A partial R code to be completed. #' @param pos The position of the cursor in this code. #' @param min.length The minimal length in characters of `code` required before #' the completion list is calculated. #' @param print Logical, print result and return invisibly. See details. #' @param types A named list giving names of types. Set to \code{NA} to give #' only names. See details. #' @param addition Should only addition string be returned? #' @param sort Do we sort the list of completions alphabetically? #' @param what What are we looking for? Allow to restrict search for faster #' calculation. #' @param description Do we describe items in the completion list #' (could be slow)? #' @param max.fun In the case where we describe items, the maximum number of #' functions to process (if longer, no description is returned for function) #' because it can be very slow otherwise. #' @param skip.used.args Logical, if completion is within function arguments, #' should the already used named arguments be omitted? #' @param sep The separator to use between returned items. #' @param field.sep Character string to separate fields for each entry. #' @param name.or.addition Should we return the completion name, addition string, or both? #' @return If `types == NA` and `description = FALSE`, a character vector giving #' the completions, otherwise a data frame with two columns: 'completion', and #' 'type' when `description = FALSE`, or with four columns: 'completion', #' 'type', 'desc' and 'context' when `description = TRUE`. If name.or.addition == 'both', #' an 'addition' column is also returned.\cr #' Attributes:\cr #' `attr(, "token")` - a completed token.\cr #' `attr(, "triggerPos")` - number of already typed characters.\cr #' `attr(, "fguess")` - name of guessed function.\cr #' `attr(, "isFirstArg")`` - is this a first argument? #' @details The completion list is context-dependent, and it is calculated as if #' the code was entered at the command line. #' #' If the code ends with `$` or `[[`, then the function look for items in a list #' or data.frame whose name is the last identifier. #' #' If the code ends with `@`, then the function look for slots of the #' corresponding S4 object. #' #' If the code ends with `::`, then it looks for objects in a namespace. #' #' If the code ends with a partial identifier name, the function returns all #' matching keywords visible from .GlobalEnv. #' #' If the code is empty or parses into an empty last token, the list of objects #' currently in the global environment is returned. #' #' @note Take care: depending on the context, the completion list could be #' incorrect (but it should work for code entered at the command line). For #' instance, inside a function call, the context is very different, and #' arguments and local variables should be returned instead. This may be #' implemented in the future, but for now, we focus on completion that should be #' most useful for novice useRs that are using R expressions entered one after #' the other at the R console or in a script (and considering the script is run #' or sourced line after line in R). #' #' There are other situations where the completion can be calculated, see the #' help of [rc.settings()]. #' #' If `print == TRUE`, results are returned invisibly, and printed in a form: #' triggerPos *newline* completions separated by `sep`. #' #' If `types` are supplied, a completion will consist of name and type, #' separated by `type.sep`. `types` may me a vector of length 5, giving the type #' codes for "function", "variable", "environment", "argument" and "keyword". #' If `types == "default"`, above type names are given; `types == "scintilla"` #' will give numeric codes that can be used with "scintilla.autoCShow" function #' (e.g., with the SciViews-K Komodo Edit plugin). #' @author Philippe Grosjean & #' Kamil Barton #' @export #' @seealso [rc.settings()] #' @keywords utilities #' @examples #' # A data frame #' data(iris) #' completion("item <- iris$") #' completion("item <- iris[[") #' #' # An S4 object #' setClass("track", representation(x = "numeric", y = "numeric")) #' t1 <- new("track", x = 1:20, y = (1:20)^2) #' completion("item2 <- t1@") #' #' # A namespace #' completion("utils::", description = TRUE) #' #' # A partial identifier #' completion("item3 <- va", description = TRUE) #' #' # Otherwise, a list with the content of .GlobalEnv #' completion("item4 <- ") #' #' # TODO: directory and filename completion! #' rm(iris, t1) completion <- function(code, pos = nchar(code), min.length = 2, print = FALSE, types = c("default", "scintilla"), addition = FALSE, sort = TRUE, what = c("arguments", "functions", "packages"), description = FALSE, max.fun = 100, skip.used.args = TRUE, sep = "\n", field.sep = "\t", name.or.addition = c("name", "addition", "both")) { finalize <- function(completions, additions = NULL) { # Construct a data frame with completions ret <- data.frame(completion = completions, stringsAsFactors = FALSE) # Do we add types? if (isTRUE(add_types)) { tl <- numeric(length(completions)) tl[grep(" = $", completions)] <- 4L tl[grep("::$", completions)] <- 3L tl[grep("<-$", completions)] <- 1L tl[completions %in% .reserved_words] <- 5L tl[!tl] <- ifelse(sapply(completions[!tl], function(x) existsFunction(x, where = .GlobalEnv)), 1L, 2L) tl <- factor(tl, levels = 1:5, labels = types) ret <- cbind(ret, data.frame(type = tl, stringsAsFactors = FALSE)) } # Do we add descriptions? if (isTRUE(description)) { ret <- cbind(ret, data.frame(desc = rep("", nrow(ret)), context = rep("", nrow(ret)), stringsAsFactors = FALSE)) # Deal with packages (completions ending with ::) if (length(test_pack <- grep("::$", completions))) { describe_package <- function(pkg) { # This is to deal with completion of :, ::, ::: in pkg base if (grepl(":$", pkg)) return("") else return(packageDescription(pkg, fields = "Description")) } ret[test_pack, "desc"] <- sapply(sub(":{2,3}$", "", completions[test_pack]), describe_package) } # Deal with argument completions (ending with " = ") if (length(test_arg <- grep(" = ", completions))) { fun <- getNamespace("utils")$.CompletionEnv[["fguess"]] ret[test_arg, "context"] <- fun ret[test_arg, "desc"] <- descArgs(fun, sub(" = $", "", completions[test_arg])) } # Deal with completions with "$" (excluding things like base::$) if (length(test_dollar <- grep("[^:]\\$", completions))) { elements <- completions[test_dollar] object <- gsub("\\$.*$", "", completions)[1] items <- gsub("^.*\\$", "", completions) pack <- .find_multiple(object) ret[test_dollar, "context"] <- pack ret[test_dollar, "desc"] <- .describe_data(object, items, package = pack) } # Deal with completions with "@" (excluding things like base::$) if (length(test_slot <- grep("[^:]@", completions))) { elements <- completions[test_slot] object <- gsub("@.*$", "", completions)[1] slots <- gsub("^.*@", "", completions) pack <- .find_multiple(object) ret[test_slot, "context"] <- pack ret[test_slot, "desc"] <- .describe_slots(object, slots, package = pack) } # Deal with completions with "[" if (length(test_square <- grep("\\[", completions))) { ret[test_square, "desc"] <- .describe_square(completions[test_square], package = pack) } # TODO: do not know what to do with these? test_others <- grep(" ", completions) # TODO: are there other kind of completions I miss here? # Deal with function completions test_fun <- setdiff(1:length(completions), c(test_arg, test_pack, test_others, test_dollar, test_slot, test_square)) if (length(test_fun)) { funs <- completions[test_fun] # If we have nmspace::fun, or nmspace:::fun, split it test_nms <- grep(".+::.+", funs) packs <- rep("", length(funs)) if (length(test_nms)) { packs[test_nms] <- sub(":{2,3}[^:]+$", "", funs[test_nms]) funs[test_nms] <- sub("^.+:{2,3}", "", funs[test_nms]) packs[-test_nms] <- .find_multiple(funs[-test_nms]) } else packs <- .find_multiple(funs) desc_fun <- rep("", length(packs)) # Do not try to find description for functions in those envs is_pack <- !packs %in% c("", ".GlobalEnv", "SciViews:TempEnv", "Autoloads", "tools:RGUI") # The following code is too slow for many function # (it takes 6-7sec for the 1210 base::XXXX functions) # So, do it only if less than max.fun # Note, without descriptions, it takes 0.3sec on my MacBook Pro if (length(is_pack) < max.fun) desc_fun[is_pack] <- descFun(funs[is_pack], packs[is_pack]) ret[test_fun, "context"] <- packs ret[test_fun, "desc"] <- desc_fun } } # Do we add addition strings as a separate column? if(!is.null(additions)) ret <- cbind(ret, data.frame(addition = additions)) # Do we sort results alphabetically? if (isTRUE(sort)) ret <- ret[order(completions), ] # Add metadata as attributes attr(ret, "token") <- token attr(ret, "triggerPos") <- triggerPos attr(ret, "fguess") <- fguess attr(ret, "funargs") <- funargs attr(ret, "isFirstArg") <- isFirstArg if (isTRUE(print)) { if (is.null(ret$desc)) { cat(triggerPos, paste(ret$completion, ret$type, sep = field.sep), sep = sep) } else { cat(triggerPos, paste(ret$completion, ret$type, ret$desc, ret$context, sep = field.sep), sep = sep) } if (sep != "\n") cat("\n") invisible(ret) } else ret } # Do we return the type of the entry, and if yes, in which format? if (is.character(types[1L])) { types <- switch(match.arg(types), default = .default_completion_types, scintilla = .scintilla_completion_types, .default_completion_types) } add_types <- as.logical(!is.na(types[1L])) # Default values for completion context token <- "" triggerPos <- 0L fguess <- "" funargs <- list() isFirstArg <- FALSE # Is there some code provided? code <- paste(as.character(code), collapse = "\n") if (is.null(code) || !length(code) || code == "" || nchar(code, type = "chars") < min.length) { # Just return a list of objects in .GlobalEnv # TODO: look if we are inside a function and list # local variables (code analysis is required!) return(finalize(ls(envir = .GlobalEnv))) } # If code ends with a single [, then look for names in the object if (regexpr("[^[][[]$", code) > 0) { # TODO: look for object names... currently, return nothing return(invisible("")) } # If code ends with a double [[, then, substitute $ instead and indicate # to quote returned arguments (otherwise, [[ is not correctly handled)! if (regexpr("[[][[]$", code) > 0) { code <- sub("[[][[]$", "$", code) dblBrackets <- TRUE } else dblBrackets <- FALSE # Save funarg.suffix and use " = " locally utils <- getNamespace("utils") completion_env <- utils$.CompletionEnv opts <- completion_env$options funarg.suffix <- opts$funarg.suffix on.exit({ opts$funarg.suffix <- funarg.suffix completion_env$options <- opts }) opts$funarg.suffix <- " = " completion_env$options <- opts # Calculate completion with standard R completion tools utils$.assignLinebuffer(code) utils$.assignEnd(pos) utils$.guessTokenFromLine() # The standard utils:::.completeToken() is replaced by our own version: .complete_token_ext() completions <- utils$.retrieveCompletions() additions <- NULL triggerPos <- pos - completion_env[["start"]] token <- completion_env[["token"]] # If token is empty, we complete by using objects in .GlobalEnv by default if (!length(completions) && token == "") { triggerPos <- nchar(code, type = "chars") # TODO: look if we are inside a function and list # local variables (code analysis is required!) return(finalize(ls(envir = .GlobalEnv))) } # For tokens like "a[m", the actual token should be "m" # completions are modified accordingly rx <- regexpr("[[]+", completion_env$token) if (rx > 0) { # Then we need to trim out whatever is before the [ in the completion # and the token start <- rx + attr(rx, "match.length") completion_env$token <- substring(completion_env$token, start) completions <- substring(completions, start) } if (!length(completions)) return(invisible("")) # Remove weird object names (useful when the token starts with ".") i <- grep("^[.]__[[:alpha:]]__", completions) if (length(i) > 0) completions <- completions[-i] if (!length(completions)) return(invisible("")) # Restrict completion for which information is gathered (speed things up) if (!"arguments" %in% what) completions <- completions[regexpr("=$", completions) < 0] if (!length(completions)) return(invisible("")) if (!"packages" %in% what) completions <- completions[regexpr("::$", completions) < 0] if (!length(completions)) return(invisible("")) if (!"functions" %in% what) completions <- completions[regexpr("(::|=)$", completions) > 0] if (!length(completions)) return(invisible("")) # Eliminate function arguments that are already used fguess <- completion_env$fguess if (skip.used.args && length(fguess) && nchar(fguess)) completions <- completions[!(completions %in% completion_env$funargs)] if (!length(completions)) return(invisible("")) # Eliminate function names like `names<-` i <- grep("<-.+$", completions) if (length(i) > 0) completions <- completions[-i] # Do we return only additional strings for the completion? if ((isTRUE(addition) || match.arg(name.or.addition) == "addition") && triggerPos > 0L) completions <- substring(completions, triggerPos + 1) else if (match.arg(name.or.addition) == "both") additions <- substring(completions, triggerPos + 1) # In case of [[, restore original code if (dblBrackets) { # Substitute var$name by var[["name" completions <- sub("[$](.+)$", '[["\\1"', completions) token <- sub("[$]$", "[[", token) triggerPos <- triggerPos + 1 } # Finalize processing of the completion list funargs <- completion_env$funargs isFirstArg <- completion_env$isFirstArg finalize(completions, additions) } .reserved_words <- c("if", "else", "repeat", "while", "function", "for", "in", "next", "break", "TRUE", "FALSE", "NULL", "Inf", "NaN", "NA", "NA_integer_", "NA_real_", "NA_complex_", "NA_character_") .default_completion_types <- list(fun = "function", var = "variable", env = "environment", args = "arg", keyword = "keyword") .scintilla_completion_types <- list(fun = "1", var = "3", env = "8", args = "11", keyword = "13") .describe_data <- function(data, columns, package = NULL, lib.loc = NULL) character(length(columns)) .describe_slots <- function(object, slots, package = NULL, lib.loc = NULL) character(length(slots)) .describe_square <- function(completions, package = NULL) character(length(completions)) # Modified utils:::inFunction() # (checked equivalent with R 2.11.1) # Only difference: it also gets current arguments list (if applicable). # They are assigned to utils:::.CompletionEnv$funargs .in_function_ext <- function(line, cursor) { utils <- getNamespace("utils") if (missing(line)) line <- utils$.CompletionEnv[["linebuffer"]] if (missing(cursor)) cursor <- utils$.CompletionEnv[["start"]] parens <- sapply(c("(", ")"), function(s) gregexpr(s, substr(line, 1L, cursor), fixed = TRUE)[[1L]], simplify = FALSE) parens <- lapply(parens, function(x) x[x > 0]) temp <- data.frame(i = c(parens[["("]], parens[[")"]]), c = rep(c(1, -1), sapply(parens, length))) if (nrow(temp) == 0) return(character(0L)) temp <- temp[order(-temp$i), , drop = FALSE] wp <- which(cumsum(temp$c) > 0) if (length(wp)) { index <- temp$i[wp[1L]] prefix <- substr(line, 1L, index - 1L) suffix <- substr(line, index + 1L, cursor + 1L) if ((length(grep("=", suffix, fixed = TRUE)) == 0L) && (length(grep(",", suffix, fixed = TRUE)) == 0L)) utils$setIsFirstArg(v = TRUE) if ((length(grep("=", suffix, fixed = TRUE))) && (length(grep(",", substr(suffix, tail(gregexpr("=", suffix, fixed = TRUE)[[1L]], 1L), 1000000L), fixed = TRUE)) == 0L)) { return(character(0L)) } else { # This is the code added to utils:::inFunction() wp2 <- rev(cumsum(temp$c[-(wp[1L]:nrow(temp))])) suffix <- sub("^\\s+", "", suffix, perl = TRUE) # TODO: simplify this: if (length(wp2)) { funargs <- strsplit(suffix, "\\s*[\\(\\)][\\s,]*", perl = TRUE)[[1]] funargs <- paste(funargs[wp2 == 0], collapse = ",") } else { funargs <- suffix } funargs <- strsplit(funargs, "\\s*,\\s*", perl = TRUE)[[1]] funargs <- unname(sapply(funargs, sub, pattern = "\\s*=.*$", replacement = utils$.CompletionEnv$options$funarg.suffix, perl = TRUE)) assign("funargs", funargs, utils$.CompletionEnv) # TODO: how to take non named arguments into account too? # ... addition ends here possible <- suppressWarnings(strsplit(prefix, utils$breakRE, perl = TRUE))[[1L]] possible <- possible[possible != ""] if (length(possible)) { return(tail(possible, 1)) } else { return(character(0L)) } } } else { return(character(0L)) } } # Modified utils:::.completeToken() # (checked equivalent with R 2.11.1) # Main difference is that calls .in_function_ext instead of utils:::inFunction # and it also makes sure completion is for Complete in 'Complete("anova(", )'! .complete_token_ext <- function() { utils <- getNamespace("utils") completion_env <- utils$.CompletionEnv text <- completion_env$token linebuffer <- completion_env$linebuffer st <- completion_env$start if (utils$isInsideQuotes()) { probably_not_filename <- (st > 2L && (substr(linebuffer, st - 1L, st - 1L) %in% c("[", ":", "$"))) if (completion_env$settings[["files"]]) { if (probably_not_filename) { completion_env[["comps"]] <- character(0L) } else { completion_env[["comps"]] <- utils$fileCompletions(text) } utils$.setFileComp(FALSE) } else { completion_env[["comps"]] <- character(0L) utils$.setFileComp(TRUE) } } else { # Completion does not a good job when there are quoted strings, # e.g for linebuffer = "Complete("anova(", )" would give arguments for # anova rather than for Complete. # Replace quoted strings with sequences of "_" of the same length. # This is a temporary solution though, there should be a better way... mt <- gregexpr('(? 0)) { prefix <- substr(text, 1L, last_arith_op) text <- substr(text, last_arith_op + 1L, 1000000L) } spl <- utils$specialOpLocs(text) if (length(spl)) { comps <- utils$specialCompletions(text, spl) } else { append_function_suffix <- !any(guessed_function %in% c("help", "args", "formals", "example", "do.call", "environment", "page", "apply", "sapply", "lapply", "tapply", "mapply", "methods", "fix", "edit")) comps <- utils$normalCompletions(text, check.mode = append_function_suffix) } if (have_arith_op && length(comps)) comps <- paste(prefix, comps, sep = "") comps <- c(comps, farg_comps) assign("comps", comps, completion_env) } } # Similar to "find" but `what` can be a vector # also, this one only searches in packages (position of the search path # matching '^package:') and only gives one result per what .find_multiple <- function(what) { stopifnot(is.character(what)) sp <- grep( "^package:", search(), value = TRUE) out <- rep( "" , length(what)) for (i in sp) { ok <- what %in% ls(i, all.names = TRUE) & out == "" out[ok] <- i if (all(out != "")) break } names(out) <- what sub("^package:", "", out) } svMisc/R/progress.R0000644000176200001440000002300714614131727013716 0ustar liggesusers#' Display progression of a long calculation at the R console and/or in a GUI #' #' @description Display progression level of a long-running task in the console. #' Two mode can be used: either percent of achievement (55\%), or the number of #' items or steps done on a total (1 file on 10 done...). This is displayed #' either through a message, or through a text-based "progression bar" on the #' console, or a true progression bar widget in a GUI. #' #' @param value Current value of the progression (use a value higher than #' `max.value` to dismiss the progression indication automatically. #' @param max.value Maximum value to be achieved. #' @param progress.bar Should we display a progression bar on the console? If #' `FALSE`, a temporary message is used. #' @param char The character to use to fill the progress bar in the console. not #' used for the alternate display, or for GUI display of progression. #' @param init Do we have to initialize the progress bar? It is usually done the #' first time the function is used, and the default value `init = (value == 0)` #' is correct most of the time. You must specify `init = TRUE` in two cases: #' (1) if the first value to display is different from zero, and (2) if your #' code issues some text on screen during progression display. Hence, you must #' force redraw of the progression bar. #' @param console Do we display progression on the console? #' @param gui Do we display progression in a dialog box, or any other GUI widget? #' See "details" and "examples" hereunder to know how to implement your own GUI #' progression indicator. #' #' @return This function returns `NULL` invisibly. It is invoked for its side #' effects. #' #' @details The function `progress()` proposes different styles of progression #' indicators than the standard [txtProgressBar()] in package 'utils'. #' #' The function uses backspace (\\8) to erase characters at the console. #' #' With `gui = TRUE`, it looks for all functions defined in the `.progress` list #' located in the `SciViews:TempEnv` environment. Each function is executed in #' turn with following call: `the_gui_function(value, max.value)`. You are #' responsible to create `the_gui_function()` and to add it as an element in #' the `.progress` list. See also example (5) hereunder. #' #' If your GUI display of the progression offers the possibility to stop #' calculation (for instance, using a 'Cancel' button), you are responsible to #' pass this info to your code doing the long calculation and to stop it there. #' Example (5) shows how to do this. #' @export #' @seealso [batch()], [txtProgressBar()] #' @keywords utilities #' @concept graphical user interface (GUI) long process progression and feedback #' @examples #' # 1) A simple progress indicator in percent #' for (i in 0:101) { #' progress(i) #' Sys.sleep(0.01) #' if (i == 101) message("Done!") #' } #' #' \dontrun{ #' # 2) A progress indicator with 'x on y' #' for (i in 0:31) { #' progress(i, 30) #' Sys.sleep(0.02) #' if (i == 31) message("Done!") #' } #' #' # 3) A progress bar in percent #' for (i in 0:101) { #' progress(i, progress.bar = TRUE) #' Sys.sleep(0.01) #' if (i == 101) message("Done!") #' } #' #' # 4) A progress indicator with 'x on y' #' for (i in 0:21) { #' progress(i, 20, progress.bar = TRUE) #' Sys.sleep(0.03) #' if (i == 21) message("Done!") #' } #' } #' #' # 5) A progression dialog box with Tcl/Tk #' \dontrun{ #' if (require(tcltk)) { #' gui_progress <- function(value, max.value) { #' # Do we need to destroy the progression dialog box? #' if (value > max.value) { #' try(tkdestroy(get_temp("gui_progress_window")), silent = TRUE) #' delete_temp(c("gui_progress_state", "gui_progress_window", #' "gui_progress_cancel")) #' return(invisible(FALSE)) #' } else if (exists_temp("gui_progress_window") && #' !inherits(try(tkwm.deiconify(tt <- get_temp("gui_progress_window")), #' silent = TRUE), "try-error")) { #' # The progression dialog box exists #' # Focus on it and change progress value #' tkfocus(tt) #' state <- get_temp("gui_progress_state") #' tclvalue(state) <- value #' } else { #' # The progression dialog box must be (re)created #' # First, make sure there is no remaining "gui_progress_cancel" #' delete_temp("gui_progress_cancel") #' # Create a Tcl variable to hold current progression state #' state <- tclVar(value) #' assign_temp("gui_progress_state", state) #' # Create the progression dialog box #' tt <- tktoplevel() #' assign_temp("gui_progress_window", tt) #' tktitle(tt) <- "Waiting..." #' sc <- tkscale(tt, orient = "h", state = "disabled", to = max.value, #' label = "Progress:", length = 200, variable = state) #' tkpack(sc) #' but <- tkbutton(tt, text = "Cancel", command = function() { #' # Set a flag telling to stop running calculation #' assign_temp("gui_progress_cancel", TRUE) # Content is not important! #' tkdestroy(tt) #' }) #' tkpack(but) #' } #' invisible(TRUE) #' } #' # Register it as function to use in progress() #' change_temp(".progress", "gui_progress", gui_progress, #' replace.existing = TRUE) #' rm(gui_progress) # Don't need this any more #' # Test it... #' for (i in 0:101) { #' progress(i) # Could also set console = FALSE for using the GUI only #' Sys.sleep(0.05) #' # The code to stop long calc when user presses "Cancel" #' if (exists_temp("gui_progress_cancel")) { #' progress(101, console = FALSE) # Make sure to clean up everything #' break #' } #' if (i == 101) message("Done!") #' } #' # Unregister the GUI for progress #' change_temp(".progress", "gui_progress", NULL) #' } #' } progress <- function(value, max.value = NULL, progress.bar = FALSE, char = "|", init = (value == 0), console = TRUE, gui = TRUE) { if (!is.numeric(value)) stop("'value' must be numeric!") if (is.null(max.value)) { max.value <- 100 percent <- TRUE } else percent <- FALSE if (!is.numeric(max.value)) stop("'max.value' must be numeric or NULL!") # If value is higher than max.value, we erase the message erase_only <- (value > max.value) # Get the saved data associated with this function cmd_progress <- get_temp(".progress", default = list(), mode = "list") if (console & progress.bar) { # The progress bar consists in two lines: # first is a "scale" (only drawn when init == TRUE), # second is filled with char according to the actual progression if (erase_only) { cat("\n") cmd_progress$pos <- NULL cmd_progress$scale <- NULL assign_temp(".progress", cmd_progress) } else { if (init || is.null(cmd_progress$pos)) { msg1 <- gettext("Progress:") l1 <- nchar(msg1) if (percent) { scale_bar <- " 0%---------25%---------50%---------75%--------100%\n" cmd_progress$scale <- 2 } else { # Calculate best scale w <- getOption("width") - l1 cmd_progress$scale <- (max.value %/% w) + 1 sl <- round(max.value / cmd_progress$scale) max_val <- as.character(round(max.value)) ticks <- sl - 1 - nchar(max_val) if (ticks > 0) { scale_ticks <- paste(rep("-", ticks), collapse = "") } else scale_ticks <- "-" scale_bar <- paste0(" 0", scale_ticks, max_val, "\n") } cat(rep(" ", l1), scale_bar, msg1, " ", sep = "") pos1 <- 0 cmd_progress$pos <- 0 assign_temp(".progress", cmd_progress) } else pos1 <- cmd_progress$pos pos2 <- round(value / cmd_progress$scale) if (pos2 > pos1) { cmd_progress$pos <- pos2 assign_temp(".progress", cmd_progress) cat(rep(as.character(char[1]), pos2 - pos1)) } } # Under Windows or MacOS, make sure the message is actualized flush.console() } else if (console & !progress.bar) { # A progress indicator in the R console # We work only with integer part of the values # and transform them into strings of same length max.value <- as.character(round(max.value)) l <- nchar(max.value) value <- formatC(round(value), width = l) msg1 <- gettext("Progress:") l1 <- nchar(msg1) msg2 <- gettext("on") #l2 <- nchar(msg2) l3 <- def(cmd_progress$msglength, 0, mode = "numeric", length.out = 1) if (l3 < 0) l3 <- 0 cmd_progress$msglength <- NULL # Avoid using twice same data backspaces <- paste(rep("\b", l3), collapse = "") if (erase_only) { message <- "" cat(backspaces, rep(" ", l3), sep = "") } else { # Treatment is different if it is 'x%' or 'x on y' display type if (percent) { message <- paste(msg1, " ", value, "% ", sep = "", collapse = "") } else { message <- paste(msg1, " ", value, " ", msg2, " ", max.value, " ", sep = "", collapse = "") } } cat(backspaces, message, sep = "") cmd_progress$msglength <- nchar(message) assign_temp(".progress", cmd_progress) # Under Windows or MacOS, make sure the message is actualized flush.console() } # An additional, graphical display of progression may be implemented too # using custom functions as items in .progress in SciViews:TempEnv... # Here we look for and trigger them... if (gui && length(cmd_progress) > 1) { # Execute each item of the list that is a function for (i in 1:length(cmd_progress)) if (mode(cmd_progress[[i]]) == "function") cmd_progress[[i]](value, max.value) } invisible(NULL) } svMisc/R/install.R0000644000176200001440000000507214614131727013522 0ustar liggesusers#' An easy package installation function that pairs with `package()` #' #' @description This is similar to [install.packages()], except it takes by #' default the list of packages from `.packages_to_install` in #' `SciViews:TempEnv`. That list is populated automatically by infructuous calls #' to `package()`, so that just a call to `Install()` without arguments is #' generally sufficient. #' #' @param pkgs The list of packages to install (character vector). If missing, #' the list is read from `packages_to_install`, which is cleared on success. #' @param ... Further arguments passed to [install.packages()]. #' @param ask If `TRUE` and `pkgs` is missing, ask first to install the #' packages. #' @return Returns `TRUE` in case of success, `FALSE` otherwise. The function is #' invoked for its side-effect of installing \R packages. #' @export #' @seealso [package()] #' @keywords utilities #' @concept package installation Install <- function(pkgs = get_temp('.packages_to_install'), ..., ask = TRUE) { if (is.null(pkgs) || !length(pkgs)) { warning("Nothing to install.") return(invisible(TRUE)) # We consider there is no error! } pkgs_list <- '.packages_to_install' if (missing(pkgs) && isTRUE(ask)) { question <- function(title, message) { # In case we are under RStudio, this function is available dlg <- get0('.rs.api.showQuestion') if (is.null(dlg)) {# Use a prompt at the console instead cat("==", title, "==\n") res <- readline(paste0(message, " ([yes]/no): ")) !res %in% c("N", "n", "No", "no", "NO") } else { dlg(title, message, ok = "Yes", cancel = "No") } } if (length(pkgs == 1)) { title <- "Install R package" message <- paste0("The package '", pkgs, "' will be installed.\nProceed?") } else { title <- "Install R packages" message <- paste0("The following packages will be installed:\n'", paste(pkgs, collapse = "', '"), "'\nProceed?") } if (!question(title, message)) { if (question(title, "Clear the list of packages to install? ")) rm_temp(pkgs_list) return(invisible(FALSE)) } } res <- try(install.packages(pkgs, ...), silent = TRUE) # Eliminate installed packages from the list in .packages_to_install # Note: we do so also if the installation failed, in order to stop keeping to # try to install those "uninstallable" packages to_install <- get_temp(pkgs_list) to_install <- to_install[!to_install %in% pkgs] assign_temp(pkgs_list, to_install, replace.existing = TRUE) invisible(!inherits(res, "try-error")) } svMisc/R/search_web.R0000644000176200001440000000401714614131727014154 0ustar liggesusers#' Search web documents about R and R functions #' #' @description Retrieve web documents, or search with Google for `what` string. #' #' @param what The string(s) to search. In case of several strings, or several #' words, any of these words are searched. #' @param type The search engine, or location to use. #' @param browse Do we actually show the page in the Web browser? If #' `type = "R"`, this argument is ignored and the result is always displayed in #' the Web browser. #' @param msg Do we issue a message indicating that a page should be displayed #' shortly in the Web browser? If `type = "R"`, this argument is ignored and a #' message is always displayed. #' @param ... Further arguments to format the result page in case of #' `type = "R"`. These are the same arguments as for [RSiteSearch()]. #' @return Returns the URL used invisibly (invoked for its side effect of #' opening the Web browser with the search result, when `browse = TRUE`). #' @note The [RSiteSearch()] function in the 'utils' package is used when #' `type = "R"`. #' @export #' @seealso [RSiteSearch()], [help.search()] #' @keywords utilities #' @examples #' \dontrun{ #' search_web("volatility") # R site search, by default #' search_web("volatility", type = "google") # Google search #' } search_web <- function(what, type = c("R", "google"), browse = TRUE, msg = browse, ...) { what <- paste0(what, collapse = " ") what <- gsub(" ", "+", what) type <- match.arg(type) search_url <- switch(type, "R" = RSiteSearch(what, ...), "google" = paste0("http://www.google.com/search?sitesearch=r-project.org&q=", what), stop("'type' could be only 'R', or 'google', currently!")) if (type != "R") { if (isTRUE(browse)) browseURL(search_url) if (isTRUE(msg)) { cat(gettext("A search query has been submitted"), "\n") cat(gettext("The results page should open in your browser shortly\n")) } } invisible(search_url) } # Backward compatibility #' @export #' @rdname search_web helpSearchWeb <- search_web svMisc/R/gui_cmd.R0000644000176200001440000000554014614131727013463 0ustar liggesusers#' Execute a command in the GUI client #' #' @description This function is not intended to be used at the command line #' (except for debugging purposes). It executes a command string to a #' (compatible) GUI client. #' #' @param command The command string to execute in the GUI client. #' @param ... Parameters provided for the command to execute in the GUI client. #' @return The result of the command if it succeed, or `NULL` if the command #' cannot be run (i.e., `.guiCmd()` is not defined in `SciViews:TempEnv`). #' @details You must define a function `.guiCmd()` in the `SciViews:TempEnv` #' environment that will take first argument as the name of the command to #' execute (like `source`, `save`, `import`, etc.), and ... with arguments to #' the command to send. Depending on your GUI, you should have code that #' delegates the GUI elements (ex: display a dialog asking for a .Rdata file to #' source) and then, execute the command in \R with the selected file as #' attribute. #' @export #' @seealso [get_temp()] #' @keywords misc #' @concept graphical user interface (GUI) control gui_cmd <- function(command, ...) { # This function sends a command to the GUI client # The actual code is a custom function named .guiCmd in SciViews:TempEnv cmd_fun <- get_temp(".guiCmd", mode = "function") if (!is.null(cmd_fun)) { cmd_fun(command, ...) } else { NULL } } #' @export #' @rdname gui_cmd gui_load <- function(...) { # Ask the GUI client to select a .Rdata file to load() gui_cmd("load", ...) } #' @export #' @rdname gui_cmd gui_source <- function(...){ # Ask the GUI client to select a .R file to source() gui_cmd("source", ...) # TODO: should use sys.source() here } #' @export #' @rdname gui_cmd gui_save <- function(...){ # Ask the GUI client for a file where to save some data gui_cmd("save", ...) } #' @export #' @rdname gui_cmd gui_import <- function(...){ # Ask the client to display a dialog for importing some data gui_cmd("import", ...) } #' @export #' @rdname gui_cmd gui_export <- function(...) { # Ask the client to display a dialog for exporting some data gui_cmd("export", ...) } #' @export #' @rdname gui_cmd gui_report <- function(...) { # Ask the client to display a dialog for reporting data (send a view...) gui_cmd("report", ...) } #' @export #' @rdname gui_cmd gui_setwd <- function(...) { # Ask the GUI client to select a directory to set as active gui_cmd("setwd", ...) } # Backward compatibility #' @export #' @rdname gui_cmd guiCmd <- gui_cmd #' @export #' @rdname gui_cmd guiLoad <- gui_load #' @export #' @rdname gui_cmd guiSource <- gui_source #' @export #' @rdname gui_cmd guiSave <- gui_save #' @export #' @rdname gui_cmd guiImport <- gui_import #' @export #' @rdname gui_cmd guiExport <- gui_export #' @export #' @rdname gui_cmd guiReport <- gui_report #' @export #' @rdname gui_cmd guiSetwd <- gui_setwd svMisc/R/svMisc-internal.R0000644000176200001440000000623414614131727015133 0ustar liggesusers.onLoad <- function(lib, pkg) { .initialize() # Determine where to find the preferred file editor for fileEdit() if (is.null(getOption("fileEditor"))) { if (interactive()) { if (is_win()) { # First check if Notepad++ is installed in default location... pfdir <- Sys.getenv("ProgramFiles") if (pfdir == "") pfdir <- "c:\\program files" file_editor <- paste0(pfdir, "\\Notepad++\\notepad++.exe") # ... otherwise, fallback to notepad.exe if (!file.exists(file_editor)) file_editor <- "notepad" # Default for Rterm } else if (is_mac()) { # Note that, in R.app, one cannot edit and wait for it is done # So, I always define a different editor, but fall back to # internal R.app if internal.if.possible is TRUE # First check if 'edit' is there # (open files in BBEdit) if (length(suppressWarnings(system("which edit", intern = TRUE)))) { file_editor <- "bbedit" } else {# Fall back to the default text editor # Note: use "open -e -n -W \"%s\"" to force use of TextEdit file_editor <- "textedit" } } else {# This is probably linux or an unix # First check if gedit or kate is there... This is different # from file.edit() and editor that looks directly to EDITOR! if (length(suppressWarnings(system("which gedit", intern = TRUE)))) { file_editor <- "gedit" } else if (length(suppressWarnings(system("which kate", intern = TRUE)))) { file_editor <- "kate" } else {# Fall back to something that is likely to be installed # Look id EDITOR or VISUAL environment variable is defined file_editor <- Sys.getenv("EDITOR") if (nzchar(file_editor)) file_editor <- Sys.getenv("VISUAL") if (nzchar(file_editor)) file_editor <- "vi" } } options(fileEditor = file_editor) } else options(fileEditor = "") # Inactivate it! } } .initialize <- function(replace = TRUE) { # If the option svGUI.methods is not defined, give reasonable default values # Those are methods that can be applied to many objects without providing # additional argument and that will be added automatically to objects' # context menu in GUIs (print and show are not included, because we know # they must exist for all objects) # Rem: use addMethods() if you just want to add methods to this list if (is.null(getOption("svGUI.methods"))) options(svGUI.methods = c("AIC", "anova", "confint", "BIC", "formula", "head", "hist", "logLik", "plot", "predict", "residuals", "summary", "tail", "vcov")) } # gettext() and hence gettextf() cannot retrieve messages ending with space # in the "R" domain, because these functions stripe them out! # This is a hack using ngettext() that uses unmodified version of the message # Restriction: on the contrary to gettext(), .gettext() can translate only # one message at a time, and default domain is changed to "R" .gettext <- function(msg, domain = "R") ngettext(1, msg, "", domain = domain) .gettextf <- function(fmt, ..., domain = "R") sprintf(ngettext(1, fmt, "", domain = domain), ...) svMisc/R/add_actions.R0000644000176200001440000001737214614131727014332 0ustar liggesusers#' Add GUI elements like actions (menu items), icons, or methods in a predefined #' list #' #' @description Manage lists of GUI actions, icons and methods. #' #' @param obj The name of the object in `SciViews:TempEnv` to manipulate. #' @param text The text of actions to add (label on first line, tip on other #' lines). #' @param code The R code of actions to add. #' @param state The default (initial) state of an action, as a succession of #' letters: `c` = checked, `u` = unchecked (default); `d` = disabled, #' `e` = enabled (default); `h` = hidden, `v` = visible (default). Default #' values are optional. Ex: `udv` means: unchecked - disabled - visible and #' it equals to simply `d`, given the defaults for the other properties. #' @param options A character vector with other options to pass to the graphical #' toolkit for this action. #' @param replace Do we replace existing items in 'x'? #' @param icons The description of the icons to add. #' @param methods The list of methods to add (character string). #' @return The modified object is returned invisibly. #' @export #' @seealso [add_items()], [obj_menu()], [temp_env()] #' @keywords utilities #' @concept list of GUI elements #' @examples #' # This is useful to add actions, icons, descriptions, shortcuts or methods #' # TODO: examples and use for functions add_actions(), add_icons() and #' # add_methods() add_actions <- function(obj = get_actions(), text = NULL, code = NULL, state = NULL, options = NULL, replace = TRUE) { dat <- get_temp(obj, default = list()) if (!inherits(dat, "list")) stop("'obj' should inherit from 'list'") # Make sure we return an svActions object class(dat) <- unique(c("svActions", class(dat))) # Add new actions characteristics to dat; make sure newdata are correct add_data <- function(x, new_data, replace) { new_names <- names(new_data) if (is.null(new_names)) stop("Data you add in actions must be a named character vector") new_data <- as.character(new_data) names(new_data) <- new_names add_items(x, new_data, replace = replace) } if (!is.null(text)) dat$text <- add_data(dat$text, text, replace) if (!is.null(code)) dat$code <- add_data(dat$code, code, replace) if (!is.null(state)) dat$state <- add_data(dat$state, state, replace) if (!is.null(options)) dat$options <- add_data(dat$options, options, replace) ## Reassign the modified values assign_temp(obj, dat) invisible(dat) } #' @export #' @rdname add_actions get_actions <- function(){ if (!exists_temp(".svActions")) { # Create .svActions if it does not exists yet .svActions <- list() class(.svActions) <- unique(c("svActions", class(.svActions))) assign_temp(".svActions", .svActions, replace.existing = FALSE) # Define actions we need for the object browser menus add_temp(".svActions", "text", c( load = gettext("Load...\nLoad R objects"), source = gettext("Source...\nSource R code"), save = gettext("Save as...\nSave to a file"), import = gettext("Import...\nImport data in R"), export = gettext("Export...\nExport data to a file"), report = gettext("Report...\nPrepare a report for this object"), setwd = gettext("Set Working dir...\nChange current R working directory"), print = gettext("Print or show\nPrint or show the content of the object"), generic = gettext("<<>>()\nApply method <<>>() to the object"), names = gettext("Names\nNames of variables contained in the object"), str = gettext("Str\nCompact str() representation of an object"), help = gettext("Help\nHelp on an object"), example = gettext("Example\nRun examples for this object"), edit = gettext("Edit\nEdit an object"), fix = gettext("Fix\nFix an R object"), pkg = gettext("Load package(s)\nLoad one or several R packages"), remove = gettext("Remove\nRemove (permanently!) one or several objects from memory"), require = gettext("Require <<>>\nRequire the package <<>>"), attach = gettext("Attach\nAttach an object to the search path"), detach = gettext("Detach\nDetach an object or package from the search path"), detachUnload = gettext("Detach and unload\nDetach a package from the search path and unload it"), reattach = gettext("Reattach\nReattach an object to the search path"), pkgInfo = gettext("Package info\nShow detailed information for this package"), viewDef = gettext("View (default)\nDefault view for this object"), view = gettext("View <<>>\nDisplay a '<<>>' view for this object"), copyDef = gettext("Copy (default)\nCopy this object to the clipboard (default format)"), copy = gettext("Copy <<>>\nCopy this object to the clipboard in '<<>>' format"), Functions = gettext("Functions\nGeneric functions and methods"), View = gettext("View\nView the object"), Copy = gettext("Copy\nCopy the object to the clipboard") ), replace = replace) add_temp(".svActions", "code", c( load = "guiLoad([[[pos = \"<<>>\"]]])", source = "guiSource([[[pos = \"<<>>\"]]])", save = "guiSave(<<>>[[[, pos = \"<<>>\"]]])", import = "guiImport()", export = "guiExport(<<>>)", report = "guiReport(<<>>)", setwd = "guiSetwd([[[<<>>]]])", print = "<<>>", generic = "[[[<<>>> <- ]]]<<>>(<<>>)", names = "names(<<>>)", str = "str(<<>>)", help = "help(<<>>)", example = "example(<<>>)", edit = "<<>> <- edit(<<>>)", fix = "fix(<<>>)", # There is no guarantee we fix the right one! pkg = "[[[<<>> <- ]]]pkg(\"<<>>\")", remove = "rm(<<>>[[[, pos = \"<<>>\"]]])", require = "[[[<<>> <- ]]]require(<<>>)", attach = "attach(<<>>)", detach = "detach(<<>>)", detachunload = "detach(<<>>, unload = TRUE)", reattach = "detach(<<>>); attach(<<>>)", pkgInfo = "<<>>library(help = <<>>)", viewDef = "view(<<>>)", view = "view(<<>>, type = \"<<>>\")", copyDef = "copy(<<>>)", copy = "copy(<<>>, type = \"<<>>\")" ), replace = replace) add_temp(".svActions", "state", c( viewDef = "d", copyDef = "d" ), replace = replace) add_temp(".svActions", "options", c( generic = "" ), replace = replace) } get_temp(".svActions") } #' @export #' @rdname add_actions add_icons <- function(obj = ".svIcons", icons, replace = TRUE) { # Get the list of icons icn <- get_temp(obj, default = character()) if (!inherits(icn, "character")) stop("'obj' should inherit from 'character'") # Check that new icons are correctly formatted nicons <- names(icons) if (is.null(nicons)) stop("Icons map you add must be a named character vector") icons <- as.character(icons) names(icons) <- nicons # Add new icons to it icn <- add_items(icn, icons, replace = replace) # Make sure we return an svIcons object class(icn) <- unique(c("svIcons", class(icn))) # Reassign the modified values assign_temp(obj, icn) invisible(icn) } #' @export #' @rdname add_actions add_methods <- function(methods) { # Get the list of methods met <- getOption("svGUI.methods") if (!is.null(met)) methods <- add_items(met, methods, use.names = FALSE) options(svGUI.methods = sort(methods)) invisible(methods) } # Backward compatibility #' @export #' @rdname add_actions addActions <- add_actions #' @export #' @rdname add_actions addIcons <- add_icons #' @export #' @rdname add_actions addMethods <- add_methods svMisc/R/pcloud.R0000644000176200001440000000331414614131727013337 0ustar liggesusers#' Create the path to a file in the p-Cloud drive #' #' @description Similar to [file.path()] but creates a path to a file located #' somewhere in a p-Cloud drive. [p-Cloud](https://www.pcloud.com/eu.html) is a #' cloud storage system that comes with an application for Windows, MacOS or #' Linux. It creates a virtual drive on the PC where files can be managed as if #' they were local. However, the path to these files differ between OSes. This #' function abstracts out the first part of the path for you. So, you just have #' to provide the folders and files and it constructs a valid absolute path, no #' matter which OS you are using. The [pcloud_crypto()] function does the same #' for the special `Crypo Folder` that p-Cloud creates if you subscribe to the #' encryption option. #' #' @param ... The folder, subfolder and file to form the path, starting to the #' root of the p-Cloud drive, or the `Crypto Folder`. #' @return A character string with the absolute path to the file or folder. #' @export #' @seealso [system_file()], [source_clipboard()], [file.path()] #' @keywords utilities #' @concept file path #' @examples #' \dontrun{ #' pcloud("subfolder", "file.txt") #' # Only valid with the encryption option and the Crypto Folder is unlocked #' pcloud_crypto("subfolder1", "subfolder2", "crypted_file.txt") #' } pcloud <- function(...) { if (is_win()) { root <- "P:" # TODO: manage the case it is Q: or R: instead } else if (is_mac()) { root <- "~/pCloud\ Drive" } else {# On Linux root <- "~/pCloudDrive" } file.path(root, ...) } #' @export #' @rdname pcloud pcloud_crypto <- function(...) pcloud("Crypto Folder", ...) # TODO: check for the existance of this folder and issue a warning otherwise svMisc/R/compare_r_version.R0000644000176200001440000000166614614131727015575 0ustar liggesusers#' Compare current R version with a specified one #' #' @description Determine if R is older (return -1), or not (return 0 if equal, #' or 1 if newer) than a given version number. #' #' @param version A string defining the version to compare to, like '2.0.0' or #' '1.9.1'. #' @return -1 if R is older, 0 if equal, 1 if newer. Take care: if you specify #' version as "2.11", and R is version "2.11.0", then the function will return 1 #' (newer)! #' @export #' @seealso [compareVersion()], [R.version()] #' @keywords utilities #' @concept version comparison #' @examples #' compare_r_version("2.11.0") # Note that we strongly advise to use R > 2.11.0! compare_r_version <- function(version) { # This is similar to compareVersion, but works for R version comparison compareVersion(paste(R.version$major, R.version$minor, sep = "."), version) } # Backward compatibility #' @export #' @rdname compare_r_version compareRVersion <- compare_r_version svMisc/R/temp_var.R0000644000176200001440000000132514614131727013666 0ustar liggesusers#' Get an arbitrary name for a temporary variable #' #' @description This function ensures that the variable name is cryptic enough #' and is not already used. #' #' @param pattern The prefix for the variable (the rest is a random number). #' @return A string with the name of a variable. #' @export #' @seealso [tempfile()] #' @keywords utilities #' @concept temporary variables #' @examples #' temp_var() temp_var <- function(pattern = ".var") { # Similar to base::tempfile() but for temporary variables repeat { var <- paste0(pattern, as.integer(runif(1) * 100000)) if (!exists(var, where = 1, inherits = TRUE)) break() } var } # Backward compatibility #' @export #' @rdname temp_var tempvar <- temp_var svMisc/R/section.R0000644000176200001440000000451114614131727013515 0ustar liggesusers#' Create a section in a list (collection of functions and other objects). #' #' @description A section tags a list to sort its items. It is particularly #' useful when you create a collection of function (or other objects) to ease #' the access to these functions. Sections are displayed in printed and "str"ed #' versions of the list and are also functions that cut the list to the section #' content only. `get_section()` is the workhorse function that does the section #' extraction. #' #' @param obj A list object. #' @param title The title of the section. It must match the name of the list #' item. For a title "My section title", the name must be "0__MY_SECTION_NAME__" #' that is both a syntactically correct name and something that emphasizes the #' entry as a title. #' #' @return A function that is able to extract the corresponding section from the #' list. #' @export #' #' @examples #' #TODO... section <- function(obj, title) { structure(function(x = obj) get_section(x, title), title = title, class = c("section", "function")) } #' @export #' @rdname section #' @param x A list containing the section #' @param ... Further arguments (not used yet) #' @method print section print.section <- function(x, ...) { title <- attr(x, "title") # TODO... # This is for RStudio. In terminal, use: cat("XXXXXXXXXXX\n\033[1A\033[KY\n") back <- rep("\b", nchar(title) + 7L) cat(back, cli::col_red("o ", title, " "), sep = "") invisible(x) } #' @export #' @rdname section #' @param object A list to use for section extraction #' @method str section str.section <- function(object, ...) { cat("section\n") } #' @export #' @rdname section get_section <- function(x, title) { stopifnot(is.list(x), is.character(title), length(title) == 1L) # We need tp rework title, so that it matches a section name # Section title -> o__SECTION_TITLE__ title <- toupper(title) title <- gsub(" ", "_", title, fixed = TRUE) title <- paste0("o__", title, "__") # Search the section in the list names <- names(x) l <- length(names) start <- which(names == title) if (!length(start)) # The section title is not found -> return an empty list return(list()) end <- which(startsWith(names[(start + 1):l], "o__")) if (length(end)) { end <- end[1] + start - 1 } else { end <- l } # Truncate the list sel <- start:end x[sel] } svMisc/R/obj_browse.R0000644000176200001440000011203614614131727014206 0ustar liggesusers#' Functions to implement an object browser #' #' @description These functions provide features required to implement a #' complete object browser in a GUI client. #' #' @param id The id of the object browser (you can run several ones #' concurrently, providing you give them different ids). #' @param envir An environment, or the name of the environment, or the position #' in the [search()] path. #' @param all.names Do we display all names (including hidden variables starting #' with '.')? #' @param pattern A pattern to match for selecting variables. #' @param group A group to filter. #' @param sep Separator to use between items (if path is not `NULL`). #' @param path The path where to write a temporary file with the requested #' information. Set to NULL (default) if you don't pass this data to your GUI #' client by mean of a file. #' @param regenerate Do we force to regenerate the information? #' @param object Name of the object selected in the object browser, #' components/arguments of which should be listed. #' @param objects A list with selected items in the object browser. #' @param all.info Do we return all the information (envir as first column or #' not (by default). #' @param compare If TRUE, result is compared with last cached value and the #' client is updated only if something changed. #' @param x Object returned by `obj_list()`. #' @param eol Separator to use between object entries, default is to list each #' item in a separate line. #' @param header If `TRUE`, two-line header is printed, of the form: \cr #' Environment = environment name \cr #' Object = object name \cr #' Default is not to print header if `all.info == TRUE`. #' @param raw.output If `TRUE`, a compact, better suited for parsing output is #' produced. #' @param ... Further arguments, passed to [write.table()]. #' @return Depending on the function, a list, a string, a reference to an #' external, temporary file or `TRUE` in case of success or `FALSE` otherwise #' is returned invisibly. #' @details `obj_browse()` does the horse work. `obj_dir()` gets the temporary #' directory where exchange files with the GUI client are stored, in case you #' exchange data through files. You can use a better way to communicate with #' your GUI (you have to provide your code) and disable writing to files by #' using `path = NULL`. #' #' `obj_list()` lists objects in a given environment, elements of a recursive #' object or function argument. #' #' `obj_search()` lists the search path. #' #' `obj_clear()` clears any reference to a given object browser. #' #' `obj_info()` computes a tooltip info for a given object. #' #' obj_menu()` computes a context menu for selected object(s) in the object #' explorer managed by the GUI client. #' #' `print.objList()` print method for `objList` objects. #' @author Philippe Grosjean & #' Kamil Barton #' @export #' @seealso [completion()], [call_tip()] #' @keywords misc #' @examples #' # Create various context menus #' data(iris) #' (obj_info(object = "iris")) #' data(trees) #' # For one object #' (obj_menu(objects = "iris")) #' # For multiple objects #' (obj_menu(objects = c("iris", "trees"))) #' # For inexistant object (return "") #' (obj_info(object = "noobject")) #' (obj_menu(objects = "noobject")) #' rm(iris, trees) #' #' # For environments #' (obj_info(envir = ".GlobalEnv")) #' (obj_menu(envir = ".GlobalEnv")) #' (obj_info(envir = "SciViews:TempEnv")) #' (obj_menu(envir = "SciViews:TempEnv")) #' (obj_info(envir = "package:datasets")) #' (obj_menu(envir = "package:datasets")) #' # For an environment that does not exist on the search path (return "") #' (obj_info(envir = "noenvir")) #' (obj_menu(envir = "noenvir")) obj_browse <- function(id = "default", envir = .GlobalEnv, all.names = NULL, pattern = NULL, group = NULL, sep = "\t", path = NULL, regenerate = FALSE) { # Maintain files for remote Object Browser # If four first parameters are NULL, use cached version of these parameters, # or default values # Format envir as character (use only first item provided!) if (is.environment(envir)) envir <- deparse(substitute(envir)) if (is.numeric(envir)) envir <- search()[envir[1]] envir <- as.character(envir)[1] # Get the current position in the search path for envir pos <- match(envir, search(), nomatch = -1) if (pos < 1) { pos <- 1 # NOT FOUND, use .GlobalEnv envir = ".GlobalEnv" } if (!is.null(path)) { # Does the directory exists? if (path == "") path <- objDir() if (!file.exists(path) || !file.info(path)$isdir) { #unlink(path) if (!dir.create(path)) stop("Impossible to create the Object Browser 'path' directory!") } } # Control that 'Search.txt' is up-to-date changed_search <- obj_search(path = path, compare = !regenerate) # Make sure id is character id <- as.character(id)[1] if (id == "") id <- "default" # Get the five parameters pos, envir, all.names, pattern & group all_pars <- get_temp(".guiObjParsCache", default = NULL) if (!is.null(all_pars)) { pars <- all_pars[[id]] } else { pars <- list(pos = 1, envir = ".GlobalEnv", all.names = FALSE, pattern = "", group = "") assign_temp(".guiObjParsCache", list()) # Create the list } if (is.null(pars)) pars <- list(pos = 1, envir = ".GlobalEnv", all.names = FALSE, pattern = "", group = "") # Possibly change some parameters (and make sure they are valid!) pars_changed <- FALSE if (!is.null(pos)) { pars_changed <- TRUE pars$pos <- as.integer(pos[1]) pars$envir <- envir if (pars$pos < 1) { pars_changed <- TRUE pars$pos <- 1 pars$envir <- ".GlobalEnv" } } if (pars$pos > length(search())) { pars_changed <- TRUE pars$pos <- 1 pars$envir <- ".GlobalEnv" } # Track possible changes in the search path if (is.na(match(pars$envir, search()))) { pars_changed <- TRUE pars$pos <- 1 pars$envir <- ".GlobalEnv" } if (match(pars$envir, search()) != pars$pos) { pars_changed <- TRUE pars$pos <- match(pars$envir, search()) } # Track changes in the options if (!is.null(all.names)) { pars_changed <- TRUE pars$all.names <- as.logical(all.names[1]) } if (!is.null(pattern)) { pars_changed <- TRUE pars$pattern <- as.character(pattern[1]) } if (!is.null(group)) { pars_changed <- TRUE pars$group <- as.character(group[1]) } # Write a cached version of these parameters in SciViews:TempEnv all_pars <- get_temp(".guiObjParsCache", default = list()) all_pars[[id]] <- pars assign_temp(".guiObjParsCache", all_pars) # Control that 'List_.txt' is up-to-date, but only if pos == 1 or # envir is not a package or regenerate or pars or Search have changed # to limit the work done on workspaces that are unlikely to have change if (pars_changed || regenerate || (changed_search != "") || (pars$pos == 1) || (regexpr("^package:", envir) == -1)) { changed_list <- objList(id = id, envir = pars$pos, all.names = pars$all.names, pattern = pars$pattern, group = pars$group, path = path, compare = !regenerate, sep = sep) changed_list <- if (!is.null(nrow(changed_list)) && nrow(changed_list) > 0) { apply(changed_list, 1, paste, collapse = sep) } else "" } else changed_list <- "" # We return the data, or indication that the data have changed to the client res <- "" if (length(changed_search) > 1 || changed_search != "") { res <- "<<>>\n" if (is.null(path)) res <- paste0(res, paste(changed_search, collapse = sep), "\n") } if (length(changed_list) > 1 || changed_list != "") { res <- paste(res, "<<>>", sep = "") if (is.null(path)) res <- paste(c(res, changed_list), collapse = "\n") } # Possibly call a .guiObjBrowse function to pass the res to the GUI client cmd_fun <- get_temp(".guiObjBrowse", mode = "function") if (!is.null(cmd_fun)) cmd_fun(id = id, data = res) invisible(res) } #' @export #' @rdname obj_browse obj_clear <- function(id = "default") { # Clear any reference to a given 'id' object browser id <- as.character(id)[1] # Make sure id is character if (id == "") id <- "default" pars <- get_temp(".guiObjParsCache", default = list()) pars[[id]] <- NULL assign_temp(".guiObjParsCache", pars) list_cache <- get_temp(".guiObjListCache", default = list()) list_cache[[id]] <- NULL assign_temp(".guiObjListCache", list_cache) # Also delete corresponding files root <- obj_dir() pars_file = file.path(root, paste0("Pars_", id, ".txt")) if (file.exists(pars_file)) unlink(pars_file) list_file = file.path(root, paste0("List_", id, ".txt")) if (file.exists(list_file)) unlink(list_file) menu_file = file.path(root, paste0("Menu_", id, ".txt")) if (file.exists(menu_file)) unlink(menu_file) invisible(TRUE) } #' @export #' @rdname obj_browse obj_dir <- function() file.path(tempdir(), "svObjBrowser") #' @export #' @rdname obj_browse obj_info <- function(id = "default", envir = .GlobalEnv, object = "", path = NULL) { # Get a tooltip information for an object (for mouseover method) # Format envir as character (use only first item provided!) if (is.environment(envir)) envir <- deparse(substitute(envir)) if (is.numeric(envir)) envir <- search()[envir[1]] envir <- as.character(envir)[1] # Possibly call a custom function .objInfo() in SciViews:TempEnv cmd_fun <- get_temp(".objInfo", mode = "function") if (!is.null(cmd_fun)) { # We call a custom function info <- cmd_fun(id = id, envir = envir, object = object) } else if (object == "") { # An environment... info <- switch(envir, .GlobalEnv = paste(c("Global environment\n", capture.output(gc())), collapse = "\n"), `SciViews:TempEnv` = "SciViews temporary variables environment", RcmdrEnv = "R Commander temporary variables environment", `tools:RGUI` = "R.app tools environment", `tools:rstudio` = "RStudio tools environment", Autoloads = "R autoloading objects environment", if (regexpr("^package:", envir) > -1) { pkg <- sub("^package:", "", envir) paste(library(help = pkg, character.only = TRUE)$info[[1]], collapse = "\n") } else if (envir %in% search()) { paste0("'", envir, "' environment") } else "" ) } else {# An object... if (!exists(object, where = envir)) return(invisible("")) obj <- get(object, pos = envir) # The info is simply a str() representation of the object # We need to capture output info <- capture.output(str(obj)) # Add estimation of size for this object, if it is not a function if (!inherits(obj, "function")) { size <- object.size(obj) if (size > 1024 * 1024) { size <- paste("Estimated size:", format(size / 1024 / 1024, digits = 3), "Mb") } else if (size > 1024) { size <- paste("Estimated size:", format(size / 1024, digits = 3), "kb") } else size <- paste("Estimated size:", format(size, digits = 3), "bytes") info[length(info) + 1] <- size } } if (!is.null(path)) { # Save the data in a file if (path == "") path <- obj_dir() info_file <- file.path(path, paste("Info_", id, ".txt", sep = "")) cat(info, collapse = "\n", file = info_file) } # Possibly call a .guiObjInfo function to pass the data to the GUI client cmd_fun <- get_temp(".guiObjInfo", mode = "function") if (!is.null(cmd_fun)) cmd_fun(id = id, data = info) # Return the info tooltip invisibly invisible(info) } #' @export #' @rdname obj_browse obj_list <- function(id = "default", envir = .GlobalEnv, object = NULL, all.names = FALSE, pattern = "", group = "", all.info = FALSE, sep = "\t", path = NULL, compare = TRUE, ...) { # Make sure that id is character id <- as.character(id)[1] if (id == "") id <- "default" ename <- NA # Format envir as character (use only first item provided!) if (!is.environment(envir)) { if (is.numeric(envir) && envir > 0) envir <- search()[envir] if (is.character(envir)) { ename <- envir envir <- tryCatch(as.environment(envir), error = function(e) NULL) if (is.null(envir) || inherits(envir, "error")) { envir <- NULL ename <- "" } } } # base and .GlobalEnv do not have name attribute if (!is.null(attr(envir, "name"))) ename <- attr(envir, "name") else if (is.na(ename)) ename <- deparse(substitute(envir)) if (ename %in% c("baseenv()", ".BaseNamespaceEnv")) ename <- "package:base" # Object to return in case of empty data #nothing <- data.frame(Envir = character(0), Name = character(0), # Dims = character(0), Group = character(0), Class = character(0), # Recursive = logical(0), stringsAsFactors = FALSE) #if (!isTRUE(all.info)) nothing <- nothing[, -1] #attr(nothing, "all.info") <- all.info #attr(nothing, "envir") <- ename #attr(nothing, "object") <- object #class(nothing) <- c("objList", "data.frame") # This is ~15x faster: nothing <- structure(list(Name = character(0), Dims = character(0), Group = character(0), Class = character(0), Recursive = logical(0), stringsAsFactors = FALSE), class = c("objList", "data.frame"), all.info = all.info, envir = ename, object = object ) if (isTRUE(all.info)) nothing <- cbind(Envir = character(0), nothing) if (is.null(envir)) return(nothing) if (!missing(object) && is.character(object) && object != "") { res <- .ls_obj(envir = envir, objname = object) } else { # Get the list of objects in this environment items <- ls(envir = envir, all.names = all.names, pattern = pattern) if (length(items) > 0) { # Get characteristics of all objects describe <- function(name, all.info = FALSE) { # Get a vector with five items: # Name, Dims, Group, Class and Recursive obj <- envir[[name]] res <- c( Name = name, Dims = if (is.null(Dim <- dim(obj))) length(obj) else paste(Dim, collapse = "x"), Group = mode(obj), Class = class(obj)[1], Recursive = is.recursive(obj) || mode(obj) == "S4" ) return(res) } res <- data.frame(t(sapply(items, describe, all.info = all.info)), stringsAsFactors = FALSE) # Quote non-syntactic names nsx <- res$Name != make.names(res$Name) res$Full.name[!nsx] <- res$Name[!nsx] res$Full.name[nsx] <- paste("`", res$Name[nsx], "`", sep = "") res <- res[, c(1, 6, 2:5)] } else res <- nothing # No, because if rm(list = ls()), we must reactualize the objects # browser anyway if (NROW(res) == 0) return(nothing) if (isTRUE(all.info)) res <- cbind(Envir = ename, res) v_mode <- groups <- res$Group v_class <- res$Class # Recalculate groups into meaningful ones for the object explorer # 1) Correspondance of typeof() and group depicted in the browser groups[groups %in% c("name", "environment", "promise", "language", "char", "...", "any", "(", "call", "expression", "bytecode", "weakref", "externalptr")] <- "language" groups[groups == "pairlist"] <- "list" # 2) All groups not being language, function or S4 whose class is # different than typeof are flagged as S3 objects groups[!(groups %in% c("language", "function", "S4")) & v_mode != v_class] <- "S3" # 3) Integers of class factor become factor in group groups[v_class == "factor"] <- "factor" # 4) Objects of class 'data.frame' are also group 'data.frame' groups[v_class == "data.frame"] <- "data.frame" # 5) Objects of class 'Date' or 'POSIXt' are of group 'DateTime' groups[v_class == "Date" | v_class == "POSIXt"] <- "DateTime" # Reaffect groups res$Group <- groups # Possibly filter according to group if (!is.null(group) && group != "") res <- res[groups == group, ] } # Determine if it is required to refresh something Changed <- TRUE if (isTRUE(compare)) { allList <- get_temp(".guiObjListCache", default = list()) if (identical(res, allList[[id]])) Changed <- FALSE else { # Keep a copy of the last version in SciViews:TempEnv allList[[id]] <- res assign_temp(".guiObjListCache", allList) } } ## Create the 'objList' object attr(res, "all.info") <- all.info attr(res, "envir") <- ename attr(res, "object") <- object attr(res, "changed") <- Changed attr(res, "class") <- c("objList", "data.frame") if (is.null(path)) { # Return results or "" if not changed return(if (Changed) res else nothing) } else if (Changed) { # Write to files in this path return(write.objList(res, path = path, sep = sep, ...)) } else { return(nothing) # Not changed } } #' @export #' @rdname obj_browse write.objList <- function(x, path, sep = "\t", ...) { id <- attr(x, "id") list_file <- file.path(path, sprintf("List_%s.txt", id)) pars_file <- file.path(path, sprintf("Pars_%s.txt", id)) write.table(as.data.frame(x), row.names = FALSE, col.names = FALSE, sep = sep, quote = FALSE, file = list_file) ## Write also in the Pars_.txt file in the same directory cat(sprintf("envir=%s\nall.names=%s\npattern=%s\ngroup=%s", attr(x, "envir"), attr(x, "all.names"), attr(x, "pattern"), attr(x, "group")), file = pars_file, append = FALSE) invisible(list_file) } #' @export #' @rdname obj_browse print.objList <- function(x, sep = NA, eol = "\n", header = !attr(x, "all.info"), raw.output = !is.na(sep), ...) { if (!inherits(x, "objList")) stop("x must be an 'objList' object") empty <- NROW(x) == 0 if (!raw.output) cat(if (empty) "An empty objects list\n" else "Objects list:\n") if (header) { header_fmt <- if (raw.output) "Env=%s\nObj=%s\n" else "\tEnvironment: %s\n\tObject: %s\n" objname <- if (is.null(attr(x, "object"))) { if (raw.output) "" else "" } else attr(x, "object") cat(sprintf(header_fmt, attr(x, "envir"), objname)) } if (!empty) { if (is.na(sep)) { print(as.data.frame(x)) } else if (!is.null(nrow(x)) && nrow(x) > 0) { write.table(x, row.names = FALSE, col.names = FALSE, sep = sep, eol = eol, quote = FALSE) } } invisible(x) } # Called by obj_list() when object is provided .ls_obj <- function(objname, envir, ...) { obj <- try(eval(parse(text = objname), envir = as.environment(envir)), silent = TRUE) if (inherits(obj, "try-error")) return(NULL) if (is.environment(obj)) obj <- as.list(obj) if (mode(obj) == "S4") { ret <- .ls_obj_s4(obj, objname) } else if (is.function(obj)) { ret <- .ls_obj_function(obj, objname) } else {# S3 if (!(mode(obj) %in% c("list", "pairlist")) || length(obj) == 0) return(NULL) item_names <- full_names <- names(obj) if (is.null(item_names)) { item_names <- seq_along(obj) full_names <- paste(objname, "[[", item_names, "]]", sep = "") } else { w_names <- item_names != "" i_names <- item_names[w_names] nsx <- i_names != make.names(i_names) # Non-syntactic names i_names[nsx] <- paste0("`", i_names[nsx], "`") full_names[w_names] <- paste0(objname, "$", i_names) full_names[!w_names] <- paste0(objname, "[[", seq_along(item_names)[!w_names], "]]") } ret <- t(sapply(seq_along(obj), function(i) .obj_desc(obj[[i]]))) ret <- data.frame(itemnames = item_names, fullnames = full_names, ret, stringsAsFactors = FALSE) } if (!is.null(ret)) names(ret) <- c("Name", "Full.name", "Dims/default", "Group", "Class", "Recursive") ret } # Called by .ls_obj for functions .ls_obj_function <- function(obj, objname = deparse(substitute(obj))){ # formals(obj) returns NULL if only arg is ..., try: formals(expression) obj <- formals(args(obj)) objname <- paste("formals(args(", objname, "))", sep = "") if (length(obj) == 0) return(NULL) item_names <- full_names <- names(obj) nsx <- item_names != make.names(item_names) # non-syntactic names item_names[nsx] <- paste("`", item_names[nsx], "`", sep = "") full_names <- paste(objname, "$", item_names, sep = "") ret <- t(sapply(seq_along(obj), function(i) { x <- obj[[i]] lang <- is.language(obj[[i]]) obj_class <- class(obj[[i]])[1] obj_mode <- mode(obj[[i]]) d <- deparse(obj[[i]]) if (lang && obj_class == "name") { obj_class <- "" obj_mode <- "" } ret <- c(paste(d, collapse = "x"), obj_class, obj_mode, FALSE) return(ret) })) data.frame(itemnames = item_names, fullnames = full_names, ret, stringsAsFactors = FALSE) } # Called by .ls_obj in S4 case .ls_obj_s4 <- function(obj, objname = deparse(substitute(obj))) { item_names <- full_names <- slotNames(obj) nsx <- item_names != make.names(item_names) item_names[nsx] <- paste("`", item_names[nsx], "`", sep = "") full_names <- paste(objname, "@", item_names, sep = "") ret <- t(sapply(item_names, function(i) .obj_desc(slot(obj, i)))) data.frame(itemnames = item_names, fullnames = full_names, ret, stringsAsFactors = FALSE) } # Returns a *character* vector with elements: dims, mode, class, rec(ursive) .obj_desc <- function(x) { d <- dim(x) if (is.null(d)) d <- length(x) c(dims = paste(d, collapse = "x"), mode = mode(x), class = class(x)[1], rec = mode(x) == "S4" || is.function(x) || (is.recursive(x) && !is.language(x) && sum(d) != 0)) } #' @export #' @rdname obj_browse obj_search <- function(sep = "\t", path = NULL, compare = TRUE) { new_search <- search() if (isTRUE(compare)) { old_search <- get_temp(".guiObjSearchCache", default = "") # Compare both versions if (length(new_search) != length(old_search) || !all(new_search == old_search)) { # Keep a copy of the last version in SciViews:TempEnv assign_temp(".guiObjSearchCache", new_search) is_changed <- TRUE } else is_changed <- FALSE } else is_changed <- TRUE if (is.null(path)) {# Return result, as a single character string with sep if (is_changed) { if (!is.null(sep)) new_search <- paste(new_search, collapse = sep) return(new_search) } else return("") } else {# Write to a file called 'Search.txt' in this path file <- file.path(path, "Search.txt") if (is_changed) { if (is.null(sep)) sep <- "\n" cat(new_search, sep = sep, file = file) } invisible(is_changed) } } #' @export #' @rdname obj_browse obj_menu <- function(id = "default", envir = .GlobalEnv, objects = "", sep = "\t", path = NULL) { # TODO: look also in .required (now .Depends) in .GlobalEnv to determine # if one can detach a package # TODO: copy name to clipboard, send name to editor in menu # Get a context menu for given object(s) or environment # It returns a matrix with the following columns: # - widget: "menu", "item", "sep" or "space" # - value: label of the menu or the item, or "-" for a separator # - tip: a short description of this menu entry # - code: the command to issue. Precede it with <<>> to run the command # silently and by <<>> to run it silently and disconnect immediately # Use a substitution placeholder for replacement in value, tip and code. # For instance, <<>>, <<>>, <<>>, <<>> and # add an argument returning the string to place there in the call to # .addStripbar() # - icon: the URL of the icon to use in the menu # - checked: if the menu entry should present a check mark # - disabled: if the menu entry is disabled # - hidden: if the menu entry is hidden # - options: further options that the GUI client can interpret # Notes: # - Selecting environments and objects inside environments is not allowed # - Selecting multiples environments is not supported # - Selecting items in different environments is not allowed popup <- .create_stripbar("popupbar") # Format envir as character (use only first item provided!) if (is.environment(envir)) envir = deparse(substitute(envir)) if (is.numeric(envir)) envir <- search()[envir[1]] envir <- as.character(envir)[1] # Get the current position in the search path for envir pos <- match(envir, search(), nomatch = -1) if (pos < 1) return(invisible(popup)) # Not found! # Do we replace envir or not? if (envir == ".GlobalEnv") Envir <- "<<>>" else Envir <- envir # Look at 'objects' if (length(objects) > 1) { # We have a multiple selection obj_type <- "multiple" # Add 'save' and 'remove' menu entries objs_par <- paste(objects, collapse = ", ") popup <- .add_stripbar(popup, c("save", "remove"), obj = objs_par, envir = Envir) } else {# Only one item is selected if (objects == "") {# This is a menu for the environment # The menu is different depending if we are in .GlobalEnv or not if (envir == ".GlobalEnv") { obj_type <- ".GlobalEnv" obj_par <- NULL # Nothing special to propose popup <- .add_stripbar(popup, c("load", "source", "import", "sep_", "detach (d)"), envir = envir) } else if (regexpr("^package:", envir) > -1) {# A package envir obj_type <- "package" obj_par <- sub("^package:", "", envir) req <- getOption("required.packages") if (is.null(req)) # Use list of known sensible environments req <- c("package:base", "package:methods", "package:datasets", "package:utils", "package:grDevices", "package:graphics", "package:stats", "package:tcltk", "package:svMisc", "package:svGUI", "package:svSocket", "package:svViews", "package:svIO", "package:svIDE", "package:svDialogs", "package:svWidgets", "package:tcltk2") # Make sure that "package:base" is in the list req <- c("package:base", req) detachable <- !(envir %in% req) if (detachable) state <- "" else state <- " (d)" popup <- .add_stripbar(popup, c("pkgInfo", "sep_", paste("detach", state, sep = ""), paste("detachUnload", state, sep = "") ), package = obj_par, envir = Envir) } else {# Another environment than .GlobalEnv, but not a package obj_type <- "environment" req <- getOption("required.environments") if (is.null(req)) # Use list of known sensible environments req <- c("SciViews:TempEnv", "RcmdrEnv", "Autoloads", "tools:RGUI") detachable <- !(envir %in% req) if (detachable) state <- "" else state <- " (d)" obj_par <- detachable popup <- .add_stripbar(popup, c(paste("detach", state, sep = "")), envir = Envir) } } else {# This is a menu for an object if (!exists(objects, where = envir)) return(invisible(popup)) obj_type <- "object" obj <- get(objects, pos = envir) obj_par <- class(obj) # Look if there is an help file and examples for this object hlp <- is_help(objects) names(hlp) <- NULL # Then we add 'help' and 'example' at the top of the menu popup <- .add_stripbar(popup, c( ifelse(hlp, c("help", "example"), c("help (d)", "example (d)")), "sep_"), obj = objects) # Add a series of standard functions/methods for this object mets <- list_methods(class = obj_par) popup <- .add_stripbar(popup, c("Functions_.", "._print", ifelse("summary" %in% mets, "._generic", "._generic (d)") ), obj = objects, fun = "summary") popup <- .add_stripbar(popup, c( ifelse("plot" %in% mets, "._generic", "._generic (d)"), ifelse(!is.null(names(obj)), "._names", "._names (d)"), "._str" ), obj = objects, fun = "plot") # Eliminate 'print', 'show', 'summary' and 'plot' from mets mets <- mets[!(mets %in% c("print", "show", "summary", "plot"))] # Add the other methods from mets in the menu if (length(mets) > 0) { popup <- .add_stripbar(popup, "._sep_") for (met in mets) popup <- .add_stripbar(popup, "._generic", obj = objects, fun = met) } # Add a &View menu and at least one entry: &Default view enabled_views <- "svViews" %in% search() # We need this package if (enabled_views) { popup <- .add_stripbar(popup, c("View_.", "._viewDef" ), obj = objects) # Complete the '&View' submenu with more entries view_types <- list_types("view", obj_par) for (view_type in view_types) popup <- .add_stripbar(popup, "._view", obj = objects, type = view_type) popup <- .add_stripbar(popup, "report", obj = objects) } else {# Give the opportunity to load the svViews package popup <- .add_stripbar(popup, c("View_.", "._viewDef (d)", "._require", "report (d)"), obj = objects, pkg = "svViews") } # Add &edit/fix and &save popup <- .add_stripbar(popup, c( ifelse(envir == ".GlobalEnv", "edit", "fix"), "save" ), obj = objects, envir = Envir) # If we are in .GlobalEnv and the object is a data.frame or a list, # then I can attach/detach it if (envir == ".GlobalEnv" && inherits(obj, "list")) { # Is this object already attached (present in the search path) if (objects %in% search()) { popup <- .add_stripbar(popup, c("detach", "reattach", "sep_"), obj = objects) } else {# The object is not attached yet... popup <- .add_stripbar(popup, c("attach", "sep_"), obj = objects) } } # Create the '©' submenu with all possible entries # plus &Export and &Remove enabled_copy <- "svIO" %in% search() # We need this package if (enabled_copy) { popup <- .add_stripbar(popup, c("Copy_.", "._copyDef" ), obj = objects) # Complete the '&Copy' submenu with more entries copy_types <- list_types("copy", obj_par) for (copy_type in copy_types) popup <- .add_stripbar(popup, "._copy", obj = objects, type = copy_type) popup <- .add_stripbar(popup, c("export", "sep_", "remove" ), obj = objects, envir = Envir) } else {# Give the opportunity to load the svIO package popup <- .add_stripbar(popup, c("Copy_.", "._copyDef (d)", "._require", "export (d)", "sep_", "remove" ), obj = objects, envir = Envir, pkg = "svIO") } } }# Done (menu construction) # Possibly call a custom function .objMenu() in SciViews:TempEnv # to finalize the menu # Depending on obj_type, we send something we already calculated to avoid # doing it twice: # obj_type -> obj_par # .GlobalEnv NULL # package Package name # environment is it detachable or not? # object class of the object # multiple string with the multiple objects separated by ', ' cmd_fun <- get_temp(".objMenu", mode = "function") if (!is.null(cmd_fun)) popup <- cmd_fun(popup, id = id, envir = envir, pos = pos, objects = objects, path = path, objType = obj_type, objPar = obj_par) if (!is.null(path)) { # Save the data in a file if (path == "") path <- obj_dir() menu_file <- file.path(path, paste("Menu_", id, ".txt", sep = "")) write.table(popup, file = menu_file, sep = sep, row.names = FALSE, col.names = FALSE) } # TODO: make this more flexible # Possibly call a .guiObjMenu function to pass the data to the GUI client cmd_fun <- get_temp(".guiObjMenu", mode = "function") if (!is.null(cmd_fun)) cmd_fun(id = id, data = popup) # Return the menu specification invisibly invisible(popup) } .create_stripbar <- function(type = c("menubar", "popupbar", "toolbar", "buttonbar", "statusbar")) { type <- match.arg(type) strp <- data.frame(widget = character(), value = character(), tip = character(), code = character(), icon = character(), checked = logical(), disabled = logical(), hidden = logical(), options = character(), stringsAsFactors = FALSE) class(strp) <- unique(c("svStripbar", "svStrip", class(strp))) attr(strp, "type") <- type strp } .add_stripbar <- function(strip, widgets, gui = getOption("svGUI.name"), actions = NULL, ..., icons = NULL) { if (!inherits(strip, "svStripbar")) stop("'strip' must be a 'svStripbar' object") strip_type <- attr(strip, "type") if (is.null(strip_type)) strip_type <- "menubar" # Default value # Extract possible state information from widgets pos <- regexpr(" *[(][cCuUdDeEhHvV]+[)] *$", widgets) pos[pos == -1] <- 1000000 state <- substr(widgets, pos, 1000000) # Clean up state to keep only digits state <- tolower(sub("^ *[(]([cCuUdDeEhHvV]+)[)] *$", "\\1", state)) widgets <- substr(widgets, 1, pos - 1) # If widgets is a named character vector, just check it is # 'menu', 'item', 'sep' or 'space', otherwise, compile name = widget wnames <- names(widgets) if (is.null(wnames)) { wnames <- widgets # Determine widgets according to wnames widgets <- rep("item", length.out = length(wnames)) widgets[regexpr("_[.]$", wnames) > -1] <- "menu" widgets[regexpr("_$", wnames) > -1] <- "sep" widgets[regexpr("__$", wnames) > -1] <- "space" names(widgets) <- wnames } else { # Name is provided => check content for 'menu', 'item', 'sep' or 'space' if (!all(widgets %in% c("menu", "item", "sep", "space"))) stop("'widgets' must be 'menu', 'item', 'sep' or 'space'") } # Get tree hierarchy of the menus being the number of dots before '_' tree <- sub("^([.]+)_.*$", "\\1", wnames) tree[regexpr("^[.]+$", tree) == -1] <- "" tree <- gsub("[.]", "|", tree) # Clean up widget names wnames <- sub("^[.]+_", "", wnames) wnames <- sub("_[.|_]{0,1}$", "", wnames) # Guess some of the values from the names value_def <- wnames value_def[widgets == "sep"] <- "-" value_def[widgets == "space"] <- "<->" # Collect together 'text', 'code', 'state' and 'options' from actions, # .svActions.[gui] and .svActions if (is.null(gui)) gui <- "___" # Default value if no gui exists act_gui <- get_temp(paste(".svActions", gui, sep = "."), default = structure(list(), class = c("svActions", "list"))) act <- get_actions() # Collect together items def_text <- c(actions$text, act_gui$text, act$text) def_code <- c(actions$code, act_gui$code, act$code) def_state <- c(actions$state, act_gui$state, act$state) def_options <- c(actions$options, act_gui$options, act$options) # Do the same for icons def_icons <- c(icons, get_temp(paste(".svIcons", gui, sep = "."), default = character()), get_temp(".svIcons", default = character())) # The function used to replace placeholders in text and code replace <- function(x, ...) { # Do replacement for ... arguments args <- list(...) largs <- length(args) if (length(args) > 0) { nargs <- names(args) for (i in 1:largs) if (nargs[i] != "") x <- gsub(paste("<<<", nargs[i], ">>>", sep = ""), args[[i]], x) } # Eliminate optional parts where no replacement occured x <- gsub("\\[\\[\\[.*<<<.*>>>.*\\]\\]\\]", "", x) # Eliminate triple square brackets for optional parts we keep x <- gsub("\\[\\[\\[", "", x) x <- gsub("\\]\\]\\]", "", x) x } # Compute the different elements we need # - text => value (first line) and tip (the rest) text <- replace(def_text[wnames], ...) text[is.na(text)] <- "" # TODO: a better guess for menus, items and sep/space names(text) <- wnames pos <- regexpr("\n", text) pos[pos == -1] <- 1000000 value <- substr(text, 1, pos - 1) value[value == ""] <- value_def[value == ""] tip <- substr(text, pos + 1, 1000000) # Indicate menu hierarchy in value value <- paste(tree, value, sep = "") # - code code <- replace(def_code[wnames], ...) code[is.na(code)] <- "" names(code) <- wnames # - icon icon <- def_icons[wnames] icon[is.na(icon)] <- "" names(icon) <- wnames # - options options <- def_options[wnames] options[is.na(options)] <- "" names(options) <- wnames # Compute state => checked, disabled and hidden state2 <- def_state[wnames] state2[is.na(state2)] <- "" state <- paste(state, tolower(state2)) checked <- ifelse(regexpr("c", state) > -1, TRUE, FALSE) disabled <- ifelse(regexpr("d", state) > -1, TRUE, FALSE) hidden <- ifelse(regexpr("h", state) > -1, TRUE, FALSE) # Create the data frame containing the data add_strip <- data.frame(widget = widgets, value = value, tip = tip, code = code, icon = icon, checked = checked, disabled = disabled, hidden = hidden, options = options, stringsAsFactors = FALSE) snames <- rownames(strip) # Add it to strip and return it strip <- rbind(strip, add_strip) rownames(strip) <- make.names(c(snames, wnames), unique = TRUE) # Make sure class and type are kept class(strip) <- unique(c("svStripbar", "svStrip", class(strip))) attr(strip, "type") <- strip_type strip } #test <- c( # "load", # "sep_", # "File_.", # "._import (cdh)", # "._sep_", # "._export (h) ", # "._View_.", # ".._viewDef (ch)", # ".._view", # "._report", # "attach (d) " #) #pop <- .create_stripbar("popupbar") #.add_stripbar(pop, test, obj = "testobj", type = "mytype") # Backward compatibility #' @export #' @rdname obj_browse objBrowse <- obj_browse #' @export #' @rdname obj_browse objClear <- obj_clear #' @export #' @rdname obj_browse objDir <- obj_dir #' @export #' @rdname obj_browse objInfo <- obj_info #' @export #' @rdname obj_browse objList <- obj_list #' @export #' @rdname obj_browse objSearch <- obj_search #' @export #' @rdname obj_browse objMenu <- obj_menu svMisc/R/pkgMan.R0000644000176200001440000002005514614131727013267 0ustar liggesusers#' Functions to manage R side of the SciViews R package manager #' #' @description These functions should not be used directly by the end-user. #' They implement the R-side code for the SciViews \R package manager. #' #' @param pkgname The name of one R package (character string). #' @param print.it Should the result be printed? #' @param page Which page to get? #' @param pattern Selection pattern. #' @param n The number of items to retrieve. #' @param keep The columns to keep in the resulting data frame. #' @param reload Do we force reload of the data and ignore cache version? #' @param sep Field separator to use. #' @param eol End-of-line sequence to use. #' @param pkgs A list of packages to install. #' @param install.deps Do we also install dependencies? #' @param ask Do we prompt the user for package installation? #' @param url The URL to use for the current CRAN mirror. #' @return These functions return data that is intended to be used by the #' SciViews \R package manager. #' @author Kamil Barton #' @export #' @seealso [package()] #' @keywords utilities #' @concept SciViews R package manager pkgman_describe <- function(pkgname, print.it = TRUE) { owarn <- getOption("warn") on.exit(options(warn = owarn)) options(warn = -1) desc <- packageDescription(pkgname) options(warn = owarn) if (is.na(desc)) { # Package is apparently not installed... Try getting data from CRAN con <- url(file.path(getOption("repos")['CRAN'], "web", "packages", pkgname, 'DESCRIPTION', fsep = '/')) m <- try(open(con, "r"), silent = TRUE) if (!inherits(m, "try-error")) { on.exit(close(con), add = TRUE) dcf <- try(read.dcf(con)) # Build a 'packageDescription' object desc <- as.list(dcf[1, ]) class(desc) <- "packageDescription" } else { return(invisible(NULL)) } } if (isTRUE(print.it)) { write.dcf(as.data.frame.list(desc[!sapply(desc, is.na)], optional = TRUE), width = Inf) invisible(desc) } else desc } #' @export #' @rdname pkgman_describe pkgman_get_mirrors <- function() { # Cache the list of CRAN mirrors in SciViews:TempEnv temp_var <- "pkgMan.CRANmirrors" if (exists_temp(temp_var)) { mirrors <- get_temp(temp_var) } else { mirrors <- getCRANmirrors() assign_temp(temp_var, mirrors) } write.table(mirrors[, c("Name", "URL", "CountryCode")], row.names = FALSE, col.names = FALSE, sep = ';', quote = FALSE, na = "") } #' @export #' @rdname pkgman_describe pkgman_get_available <- function(page = "next", pattern = "", n = 50, keep = c("Package", "Version", "InstalledVersion", "Status"), reload = FALSE, sep = ";", eol = "\t\n") { available_pkgs <- function(avpkg = available.packages(), installed = TRUE) { avpkg <- avpkg[order(toupper(avpkg[, "Package"])), , drop = FALSE] if (isTRUE(installed)) { inspkg <- installed.packages() ipkgnames <- unique(inspkg[, 'Package']) ipkgnames <- ipkgnames[ipkgnames %in% avpkg[, 'Package']] avpkg <- cbind(avpkg, InstalledVersion = NA, Status = NA) if (length(ipkgnames)) { pkgstatus <- sapply(ipkgnames, function(pkg) { compareVersion(avpkg[pkg, 'Version'], inspkg[pkg, 'Version']) }) avpkg[ipkgnames, 'Status'] <- pkgstatus avpkg[ipkgnames, 'InstalledVersion'] <- inspkg[ipkgnames, 'Version'] } } avpkg } if (!exists_temp('avpkg.list') || isTRUE(reload)) { avpkg.list <- available_pkgs(available.packages(filters = c("R_version", "OS_type", "duplicates")), installed = FALSE) assign_temp('avpkg.list', avpkg.list) } else { avpkg.list <- get_temp('avpkg.list') } if (page == "first") { new_search <- TRUE i0 <- 1 } else { new_search <- get_temp('avpkg.pattern', "") != pattern i0 <- get_temp('avpkg.idx', default = 1) } if (is.character(pattern) && pattern != "") { if (new_search) { page <- "current" i0 <- 1 idx <- grep(pattern, avpkg.list[,'Package'], ignore.case = TRUE) assign_temp('avpkg.pattern.idx', idx) } else { idx <- get_temp('avpkg.pattern.idx') } imax <- length(idx) } else { imax <- nrow(avpkg.list) idx <- seq(imax) } assign_temp('avpkg.pattern', pattern) if (page == "next") { i0 <- i0 + n } else if (page == "prev") { i0 <- i0 - n } outside <- i0 > imax || i0 < 1 if (outside) return(NULL) assign_temp('avpkg.idx', i0) i1 <- min(i0 + n - 1, imax) i <- seq(i0, i1) cat(i0, i1, imax, "\t\n") write.table(available_pkgs(avpkg.list[idx[i], , drop = FALSE])[ , keep, drop = FALSE], row.names = FALSE, col.names = FALSE, sep = sep, quote = FALSE, eol = eol, na = "") } #' @export #' @rdname pkgman_describe pkgman_get_installed <- function(sep = ";", eol = "\t\n") { inspkg <- installed.packages(fields = "Description") inspkg <- inspkg[order(toupper(inspkg[ , "Package"])), c("Package", "Version", "Description")] inspkg[, 3] <- gsub("\n", " ", inspkg[, 3]) inspkg <- cbind(inspkg, Installed = inspkg[, 'Package'] %in% .packages()) write.table(inspkg, row.names = FALSE, col.names = FALSE, sep = sep, quote = FALSE, eol = eol, na = "") } #' @export #' @rdname pkgman_describe pkgman_set_cran_mirror <- function(url) { repos <- getOption("repos") repos['CRAN'] <- url options(repos = repos) } #' @export #' @rdname pkgman_describe pkgman_install <- function(pkgs, install.deps = FALSE, ask = TRUE) { dep <- suppressMessages(getNamespace("utils")$getDependencies(pkgs, available = get_temp('avpkg.list'))) msg <- status <- "" if (!isTRUE(ask) && (isTRUE(install.deps) || all(dep %in% pkgs))) { msg <- capture_all(install.packages(dep)) status <- "done" } else { l <- length(dep) msg <- sprintf(ngettext(l, "This will install package %2$s.", "This will install packages: %s and %s.", ), paste(sQuote(dep[-l]), collapse = ", "), sQuote(dep[l])) status <- "question" } list(packages = dep, message = msg, status = status) } #' @export #' @rdname pkgman_describe pkgman_remove <- function(pkgname) { sapply(pkgname, function(pkgname) { pkg_search_name <- paste("package", pkgname, sep = ":") if (pkg_search_name %in% search()) detach(pkg_search_name, character.only = TRUE, unload = TRUE) if (pkgname %in% loadedNamespaces()) unloadNamespace(pkgname) dlli <- getLoadedDLLs()[[pkgname]] if (!is.null(dlli)) dyn.unload(dlli[['path']]) pkg_path <- find.package(pkgname, quiet = TRUE) if (length(pkg_path) == 0L) return(FALSE) pkg_lib <- normalizePath(file.path(pkg_path, "..")) if (file.access(pkg_lib, 2) == 0) { remove.packages(pkgname, lib = pkg_lib) TRUE } else { #warning("No sufficient access rights to library", sQuote(pkglib)) FALSE } }, simplify = FALSE) } #' @export #' @rdname pkgman_describe pkgman_load <- function(pkgname) { sapply(pkgname, library, character.only = TRUE, logical.return = TRUE, simplify = FALSE) } #' @export #' @rdname pkgman_describe pkgman_detach <- function(pkgname) { sapply(pkgname, function(pkgname) { tryCatch({ pkg_search_name <- paste("package", pkgname, sep = ":") if (pkg_search_name %in% search()) detach(pkg_search_name, character.only = TRUE, unload = TRUE) if (pkgname %in% loadedNamespaces()) unloadNamespace(pkgname) TRUE }, error = function(e) conditionMessage(e)) }, simplify = FALSE) } # Backward compatibility #' @export #' @rdname pkgman_describe pkgManDescribe <- pkgman_describe #' @export #' @rdname pkgman_describe pkgManGetMirrors <- pkgman_get_mirrors #' @export #' @rdname pkgman_describe pkgManGetAvailable <- pkgman_get_available #' @export #' @rdname pkgman_describe pkgManGetInstalled <- pkgman_get_installed #' @export #' @rdname pkgman_describe pkgManSetCRANMirror <- pkgman_set_cran_mirror #' @export #' @rdname pkgman_describe pkgManInstall <- pkgman_install #' @export #' @rdname pkgman_describe pkgManRemove <- pkgman_remove #' @export #' @rdname pkgman_describe pkgManLoad <- pkgman_load #' @export #' @rdname pkgman_describe pkgManDetach <- pkgman_detach svMisc/R/source_clipboard.R0000644000176200001440000000205314614131727015367 0ustar liggesusers#' Source code from the clipboard #' #' @description This function reads R code from the clipboard, and then source #' it. Clipboard is managed correctly depending on the OS (Windows, MacOS, or #' *nix) #' #' @param primary Only valid on *nix: read the primary (or secondary) clipboard. #' @param ... Further parameters passed to [source()]. #' @return Same result as [source()]. #' @export #' @seealso [source()], [file()] #' @keywords IO #' @concept Source code from clipboard source_clipboard <- function(primary = TRUE, ...) { # Source data from clipboard, manage clipboard correctly depending on the OS if (is_win()) { data <- file("clipboard") } else if (is_mac()) { data <- pipe("pbpaste") } else {# Must be Linux/Unix if (primary) { data <- file("X11_clipboard") } else { data <- file("X11_secondary") } } on.exit(close(data)) # Invoke source() with the data from the clipboard invisible(source(data, ...)) } # Backward compatibility #' @export #' @rdname source_clipboard sourceClipboard <- source_clipboard svMisc/R/system_file.R0000644000176200001440000001146214614131727014377 0ustar liggesusers#' Get a system file or directory #' #' @description Get system files or directories, in R subdirectories, in package #' subdirectories, or elsewhere on the disk (including executables that are #' accessible on the search path). #' #' @param ... One or several executables if `exec = TRUE`, or subpath to a file #' or dir in a package directory if `package != NULL`, or a list of paths and #' subpaths for testing the existence of a file on disk, or a list of directory #' components to retrieve in 'temp', 'sysTemp', 'user', 'home', 'bin', 'doc', #' 'etc' and/or 'share' to retrieve special system directories. #' @param exec If `TRUE` (default) search for executables on the search path. #' It supersedes all other arguments. #' @param package The name of one package to look for files or subdirs in its #' main directory (use `exec = FALSE` to search inside package dirs). #' @param lib.loc A character vector with path names of \R libraries or `NULL` #' (search all currently known libraries in this case). #' @return A string with the path to the directories or files, or `""` if they #' are not found, or of the wrong type (a dir for `system_file()` or or a file #' for `system_dir()`). #' @note These function aggregate the features of several \R functions in #' package base: [system.file()], [R.home()], [tempdir()], [Sys.which()], and #' aims to provide a unified and convenient single interface to all of them. We #' make sure also to check that returned components are respectively directories #' and files for `system_dir()` and `system_file()`. #' @export #' @seealso [file_edit()], [file.path()], [file.exists()] #' @keywords utilities #' @concept system files and directories #' @examples #' system_file("INDEX", package = "base") #' system_file("help", "AnIndex", package = "splines") #' system_file(package = "base") # This is a dir, not a file! #' system_file("zip", exec = TRUE) #' system_file("ftp", "ping", "zip", "nonexistingexe", exec = TRUE) #' system_dir("temp") # The R temporary directory #' system_dir("sysTemp") # The system temporary directory #' system_dir("user") # The user directory #' system_dir("home", "bin", "doc", "etc", "share") # Various R dirs #' system_dir("zip", exec = TRUE) # Look for the dir of an executable #' system_dir("ftp", "ping", "zip", "nonexistingexe", exec = TRUE) #' system_dir(package = "base") # The root of the 'base' package #' system_dir(package = "stats") # The root of package 'stats' #' system_dir("INDEX", package = "stats") # This is a file, not a dir! #' system_dir("help", package = "splines") system_file <- function(..., exec = FALSE, package = NULL, lib.loc = NULL) { # First look if exec is TRUE if (isTRUE(exec)) { res <- Sys.which(as.character(unlist(list(...)))) if (length(res) == 1) res <- as.character(res) } else if (!is.null(package)) { # A file in a package res <- system.file(..., package = package, lib.loc = lib.loc) # Check that this is a directory if (!file_test("-f", res)) res <- "" } else { # Look if this file exists and is a file file <- as.character(unlist(list(...))) file <- file.path(file) if (file_test("-f", file)) res <- normalizePath(file) else res <- "" } res } #' @export #' @rdname system_file system_dir <- function(..., exec = FALSE, package = NULL, lib.loc = NULL) { # First look if exec is TRUE if (isTRUE(exec)) { files <- Sys.which(as.character(unlist(list(...)))) # Note: Sys.which() does not always return "" for items not found! res <- dirname(files) res[res == "."] <- "" if (length(res) > 1) names(res) <- names(files) } else if (!is.null(package)) { # A directory in a package res <- system.file(..., package = package, lib.loc = lib.loc) # Check that this is a directory if (!file_test("-d", res)) res <- "" } else { # A predefined directory which <- as.character(unlist(list(...))) # This is a specific directory get_dir <- function(which = c("temp", "sysTemp", "user", "home", "bin", "doc", "etc", "share")) { which = match.arg(which) switch(which, "temp" = tempdir(), "sysTemp" = if (!isWin() && file_test("-d", "/tmp")) "/tmp" else dirname(tempdir()), "user" = file_path_as_absolute("~"), # From tools package "home" = R.home("home"), "bin" = R.home("bin"), "doc" = R.home("doc"), "etc" = R.home("etc"), "share" = R.home("share")) } if (is.null(which) || length(which) == 0) { return(character(0)) } else { res <- character(length(which)) if (length(which) > 1) names(res) <- which for (i in seq_along(which)) res[i] <- get_dir(which[i]) } } res } # Backward compatibility #' @export #' @rdname system_file systemFile <- system_file #' @export #' @rdname system_file systemDir <- system_dir svMisc/R/temp_env.R0000644000176200001440000001506414614131727013673 0ustar liggesusers#' Get an environment dedicated to temporary variables (and create it if needed) #' #' @description Create and manage a temporary environment `SciViews:TempEnv` #' low enough on the search path so that all loaded packages (except **base**) #' could easily access objects there. #' #' @param x The vector to add items to for `add_items()` or any object. for #' `delete_temp()`, it is the name of the variable (character string), or a #' vector of characters with the name of all variables to remove from #' `SciViews:TempEnv`. #' @param y The vector of which we want to inject missing items in 'x'. #' @param use.names Use names of items to determine which one is unique, #' otherwise, the selection is done on the items themselves. #' @param replace Do we replace existing items in 'x'? #' @param item The item to add data to in the list. #' @param value The value to add in the item, it must be a named vector and #' element matching is done according to name of items. #' @param replace.existing Do we replace an existing variable? #' @param mode The mode of the seek variable #' @param default The default value to return, in case the variable or the item #' does not exist. #' @return The temporary environment for `temp-env()`, the value assigned, added #' or changed for `assign_temp()`, `add_temp()`, `change_temp()`, or #' `get_temp()`. `TRUE` or `FALSE` for `exists_temp()`, `delete_temp()` or #' `rm_temp()`. #' @details The temporary environment is attached to the search path for easier #' access to its objects. #' @export #' @seealso [assign()], [search()], [temp_var()] #' @keywords utilities #' @concept temporary variables #' @examples #' ls(temp_env()) #' #' # I have a vector v1 with this: #' v1 <- c(a = "some v1 text", b = "another v1 text") #' # I want to add items whose name is missing in v1 from v2 #' v2 <- c(a = "v2 text", c = "the missign item") #' add_items(v1, v2, replace = FALSE) #' # Not the same as #' add_items(v1, v2, replace = TRUE) #' # This yield different result (names not used and lost!) #' add_items(v1, v2, use.names = FALSE) #' #' add_temp("tst", "item1", c(a = 1, b = 2)) #' # Retrieve this variable #' get_temp("tst") #' # Add to item1 in this list without replacement #' add_temp("tst", "item1", c(a = 45, c = 3), replace = FALSE) #' get_temp("tst") #' # Same but with replacement of existing items #' add_temp("tst", "item1", c(a = 45, c = 3), replace = TRUE) #' get_temp("tst") #' # Delete the whole variable #' delete_temp("tst") #' #' assign_temp("test", 1:10) #' # Retrieve this variable #' get_temp("test") #' #' change_temp("tst", "item1", 1:10) #' # Retrieve this variable #' get_temp("tst") #' # Create another item in the list #' change_temp("tst", "item2", TRUE) #' get_temp("tst") #' # Change it #' change_temp("tst", "item2", FALSE) #' get_temp("tst") #' # Delete it (= assign NULL to the item) #' change_temp("tst", "item2", NULL) #' get_temp("tst") #' # Delete the whole variable #' delete_temp("tst") #' #' assign_temp("test", 1:10) #' # Check if this variable exists #' exists_temp("test") #' # Remove it #' delete_temp("test") #' # Does it still exists? #' exists_temp("test") temp_env <- function() { pos <- match("SciViews:TempEnv", search()) if (is.na(pos)) { # Must create it `SciViews:TempEnv` <- list() attach_env <- function(...) get("attach", mode = "function")(...) attach_env(`SciViews:TempEnv`, pos = length(search()) - 1L) rm(`SciViews:TempEnv`) pos <- match("SciViews:TempEnv", search()) } pos.to.env(pos) } #' @export #' @rdname temp_env add_items <- function(x, y, use.names = TRUE, replace = TRUE) { if (isTRUE(replace)) res <- c(y, x) else res <- c(x, y) if (use.names) { res[!duplicated(names(res))] } else { sort(unique(res)) } } #' @export #' @rdname temp_env add_temp <- function(x, item, value, use.names = TRUE, replace = TRUE) { x <- as.character(x)[1] item <- as.character(item)[1] if (exists_temp(x)) dat <- get_temp(x) else dat <- list() if (!inherits(dat, "list")) stop(x, " must be a list!") if (item %in% names(dat)) value <- add_items(dat[[item]], value, use.names = use.names, replace = replace) dat[[item]] <- value assign_temp(x, dat) } #' @export #' @rdname temp_env assign_temp <- function(x, value, replace.existing = TRUE) { t_env <- temp_env() if (replace.existing || !exists(x, envir = t_env, mode = "any", inherits = FALSE)) assign(x, value, envir = t_env) } #' @export #' @rdname temp_env change_temp <- function(x, item, value, replace.existing = TRUE) { x <- as.character(x)[1] item <- as.character(item)[1] if (exists_temp(x)) dat <- get_temp(x) else dat <- list() if (!inherits(dat, "list")) stop(x, " must be a list!") if (replace.existing || !item %in% names(dat)) { dat[[item]] <- value assign_temp(x, dat) } } #' @export #' @rdname temp_env exists_temp <- function(x, mode = "any") exists(x, envir = temp_env(), mode = mode, inherits = FALSE) #' @export #' @rdname temp_env get_temp <- function(x, default = NULL, mode = "any", item = NULL) { if (is.null(item)) Mode <- mode else Mode <- "any" t_env <- temp_env() if (exists(x, envir = t_env, mode = Mode, inherits = FALSE)) { dat <- get(x, envir = t_env, mode = Mode, inherits = FALSE) if (is.null(item)) { return(dat) } else { item <- as.character(item)[1] if (inherits(dat, "list") && item %in% names(dat)) { dat <- dat[[item]] if (mode != "any" && mode(dat) != mode) dat <- default return(dat) } else { return(default) } } } else {# Variable not found, return the default value default } } #' @export #' @rdname temp_env delete_temp <- function(x) { if (!is.character(x)) stop("'x' must be character string(s)!") l <- length(x) res <- rep(TRUE, l) if (l > 1) names(res) <- x t_env <- temp_env() for (i in 1:l) { exists_in_temp <- exists(x[i], envir = t_env, inherits = FALSE) res0 <- try(if (exists_in_temp) rm(list = x[i], envir = t_env), silent = TRUE) if (!exists_in_temp || inherits(res0, "try-error")) res[i] <- FALSE } invisible(res) } #' @export #' @rdname temp_env rm_temp <- delete_temp # Backward compatibility #' @export #' @rdname temp_env TempEnv <- temp_env #' @export #' @rdname temp_env addItems <- add_items #' @export #' @rdname temp_env addTemp <- add_temp #' @export #' @rdname temp_env assignTemp <- assign_temp #' @export #' @rdname temp_env changeTemp <- change_temp #' @export #' @rdname temp_env existsTemp <- exists_temp #' @export #' @rdname temp_env getTemp <- get_temp #' @export #' @rdname temp_env rmTemp <- delete_temp svMisc/R/package.R0000644000176200001440000001143714614131727013451 0ustar liggesusers#' A (possibly) very silent and multi-package library()/require() function #' #' @description This function loads one or several R packages as silently as #' possible (with `warn/message = FALSE`) and it returns `TRUE` only if all #' packages are loaded successfully. If at least one loading fails, a short #' message is printed, by default. For all packages that were not found, an #' entry is recorded in `.packages_to_install` in `SciViews:TempEnv`, and that #' list can be automatically used by [Install()]. #' #' @param ... The name of one or several R packages to load (character strings). #' @param stop If `TRUE`, issue an error in case the package(s) cannot be #' loaded. #' @param message Do we display introductory message of the package? If a #' package displays such a message, there is often a good reason. So, it is #' **not** a good idea to disable it in _interactive_ sessions. However, in #' other contexts, like in non-interactive use, inside an R Markdown document, #' etc., it is more convenient not to display it. #' @param warn.conflicts As for [library()]: "logical. If TRUE, warnings are #' printed about conflicts from attaching the new package. A conflict is a #' function masking a function, or a non-function masking a non-function. #' @param pos As for [library()]: "the position on the search list at which to #' attach the loaded namespace. Can also be the name of a position on the #' current search list as given by [search()]". Only one position can be #' provided here, even if several packages, and they will be all inserted one #' after the other at the given position. #' @param lib.loc As for [library()]: "a character vector describing the #' location of \R library trees to search through, or `NULL`. The default value #' of `NULL` corresponds to all libraries currently known to [.libPaths()]. #' Non-existent library trees are silently ignored". #' @param verbose A logical indicating if additional diagnostic messages are #' printed. #' @return `TRUE` if all packages are loaded correctly, `FALSE` otherwise, with #' a `details` attribute indicating which package was loaded or not. #' @note This function is designed to concisely and possibly quietly (with #' `warn = FALSE`) load packages and attach them to the search path. Also, on #' the contrary to [library()], or [require()], it is **not** possible to use #' unquoted names of the packages. This is cleaner, and avoids the contrived #' work-around to pass name(s) of packages as a variable with an arguments #' `character.only = TRUE`! #' #' If several packages are provided, they are loaded and attached in reverse #' order, so that the order in the search path is the same one as the order in #' the provided vector. #' #' The `library(help = ...)` version is not implemented here. #' @export #' @seealso [require()], [library()], [Install()] #' @keywords utilities #' @concept package requirement and loading #' @examples #' # This should work... #' if (package('tools', 'methods', stop = FALSE)) message("Fine!") #' # ... but this not (note that there are no details here!) #' if (!package('tools', 'badname', stop = FALSE)) message("Not fine!") #' \dontrun{ #' # Get an error #' package('badname') #' } package <- function(..., stop = TRUE, message = stop, warn.conflicts = message, pos = 2L, lib.loc = NULL, verbose = getOption("verbose")) { owarn <- getOption("warn") options(warn = -1) # Suppress warnings on.exit(options(warn = owarn)) pkgs <- unlist(list(...)) l <- length(pkgs) if (l < 1) return(library()) # Same as library invoked without arguments (list of pkgs) if (length(pos) > 1) { warning("more than one 'pos' provided; Using only the first one") pos <- pos[1] } check <- rep(TRUE, l) names(check) <- pkgs if (message) suppressPackageStartupMessages <- function(expr) expr for (i in l:1) check[i] <- suppressPackageStartupMessages(suppressWarnings( tryCatch( library(pkgs[i], pos = pos, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE, warn.conflicts = warn.conflicts, quietly = TRUE, verbose = verbose) , error = function(e) e))) res <- structure(all(check), details = check) if (!res) { bads <- pkgs[!check] # Record the list of packages that were not found for easier Install() to_install <- get_temp('.packages_to_install', default = character(0)) to_install <- unique(c(bads, to_install)) assign_temp('.packages_to_install', to_install, replace.existing = TRUE) options(warn = owarn) if (stop) { if (length(bads) == 1) { stop("Unable to load package '", bads, "'!\nUse `Install()` to make it available...") } else { stop("Unable to load package(s): '", paste(bads, collapse = "', '"), "'!\nUse `Install()` to make them available...") } } } invisible(res) } svMisc/R/describe_function.R0000755000176200001440000002302414614131727015541 0ustar liggesusers#' Get textual help on function or function arguments, or get a call tip #' #' @description Textual help on functions or their arguments is extracted for #' text online help for a given function. By default, all arguments from the #' online help are returned for `describe_args()`. If the file contains help for #' several functions, one probably gets also some irrelevant information. Use of #' 'args' to limit result is strongly encouraged. `args_tip()` provides a #' human-readable textual description of function arguments in a better way than #' `args()` does. It is primarily intended for code tips in GUIs. `call_tip()` #' has a similar purpose to show how some code could be completed. #' #' @param fun A character string with the name of a function (several functions #' accepted too for `describe_function()`. #' @param args Either `NULL` (by default) to return the description of all #' arguments from the corresponding man page, or a character vector with names #' of the arguments to search for. #' @param package A character string with the name of the package that contains #' `fun`, or `NULL` for searching in all loaded packages. #' @param lib.loc A character vector of directory names of \R libraries, or #' `NULL`. The default value of `NULL` corresponds to all libraries currently #' known. If the default is used, the loaded packages are searched before the #' libraries. #' @param name A string with the name of a function. #' @param code A fraction of R code ending with the name of a function, #' eventually followed by '('. #' @param only.args Do we return only arguments of the function #' (`arg1, arg2 = TRUE, ...`), or the full call, like #' (`myfun(arg1, arg2 = TRUE, ...)`). #' @param width Reformat the tip to fit to fit in that width, except if #' `width = NULL`. #' @param location If `TRUE` then the location (in which package the function #' resides) is appended to the calltip between square brackets. #' @param description If `TRUE` then a short description of the function is #' added to the call_tip (in fact, the title of the corresponding help page, if #' it exists). #' @param methods If `TRUE` then a short message indicating if this is a generic #' function and that lists, in this case, available methods. #' @return A string with the description of the function or of its arguments, or #' the calling syntax of the function, plus additional information depending on #' the flags used. If the man page is not found, a vector of empty strings is #' returned. Empty strings are also returned for arguments that are not found in #' the man page. #' @note `args_tip()` is supposed to display S3 and S4 methods, and primitives #' adequately,... but this is not implemented yet in the current version! For #' `call_tip()`, the use of `methods = TRUE` slows down the execution of the #' function, especially for generic functions that have many methods like #' `print()` or `summary()`. #' @export #' @seealso [completion()], [args()], [argsAnywhere()] #' @keywords utilities #' @concept graphical user interface (GUI) control #' @examples #' describe_function("ls", "base") #' describe_function("library", "base") #' describe_function("descFun", "svMisc") #' describe_function("descArgs") #' #' describe_args("ls") #' describe_args("library", args = c("package", "pos")) #' #' args_tip("ls") #' #' call_tip("myvar <- lm(") describe_function <- function(fun, package, lib.loc = NULL) { if (!length(fun)) return("") fun <- as.character(fun) l <- length(fun) if (missing(package) || is.null(package)) package <- "" package <- rep(package, length.out = l) # Create a vector of results res <- rep("", l) # Collect help for each function for (i in 1:l) { # Get location of the help file # We cannot just call help normally because otherwise it thinks # we are looking for package "package" so we create a call and eval it help_call <- call("help", fun[i], lib.loc = lib.loc, help_type = "text") if (package[i] != "") help_call[["package"]] <- package[i] file <- as.character(eval(help_call)) if (length(file) > 0) { # Read the Rd file and get the title section out of it Rdoc <- getNamespace("utils")$.getHelpFile(file[1L]) # Look for the \title tag j <- 0 for (j in seq_along(Rdoc)) if (attr(Rdoc[[j]], "Rd_tag") == "\\title") break if (j > 0) { desc <- as.character(Rdoc[[j]][[1]]) desc <- sub("^[ \t]+", "", desc) desc <- sub("[ \t]+$", "", desc) res[i] <- desc } } } res } #' @export #' @rdname describe_function describe_args <- function(fun, args = NULL, package = NULL, lib.loc = NULL) { # We cannot just call help normally because otherwise it thinks # we are looking for package "package" so we create a call and eval it help_call <- call("help", fun, lib.loc = lib.loc, help_type = "text") if (!is.null(package)) help_call[["package"]] <- package file <- eval(help_call) # This is borrowed from utils::print.help_files_with_topic path <- dirname(file) dirpath <- dirname(path) pkgname <- basename(dirpath) RdDB <- file.path(path, pkgname) if (!file.exists(paste(RdDB, "rdx", sep = "."))) return(character(length(args))) rd <- getNamespace("tools")$fetchRdDB(RdDB, basename(file)) # This is not exported from tools rd_tags <- function(Rd) { res <- sapply(Rd, attr, "Rd_tag") if (!length(res)) res <- character(0) return(res) } tags <- gsub("\\", "", rd_tags(rd), fixed = TRUE) if (!any(tags == "arguments")) return(character(length(args))) arguments <- rd[[which(tags == "arguments")[1]]] items <- arguments[rd_tags(arguments) == "\\item"] descriptions <- do.call(rbind, lapply(items, function(item) { names <- try(strsplit(item[[1]][[1]], "\\s*,\\s*", perl = TRUE)[[1]], silent = TRUE) if (inherits(names, "try-error")) { # This happens with the "..." argument names <- "..." } content <- paste(rapply(item[-1], as.character), collapse = "") cbind(names, rep.int(content, length(names))) })) if (is.null(args)) { structure(descriptions[, 2], names = descriptions[, 1]) } else { sapply(args, function(a) { if (a %in% descriptions[, 1]) { descriptions[which(descriptions[, 1] == a)[1] , 2] } else "" }) } } #' @export #' @rdname describe_function args_tip <- function(name, only.args = FALSE, width = getOption("width")) { # TODO: handle primitives and S3/S4 methods for generic functions ret <- try(res <- eval(parse(text = paste0("argsAnywhere(", name, ")"))), silent = TRUE) if (inherits(ret, "try-error") || is.null(res)) return("") # Function 'name' not found res <- deparse(res) res <- paste(res[-length(res)], collapse = "\n") if (isTRUE(only.args)) { res <- sub("^function *[(]", "", res) res <- sub(" *[)] *$", "", res) } else { res <- sub("^function *", name, res) res <- sub(" *$", "", res) } # Reflow the tip if (!is.null(width)) res <- paste(strwrap(res, width = width, exdent = 4), collapse = "\n") res } #' @export #' @rdname describe_function call_tip <- function(code, only.args = FALSE, location = FALSE, description = FALSE, methods = FALSE, width = getOption("width")) { code <- attr(completion(code, types = NA, description = FALSE), "fguess") if (is.null(code) || !length(code) || code == "") return("") # Get the corresponding call_tip ctip <- args_tip(code, only.args = only.args, width = NULL) # Reflow later! if (is.null(ctip)) return("") # Do we need to append an indication about where this function is located? if (isTRUE(location)) { where <- res <- eval(parse(text = paste0("getAnywhere(", code, ")")))$where[1] if (!is.na(where) && where != ".GlobalEnv") ctip <- paste0(ctip, " [", sub("^package:", "", where), "]") } # Reflow the tip now if (!is.null(width)) ctip <- paste(strwrap(ctip, width = width, exdent = 4), collapse = "\n") # Do we add the description of this function? if (isTRUE(description)) { desc <- describe_function(code) if (!is.null(desc) && length(desc) && desc != "") { if (!is.null(width)) desc <- paste(strwrap(desc, width = width), collapse = "\n") ctip <- paste0(ctip, "\n\n", desc) } } # Do we add a short mention of available methods if the function is generic? if (isTRUE(methods)) { mets <- list_methods(code) if (length(mets)) { # How many 25 char strings can we put on width and 5 lines max? # Note: we use two space each time as separator, except for last # line => take this into account in the calculation if (is.null(width)) nitems <- 3 else nitems <- (width + 2) %/% 27 if (nitems < 1) nitems <- 1 # Make sure the list is not too long: restrict to nitems * 5 entries if (length(mets) > nitems * 5) mets <- c(mets[1:(nitems * 5)], "...") # Make sure each method description is not longer than 25 characters n <- nchar(mets) # Cut entries that are too long tooLong <- n > 25 mets[tooLong] <- paste0(substr(mets[tooLong], 1, 22), "...") # Paste strings together mets <- paste0(format(mets, width = 25), c(rep(" ", nitems - 1), "\n"), collapse = "") # Add this info to the call_tip ctip <- paste0(ctip, "\n\nGeneric function with methods for the following classes:\n", mets) } } ctip } # Backward compatibility #' @export #' @rdname describe_function descFun <- describe_function #' @export #' @rdname describe_function descArgs <- describe_args #' @export #' @rdname describe_function argsTip <- args_tip #' @export #' @rdname describe_function callTip <- call_tip svMisc/R/def.R0000644000176200001440000000552214614131727012612 0ustar liggesusers#' Define a vector of a given mode and length (possibly filling it with default #' values) #' #' @description This function makes sure that a vector of a given mode and #' length is returned. If the value provided is `NULL`, or empty, the default #' value is used instead. If `length.out = NULL`, the length of the vector is #' not constrained, otherwise, it is fixed (possibly cutting or recycling #' `value`). #' #' @param value The value to pass with default. #' @param default The default value to use, in case of `NULL`, or #' `length(value) == 0`. #' @param mode The mode of the resulting object: 'character', 'logical', #' 'numeric' (and, if you want to be more precise: 'double', 'integer' or #' 'single') or 'complex'. Although not being a mode by itself, you can also #' specify 'factor' to make sure the result is a factor (thus, of mode #' 'numeric', storage mode 'integer', with a levels attribute). Other modes are #' ignored, and `value` is NOT coerced (silently) in this case, i.e., if you #' don't want to force coercion of the resulting object, use anything else. #' @param length.out The desired length of the returned vector; use #' `length.out = NULL` (default) if you don't want to change the length of the #' vector. #' @return A vector of given mode and length, with either `value` or `default`. #' @export #' @seealso [mode()], [rep()], [temp_env()] #' @keywords utilities #' @concept coercion and default values #' @examples #' def(1:3, length.out = 5) # Convert into character and recycle #' def(0:2, mode = "logical") # Numbers to logical #' def(c("TRUE", "FALSE"), mode = "logical") # Text to logical #' def(NULL, "default text") # Default value used #' def(character(0), "default text") # Idem #' def(NA, 10, mode = "numeric", length.out = 2) # Vector of two numbers def <- function(value, default = "", mode = "character", length.out = NULL) { # Ensure we got a value of a given mode, and if not, use default # If length.out is provided, make sure that the returned vector has # that length (if needed, cut or recycle 'value') # If either NULL or something of length == 0 is in 'value', then, # return default if (!length(value)) value <- default # Coerce to mode... res <- switch(as.character(mode[1]), logical = as.logical(value), character = as.character(value), numeric = as.numeric(value), double = as.double(value), integer = as.integer(value), single = as.single(value), factor = as.factor(value), complex = as.complex(value), value) # This is for unrecognized modes! # If length.out is provided, make sure the vector has this length if (!is.null(length.out)) { if (length(length.out) == 0) length.out <- 1 else length.out <- round(as.numeric(length.out[1])) res <- rep(res, length.out = length.out) } res } svMisc/R/about.R0000644000176200001440000001625614614131727013174 0ustar liggesusers#' Get information and help about \R objects #' #' @description Help obtained with this function is wider than with [help()]. If #' a man page is not found, it suggests related topics. If an object is an S3 #' generic function, it also lists all its known methods. Also, one can track #' the help page of an object even if its name is changed, by using the `src` or #' `srcfile` attribute of the object's comment. By the way, if the object has a #' comment, it is also displayed. This can be used as a quick and dirty way to #' provide short hints to custom objects. Finally, it is possible to track down #' the source of an object into a file with the `srcfile` attribute of its #' comment. In this case, it is the source file that is displayed. So, you can #' also further document your custom objects easily in their source files! #' #' @param topic The name of an object, or the topic to search for, if this is #' not the name of a known object. #' @param ... Further arguments passed to [help()]. #' @return A string with the location of all objects named `topic` are found is #' returned invisibly. #' @export #' @seealso [help()], [help.search()], [apropos()] #' @keywords utilities #' @concept help and information about objects #' @examples #' \dontrun{ #' about("nonexisting") # Not found on search path, but help pages #' about("htgdsfgfdsgf") # Not found anywhere #' #library(tidyverse) #' #about("group_by") # Just one page #' #about("filter") # Several items #' about("stats::filter") # OK #' #about("dplyr::filter") # OK too #' about("base::filter") # Not found there #' # Objects with comment: print comment #' vec <- structure(1:10, comment = "A simple vector") #' about("vec") #' # If there is a srcfile attribute in the comment, also display the file #' # Hint: integrate some help in the header! #' #library(data) #' #(iris <- read(data_example("iris.csv"))) #' #about("iris") #' # If the comment has a src attribute, change the topic to that one #' #urchin <- read("urchin_bio", package = "data") #' #about("urchin") #' .?filter #' .?stats::filter #' } about <- function(topic, ...) { if (!is.character(topic) || length(topic) != 1 || nchar(topic) < 1) stop("topic must be a single character string") # Is topic like pkg::topic? pkg_topic <- strsplit(topic, "::", fixed = TRUE)[[1]] if (length(pkg_topic) == 1) { package <- NULL where <- find(topic) } else {# topic provided as pkg::topic package <- pkg_topic[1] topic <- pkg_topic[2] where <- paste0("package:", package) if (!exists(topic, where = where, inherits = FALSE)) where <- character(0) } nitems <- length(where) if (!nitems) {# Nothing found... use apropos() and help.search() # Look for similar objects as topic using apropos() found <- apropos(topic, where = TRUE) if (length(found)) { if (is.null(package)) { message("'", topic, "' not found, do you mean?") } else { message("'", topic, "' not found in package '", package, "', do you mean?") } locations <- search()[as.numeric(names(found))] locations[!grepl("^package:", locations)] <- "" locations <- sub("^package:(.+)$", "\\1::", locations) message(paste0(locations, found, collapse = ", ")) } else { if (is.null(package)) { message("'", topic, "' not found") } else { message("'", topic, "' not found in package '", package, "'") } } message("Searching keyword in all R help pages for '", package, "'...") print(help.search(topic, package = package, ...)) } else {# At least one found if (nitems > 1) { message("'", topic, "' was found multiple times in:") message(paste0(where, collapse = ", ")) message("Hint: use 'pkg::topic' to be more accurate") } # Is there comments, and is it a 'src' attribute too to substitute topic? obj <- get(topic) info <- comment(obj) # Note: hard-coded for now, but these strings should be trnaslated in a regular way! lang <- Sys.getenv("language", unset = "en") description <- attr(info, "description") if (!is.null(description)) writeLines((description)) seealso <- attr(info, "seealso") if (!is.null(seealso)) { cat("\n") if (lang == "fr") { cat("- Voir aussi : ") } else { cat("- See also: ") } cat(paste(seealso, collapse = ", "), "\n", sep = "") } example <- attr(info, "example") if (!is.null(example)) { cat("\n") if (lang == "fr") { cat("- Exemples (taper `ex` pour les lancer) :\n") } else { message("- Examples (type `ex` to run them):\n") } assign_temp(".last.example", example) writeLines(example) cat("\n") } if (!is.null(info)) { if (length(info) != 1 || info != "") { cat("\n") if (lang == "fr") { cat("- Commentaire :\n") } else { cat("- Comment:\n") } writeLines(info) } # Is there a 'src_file' attribute? src_file <- attr(info, "srcfile") if (!is.null(src_file)) { message("'", topic, "' comes from '", src_file, "'. ") message("Displaying that file...") file.show(src_file, title = topic) return(invisible(character(0))) # The object has no R help page } else {# Look for a different help page in 'src' attribute src_topic <- attr(info, "src") if (!is.null(src_topic)) { message("Matching help page is '", src_topic, "'") topic <- src_topic pkg_topic <- strsplit(topic, "::", fixed = TRUE)[[1]] if (length(pkg_topic) == 1) { package <- NULL } else {# topic provided as pkg::topic package <- pkg_topic[1] topic <- pkg_topic[2] } } } } # Is there an help page for this topic? if (do.call(is_help, list(topic, package = package))[["help"]]) { meths <- try(methods(topic), silent = TRUE) if (!inherits(meths, "try-error") && length(meths)) { message("Possible methods for '", topic, "':") print(meths) } message("Displaying help page...") print(do.call(help, list(topic, package = package, ...))) } else {# Search R help for it message("Searching all R help pages...") print(help.search(topic, ...)) } } invisible(where) } #' @export #' @rdname about #' @param type First argument to `?`. If it is a dot, like `.?topic`, the second #' argument is a topic passed to the `about()` function. Otherwise, it is the #' first argument to restrict help pages, like `class`, `methods`, or `method`. #' See examples for how to use it. `?` <- function(type, topic) { type <- substitute(type) if (missing(topic)) { do.call(utils::`?`, list(type)) } else { topic <- substitute(topic) if (type == ".") { about(deparse(topic)) } else { do.call(utils::`?`, list(type, topic)) } } } #' @rdname about #' @export ex <- structure(function() { ex <- get_temp(".last.example") if (is.null(ex)) return() source(textConnection(ex), echo = TRUE) }, class = c("runnable", "function")) #' @rdname about #' @param x The name of a function. #' @export print.runnable <- function(x, ...) { x() invisible(x) } svMisc/R/is_xxx.R0000644000176200001440000001201614614426141013367 0ustar liggesusers#' Check for the existence of an help file, or some context #' #' @description For `is_help()`, determine if 'topic' has a help file and #' example to run. For `is_win()` and `is_mac()`, determine if the platform is #' Windows or MacOS. For `is_aqua()`, is the R UI is AQUA, the standard R GUI #' under Macintosh? For `is_rgui()`, determine if the default Rgui under Windows #' is in use, and with `is_sdi()` in this case, you can check if it is in SDI #' (single-document interface) _versus_ MDI (multi-document interface, by #' default). `is_rstudio()` and `is_rstudio_server()` check if R is run under #' RStudio (server), and `is_jgr()` indicate if the R GUI is JGR. #' #' @param topic Name or literal character string: the online help topic to #' look for. #' @param package A character vector giving the package names to look into for #' help or example code, or `NULL`. By default, all packages in the search #' path are used. #' @param lib.loc A character vector of directory names of \R libraries, or #' `NULL`. The default value of `NULL` corresponds to all libraries currently #' known. If the default is used, the loaded packages are searched before the #' libraries. #' @return All these functions return either `TRUE` or `FALSE` depending on the #' tested item, except for `is_help()`, which returns a logical vector with two #' elements. The first one indicating if there is a help file, and the second #' one indicating if there are examples associated with this help file. #' @note The code of `is_help()` is largely inspired from the first part of #' `example()`. #' @note Under **Rgui**, to switch fro MDI to SDI more, go to the menu entry #' 'Edit' -> 'GUI preferences' to change the Rgui mode, or start Rgui with the #' '--SDI' argument line parameter. Under another platform than Windows or if it #' is not Rgui, then `is_sdi()` always returns `FALSE`.` #' @export #' @seealso [example()], [help()], [capabilities()] #' @keywords utilities #' @examples #' is_help("help") # Help and example #' is_help("Rtangle") # Help but no example #' is_help("notopic") # No help or example #' #' is_win() #' is_mac() #' #' is_aqua() #' is_rgui() #' is_sdi() #' is_rstudio() #' is_rstudio_desktop() #' is_rstudio_server() #' is_jgr() is_help <- function(topic, package = NULL, lib.loc = NULL) { # Code taken from example(), but here we don't run the example! topic <- substitute(topic) if (!is.character(topic)) topic <- deparse(topic)[1L] pkg_paths <- find.package(package, lib.loc, verbose = FALSE) utils_ns <- getNamespace("utils") file <- utils_ns$index.search(topic, pkg_paths, TRUE) if (!length(file)) return(c(help = FALSE, example = FALSE)) encoding <- NULL temp_file <- tempfile("Rex") on.exit(unlink(temp_file)) encoding <- "UTF-8" tools::Rd2ex(utils_ns$.getHelpFile(file), temp_file) if (!file.exists(temp_file)) { c(help = TRUE, example = FALSE) } else c(help = TRUE, example = TRUE) } #' @export #' @rdname is_help is_win <- function() (.Platform$OS.type == "windows") #' @export #' @rdname is_help is_rgui <- function() (.Platform$GUI[1] == "Rgui") #' @export #' @rdname is_help is_sdi <- function() { # This function is specific to Windows, but it is defined everywhere # so that we don't have to test the platform before use! # Check if Rgui was started in SDI mode (needed by some GUI clients) # First, is it Rgui? if (!is_rgui()) return(FALSE) # RGui SDI mode: returns "R Console", in MDI mode: returns "RGui" if (utils::getIdentification() == "R Console") TRUE else FALSE } #' @export #' @rdname is_help is_mac <- function() grepl("darwin", R.version$os) # According to what's done in R sources #(grepl("^mac", .Platform$pkgType)) #' @export #' @rdname is_help is_aqua <- function() (.Platform$GUI[1] == "AQUA") #' @export #' @rdname is_help is_rstudio <- function() !is.null(get0("RStudio.Version")) #' @export #' @rdname is_help is_rstudio_desktop <- function() { rstudio_version <- get0("RStudio.Version") if (is.null(rstudio_version) || !is.function(rstudio_version)) return(FALSE) (rstudio_version()$mode == "desktop") } #' @export #' @rdname is_help is_rstudio_server <- function() { rstudio_version <- get0("RStudio.Version") if (is.null(rstudio_version) || !is.function(rstudio_version)) return(FALSE) (rstudio_version()$mode == "server") } #' @export #' @rdname is_help is_jgr <- function() { # Search for .jgr.works on the whole search path, starting from GlobalEnv if (exists(".jgr.works", envir = .GlobalEnv, inherits = TRUE)) { get(".jgr.works", envir = .GlobalEnv, inherits = TRUE) } else FALSE # JGR is probably not (correctly) installed } # Backward compatibility #' @export #' @rdname is_help isHelp <- is_help #' @export #' @rdname is_help isWin <- is_win #' @export #' @rdname is_help isRgui <- is_rgui #' @export #' @rdname is_help isSDI <- is_sdi #' @export #' @rdname is_help isMac <- is_mac #' @export #' @rdname is_help isAqua <- is_aqua #' @export #' @rdname is_help isJGR <- is_jgr # One could define this too: #`%is%` <- function(x, what) # inherits(x, what) svMisc/R/batch.R0000644000176200001440000000612414614131727013134 0ustar liggesusers#' Run a function in batch mode #' #' @description A function can be run in batch mode if it never fails (replace #' errors by warnings) and returns `TRUE` in case of success, or `FALSE` otherwise. #' #' @param items The items (usually, arguments vector of character strings) on #' which to apply `fun` sequentially. #' @param fun The function to run (must return `TRUE` or `FALSE` and issue only #' warnings or messages to be a good candidate, batchable, function). #' @param ... Further arguments to pass the `fun`. #' @param show.progress Do we show progression as item x on y... message? This #' uses the [progress()] function. #' @param suppress.messages Are messages from the batchable function suppressed? #' Only warnings will be issued. Recommended if `show.progress = TRUE`. #' @param verbose Display start and end messages if `TRUE` (default). #' @return Returns invisibly the number of items that were correctly processed #' with attributes `items` and `ok` giving more details. #' @export #' @seealso [progress()] #' @keywords utilities #' @concept batch processing #' @examples #' \dontrun{ #' # Here is a fake batchable process #' fake_process <- function(file) { #' message("Processing ", file, "...") #' flush.console() #' Sys.sleep(0.5) #' if (runif(1) > 0.7) { # Fails #' warning("fake_process was unable to process ", file) #' invisible(FALSE) #' } else invisible(TRUE) #' } #' #' # Run it in batch mode on five items #' files <- paste0("file", 1:5) #' batch(files, fake_process) #' } batch <- function(items, fun, ..., show.progress = !is_aqua() && !is_jgr(), suppress.messages = show.progress, verbose = TRUE) { if (!is.function(fun)) stop("'fun' must be a function") # Preparation of the batch process... owarn <- options(warn = 1) # Issue warnings immediatelly! on.exit(options(owarn)) verbose <- isTRUE(as.logical(verbose)) if (verbose) message("Running the batch process with ", deparse(substitute(fun)), "...") cat("\n") n <- length(items) if (n < 1) { warning("No items to process!") return(invisible(structure(FALSE, items = items, ok = logical(0)))) } ok <- rep(NA, n) # A vector with results # Do we show progression? if (!isTRUE(as.logical(show.progress))) progress <- function(...) NULL # Fake progress() function if (!isTRUE(as.logical(suppress.messages))) suppressMessages <- function(x) return(x) # Fake suppressMessages() fun # Run fun() for each item flush.console() for (i in 1:n) { progress(i, n) item <- items[i] ok[i] <- as.logical(suppressMessages(fun(item, ...)))[1] # Go to a new line in case of error and prevent progess() to erase text if (!ok[i]) { cat("\n") rm_temp(".progress") } flush.console() } progress(n + 1, n) # Cancel progression message if (verbose) { cat("\n") message("Processed successfully ", sum(ok, na.rm = TRUE), " items on ", n, " (see .last.batch)") } # Record .last.batch variable in SciViews:TempEnv last_batch <- structure(sum(ok, na.rm = TRUE) == n, items = items, ok = ok) assignTemp(".last.batch", last_batch) invisible(last_batch) } svMisc/R/parse_text.R0000644000176200001440000000746114614131727014236 0ustar liggesusers#' Parse a character string as if it was a command entered at the command line #' #' @description Parse R instructions provided as a string and return the #' expression if it is correct, or an object of class 'try-error' if it is an #' incorrect code, or `NA` if the (last) instruction is incomplete. #' #' @param text The character string vector to parse into an R expression. #' @param firstline The index of first line being parsed in the file. If this is #' larger than `1`, empty lines are added in front of `text` in order to match #' the correct position in the file. #' @param srcfilename A character string with the name of the source file. #' @param encoding Encoding of `text``, as in [parse()]. #' @return Returns an expression with the parsed code or `NA` if the last #' instruction is correct but incomplete, or an object of class 'try-error' with #' the error message if the code is incorrect. #' @note On the contrary to `parse()`, `parse_text()` recovers from incorrect #' code and also detects incomplete code. It is also easier to use in case you #' pass a character string to it, because you don't have to name the argument #' explicitly (`text = ...`). #' @export #' @seealso [parse()], [capture_all()] #' @keywords IO #' @examples #' parse_text("1 + 1") #' parse_text("1 + 1; log(10)") #' parse_text(c("1 + 1", "log(10)")) #' #' # Incomplete instruction #' parse_text("log(") #' #' # Incomplete strings #' parse_text("text <- \"some string") #' parse_text("text <- 'some string") #' #' # Incomplete names (don't write backtick quoted names on several lines!) #' # ...but just in case #' parse_text("`myvar") #' #' # Incorrect expression #' parse_text("log)") parse_text <- function(text, firstline = 1, srcfilename = NULL, encoding = "unknown") { # Parse R instructions provided as a string and return the expression if it # is correct, or a 'try-error' object if it is an incorrect code, or NA if # the (last) instruction is incomplete text <- paste(text, collapse = "\n") # if firstline is higher than 1, "align" code by prepending empty codes firstline <- as.integer(firstline)[1] if (firstline > 1) text <- paste(c(rep("", firstline - 1), text), collapse = "\n") if (is.null(srcfilename)) srcfilename <- "" res <- tryCatch(parse(text = text, srcfile = srcfilecopy(srcfilename, text), encoding = encoding), error = identity) if (inherits(res, "error")) { # Check if this is incomplete code msg <- conditionMessage(res) # Incomplete string if (regexpr(gettext("INCOMPLETE_STRING", domain = "R"), msg) > 0) return(NA) # Incomplete instruction if (regexpr(gettext("end of input", domain = "R"), msg) > 0) return(NA) # This should be incorrect R code # Rework the message a little bit... keep line:col position in front # TODO: from SciViews-K-dev: # This reformats the message as it would appear in the CLI: #errinfo <- # strsplit(sub("(?::)?(\\d+):(\\d+): +([^\n]+)\n([\\s\\S]*)$", # "\\1\n\\2\n\\3\n\\4", msg, perl = TRUE), "\n", fixed = TRUE)[[1]] #errpos <- as.numeric(errinfo[1:2]) #err <- errinfo[-(1:3)] #rx <- sprintf("^%d:", errpos[1]) #errcode <- sub(rx, "", err[grep(rx, err)]) #err <- simpleError(sprintf("%s in \"%s\"", errinfo[3], errcode)) # -or- err <- res err$message <- res <- sub("^<.*>:", "", msg) # Call is from instructions in "text"... but from the corresponding line err$call <- strsplit(text, "\n")[[1]][as.integer( sub("^[^0-9]*([0-9]+):.*$", "\\1", res))] # ... until here... # Return a try-error object to remain compatible with previous versions # TODO: from SciViews-K-dev: #res <- .makeMessage(res) class(res) <- "try-error" attr(res, 'error') <- err } res } # Backward compatibility #' @export #' @rdname parse_text parseText <- parse_text svMisc/R/aka.R0000644000176200001440000001026314614131727012606 0ustar liggesusers#' Create an alias (also known as) for an object whose a short help page and/or original help page can be viewed with .?obj. #' #' @description When a function or object is renamed, the link to its original #' help page is lost in R. Using `aka()` (also known as) with correct `alias=` #' allows to keep track of the original help page and get it with `.?obj`. #' Moreover, one can also populate a short man page with description, seealso and example or add a short comment message that is displayed at the #' same time in the R console. #' #' @param obj An R object. #' @param alias The full qualified name of the alias object whose help #' page should be retained as `pkg::name`. If `NULL` (by default), use `obj`. #' @param comment A comment to place in `obj` (will also be printed when calling #' `.?obj`). #' @param description A description of the function for the sort man page. #' @param seealso A character string of functions in the form `fun` or `pkg::fun`. #' @param example A character string with code for a short example. #' @param url An http or https URL pointing to the help page for the function #' on the Internet. #' #' @return The original `obj` with the `comment` attribute set or replaced with #' `comment =` plus a `src` attribute set to `alias =` and `description`, #' `seealso`, `example`, and `url` attributes also possibly populated. If the #' object is a function, its class becomes **aka** and **function**. #' @export #' #' @examples #' # Say you prefer is.true() similar to is.na() or is.null() #' # but R provides isTRUE(). #' library(svMisc) #' # Also defining a short man page #' is.true <- aka(isTRUE, description = "Check if an object is TRUE.", #' seealso = c("is.false", "logical"), example = c("is.true(TRUE)", "is.true(FALSE)", "is.true(NA)")) #' # This way, you still got access to the right help page for is.true() #' \dontrun{ #' .?is.true #'} aka <- function(obj, alias = NULL, comment = "", description = NULL, seealso = NULL, example = NULL, url = NULL) { if (is.null(alias)) alias <- deparse(substitute(obj)) attr(comment, "src") <- alias if (!is.null(description)) attr(comment, "description") <- as.character(description) if (!is.null(seealso)) attr(comment, "seealso") <- as.character(seealso) if (!is.null(example)) attr(comment, "example") <- as.character(example) if (!is.null(url)) attr(comment, "url") <- url comment(obj) <- comment if (is.function(obj)) class(obj) <- c("aka", "function") obj } # Internal function to cache the type of hyperlink that can be used .hyperlink_type <- function() { if (rlang::is_interactive() && cli::ansi_has_hyperlink_support()) { types <- cli::ansi_hyperlink_types() if (isTRUE(types$help)) { res <- "help" } else if (isTRUE(types$href)) { res <- "href" } else { res <- "none" } } else { res <- "none" } if (is.null(getOption("hyperlink_type"))) options(hyperlink_type = res) res } #' @export #' @rdname aka #' @param x An aka object #' @param hyperlink_type The type of hyperlink supported. The default value #' should be ok. Use `"none"` to suppress hyperlink, `"href"` for http(s):// #' link that opens a web page, or `"help"` in RStudio to open the corresponding #' help page in the Help tab. #' @param ... Further arguments (not used yet) #' @method print aka print.aka <- function(x, hyperlink_type = getOption("hyperlink_type", default = .hyperlink_type()), ...) { src <- attr(comment(x), "src") link <- switch(hyperlink_type, help = { # src must be package::helpage pkg_page <- strsplit(src, "::", fixed = TRUE)[[1]] # Assume package = base if not provided if (length(pkg_page) == 1L) pkg_page <- c("base", pkg_page) cli::style_hyperlink(src, "ide:help", params = c(package = pkg_page[1], topic = pkg_page[2])) }, href = { url <- attr(comment(x), "url") if (is.null(url)) { src } else { cli::style_hyperlink(src, url) } }, src) cat(cli::col_blue("\b = ", link, "()")) invisible(x) } #' @export #' @rdname aka #' @param object An aka object #' @method str aka str.aka <- function(object, ...) { cat("aka ", attr(comment(object), "src"), "()\n", sep = "") } svMisc/R/svMisc-package.R0000644000176200001440000000250114715134714014704 0ustar liggesusers#' Miscellaneous Functions for 'SciViews::R' #' #' The \{svMisc\} package is of general use among SciViews::R, a layer on top of #' R, and the tidyverse. This package collects together a series of general #' functions to manage a centralized environment for temporary variables, a #' progress bar and batch analysis mode, etc. #' #' @section Important functions: #' #' - [temp_env()] for using a temporary environment attached to the search path, #' #' - [temp_var()] create the name of temporary variables, #' #' - [capture_all()] to capture R output, errors, warnings and messages, #' #' - [parse_text()] to parse any R expression, including partial or incorrect #' ones (fails gracefully). ## usethis namespace: start #' @importFrom utils RSiteSearch apropos available.packages browseURL #' capture.output compareVersion file.edit file_test flush.console #' getCRANmirrors getS3method install.packages installed.packages methods #' object.size packageDescription remove.packages str tail write.table ? help #' help.search apropos find txtProgressBar setTxtProgressBar #' @importFrom methods findFunction existsFunction new isGeneric #' showMethods slot slotNames #' @importFrom stats cor fft quantile rnorm runif #' @importFrom tools file_path_as_absolute #' @importFrom rlang is_interactive ## usethis namespace: end "_PACKAGE" svMisc/R/subsettable.R0000644000176200001440000000237014614131727014367 0ustar liggesusers#' Define a function as being 'subsettable' using $ operator #' #' @description In case a textual argument allows for selecting the result, for #' instance, if `plot()` allows for several charts that you can choose with a #' `type=` or `which=`, making the function 'subsettable' also allows to #' indicate `fun$variant()`. See examples. #' @export #' @name subsettable #' @param x A `subsettable_type` function. #' @param name The value to use for the `type=` argument. #' @method $ subsettable_type #' @keywords utilities #' @concept create 'subsettable' functions #' @examples #' foo <- structure(function(x, type = c("histogram", "boxplot"), ...) { #' type <- match.arg(type, c("histogram", "boxplot")) #' switch(type, #' histogram = hist(x, ...), #' boxplot = boxplot(x, ...), #' stop("unknow type") #' ) #' }, class = c("function", "subsettable_type")) #' foo #' #' # This function can be used as usual: #' foo(rnorm(50), type = "histogram") #' # ... but also this way: #' foo$histogram(rnorm(50)) #' foo$boxplot(rnorm(50)) `$.subsettable_type` <- function(x, name) function(...) x(type = name, ...) #' @export #' @rdname subsettable #' @method $ subsettable_which `$.subsettable_which` <- function(x, name) function(...) x(which = name, ...) svMisc/R/capture_all.R0000644000176200001440000002455614614131727014357 0ustar liggesusers#' Run an R expression and capture output and messages in a similar way as it #' would be done at the command line #' #' @description This function captures results of evaluating one or several R #' expressions the same way as it would be issued at the prompt in a R console. #' The result is returned in a character string. Errors, warnings and other #' conditions are treated as usual, including the delayed display of the #' warnings if `options(warn = 0)`. #' #' @param expr A valid R expression to evaluate (names and calls are also #' accepted). #' @param split Do we split output, that is, do we also issue it at the R #' console too, or do we only capture it silently? #' @param echo Do we echo each expression in front of the results (like in the #' console)? In case the expression spans on more than 7 lines, only first and #' last three lines are echoed, separated by `[...]`. #' @param file A file, or a valid opened connection where output is sunk. It #' is closed at the end, and the function returns `NULL` in this case. If #' `file = NULL` (by default), a `textConnection()` captures the output and it #' is returned as a character string by the function. #' @param markStdErr If `TRUE`, stderr is separated from stddout by STX/ETX #' characters. #' @return Returns a string with the result of the evaluation done in the user #' workspace. #' @note If the expression is provided as a character string that should be #' evaluated, and you need a similar behavior as at the prompt for incomplete #' lines of code (that is, to prompt for more), you should not parse the #' expression with `parse(text = "")` because it returns an error #' instead of an indication of an incomplete code line. Use #' `parse_text("")` instead, like in the examples bellow. #' Of course, you have to deal with incomplete line management in your GUI/CLI #' application... the function only returns `NA` instead of a character string. #' Starting from version 1.1.3, `.Traceback` is not set any more in the base #' environment, but it is `.Traceback_capture_all` that is set in `temp_env()`. #' You can get its value with `get_temp(".Traceback_capture_all")`. #' Also, if there are many warnings, those are now assigned in `temp_env()` #' instead of `baseenv()`. Consequently, they cannot be viewer with [warnings()] #' but use `warnings2()` in this case. #' @export #' @seealso [parse()], [expression()], [capture.output()] #' @keywords IO #' @concept capturing output for GUI clients #' @examples #' writeLines(capture_all(expression(1 + 1), split = FALSE)) #' writeLines(capture_all(expression(1 + 1), split = TRUE)) #' writeLines(capture_all(parse_text("search()"), split = FALSE)) #' \dontrun{ #' writeLines(capture_all(parse_text('1:2 + 1:3'), split = FALSE)) #' writeLines(capture_all(parse_text("badname"), split = FALSE)) #' } #' #' # Management of incomplete lines #' capt_res <- capture_all(parse_text("1 +")) # Clearly an incomplete command #' if (is.na(capt_res)) cat("Incomplete line!\n") else writeLines(capt_res) #' rm(capt_res) capture_all <- function(expr, split = TRUE, echo = TRUE, file = NULL, markStdErr = FALSE) { # Inspired by 'capture.output' and the old .try_silent in utils package # Requires: R >= 2.13.0 if (is.null(expr)) stop("argument is of length zero") if (!is.expression(expr)) { if (is.na(expr)) return(NA) else stop("expr must be an expression or NA") } # TODO: support for 'file' # markStdErr: if TRUE, stderr is separated from sddout by STX/ETX character last.warning <- list() Traceback <- list() n_frame_offset <- sys.nframe() + 23L # frame of reference (used in traceback) # + length of the call stack when a condition occurs # Note: if 'expr' is a call, not an expression, 'n_frame_offset' is lower by 2 # (i.e. 24): -1 for lapply, -1 for unwrapping 'expression()' # This may change in course of evaluation, so must be retrieved dynamically get_warn_level <- function() options('warn')[[1L]] ret_val <- NULL conn <- textConnection("ret_val", "w", local = TRUE) split <- isTRUE(split) if (split) { # This is required to print error messages when we are, say, in a # browser() environment sink(stdout(), type = "message") } else { # This is the conventional way to do it sink(conn, type = "message") } sink(conn, type = "output", split = split) #sink(conn, type = "message") on.exit({ sink(type = "message") sink(type = "output") close(conn) }) in_stdout <- TRUE if (isTRUE(markStdErr)) { put_mark <- function(to_stdout, id) { if (in_stdout) { if (!to_stdout) { cat("\x03") in_stdout <<- FALSE } } else {# in StdErr stream if (to_stdout) { cat("\x02") in_stdout <<- TRUE } } #cat("<", id, in_stdout, ">") } } else { put_mark <- function(to_stdout, id) {} } eval_vis <- function(x) { # Do we print the command? (note that it is reformatted here) if (isTRUE(echo)) { # Reformat long commands... and possibly abbreviate them cmd <- deparse(x) l <- length(cmd) if (l > 7) cmd <- c(cmd[1:3], "[...]", cmd[(l - 2):l]) cat(":> ", paste(cmd, collapse = "\n:+ "), "\n", sep = "") } res <- withVisible(eval(x, .GlobalEnv)) # Do we have result to print? if (inherits(res, "list") && res$visible) { # Printing is veeery slow on Windows when split = TRUE # => unsplit temporarily, and print twice instead! #print(res$value) if (split) { sink(type = "message") sink(type = "output") # Print first to the console try(print(res$value), silent = TRUE) sink(conn, type = "message") sink(conn, type = "output", split = FALSE) # Print a second time to the connection try(print(res$value), silent = TRUE) # Resink with split = TRUE sink(type = "message") sink(type = "output") sink(stdout(), type = "message") sink(conn, type = "output", split = TRUE) } else { # This is the conventional way to do it print(res$value) } } res } fomat_message <- function(msg) { # For some reasons, 'Error: ' and 'Error in ' are not translated, # although the rest of the message is correctly translated # This is a workaround for this little problem res <- .makeMessage(msg) res <- sub("^Error: ", ngettext(1, "Error: ", "Error: ", domain = "R"), res) sub("^Error in ", ngettext(1, "Error in ", "Error in ", domain = "R"), res) } restart_error <- function(e, calls) { # Remove call (eval(expr, envir, enclos)) from the message ncls <- length(calls) #DEBUG: cat("n calls: ", ncls, "n_frame_offset: ", n_frame_offset, "\n") if (isTRUE(all.equal(calls[[n_frame_offset]], e$call, check.attributes = FALSE))) e$call <- NULL Traceback <<- rev(calls[-c(seq.int(n_frame_offset), (ncls - 1L):ncls)]) #> cat(captureAll(expression(1:10, log(-1),log(""),1:10)), sep="\n") #Error in calls[[n_frame_offset]]: subscript out of bounds #Warning message: #In log(-1) : NaNs produced put_mark(FALSE, 1) cat(fomat_message(e)) if (get_warn_level() == 0L && length(last.warning) > 0L) cat(ngettext(1, "In addition: ", "In addition: ", domain = "R")) } res <- tryCatch( withRestarts( withCallingHandlers( { # TODO: allow for multiple expressions and calls (like in # 'capture.output'). The problem here is how to tell 'expression' # from 'call' without evaluating it? #list(eval_vis(expr)) lapply(expr, eval_vis) }, error = function(e) invokeRestart("grmbl", e, sys.calls()), warning = function(e) { # Remove call (eval(expr, envir, enclos)) from the message if (isTRUE(all.equal(sys.call(n_frame_offset), e$call, check.attributes = FALSE))) e$call <- NULL last.warning <<- c(last.warning, structure(list(e$call), names = e$message)) if (get_warn_level() != 0L) { put_mark(FALSE, 2) .signalSimpleWarning(conditionMessage(e), conditionCall(e)) put_mark(TRUE, 3) } invokeRestart("muffleWarning") } ), # Restarts: # Handling user interrupts. Currently it works only from within R. #TODO: how to trigger interrupt via socket connection? abort = function(...) { put_mark(FALSE, 4) cat("\n") #DEBUG }, interrupt = function(...) cat("\n"), #DEBUG: this does not seem to be ever called. muffleWarning = function() NULL, grmbl = restart_error ), error = function(e) { # This is called if warnLevel == 2 put_mark(FALSE, 5) cat(fomat_message(e)) e #identity }, finally = {} ) if (get_warn_level() == 0L) { n_warn <- length(last.warning) # was: assign("last.warning", last.warning, envir = baseenv()) assign_temp("last.warning", last.warning) if (n_warn > 0L) put_mark(FALSE, 6) if (n_warn <= 10L) { print.warnings(last.warning) } else if (n_warn < 50L) { # This is buggy and does not retrieve a translation of the message! #cat(gettextf("There were %d warnings (use warnings() to see them)\n", # n_warn, domain = "R")) msg <- ngettext(1, "There were %d warnings (use warnings2() to see them)\n", "There were %d warnings (use warnings2() to see them)\n", domain = "R") cat(sprintf(msg, n_warn)) } else { cat(ngettext(1, "There were 50 or more warnings (use warnings2() to see the first 50)\n", "There were 50 or more warnings (use warnings2() to see the first 50)\n", domain = "R")) } } put_mark(TRUE, 7) sink(type = "message") sink(type = "output") close(conn) on.exit() # Allow for tracebacks of this call stack: assign_temp(".Traceback_capture_all", lapply(Traceback, deparse)) # Make sure last line ends up with \n l <- length(ret_val) if (l) ret_val[l] <- paste(ret_val[l], "\n", sep = "") ret_val } # Backward compatibility #' @export #' @rdname capture_all captureAll <- capture_all #' @export #' @rdname capture_all #' @param ... Items passed directly to `warnings2()`. warnings2 <- function(...) { if (length(last.warning <- get_temp("last.warning"))) structure(last.warning, dots = list(...), class = "warnings") } svMisc/R/rjson.R0000644000176200001440000002640014614131727013205 0ustar liggesusers#' Convert R object to and from RJSON specification #' #' @description RJSON is an object specification that is not unlike JSON, but #' better adapted to represent \R objects (i.e., richer than JSON). It is also #' easier to parse and evaluate in both \R and JavaScript to render the objects #' in both languages. RJSON objects are used by SciViews to exchange data #' between \R and SciViews GUIs like Komodo/SciViews-K. #' #' @param x Any \R object to be converted into RJSON (do not work with objects #' containing C pointers, environments, promises or expressions, but should #' work with almost all other \R objects). #' @param attributes If `FALSE` (by default), a simple object is created by #' ignoring all attributes. This is usually the suitable option to transfer data #' to another language, like JavaScript that do not understand R attributes #' anyway. With `attributes = TRUE`, the complete information about the object #' is written, so that the object could be recreated (almost) identical when #' evaluated in \R (but prefer [save()] and [load()] to transfer objects between #' \R sessions!). #' @param rjson A string containing an object specified in RJSON notation. The #' specification is evaluated in \R... and it can contain also R code. There is #' no protection provided against execution of bad code. So, you must trust the #' source! #' @return For `to_rjson()`, a character string vector with the RJSON #' specification of the argument. #' #' For `eval_rjson()`, the corresponding \R object in case of a pure RJSON #' object specification, or the result of evaluating the code, if it contains \R #' commands (for instance, a RJSONp -RJSON with padding- item where a RJSON #' object is an argument of an \R function that is evaluated. In this case, the #' result of the evaluation is returned). #' #' For `list_to_json()`, correct (standard) JSON code is generated if `x` is a #' list of character strings, or lists. #' @details JSON (JavaScript Object Notation) allows to specify fairly complex #' objects that can be rather easily exchanged between languages. The notation #' is also human-readable and not too difficult to edit manually (although not #' advised, of course). However, JSON has too many limitations to represent \R #' objects (no `NA` versus `NaN`, no infinite numbers, no distinction between #' lists and objects with attributes, or S4 objects, etc.). Moreover, JSON is #' not very easy to interpret in \R and the existing implementations can convert #' only specified objects (simple objects, lists, data frames, ...). #' #' RJSON slightly modifies and enhances JSON to make it: (1) more complete to #' represent almost any \R object (except objects with pointers, environments, #' ..., of course), and (2) to make it very easy to parse and evaluate in both #' \R and JavaScript (and probably many other) languages. #' #' With `attributes = FALSE`, factors and Dates are converted to their usual #' character representation before encoding the RJSON object. If #' `attributes = TRUE`, they are left as numbers and their attributes (class, #' -and levels for factor-) completely characterize them (i.e., using #' `eval_rjson()` and such objects recreate factors or Dates, respectively). #' However, they are probably less easy to handle in JavaScript of other #' language where you import the RJSON representation. #' #' Note also that a series of objects are not yet handled correctly. These #' include: complex numbers, the different date flavors other that Date, #' functions, expressions, environments, pointers. Do not use such items in #' objects that you want to convert to RJSON notation. #' #' A last restriction: you cannot have any special characters like linefeed, #' tabulation, etc. in names. If you want to make your names most compatible #' with JavaScript, note that the dot is not allowed in syntactically valid #' names, but the dollar sign is allowed. #' @export #' @seealso [parse_text()] #' @keywords utilities #' @examples #' # A complex R object #' obj <- structure(list( #' a = as.double(c(1:5, 6)), #' LETTERS, #' c = c(c1 = 4.5, c2 = 7.8, c3 = Inf, c4 = -Inf, NA, c6 = NaN), #' c(TRUE, FALSE, NA), #' e = factor(c("a", "b", "a")), #' f = 'this is a "string" with quote', #' g = matrix(rnorm(4), ncol = 2), #' `h&$@` = data.frame(x = 1:3, y = rnorm(3), #' fact = factor(c("b", "a", "b"))), #' i = Sys.Date(), #' j = list(1:5, y = "another item")), #' comment = "My comment", #' anAttrib = 1:10, #' anotherAttrib = list(TRUE, y = 1:4)) #' #' # Convert to simplest RJSON, without attributes #' rjson1 <- to_rjson(obj) #' rjson1 #' eval_rjson(rjson1) #' #' # More complex RJSON, with attributes #' rjson2 <- to_rjson(obj, TRUE) #' rjson2 #' obj2 <- eval_rjson(rjson2) #' obj2 #' # Numbers near equivalence comparison (note: identical(Robj, Robj2) is FALSE) #' all.equal(obj, obj2) #' #' rm(obj, obj2, rjson1, rjson2) to_rjson <- function(x, attributes = FALSE) { # TODO: complex => character + how to restore complex numbers with # attributes = TRUE? # TODO: check dates, and manage other date formats than Date! # TODO: convert functions, expressions into string, and how to include JS # code? or R code? # TODO: allow for special characters \b, \n, \r, \f, \t, \" in names! # TODO: environment and proto # This is derived from dput() file <- file() on.exit(close(file)) # Martin Maechler suggested 'niceNames' used from R >= 3.5.0 opts <- c("digits17", if (getRversion() >= "3.5") "niceNames", if (isTRUE(attributes)) "showAttributes", "S_compatible") # Non-named list items are not allowed => make sure we give names to these # Also if attributes == FALSE, we use the string representation of factors rework <- function(x, attributes = FALSE) { if (is.list(x) && length(x)) { # Make sure all items have names, and use [[x]] for unnamed items i <- paste("[[", 1:length(x), "]]", sep = "") n <- names(x) if (is.null(n)) { n <- i } else { no_names <- n == "" n[no_names] <- i[no_names] } # Flag names with leading and trailing sequence (unlikely elsewhere) n <- paste0("@&#&&", n, "&&#&@") # Change names of x names(x) <- n # If we don't use attributes, convert factors and Dates to characters if (!isTRUE(attributes)) x <- rapply(x, as.character, classes = c("factor", "Date"), how = "replace") # Do this recursively for (item in names(x)) x[[item]] <- rework(x[[item]], attributes) } else if (!isTRUE(attributes) && inherits(x, c("factor", "Date"))) { x <- as.character(x) } # Process also all attributes if (isTRUE(attributes)) { a <- attributes(x) if (!is.null(a)) { n <- names(x) a$.Names <- NULL a$names <- NULL na <- names(a) if (length(na)) { for (item in na) a[[item]] <- rework(a[[item]], attributes) # Tag attributes names and translate a few special ones specials <- c(".Dim", ".Dimnames", ".Tsp", ".Label") replace <- c("dim", "dimnames", "tsp", "levels") m <- match(na, specials) ok <- (!is.na(m) & m) na[ok] <- replace[m[ok]] names(a) <- paste0("@&#&&", na, "&&#&@") } attributes(x) <- a names(x) <- n } } x } # FIXME eventually: In R 3.5.0, dput() works for S4 objects # Is this an S4 object => process each slot separately if (isS4(x)) { cat('list("Class_" := "', class(x), '"\n', file = file, sep = "") for (n in slotNames(x)) { cat(' , "', n, '" := ', file = file) dput(rework(slot(x, n), attributes), file = file, control = opts) } cat(")\n", file = file) invisible() } else { dput(rework(x, attributes), file = file, control = opts) } # Now read content from the file res <- readLines(file) # dput() indicates sequences of integers with x:y that JavaScript cannot # process... replace these by the equivalent code seq(x, y) res <- gsub("(-?[0-9]+):(-?[0-9]+)", "seq(\\1, \\2)", res) # Convert '.Names = ' into '"names" := ' res <- gsub(".Names = ", '"names" := ', res, fixed = TRUE) # We need to replace special characters # TODO: do so only inside `@&#&&...&&#&@` # TODO: all this does not work!!! # res <- gsub('(`@&#&&.*)\b(.*&&#&@`)', '\\1\\\\b\\2', res) # res <- gsub('(`@&#&&.*)\t(.*&&#&@`)', '\\1\\\\t\\2', res) # res <- gsub('(`@&#&&.*)\n(.*&&#&@`)', '\\1\\\\n\\2', res) # res <- gsub('(`@&#&&.*)\f(.*&&#&@`)', '\\1\\\\f\\2', res) # res <- gsub('(`@&#&&.*)\r(.*&&#&@`)', '\\1\\\\r\\2', res) # res <- gsub('(`@&#&&.*)\"(.*&&#&@`)', '\\1\\\\"\\2', res) #res <- gsub('\t', '\\t', res, fixed = TRUE) #res <- gsub('\n', '\\n', res, fixed = TRUE) #res <- gsub('\f', '\\f', res, fixed = TRUE) #res <- gsub('\r', '\\r', res, fixed = TRUE) #res <- gsub('\"', '\\"', res, fixed = TRUE) # Convert `@&#&& into ", and &&#&@` = into " := res <- gsub('"?`@&#&&', '"', res) res <- gsub('&&#&@`\"? =', '" :=', res) # Convert "@&#&&[[d]]&&#&@" to "" (non-named items) #res <- gsub('"@&#&&\\[\\[[1-9][0-9]*]]&&#&@"', '""', res) res <- gsub('"\\[\\[[1-9][0-9]*]]" :=', '"" :=', res) # Convert "@&#&& into " and &&#&@" into " res <- gsub('"@&#&&', '"', res, fixed = TRUE) res <- gsub('&&#&@"', '"', res, fixed = TRUE) # No unnamed items, so, convert 'structure(' into 'list("Data_" := ' res <- gsub("([^a-zA-Z0-9._])structure\\(", '\\1list("Data_" := ', res) res <- sub("^structure\\(", 'list("Data_" := ', res) # Old code! # Convert 'list(' into 'hash(' #res <- gsub("([^a-zA-Z0-9._])list\\(", "\\1hash(", res) #res <- sub("^list\\(", "hash(", res) # Return the no quoted results noquote(res) } #' @export #' @rdname to_rjson eval_rjson <- function(rjson) { # Our list() manages to create list() but also new() or structure() items list <- function(..., Class_, Data_) { # If there is a "Class_" argument, create new S4 object # Note that "Data_" is ignored in this case! if (!missing(Class_)) return(new(Class_, ...)) # If there is a "_Data_" argument, create a structure if (!missing(Data_)) return(structure(Data_, ...)) # otherwise, create a list base::list(...) } # To convert RJSON data into a R object, simply evaluate it # Note: RJSONp objects will be evaluated correctly too # providing the () exists and can manage a single # argument (being the RJSOn object converted to R) # We need first to convert all '"" := ' into nothing and ':=' into '=' rjson <- gsub('"" := ', "", rjson, fixed = TRUE) rjson <- gsub(":=", "=", rjson, fixed = TRUE) eval(parse(text = rjson)) } #' @export #' @rdname to_rjson list_to_json <- function(x) { # Simple JSON for lists containing character strings if (!is.list(x) && length(x) == 1L) return(encodeString(x, quote = '"')) x <- lapply(x, list_to_json) x <- if (is.list(x) || length(x) > 1L) { nms <- names(x) if (is.null(nms)) { paste0('[', paste(x, collapse = ','), ']') } else { paste0("{", paste( paste0(encodeString(make.unique(nms, sep = '#'), quote = '"'), ":", x), collapse = ","), "}") } } x } # Backward compatibility #' @export #' @rdname to_rjson toRjson <- to_rjson #' @export #' @rdname to_rjson evalRjson <- eval_rjson #' @export #' @rdname to_rjson listToJson <- list_to_json svMisc/R/rbenchmark.R0000644000176200001440000003405514614446763014204 0ustar liggesusers#' R Benchmark 2.6 #' #' This is a benchmark of base R with 15 tests of various common (matrix) #' calculations and programming techniques like loops, vector calculation, #' recursion, etc. #' #' @param runs Number of times each test is run (3 by default). #' @param x A **rbenchmark** object #' @param ... Further arguments (not used yet) #' #' @return An **rbenchmark** object with the timing of all 15 tests. #' @export #' #' @details #' This code is reworked from the R Benchmark 2.5 adapted by Simon Urbanek #' (https://mac.r-project.org/benchmarks/) from my initial implementation , #' itself inspired from Matlab code by Stephan Steinhaus. In comparison to #' version 2.5, this one is included in a function and returns a **rbenchmark** #' objects that prints in a very similar way to the original code. However, #' only functions from base R packages (including \{stats\} and \{utils\}) are #' used, where previous versions also used recommended package \{Matrix\} and #' possibly CRAN package \{SuppDists\}. Expect some slight differences. #' #' Some tests in sections I and II use BLAS/LAPACK code. Their results are #' heavily dependent on the BLAS implementation that you choose. The default R #' BLAS is single-threaded and is rather slow, but it well tested and certified #' to be accurate. Use a good multi-threaded BLAS alternative for much improved #' results (sometimes 10x faster or more), like ATLAS, OpenBLAS, Intel MKL, ... #' See https://cran.r-project.org/web/packages/gcbd/vignettes/gcbd.pdf. Use #' `utils::sessionInfo()` to know which BLAS version R currently uses. #' #' Beside multi-threaded BLAS, all tests are single-threaded. This benchmark #' does not test full parallel potential of R. Also, other key aspects like read #' and write of data on disk of from databases are not tested. As usual, take #' these artificial benchmarks with a grain of salt: it may not represent the #' speed of your actual calculations since it depends mainly on the functions #' you use and on your programming style... #' #' @examples #' \dontrun{ #' # This can be slow #' rbenchmark() #' } rbenchmark <- function(runs = 3L) { if (!is.numeric(runs) || length(runs) != 1 || runs < 1 || runs > 10) stop("runs must be a single integer between 1 and 10") runs <- as.integer(runs) version <- "2.6" times <- rep(0, 15L * runs) dim(times) <- c(15L, runs) colnames(times) <- 1L:runs rownames(times) <- c( "random matrix", "matrix^1000", "sorting", "cross-product", "regression", "fft", "eigenvalues", "determinant", "cholesky", "inverse", "fibonacci", "hilbert", "gcd", "toeplitz", "escoufier" ) options(object.size = 100000000) pb <- txtProgressBar(max = 15L * runs, style = 3) # I. Matrix calculation # (1) random matrix: Creation, transp., deformation of a 2500x2500 matrix for (i in 1L:runs) { setTxtProgressBar(pb, i) a <- 0 b <- 0 invisible(gc()) times[1L, i] <- system.time({ a <- matrix(rnorm(2500 * 2500) / 10, ncol = 2500, nrow = 2500) b <- t(a) dim(b) <- c(1250, 5000) a <- t(b) })[3] } # (2) matrix^1000: 2400x2400 normal distributed random matrix ^1000 for (i in 1L:runs) { setTxtProgressBar(pb, runs + i) a <- abs(matrix(rnorm(2500 * 2500) / 2, ncol = 2500, nrow = 2500)) b <- 0 invisible(gc()) times[2L, i] <- system.time({ b <- a^1000 })[3] } # (3) sorting: Sorting of 7,000,000 random values for (i in 1L:runs) { setTxtProgressBar(pb, 2 * runs + i) a <- rnorm(7000000) b <- 0 invisible(gc()) times[3L, i] <- system.time({ b <- sort(a, method = "quick") # Sort is modified in v. 1.5.x # And there is now a quick method that better suits this test })[3] } # (4) cross-product: 2800x2800 cross-product matrix (b = a' * a) for (i in 1L:runs) { setTxtProgressBar(pb, 3 * runs + i) a <- rnorm(2800 * 2800) dim(a) <- c(2800, 2800) b <- 0 invisible(gc()) times[4L, i] <- system.time({ b <- crossprod(a) # Equivalent to: b <- t(a) %*% a })[3] } # (5) regression: Linear regr. over a 3000x3000 matrix (c = a \\ b') for (i in 1L:runs) { setTxtProgressBar(pb, 4 * runs + i) # Was in version 2.5 #a <- new("dgeMatrix", x = rnorm(2000 * 2000), Dim = as.integer(c(2000, 2000))) a <- rnorm(2000 * 2000) dim(a) <- c(2000, 2000) b <- as.double(1:2000) c <- 0 invisible(gc()) times[5L, i] <- system.time({ c <- solve(crossprod(a), crossprod(a, b)) # Another solution, sometimes slower, sometimes faster #c <- lsfit(a, b, intercept = FALSE)$coef })[3] # This is the old method #a <- rnorm(600 * 600) #dim(a) <- c(600, 600) #b <- 1:600 #invisible(gc()) #times[5L, i] <- system.time({ # qra <- qr(a, tol = 1e-7) # c <- qr.coef(qra, b) #})[3] } # II. Matrix functions # (1) fft: FFT over 2,400,000 random values for (i in 1L:runs) { setTxtProgressBar(pb, 5 * runs + i) a <- rnorm(2400000) b <- 0 invisible(gc()) times[6L, i] <- system.time({ b <- fft(a) })[3] } # (2) eigenvalues: Eigenvalues of a 640x640 random matrix for (i in 1L:runs) { setTxtProgressBar(pb, 6 * runs + i) a <- array(rnorm(600 * 600), dim = c(600, 600)) b <- 0 # Only needed if using eigen.Matrix(): Matrix.class(a) invisible(gc()) times[7L, i] <- system.time({ b <- eigen(a, symmetric = FALSE, only.values = TRUE)$Value # Rem: on my machine, it is faster than: # b <- La.eigen(a, symmetric = FALSE, only.values = TRUE, method = "dsyevr")$Value # b <- La.eigen(a, symmetric = FALSE, only.values = TRUE, method = "dsyev")$Value # b <- eigen.Matrix(a, vectors = FALSE)$Value })[3] } # (3) determinant: Determinant of a 2500x2500 random matrix for (i in 1L:runs) { setTxtProgressBar(pb, 7 * runs + i) a <- rnorm(2500 * 2500) dim(a) <- c(2500, 2500) #Matrix.class(a) b <- 0 invisible(gc()) times[8L, i] <- system.time({ b <- determinant(a, logarithm = FALSE) })[3] } # (4) cholesky: Cholesky decomposition of a 3000x3000 matrix for (i in 1L:runs) { setTxtProgressBar(pb, 8 * runs + i) # Was in version 2.5 #a <- crossprod(new("dgeMatrix", x = rnorm(3000 * 3000), # Dim = as.integer(c(3000, 3000)))) # Matrix must be real symmetric positive-definite square matrix #a <- forceSymmetric(a) a <- runif(3000 * 3000, min = 1, max = 100) dim(a) <- c(3000, 3000) a <- crossprod(a) b <- 0 invisible(gc()) times[9L, i] <- system.time({ b <- chol(a) })[3] } # (5) inverse: Inverse of a 1600x1600 random matrix for (i in 1L:runs) { setTxtProgressBar(pb, 9 * runs + i) # Was in version 2.5 #a <- new("dgeMatrix", x = rnorm(1600 * 1600), # Dim = as.integer(c(1600, 1600))) a <- rnorm(1600 * 1600) dim(a) <- c(1600, 1600) b <- 0 invisible(gc()) times[10L, i] <- system.time({ b <- solve(a) # Rem: faster than #b <- qr.solve(a) })[3] } # III. Programmation # (1) fibonacci: 3,500,000 Fibonacci numbers calculation (vector calc) for (i in 1L:runs) { setTxtProgressBar(pb, 10 * runs + i) a <- floor(runif(3500000) * 1000) b <- 0 phi <- 1.6180339887498949 sqrt5 <- sqrt(5) invisible(gc()) times[11L, i] <- system.time({ b <- (phi^a - (-phi)^(-a)) / sqrt5 })[3] } # (2) hilbert: Creation of a 3000x3000 Hilbert matrix (matrix calc) for (i in 1L:runs) { setTxtProgressBar(pb, 11 * runs + i) a <- 3000 b <- 0 invisible(gc()) times[12L, i] <- system.time({ b <- rep(1:a, a) dim(b) <- c(a, a) b <- 1 / (t(b) + 0:(a - 1)) # Rem: this is twice as fast as the following code proposed by R programmers # a <- 1:a; b <- 1 / outer(a - 1, a, "+") })[3] } # (3) gcd: Grand common divisors of 400,000 pairs (recursion) gcd2 <- function(x, y) { if (sum(y > 1.0E-4) == 0) { x } else { y[y == 0] <- x[y == 0] Recall(y, x %% y) } } for (i in 1L:runs) { setTxtProgressBar(pb, 12 * runs + i) a <- ceiling(runif(400000) * 1000) b <- ceiling(runif(400000) * 1000) c <- 0 invisible(gc()) times[13L, i] <- system.time({ c <- gcd2(a, b) # gcd2() is a recursive function })[3] } # (4) toeplitz: Creation of a 500x500 Toeplitz matrix (loops) for (i in 1L:runs) { setTxtProgressBar(pb, 13 * runs + i) a <- rep(0, 500 * 500) dim(a) <- c(500, 500) invisible(gc()) times[14L, i] <- system.time({ # Rem: there are faster ways to do this # but here we want to time loops (500 * 500 'for' loops)! for (j in 1:500) { for (k in 1:500) { a[k, j] <- abs(j - k) + 1 } } })[3] } # (5) escoufier: Escoufier's method on a 45x45 matrix (mixed) Trace <- function(y) {# Calculate the trace of a matrix (sum of its diagonal elements) sum(diag(y)) } #was: Trace <- function(y) { # sum(c(y)[1 + 0:(min(dim(y)) - 1) * (dim(y)[1] + 1)], na.rm = FALSE) #} for (i in 1L:runs) { setTxtProgressBar(pb, 14 * runs + i) x <- abs(rnorm(45 * 45)) dim(x) <- c(45, 45) p <- 0 vt <- 0 vr <- 0 RV <- 0 vrt <- 0 Rvmax <- 0 x2 <- 0 R <- 0 Rxx <- 0 Rxy <- 0 Ryy <- 0 Ryx <- 0 rvt <- 0 invisible(gc()) times[15L, i] <- system.time({ # Calculation of Escoufier's equivalent vectors p <- ncol(x) vt <- 1:p # Variables to test vr <- NULL # Result: ordered variables RV <- 1:p # Result: correlations vrt <- NULL for (j in 1:p) { # loop on the variable number Rvmax <- 0 for (k in 1:(p - j + 1)) { # loop on the variables x2 <- cbind(x, x[, vr], x[, vt[k]]) R <- cor(x2) # Correlations table Ryy <- R[1:p, 1:p] Rxx <- R[(p + 1):(p + j), (p + 1):(p + j)] Rxy <- R[(p + 1):(p + j), 1:p] Ryx <- t(Rxy) rvt <- Trace(Ryx %*% Rxy) / sqrt(Trace(Ryy %*% Ryy) * Trace(Rxx %*% Rxx)) # RV calculation if (rvt > Rvmax) { Rvmax <- rvt # test of RV vrt <- vt[k] # temporary held variable } } vr[j] <- vrt # Result: variable RV[j] <- Rvmax # Result: correlation vt <- vt[vt != vr[j]] # reidentify variables to test } })[3] } close(pb) structure(times, version = version, class = "rbenchmark") } #' @export #' @rdname rbenchmark print.rbenchmark <- function(x, ...) { version <- attr(x, "version") runs <- ncol(x) timing <- function(x, n, digits = 3L) { if (n == 0) {# Total timing times <- x } else {# Timing of a single test times <- x[n, ] } res <- sum(times) / ncol(x) formatC(res, digits = digits, format = "f", width = 4L + digits, flag = " ") } timing_section <- function(x, n, digits = 3L) { runs <- ncol(x) if (n == 0) {# Total timing start <- 1 end <- 15 } else {# Timing of one of the three sections start <- 1 + (n - 1) * 5 end <- start + 4 } times5tests <- sort(apply(x[start:end, ], 1L, mean)) # We calculate a trimmed mean for all 5 tests (two extremes eliminated) res <- exp(mean(log(times5tests[-c(1, length(times5tests))]))) formatC(res, digits = digits, format = "f", width = 4L + digits, flag = " ") } cat0 <- function(...) { cat(..., sep = "") } cat0("\n R Benchmark ", version, "\n") cat0(" ===============\n") cat0("Number of times each test is run__________________________: ", runs) cat0("\n\n") cat0(" I. Matrix calculation\n") cat0(" ---------------------\n") cat0("Creation, transp., deformation of a 2500x2500 matrix (sec):", timing(x, 1L), "\n") cat0("2400x2400 normal distributed random matrix ^1000____ (sec):", timing(x, 2L), "\n") cat0("Sorting of 7,000,000 random values__________________ (sec):", timing(x, 3L), "\n") cat0("2800x2800 cross-product matrix (b = a' * a)_________ (sec):", timing(x, 4L), "\n") cat0("Linear regr. over a 3000x3000 matrix (c = a \\ b')___ (sec):", timing(x, 5L), "\n") cat0(" --------------------------------------------------\n") cat0(" Trimmed geom. mean (2 extremes eliminated):", timing_section(x, 1L), "\n\n") cat0(" II. Matrix functions\n") cat0(" --------------------\n") cat0("FFT over 2,400,000 random values____________________ (sec):", timing(x, 6L), "\n") cat0("Eigenvalues of a 640x640 random matrix______________ (sec):", timing(x, 7L), "\n") cat0("Determinant of a 2500x2500 random matrix____________ (sec):", timing(x, 8L), "\n") cat0("Cholesky decomposition of a 3000x3000 matrix________ (sec):", timing(x, 9L), "\n") cat0("Inverse of a 1600x1600 random matrix________________ (sec):", timing(x, 10L), "\n") cat0(" --------------------------------------------------\n") cat0(" Trimmed geom. mean (2 extremes eliminated):", timing_section(x, 2L), "\n\n") cat0(" III. Programming\n") cat0(" ----------------\n") cat0("3,500,000 Fibonacci numbers calculation (vector calc)(sec):", timing(x, 11L), "\n") cat0("Creation of a 3000x3000 Hilbert matrix (matrix calc) (sec):", timing(x, 12L), "\n") cat0("Grand common divisors of 400,000 pairs (recursion)__ (sec):", timing(x, 13L), "\n") cat0("Creation of a 500x500 Toeplitz matrix (loops)_______ (sec):", timing(x, 14L), "\n") cat0("Escoufier's method on a 45x45 matrix (mixed)________ (sec):", timing(x, 15L), "\n") cat0(" --------------------------------------------------\n") cat0(" Trimmed geom. mean (2 extremes eliminated):", timing_section(x, 3L), "\n\n") cat0("Total time for all 15 tests_________________________ (sec):", timing(x, 0L), "\n") cat0("Overall mean (sum of I, II and III trimmed means/", runs, ")_ (sec):", timing_section(x, 0L), "\n") #cat0(" --- End of test ---\n\n") invisible(x) } svMisc/R/file_edit.R0000644000176200001440000003341414614425775014012 0ustar liggesusers#' Invoke an external text editor for a file #' #' @description Edit a text file using an external editor. Possibly wait for the #' end of the program and care about creating the file (from a template) if it #' does not exists yet. #' #' @param ... Path to one or more files to edit. #' @param title The title of the editor window (not honored by all editors, #' most external editors only display the file name or path). #' @param editor Editor to use. Either the name of the program, or a string #' containing the command to run, using \%s as replacement tag where to place #' the filename in the command, or a function with 'file', 'title' and 'wait' #' arguments to delegate process of the files. #' @param file.encoding Encoding of the files. If `""` or `native.enc`, the #' files are considered as being already in the right encoding. #' @param template One or more files to use as template if files must be #' created. If `NULL`, an empty file is created. This argument is recycled for #' all files to edit. #' @param replace Force replacement of files if `template=` is not null. #' @param wait Wait for edition to complete. If more than one file is edited, #' the program waits sequentially for each file to be edited in turn (with a #' message in the R console). #' @return The function returns `TRUE` if it was able to edit the files or #' `FALSE` otherwise, invisibly. Encountered errors are reported as warnings. #' @note The default editor program, or the command to run is in the #' `fileEditor` option (use `getOption("fileEditor")` to retrieve it, and #' `options(fileEditor = "")` to change it). Default values are #' determined automatically. #' #' On Unixes, "gedit", "kate" and "vi" are looked for in that order. Note that #' there is a gedit plugin to submit code directly to R: #' . Since, gedit natively supports a lot of #' different syntax highlighting, including R, and is lightweight but feature #' rich, it is recommended as default text editor for `file_edit()` on Unixes. #' #' On MacOS, if the "bbedit" program exists, it is used (it is the command line #' program installed by BBEdit, see , a much #' more capable text editor than the default TextEdit program), otherwise, the #' default text editor used by MacOS is chosen (default usually to TextEdit). #' BBEdit can be configured to highlight and submit R code.It features also #' several tools that makes it a much better choice than TextEdit for #' `file_edit()` on MacOS. Specify "bbedit" to force using it. The default value #' is "textedit", the MacOS default text editor, but on R.app, and with #' `wait = FALSE`, the internal R.app editor is used instead in that case. If #' RStudio is run, and the editor is "textedit", "internal" or "vi", then, the #' RStudio internal editor is used instead. If `wait = TRUE` with an RStudio #' editor, it is enough to switch to another editor to continue. #' #' On Windows, if Notepad++ is installed in its default location, it is used, #' otherwise, the default "notepad" is used in Rterm and the internal editors #' are chosen for Rgui. Notepad++ is a free text editor that is much better #' suited to edit code or text files that the default Windows' notepad #' application, in particular because it can handle various line end types #' (Unix, Mac or Windows) and encodings. It also supports syntax highlighting, #' code completion and much more. So, it is strongly recommended to install it #' (see ) and use it with `file-edit()`. There is #' also a plugin to submit code to R directly from Notepad++: #' . #' #' Of course, you can use your own text editor, just indicate it in the #' `fileEditor` option. Note, however, that you should use only lightweight and #' fast starting programs. Also, for the `wait = TRUE` argument of #' `file_edit()`, you must check that R waits for the editor to be closed #' before further processing code. In some cases, a little command line program #' is used to start a larger application (like for Komodo Edit/IDE), or the #' program delegates to an existing instances and exits immediately, even if the #' file is still edited. Such editors are not recommended at all for #' `file_edit()`. #' #' If you want to use files that are compatibles between all platforms supported #' by R itself, you should think about using ASCII encoding as much as possible #' and the Windows style of line-ending. That way, you ensure that all the #' default editors will handle those files correctly, including the broken #' default editor on Windows, notepad, which does not understand at all MacOS #' or Unix line ending characters! #' @export #' @seealso [system_file()], [file.path()], [file.edit()] #' @keywords utilities #' @concept file edition #' @examples #' \dontrun{ #' # Create a template file in the tempdir... #' template <- tempfile("template", fileext = ".txt") #' cat("Example template file to be used with file_edit()", file = template) #' #' # ... and edit a new file, starting from that template: #' new_file <- tempfile("test", fileext = ".txt") #' file_edit(new_file, template = template, wait = TRUE) #' #' message("Your file contains:") #' readLines(new_file) #' #' # Eliminate both the file and template #' unlink(new_file) #' unlink(template) #' } file_edit <- function(..., title = files, editor = getOption("fileEditor"), file.encoding = "", template = NULL, replace = FALSE, wait = FALSE) { # Rework files, title and template files <- c(...) lf <- length(files) if (!lf) { warning("You must provide at least one file path") return(invisible(FALSE)) } title <- rep(as.character(title), len = lf) if (length(template)) template <- rep(as.character(template), len = lf) # If the file(s) do not exist or must be replaced, # create them (possibly from template) to_replace <- (isTRUE(as.logical(replace)) | !file.exists(files)) if (length(to_replace)) { new_files <- files[to_replace] if (length(template)) template <- template[to_replace] for (i in 1:length(new_files)) { if (!length(template) || !nzchar(template[i])) { file.create(new_files[i]) } else if (file.exists(template[i])) { file.copy(template[i], new_files[i], overwrite = TRUE, copy.mode = FALSE) } else {# Template file not found! warning("Template file '", template[i], '" not found, starting from an empty file') file.create(new_files[i]) } } } files <- normalizePath(files) # Manage file encoding if (nzchar(file.encoding) && file.encoding != "native.enc") { tfile <- file for (i in seq_along(file)) { tfile <- tempfile() con <- file(file[i], encoding = file.encoding) writeLines(readLines(con), tfile) close(con) file[i] <- tfile } } # There are a few shortcuts for editors that need to be expanded if (length(editor) && is.character(editor)) editor <- switch(tolower(editor), textedit = "open -e -n -W \"%s\"", textwrangler = "bbedit --wait --resume \"%s\"", bbedit = "bbedit --wait --resume \"%s\"", editor) # Fallback to "editor", in case no fileEditor is provided if (!length(editor)) { editor <- getOption("editor") } else if (!is_win() && is.character(editor) && !grepl("%s", editor)) { cmd <- paste('which ', '"', editor, '"', sep = "") if (!length(system(cmd, intern = TRUE))) { # Fall back to the default editor (if any) editor <- getOption("editor") } } # If not in interactive mode, or expressly no editor provided # We don't edit! if (!interactive() || !length(editor) || (!is.function(editor) && !nzchar(editor))) { # Do nothing, issue, a warning! warning("Cannot edit files: no editor or not in interactive mode") return(invisible(FALSE)) } # Special cases... where we prefer the internal editor # Note: just change editor a little bit to make sure to avoid internal! wait <- isTRUE(as.logical(wait)) if (is.character(editor) && editor %in% c("notepad", "internal", "vi", "open -e -n -W \"%s\"")) { done <- FALSE # We don't want to depend on rJava, so this code is commented out! # # 1) JGR # if (is_jgr()) { # for (i in 1:lf) # .file_edit_jgr(files[i], title = title[i], wait = wait) # done <- TRUE # 2) Windows Rgui if (is_rgui()) { for (i in 1:lf) .file_edit_rgui(files[i], title = title[i], wait = wait) done <- TRUE # 3) R.app and wait == FALSE (we cannot wait the end of edition using # the internal R.app editor!) } else if (is_aqua() && !wait) { # Note that, here, the editor in use is the one defined in the # R.app preference dialog box! for (i in 1:lf) file.edit(files[i], title = title[i], fileEncoding = "") done <- TRUE # 4) RStudio and wait == FALSE (note that we should use rstudioapi here, # but we don't want to add a dependency to it here... and # .rs.api.navigateToFile should be directly available under RStudio). } else if (is_rstudio()) { for (i in 1:lf) .file_edit_rstudio(files[i], title = title[i], wait = wait) done <- TRUE } if (done) return(invisible(TRUE)) } # In any other case, we use the defined editor if (is.function(editor)) { # Here, we need a special editor function that is able to wait! res <- try(editor(file = file, title = title, wait = wait), silent = TRUE) } else { # Construct the command... if (grepl("%s", editor)) { cmds <- sprintf(editor, files) } else { cmds <- paste('"', editor, '" "', files, '"', sep = "") } if (is_mac()) msg <- "'... Close the editor (Cmd-Q) to continue!" else msg <- "'... Close the editor to continue!" for (i in 1:length(cmds)) { if (wait) message("Editing the file '", basename(files[i]), msg) flush.console() if (is_win()) { res <- try(system(cmds[i], ignore.stdout = TRUE, ignore.stderr = TRUE, wait = wait, minimized = FALSE, invisible = FALSE, show.output.on.console = FALSE), silent = TRUE) } else { res <- try(system(cmds[i], ignore.stdout = TRUE, ignore.stderr = TRUE, wait = wait), silent = TRUE) } if (inherits(res, "try-error")) break } } if (inherits(res, "try-error")) { warning(as.character(res)) # Transform the error into a warning invisible(FALSE) } else invisible(TRUE) } .file_edit_rstudio <- function(file, title = file, wait = FALSE) { # Note that title is not used here! file <- as.character(file) if (length(file) != 1) stop("Only one item for 'file' is accepted") # Check that RStudio is running if (!is_rstudio()) { message(".file_edit_rstudio() cannot be used outside RStudio.\n") return(invisible(NULL)) } # Create a new editor window and open the file in it open_file <- get0(".rs.api.navigateToFile") if (is.null(open_file)) stop("impossible to get .rs.api.navigateToFile() function") editor <- open_file(file) # Do we wait that the file is edited? if (isTRUE(as.logical(wait))) { get_editor_context <- get0(".rs.api.getSourceEditorContext") if (is.null(get_editor_context)) warning("impossible to get editor context... cannot honor wait = TRUE") Sys.sleep(0.5) path <- get_editor_context()$path message("Editing file '", basename(file), "'... Close the editor, or switch to another one to continue!") while (get_editor_context()$path == path) { Sys.sleep(0.3) } } invisible(editor) } # We do not want to depend on rJava -> commented code! # .file_edit_jgr <- function(file, title = file, wait = FALSE) { # file <- as.character(file) # if (length(file) != 1) # stop("Only one item for 'file' is accepted") # title <- as.character(title) # if (length(title) != 1) # stop("Only one item for 'title' is accepted") # # # Check that JGR is running # if (!is_jgr()) { # message(".file_edit_jgr() cannot be used outside JGR.\n") # return(invisible(NULL)) # } # # # Create a new editor window and open the file in it # # Note that, if JGR is loaded, rJava is there too. So .jnew is available! # editor <- rJava::.jnew('org/rosuda/JGR/editor/Editor', as.character(file)[1]) # # Set the title # if (title != file) editor$setTitle(title) # # # Do we wait that the file is edited? # if (isTRUE(as.logical(wait))) { # message("Editing file '", basename(file), # "'... Close the editor to continue!") # while (editor$isVisible()) { # editor$setState(0L) # Make sure it is not iconized # editor$toFront() # Make the editor the frontmost window # Sys.sleep(0.3) # } # } # invisible(editor) # } .file_edit_rgui <- function(file, title = file, wait = FALSE) { # Avoid errors in R CMD check about missing getWindowsHandles() function if (!is_win()) getWindowsHandles <- function(...) NULL file <- as.character(file) if (length(file) != 1) stop("Only one item for 'file' is accepted") title <- as.character(title) if (length(title) != 1) stop("Only one item for 'title' is accepted") # Check if we are in RGui if (!is_rgui()) { message(".file_edit_rgui() cannot be used outside Rgui.\n") return(invisible(NULL)) } # Edit file in an Rgui internal editor and track its existence # if wait == TRUE hdl <- getWindowsHandles() file.edit(file, title = title, editor = "internal", fileEncoding = "") hdl2 <- getWindowsHandles() editor <- hdl2[!hdl2 %in% hdl] # Do we wait that the file is edited? if (isTRUE(as.logical(wait)) && length(editor) == 1) { message("Editing file '", basename(file), "'... Close the editor to continue!") flush.console() while (editor %in% getWindowsHandles(minimized = TRUE)) Sys.sleep(0.3) } invisible(editor) } # Backward compatibility #' @export #' @rdname file_edit fileEdit <- file_edit svMisc/R/cut_quantile.R0000644000176200001440000000262014614131727014545 0ustar liggesusers#' Convert numeric to factor with intervals of equal number of items by using quantiles #' #' @description `cut_quantile()` is like [cut()], but it calculates intervals #' from quantiles such that each interval has approximately the same number of #' items from the original vector. `x` must have both [quantile()] and [cut()] #' methods implemented. #' #' @param x An R object, usually a numeric vector. #' @param breaks A single integer with the number of breaks to use. #' @param labels Labels for the resulting category or `NULL` (by default) to #' construct them automatically like "(a,b]". If `labels = FALSE`, simple #' integer codes are returned instead of factor. #' @param ... Further arguments passed to [cut()]. #' #' @return A [factor()] is returned, unless `labels = FALSE` (in this case, a #' integer vector is obtained). #' @export #' #' @examples #' # Transform a numeric vector into a factor with 5 levels of same item numbers #' vec <- rnorm(20) #' fact <- cut_quantile(vec, breaks = 5) #' fact #' table(fact) cut_quantile <- function(x, breaks, labels = NULL, ...) { stopifnot(is.numeric(x) && length(x) > 1) stopifnot(length(breaks) == 1 && breaks > 0) m <- breaks + 1 cuts <- quantile(x, seq(0, 1, length.out = m), na.rm = TRUE) # Extend range by 0.1% ext <- (cuts[m] - cuts[1]) * 0.0005 cuts[1] <- cuts[1] - ext cuts[m] <- cuts[m] + ext cut(x, breaks = cuts, labels = labels, ...) } svMisc/R/list_methods.R0000644000176200001440000001457014614131727014555 0ustar liggesusers#' List all methods associated with a generic function or a class, or all types #' associated with a method #' #' @description List all S3 and/or S4 methods for a generic function or for a #' class. List all types for a method; types are variants for a given method #' defined in a way it is easy to add other variants dynamically (on the #' contrary to a usual `type =` or `which =` argument, like in [plot.ts()] or #' [plot.lm()], respectively. #' #' @param f The name of the generic function (character string), used only when #' `class = NULL`. #' @param method The method name. #' @param class The name of a class. #' @param S3 If `TRUE`, list of S3 methods. #' @param S4 If `TRUE`, list of S4 methods. #' @param mixed If `TRUE`, S3 and S4 methods are mixed together in a character #' vector, otherwise, S3 and S4 methods are reported separately in a list. #' @param filter A list of methods to consider when listing class methods. Only #' classes in this list that are defined for the class are returned. Store the #' list of methods you want in the options `"svGUI.methods"`. The package #' proposes a reasonable starting point on loading if this option is not defined #' yet. #' @param strict Do we list only types for the class (\code{TRUE}), or all #' possible types, including for inherited objects, and default ones `FALSE`, #' by default)? #' @return For `list_methods()`, if `mixed = TRUE`, a list with components: #' - `S3` The S3 methods for the generic function or the class, or #' `character(0)` if none #' - `S4` The S4 methods for the generic function or the class, or #' `character(0)` if none. #' #' Otherwise, a character vector with the requested methods. #' #' For `list_types()`, a vector with character strings with methods' type names. #' #' @note `list_types()` is only useful for special generic functions with type #' argument like `view`, `copy` or `export`. These functions offer a mechanism #' to easily add custom types, and the present function list them. For S3 #' objects a type is simply a function whose name is : *method*_*type*.*class*. #' So, adding new *type*s for *method* is very easy to implement. #' #' @export #' @seealso [obj_menu()] #' @keywords utilities #' @examples #' # Generic functions #' list_methods("t.test") # S3 #' list_methods("show", mixed = FALSE) # S4 #' list_methods("ls") # None, not a generic function! #' #' # Classes #' # Only the following methods are considered #' getOption("gui.methods") #' list_methods(class = "data.frame") #' list_methods(class = "lm") #' #' # List method types #' list_types("view") # All default view types currently defined #' list_types("view", "data.frame") #' list_types("view", "data.frame", TRUE) # None, except if you defined custom views! list_methods <- function(f = character(), class = NULL, S3 = TRUE, S4 = TRUE, mixed = TRUE, filter = getOption("svGUI.methods")) { # Given a function, if it is generic then return a list of its methods # or given a class name, return all methods for this class if (!inherits(f, "character")) stop("'f' must be a character string!") if (!is.null(class)) { class <- as.character(class)[1] res <- list() # S3 version if (isTRUE(S3)) { s3 <- unclass(methods(class = class)) attr(s3, "info") <- NULL # Do we have to filter the methods? if (!is.null(filter)) s3 <- s3[s3 %in% paste(filter, class, sep = ".")] res$S3 <- sub(paste(".", class, sep = ""), "", s3) } # S4 version if (isTRUE(S4)) { if (is.null(filter)) filter <- character() s4 <- capture.output(showMethods(filter, classes = class, inherited = FALSE, showEmpty = FALSE)) # I need to filter this output to get only function names res$S4 <- sub("^.*\\: +([^ ]+).*$", "\\1", s4[regexpr("Function:", s4) == 1]) } if (isTRUE(mixed)) res <- sort(unique(c(res$S3, res$S4))) return(res) } else {# List all methods for one generic function # Keep only first item if a vector is provided f <- f[1] res <- list() # S3 version if (isTRUE(S3)) { # Does the function exists somewhere? if (length(findFunction(f, where = .GlobalEnv)) > 0) { s3 <- unclass(suppressWarnings(methods(f))) attr(s3, "info") <- NULL # Rework this to match presentation for S4 methods arg <- names(formals(eval(parse(text = paste("getAnywhere(", f, ")", sep = "")))[1]))[1] s3 <- sub(paste("^", f, ".", sep = ""), "", s3) if (length(s3) == 0 || (length(s3) == 1 && s3 == "")) { res$S3 <- character(0) } else { # Check all possible methods in turn, to verify them for (i in 1:length(s3)) if (inherits(try(getS3method(f, s3[i]), silent = TRUE), "try-error")) s3[i] <- "" s3 <- s3[s3 != ""] if (length(s3) == 0) res$S3 <- character(0) else res$S3 <- paste(arg, "=\"", s3, "\"", sep = "") } } else {# Not found res$S3 <- character(0) } } # S4 version if (isTRUE(S4)) { # Is it an S4 generic function? if (isGeneric(f, where = .GlobalEnv)) { s4 <- capture.output(showMethods(f, inherited = FALSE, showEmpty = FALSE)) res$S4 <- s4[-c(1, length(s4))] } else { res$S4 <- character(0) } } if (isTRUE(mixed)) res <- sort(unique(c(res$S3, res$S4))) return(res) } } #' @export #' @rdname list_methods list_types <- function(method, class = "default", strict = FALSE) { # List all custom functions for a method and for a given class # For instance, a custom view is a function as 'view_.class' make_list <- function(method, class) { pat <- paste("^", method, "_([^.]+)\\.", class, "$", sep = "") sub(pat, "\\1", apropos(pat, ignore.case = FALSE, mode = "function")) } method <- as.character(method[1]) class <- as.character(class) types <- make_list(method, class[1]) if (!isTRUE(strict)) { # Also include views for inherited classes if (l <- length(class) > 1) for (i in 2:l) types <- c(types, make_list(method, class[i])) # Also include default views if (class != "default") types <- c(types, make_list(method, "default")) types <- sort(unique(types)) } types } # Backward compatibility #' @export #' @rdname list_methods listMethods <- list_methods #' @export #' @rdname list_methods listTypes <- list_types svMisc/vignettes/0000755000176200001440000000000014715356216013540 5ustar liggesuserssvMisc/vignettes/svMisc.Rmd0000644000176200001440000002307014614413201015434 0ustar liggesusers--- title: "Miscellaneous Functions for 'SciViews::R'" author: "Philippe Grosjean" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 3 fig_caption: yes vignette: > %\VignetteIndexEntry{Miscellaneous Functions for 'SciViews::R'} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(svMisc) ``` The {svMisc} package contains a large collection of functions that are useful in the context of (G)UI (Graphical) User Interface development, and also, of more general usage. Here is a series of functions you should look at. ## Help In R, you access man pages for the various R objects with `help(topic)`, or `?topic`. But, if `topic` is not found, these function do not return a very useful information. For instance, if you want to make a [Kalman filtering](https://doi.org/10.18637/jss.v039.i02) in R, you may be inclined to search for the topic `kalman` ```{r} ?kalman ``` OK, it is suggested to use `??` to search the documentation for `kalman`. However, using `about()` instead immediately produces a more useful result: ```{r} library(svMisc) about("kalman") ``` ... and it also provides a list of potential man pages that could interest you. In case the topic is found, `about()` does the same as `help()` and shows the page (try with `about("log")`, for instance). If you still have not found what you are looking for, you could try to search on the Web by using `search_web()`. You may also be interested by `is_help()` that indicates if an object is associated with a man page, and if it has a running example. ## Packages In R, the use of `library()` to load a **package** is very confusing. Given the number of questions raised about it, one could consider another function to load R packages in memory. `svMisc` proposes `package()`. That function loads one or several R packages as silently as possible and it returns `TRUE` only if **all** the packages are loaded. Otherwise, the list of missing packages is recorded^[The list of missing packages is written in a variable named `.packages_to_install` located in the `SciViews:TempEnv` environment], and one could simply issue `Install()` to install them. This is indeed a semi-automatic installation mechanisms for R packages. The UseR still masters the process, but it is more straightforward. ## Analyses in batch and show progression If you need to perform an analysis in batch mode, you may be happy with `batch()` and `progress()`. The first function runs a function sequentially on all items **allowing for an informative message in case of failure**. Also, `batch()` provides a mechanism to recover from the error, so that following items in the list are also analyzed. Indeed, if you use a simple `for()` loop or `applyXXX()` functions, the execution is stopped at the first error encountered. Imagine 500 items to process, and an error that appears at the second one... it leaves you 498 items unanalyzed! allows to continue to the next item. The example shows a fake batch process of files, which fails randomly. Here is the function to run sequentially: ```{r} fake_process <- function(file) { message("Processing ", file, "...") flush.console() Sys.sleep(0.5) if (runif(1) > 0.7) {# Fail warning("fake_process was unable to process ", file) invisible(FALSE) } else invisible(TRUE) } ``` The key aspect here is that you function, instead of using `stop()` must use `warning()` and return `FALSE`. Otherwise, in case of success, it should return `TRUE`. Then, calling your function on a series of objects is straightforward: ```{r} # Run it in batch mode on ten items batch(paste0("file", 1:10), fake_process) ``` In case an error occurred, the information is recorded i, `.last.batch`: ```{r} .last.batch ``` The `items` and `ok` attributes are also available from that object for further inspection and action. If you run `batch()` in R, you noted also the `progress()`ion message that appeared. Indeed the `progress()` function allows to display such a message, either as a text at the R console, or in a dialog box. There are many different forms, see the man page `?progress`. for instance, here is a progress bar in percent, stopped at 75% () you need to call `progress()` with a value higher than `max.value =` to dismiss it): ```{r} for (i in 0:75) { progress(i, progress.bar = TRUE) # Some process here... } ``` ## Subsettable functions The `$` operator is not applicable on functions. It is not meaningful in that context. Yet, it may be convenient to use it in certain conditions. From the example of `?subsettable`: ```{r} foo <- structure(function(x, type = c("histogram", "boxplot"), ...) { type <- match.arg(type, c("histogram", "boxplot")) switch(type, histogram = hist(x, ...), boxplot = boxplot(x, ...), stop("unknow type") ) }, class = c("function", "subsettable_type")) foo # This function can be used as usual: foo(rnorm(50), type = "histogram") # ... but also this way: foo$histogram(rnorm(50)) foo$boxplot(rnorm(50)) ``` ## Capture and parse R code The `capture.output()` function from the 'utils' package can capture output usually send to the R console, but it does so in an imperfect way. If you want to capture output *exactly* as it would appear at the R console, you could use `capture_all()`: ```{r} captured <- capture_all(parse_text('1:2 + 1:3'), split = FALSE) captured ``` Only the prompt is changed to `:>`. You can use that content, or print it somewhere, for instance: ```{r} writeLines(captured) ``` The `parse_text()` function parse one or more character strings exactly as if they were commands entered at the R prompt: ```{r} parse_text(c("1 + 1", "log(10)")) ``` ... and for an incomplete expression: ```{r} parse_text("log(") ``` The `source_clipboard()` source code directly from the clipboard. All these functions form the basis to simulate an R console in a different context (a console widget in your own GUI). You can combine this with `to_rjson()`/`eval_rjson` to encode and decode R objects on both sides of a pipeline between the R process and your GUI. ## Encode/decode R objects in Rjson Rjson is a version of [JSON](https://www.json.org/json-en.html) that allows to encore and decode rapidly almost all R objects. From the example at `?to_rjson`: ```{r} # A complex R object # Note: we round doubles to 14 digits because precision is lost in the process obj <- structure(list( a = as.double(c(1:5, 6)), LETTERS, c = c(c1 = 4.5, c2 = 7.8, c3 = Inf, c4 = -Inf, NA, c6 = NaN), c(TRUE, FALSE, NA), e = factor(c("a", "b", "a")), f = 'this is a "string" with quote', g = matrix(round(rnorm(4), 14), ncol = 2), `h&$@` = list(x = 1:3, y = round(rnorm(3), 14), fact = factor(c("b", "a", "b"))), i = Sys.Date(), j = list(1:5, y = "another item")), comment = "My comment", anAttrib = 1:10, anotherAttrib = list(TRUE, y = 1:4)) # Convert to RJSON (rjson1 <- to_rjson(obj, attributes = TRUE)) # Get back an R object from Rjson (obj2 <- eval_rjson(rjson1)) # Is it identical to obj? identical(obj, obj2) ``` ## Get system file or directory There are several different functions in R to access system files, or files inside R packages: `R.home()`, `system.file()`, `Sys.which()`, `tempdir()`. The `system_dir()` and `system_file()` functions centralize their functionalities. For instance: - Get the temporary directory used by this R process ```{r} system_dir("temp") ``` - Get the system temporary directory ```{r} system_dir("sysTemp") ``` - Get the home directory of the current user ```{r} system_dir("user") ``` - Get the R home directory ```{r} system_dir("home") ``` - Get the path to an executable ```{r} system_dir("zip", exec = TRUE) ``` - Get the file of that executable ```{r} system_file("zip", exec = TRUE) ``` - Get the root directory of a package ```{r} system_dir(package = "stats") ``` - Get a file from a package ```{r} system_file("help", "AnIndex", package = "splines") ``` There are other possibilities. See `?system_dir`. You may also be interested by `file_edit()` that allows to create and edit a text file from a template. ## Various information functions - `compare_r_version()` conveniently compares the current R version with a specified one. It returns 1 if it is newer, 0, if it is equal and -1 if it is older. ```{r} compare_r_version("5.6.0") # Probably older ``` ```{r} compare_r_version("0.6.0") # Probably newer ``` - Check the environment: ```{r} is_win() # Windows? is_mac() # MacOS? is_rgui() # Is it RGui under Windows? is_sdi() # Is RGui run in SDI mode (separate windows)? is_rstudio() # Is it RStudio? is_rstudio_desktop() # RStudio desktop? is_rstudio_server() # RStudio server? is_jgr() # Is R running under JGR? ``` ## Miscellaneous - Make sure a vector is of a defined mode and length (possibly by applying recycling rule) using `def()`: ```{r} def(0:2, mode = "logical", length.out = 5) # logical, size 5 ``` - Get a nicely formatted `args()` (see `?arg_tips` for other functions to get short textual information about functions): ```{r} args_tip("ls") ``` - Get the name of an (unused) temporary variable: ```{r} temp_var("my_var") ``` - Manage a temporary environment attached to the search path using `TempEnv()` and the `temp_XXX()` functions. The **temporary_environment** vignette gives more details on this series of functions. ```{r} search() # Assign a variable in a temporary environment assign_temp("my_var", 1:5) # The environment is named SciViews:TempEnv search() # Get the variable get_temp("my_var") # List variables in the temporary environment ls(envir = TempEnv()) # Delete the variable rm_temp("my_var") ``` svMisc/vignettes/temporary_environment.Rmd0000644000176200001440000000242014614413255020643 0ustar liggesusers--- title: "Temporary environment" author: "Philippe Grosjean" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 3 fig_caption: yes vignette: > %\VignetteIndexEntry{Temporary environment} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(svMisc) ``` {svMisc} attaches `SciViews:TempEnv` at the fore last position in the search path, so that its content is accessible from any loaded R package (except 'base'). This environment is a convenient place where temporary items that you do not want to see in the global environment, for instance, variables related to GUI (Graphical User Interface) and that are typically a nonsense to `save()` and re`load()` in the global environment. **TODO: show a couple of case where it is useful.** The following functions are available to ease access to these variables: - `temp_env()` get the environment itself, - `assign_temp()`, `add_temp()`, and `change_temp()` place or modify data in the temporary environment, - `rm_temp()` or `delete_temp()` eliminate variables from there, - `exists_temp()` tests for the existence of objects it this environment, - `get_temp()` retrieves objects from there. svMisc/NAMESPACE0000644000176200001440000001002314715134453012740 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",subsettable_type) S3method("$",subsettable_which) S3method(print,aka) S3method(print,objList) S3method(print,rbenchmark) S3method(print,runnable) S3method(print,section) S3method(str,aka) S3method(str,section) export("?") export(Install) export(TempEnv) export(about) export(addActions) export(addIcons) export(addItems) export(addMethods) export(addTemp) export(add_actions) export(add_icons) export(add_items) export(add_methods) export(add_temp) export(aka) export(argsTip) export(args_tip) export(assignTemp) export(assign_temp) export(batch) export(callTip) export(call_tip) export(captureAll) export(capture_all) export(changeTemp) export(change_temp) export(compareRVersion) export(compare_r_version) export(completion) export(cut_quantile) export(def) export(delete_temp) export(descArgs) export(descFun) export(describe_args) export(describe_function) export(evalRjson) export(eval_rjson) export(ex) export(existsTemp) export(exists_temp) export(fileEdit) export(file_edit) export(getTemp) export(get_actions) export(get_section) export(get_temp) export(guiCmd) export(guiExport) export(guiImport) export(guiLoad) export(guiReport) export(guiSave) export(guiSetwd) export(guiSource) export(gui_cmd) export(gui_export) export(gui_import) export(gui_load) export(gui_report) export(gui_save) export(gui_setwd) export(gui_source) export(helpSearchWeb) export(isAqua) export(isHelp) export(isJGR) export(isMac) export(isRgui) export(isSDI) export(isWin) export(is_aqua) export(is_help) export(is_jgr) export(is_mac) export(is_rgui) export(is_rstudio) export(is_rstudio_desktop) export(is_rstudio_server) export(is_sdi) export(is_win) export(listMethods) export(listToJson) export(listTypes) export(list_methods) export(list_to_json) export(list_types) export(objBrowse) export(objClear) export(objDir) export(objInfo) export(objList) export(objMenu) export(objSearch) export(obj_browse) export(obj_clear) export(obj_dir) export(obj_info) export(obj_list) export(obj_menu) export(obj_search) export(package) export(parseText) export(parse_text) export(pcloud) export(pcloud_crypto) export(pkgManDescribe) export(pkgManDetach) export(pkgManGetAvailable) export(pkgManGetInstalled) export(pkgManGetMirrors) export(pkgManInstall) export(pkgManLoad) export(pkgManRemove) export(pkgManSetCRANMirror) export(pkgman_describe) export(pkgman_detach) export(pkgman_get_available) export(pkgman_get_installed) export(pkgman_get_mirrors) export(pkgman_install) export(pkgman_load) export(pkgman_remove) export(pkgman_set_cran_mirror) export(progress) export(rbenchmark) export(rmTemp) export(rm_temp) export(search_web) export(section) export(sourceClipboard) export(source_clipboard) export(systemDir) export(systemFile) export(system_dir) export(system_file) export(temp_env) export(temp_var) export(tempvar) export(toRjson) export(to_rjson) export(warnings2) export(write.objList) importFrom(methods,existsFunction) importFrom(methods,findFunction) importFrom(methods,isGeneric) importFrom(methods,new) importFrom(methods,showMethods) importFrom(methods,slot) importFrom(methods,slotNames) importFrom(rlang,is_interactive) importFrom(stats,cor) importFrom(stats,fft) importFrom(stats,quantile) importFrom(stats,rnorm) importFrom(stats,runif) importFrom(tools,file_path_as_absolute) importFrom(utils,"?") importFrom(utils,RSiteSearch) importFrom(utils,apropos) importFrom(utils,available.packages) importFrom(utils,browseURL) importFrom(utils,capture.output) importFrom(utils,compareVersion) importFrom(utils,file.edit) importFrom(utils,file_test) importFrom(utils,find) importFrom(utils,flush.console) importFrom(utils,getCRANmirrors) importFrom(utils,getS3method) importFrom(utils,help) importFrom(utils,help.search) importFrom(utils,install.packages) importFrom(utils,installed.packages) importFrom(utils,methods) importFrom(utils,object.size) importFrom(utils,packageDescription) importFrom(utils,remove.packages) importFrom(utils,setTxtProgressBar) importFrom(utils,str) importFrom(utils,tail) importFrom(utils,txtProgressBar) importFrom(utils,write.table) svMisc/NEWS.md0000644000176200001440000003110714715356171012630 0ustar liggesusers# svMisc 1.4.3 - New bibentry format for the CITATION file. # svMisc 1.4.2 - The deprecated `methods::getMethods()` function was imported but not used any more. The import is dropped now. # svMisc 1.4.1 - The JGR version of `file_edit()` is not available any more because JGR is not maintained any more and we can eliminate the dependency to {rJava} and a Java installation. # svMisc 1.4.0 - The `aka()` function objects are now **aka** and **function** objects with `print()` and `str()` methods. A new argument `url=` allows to indicate an http(s) URL for the help page of the object. - A function `section()` allows to document different sections in sets of objects. # svMisc 1.3.2 - First implementation of concise help pages for functions aliased with `aka()` (description + seealso + example). # svMisc 1.3.1 - Bug correction: `print.rbenchmark()` was not exported. # svMisc 1.3.0 - Function `._(x, code)` is removed from here to be included into the {svFlow} package where it is more appropriate. - Function `hint()` is renamed `aka()` (also known as) because the name is much more in line with what it does. `alias()` would have been an even better name, but there is already `stats::alias()` and we don't want a conflict on this function. - `rbenchmark()` provides R Benchmark version 2.6 without needing to source external code. - Function `cut_quantile()` like `cut()`, but calculating breaks on quantiles in order to break down the vector into intervals of equal number of items. - Function `hint()` added to attach information to an object (an "alias" to another object that has an help page, or a "comment" information to display about the object). The corresponding information and help page can be displayed with `.?obj`. - Function `._(x, code)` allows to use a concise syntax to pass a left-hand side argument to dot (`.`) into the right-hand side of a pipe operator, even if it does not support the dot itself (like the standard R pipe `|>` in R \>= 4.1). # svMisc 1.2.3 - Several examples set as \dontrun{} because time to run all examples is too long on CRAN. # svMisc 1.2.2 - Link to a JSS paper replaced by the DOI link. # svMisc 1.2.1 - No more assignation (`last.warning`) into base environment: not permitted any more in R \>= 4.1.0. # svMisc 1.2.0 - Two new functions `pcloud()` and `pcloud_crypto()` ease the management of files that are located in a p-Cloud drive (p-Cloud is a cloud storage system). # svMisc 1.1.4 - Minor changes in the documentation to avoid notes in latest devel R CMD check. # svMisc 1.1.3 - `.Traceback` is not set any more in the base environment by `capture_all()` because CRAN policy does not allow it. The variable `.Traceback_capture_all` is set in `temp_env()` instead. It can be retrieved with `get_temp(".Traceback_capture_all")`. # svMisc 1.1.2 - A new argument is added to `completion()`: `name.or.addition=` which determines if the function returns the completion name, completion additions or both. Thanks to @rhuffy. # svMisc 1.1.1 - `News.md` reworked in `R CMD build`-compatible format, and `TODO` reworked as `TODO.md`. - 'pkgdown' site added. # svMisc 1.1.0 - `about()` added and a special version of `?` accepts `.?` as a shortcut to `about()`, but is otherwise, compatible with `utils::?`. - `subsettable` functions for arguments `type =` or `which =` added. # svMisc 1.0.2 - `captureAll()` and `parseText()` were not exported anymore after switching help pages to Roxygen2. Fixed. # svMisc 1.0-1 - This is a minor update to avoid 2 notes on CRAN `R CMD check`. # svMisc 1.0-0 - New, snake_case names of all the functions. Old camelCase functions names are kept for compatibility, e.g., `captureAll()` -\> `capture_all()`. - All documentation converted to Roxygen2 format. - Tests converted to `testthat` format. - `package()` is reworked to record packages it cannot install, and the `Install()` function uses these automatically. # svMisc 0.9-73 \_ New `is_rstudio()`, and `is_rstudio_server()` functions. Also, `file_edit()` detects if RStudio is used and get an internal buffer to edit a file by default in that case. - Vignette added. # svMisc 0.9-72 - `toRjson()` adapted to be compatible with R \>= 3.5.0 (thanks to Martin Maechler). # svMisc 0.9-71 - Switch to Github for development; CI added. - Code added to make 'svUnit' tests compatibles with RStudio and `devtools::test()`. # svMisc 0.9-70 - Deprecated functions `Args()`, `CallTip()`, `clipsource()`, `Complete()`, `CompletePlus()`, `getEnvironment()`, `Parse()`, `r()`, `Sys.tempdir()`, `Sys.userdir()` are now defunct and eliminated from the package. - Function `pkg()` is renamed `package()`. - Reworked code that was using `:::`. # svMisc 0.9-69 - On MacOS \>= 10.7, the package could not load because of a warning (converted into an error) in `.onLoad()`. Solved. (thanks Travis Porco for bug report). - `isHelp()` now uses `find.package()` instead of the deprecated `.find.package()`. # svMisc 0.9-68 - The temporary environment that `TempEnv()` attaches to the search path is now called `'SciViews:TempEnv'` instead of simply `'TempEnv'` to avoid potential conflicts with other packages in CRAN. # svMisc 0.9-67 - Added the `fileEdit()` function. - Reworked `argsTip()` function to eliminate old code (for R \< 2.10). - `parseText()` reported an error instead of `NA` in the case last string is incomplete in R 2.15. # svMisc 0.9-66 - Added function `isJGR()`. - Added batch processing function `batch()`. # svMisc 0.9-65 - Partial argument matching in `completion()`, `progress()` and `rmTemp()` code fixed. - Call to `.Internal(...)` in `captureAll()` eliminated, but need to call `.signalSimpleWarning()` that is not intended for external use anyway. - Call to `.Internal(dput(....))` in `toRjson()` eliminated. # svMisc 0.9-64 - Added `listToJson()` for conversion of lists of character strings into correct JSON format. - Added `pkgManXXX()` functions to run R code for the SciViews package manager. # svMisc 0.9-63 - `progress()` used `\8`, that was treated as octal for R \< 2.14. Changed to `\b` in order to correct this bug. Thanks Duncan Murdoch for pointing me on this. # svMisc 0.9-62 - `captureAll()` now handles user interrupts and allows for `traceback()` afterwards and default value for `split=` now changed to `TRUE`. The `echo =` argument allows for echoing expressions being evaluated, like in the usual R console, but a mechanism allows to abbreviate very long expressions. - `parseText()` is reworked internally and it uses the `srcfile`/`srcref` mechanism introduced in R recently. `firstline =`, `srcfilename =` and `encoding =` arguments are added. - Unit tests added (should run with both 'svUnit' (advised) and 'RUnit'). - A bug in `objList()` is corrected: if the list of objects in the environment is cleared, e.g., by `rm(list = ls())`, the function returned as if nothing was changed with `compare = TRUE`. Now, an attribute `changed =` is set to `TRUE` or `FALSE` to differentiate between "no changes" and "changes towards an empty environment". # svMisc 0.9-61 - Better handling of non syntactically correct names in `objList()`. # svMisc 0.9-60 - A couple of functions are renamed: `Parse()` -\> `parseText()`, `clipsource()` -\> `sourceClipboard()`. Old names are declared deprecated, and will become defunct before version 1.0-0 of the package. - `captureAll()` now returns `NA` in case of incomplete line of code parsed by `parseText()`. It also detects if `expr =` is a valid language expression or is `NA`. - `isMac()` was not working correctly on Mac OS X Leopard and Snow Leopard (bug corrected). - `Sys.userdir()` did not expanded tilde in recent R versions (corrected). - Little change in `def()` arguments: `length.out =` instead of `length =` to use the same name as corresponding argument in `rep()`. Coercion to logical is now done using `as.logical()`... the result may differ from previous implementations. - For `listTypes()`, the convention has changed. Method/type is now separated by an underscore instead as with two dots (like in `view_text.default`). - `Sys.tempdir()` and `Sys.userdir()` are deprecated in favor of the new more general functions `systemFile()` and `systemDir()`. - `r()` is deprecated in favor of `pkg()` (`r()` is not informative enough and more susceptible to be used elsewhere too). - `Args()` is deprecated in favor of `argsTip()` and `CallTip()` is deprecated in favor of `callTip()` (further homogenization of svMisc function names). The new `argsTip()` and `callTip()` functions can reflow the tip to a given width, and `callTip()` can also return a short description of the function as well as the list of available methods if the tip os asked for a generic function. - `Complete()` and `CompletePlus()` are deprecated in favor of a unique `completion()` function. Code of both original functions has been fused and reworked. # svMisc 0.9-59 - RJSON objects now use a customized `list()` function to build lists, but also structures and new S4 objects. - `captureAll()` has now a `split =` argument that allows to output to the R console, while capturing output. - Bug correction in `captureAll()`: call[[1L]] is not subsettable. # svMisc 0.9-58 - Additions of functions `toRjson()` and `evalRjson()` and specification of the RJSON (R-JavaScript Object Notation), an object exchange format not unlike JSON, but richer and more adapted to represent most R objects. # svMisc 0.9-57 - Small changes to `objList()` (now look at objects in their correct environment). - A bug in `descArgs()` with R \>= 2.10 did not allowed to gest arguments description for functions using the `...` argument. Thanks to Diego Zardetto for pointing this bug. # svMisc 0.9-56 - Temporary code to disable `index.search()` in devel R 2.11 in `isHelp()` and `descFun()`. # svMisc 0.9-55 - Implement `descArgs()` using the new help system (`parse_Rd()`), this eliminates the need for the workaround of version 0.9-54 # svMisc 0.9-54 - Cosmetic changes in Rd files to make them compatible with R 2.11 (devel). A part of the example of `CompletePlus()` is eliminated because it raises an error. # svMisc 0.9-53 - `Complete()` now sorts items alphabetically and does not return completions as factor type in the data frame any more. - `CallTip()` does a better work to find current function, i.e., not only after the opening parentheses `(`. - `Args()` now do no place a space anymore between the name of a function and its arguments # svMisc 0.9-52 - `Complete()` now manages cases where code is like `iris[`, `iris[[`, or where last parsed token is empty (in this case, it returns the list of objects loaded in `.GlobalEnv`). # svMisc 0.9-51 - `Complete()` now includes additions from `Complete2()` and `CompletePlus()`. # svMisc 0.9-50 - `CompletePlus()` removes the weird object names ( `.__M__`, ...) which were causing trouble. - `CompletePlus()` handles completions like `a[m`. # svMisc 0.9-49 - `Complete2()` is a temporary new version of `Complete()` for experiments. # svMisc 0.9-48 - `Parse()` does not detect incomplete R code any more, fixed [PhG]. # svMisc 0.9-47 - `objList()`, `print.objectList()` and `write.objList()` reworked [PhG]. # svMisc 0.9-46 - Added `objList()`, `print()` method for 'objList' objects and `write.objList()` [KB]. - Localization complete and French local file done. # svMisc 0.9-45 - Made backward compatible with R 2.6.0 (was R \>= 2.7.0 in previous version). - `captureAll()` is reworked by Kamil Barton [KB]. Debugging code eliminated (data saved in `.GlobalEnv` for debugging). - Error handler added to `captureAll()` - [KB]. # svMisc 0.9-44 - `CompletePlus()` reworked to use man pages instead of .Rd files. - `descFun()` and `descArgs()` added. # svMisc 0.9-43 - `CompletePlus()` created to obtain information on the completion possibilities. # svMisc 0.9-42 - `objList()` did not place each item in a line when result is written in a file. - `objXXX()` functions did not always returned results invisibly. Solved. - `Args()` is more robust against bad `name =` parameter because it now calls `argsAnywhere()` within a `try()`. # svMisc 0.9-41 - `objInfo()` returns also estimated size of objects that are not functions. - `objSearch()` is reworked to return a single string using `sep =` as separator when `sep =` is not `NULL`. # svMisc 0.9-40 - This is the first version distributed on R-forge. It is completely refactored from older versions (on CRAN since 2003) to make it run with SciViews-K and Komodo Edit (Tinn-R is also supported, but not SciViews-R Console any more). svMisc/inst/0000755000176200001440000000000014715356216012505 5ustar liggesuserssvMisc/inst/CITATION0000644000176200001440000000115014715356103013632 0ustar liggesusersbibentry( bibtype = "Misc", header = "To cite SciViews::R in publications, please use", author = c(person("Philippe", "Grosjean", role = c("aut", "cre"), email = "phgrosjean@sciviews.org", comment = c(ORCID = "0000-0002-2694-9471")), person("Guyliann", "Engels", role = "aut", email = "guyliann.engels@umons.ac.be", comment = c(ORCID = "0000-0001-9514-1014"))), title = "SciViews: A Series of Tools for the R Language and Environment", year = "2024", url = "https://sciviews.r-universe.dev/", ) svMisc/inst/po/0000755000176200001440000000000014614131727013117 5ustar liggesuserssvMisc/inst/po/fr/0000755000176200001440000000000014614131727013526 5ustar liggesuserssvMisc/inst/po/fr/LC_MESSAGES/0000755000176200001440000000000014614131727015313 5ustar liggesuserssvMisc/inst/po/fr/LC_MESSAGES/R-svMisc.mo0000644000176200001440000001302514614131727017314 0ustar liggesusers.=$%6 \%}>2 .2O*%AH8^7E$)Nn'29I0`75 . ?8 *x ; /  5) _ -w  + ; " 2 5 + + % 3 (N Hw  5 O8f6+L8OmAc88<2-O}a3>*(i7BB  P7^P9P!6r%X'(/P)<'$-(! & *+"),.# % 'f' must ba a character string!'max.value' must be numeric or NULL!'obj' should inherit from 'character''obj' should inherit from 'list''strip' must be a 'svStripbar' object'type' could be only 'google', 'archive' or 'wiki', currently!'value' must be numeric!'widgets' must be 'menu', 'item', 'sep' or 'space''x' must be character string(s)!<<>>() Apply method <<>>() to the objectAttach Attach an object to the search pathCopy Copy the object to the clipboardCopy (default) Copy this object to the clipboard (default format)Copy <<>> Copy this object to the clipboard in '<<>>' formatData you add in actions must be a named character vectorDetach Detach an object or package from the search pathDetach and unload Detach a package from the search path and unload itEdit Edit an objectExample Run examples for this objectExport... Export data to a fileFix Fix an R objectFunctions Generic functions and methodsHelp Help on an objectIcons map you add must be a named character vectorImport... Import data in RImpossible to create the Object Browser 'path' directory!Load... Load R objectsNames Names of variables contained in the objectPackage info Show detailed information for this packagePrint or show Print or show the content of the objectProgress:Reattach Reattach an object to the search pathRemove Remove (permanently!) one or several objects from memoryReport... Prepare a report for this objectRequire (compact) Compact require one or several R packagesRequire <<>> Require the package <<>>Save as... Save to a fileSet Working dir... Change current R working directorySource... Source R codeStr Compact str() representation of an objectView View the objectView (default) Default view for this objectView <<>> Display a '<<>>' view for this objectmust be a list!onProject-Id-Version: R 2.6.0 Report-Msgid-Bugs-To: bugs@r-project.org POT-Creation-Date: 2009-01-22 15:56 PO-Revision-Date: 2009-01-22 16:33+0100 Last-Translator: Philippe Grosjean Language-Team: French MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n > 1); 'f' doit être une chaîne de caractères !'max.value' doit être numérique ou NULL !'obj' doit être un objet 'character''obj' doit un objet 'list''strip' doit être un objet 'svStripbar''type' ne peut être que 'google', 'archive' ou 'wiki', pour l'instant !'value' doit être numérique !'widgets' doit être 'menu', 'item', 'sep' ou 'space''x' doit une chaîne de caractères, ou un vecteur de chaînes de caractères !<<>>() Appliquer la méthode <<>>() à l'objetAttacher Attacher un objet au chemin de recherche de RCopier Copier l'objet vers le presse-papierCopier (défaut) Copier cet objet vers le presse-papier (format par défaut)Copier @@@type>>> Copier cet objet vers le presse-papierLes données que vous ajoutez dans les actions doivent être des vecteurs de chaînes de caractères nomméesDétacher Détacher un objet ou un package du chemin de rechercheDétacher et décharger Détacher un package du chemin de recherche et le décharger de la mémoireEditer Editer un objet : edit()Exemple Exacuter les exemples pour cet objet : example()Exporter... Exporter des données vers un fichier : export()Réparer Réparer un objet RFonctions Fonctions génériques et méthodesAide Aide sur un objetLe mappage des icônes que vous ajoutez doit être un vecteur de chaînes de caractères nomméesImporter... Importer des données dans R : import()Impossible de créer le répertoire pour lexplorateur d'objetsCharger... Charger des objets R : load()Noms Nom des variables contenues dans l'objet : names()Package info Afficher des informations détaillées sur ce packageVisualiser... Visualiser le contenu de l'objet : print() ou show()Progression :Réattacher Réattacher un objet au chemin de rechercheEffacer Effacer (de manière permanente !) un ou plusieurs objets de la mémoireReporter... Preparer un rapport pour cet objet : report()Requiérir (forme compacte) Requiérir un ou plusieurs packages (forme compacte)Requière le <<>> Requiérir le package <<>>Sauver sous... Sauver dans un fichierChanger le répertoire de travail... Changer le répertoire de travail courant : setwd()Sourcer... Sourcer du code R : source()Str Représentation compacte de l'objet : str()Voir Voir cet objetVoir (défaut) Vue par défaut de l'objetVoir <<>> Afficher une vue '<<>>' pour cet objetdoit être une liste!sursvMisc/inst/doc/0000755000176200001440000000000014715356216013252 5ustar liggesuserssvMisc/inst/doc/svMisc.Rmd0000644000176200001440000002307014614413201015146 0ustar liggesusers--- title: "Miscellaneous Functions for 'SciViews::R'" author: "Philippe Grosjean" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 3 fig_caption: yes vignette: > %\VignetteIndexEntry{Miscellaneous Functions for 'SciViews::R'} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(svMisc) ``` The {svMisc} package contains a large collection of functions that are useful in the context of (G)UI (Graphical) User Interface development, and also, of more general usage. Here is a series of functions you should look at. ## Help In R, you access man pages for the various R objects with `help(topic)`, or `?topic`. But, if `topic` is not found, these function do not return a very useful information. For instance, if you want to make a [Kalman filtering](https://doi.org/10.18637/jss.v039.i02) in R, you may be inclined to search for the topic `kalman` ```{r} ?kalman ``` OK, it is suggested to use `??` to search the documentation for `kalman`. However, using `about()` instead immediately produces a more useful result: ```{r} library(svMisc) about("kalman") ``` ... and it also provides a list of potential man pages that could interest you. In case the topic is found, `about()` does the same as `help()` and shows the page (try with `about("log")`, for instance). If you still have not found what you are looking for, you could try to search on the Web by using `search_web()`. You may also be interested by `is_help()` that indicates if an object is associated with a man page, and if it has a running example. ## Packages In R, the use of `library()` to load a **package** is very confusing. Given the number of questions raised about it, one could consider another function to load R packages in memory. `svMisc` proposes `package()`. That function loads one or several R packages as silently as possible and it returns `TRUE` only if **all** the packages are loaded. Otherwise, the list of missing packages is recorded^[The list of missing packages is written in a variable named `.packages_to_install` located in the `SciViews:TempEnv` environment], and one could simply issue `Install()` to install them. This is indeed a semi-automatic installation mechanisms for R packages. The UseR still masters the process, but it is more straightforward. ## Analyses in batch and show progression If you need to perform an analysis in batch mode, you may be happy with `batch()` and `progress()`. The first function runs a function sequentially on all items **allowing for an informative message in case of failure**. Also, `batch()` provides a mechanism to recover from the error, so that following items in the list are also analyzed. Indeed, if you use a simple `for()` loop or `applyXXX()` functions, the execution is stopped at the first error encountered. Imagine 500 items to process, and an error that appears at the second one... it leaves you 498 items unanalyzed! allows to continue to the next item. The example shows a fake batch process of files, which fails randomly. Here is the function to run sequentially: ```{r} fake_process <- function(file) { message("Processing ", file, "...") flush.console() Sys.sleep(0.5) if (runif(1) > 0.7) {# Fail warning("fake_process was unable to process ", file) invisible(FALSE) } else invisible(TRUE) } ``` The key aspect here is that you function, instead of using `stop()` must use `warning()` and return `FALSE`. Otherwise, in case of success, it should return `TRUE`. Then, calling your function on a series of objects is straightforward: ```{r} # Run it in batch mode on ten items batch(paste0("file", 1:10), fake_process) ``` In case an error occurred, the information is recorded i, `.last.batch`: ```{r} .last.batch ``` The `items` and `ok` attributes are also available from that object for further inspection and action. If you run `batch()` in R, you noted also the `progress()`ion message that appeared. Indeed the `progress()` function allows to display such a message, either as a text at the R console, or in a dialog box. There are many different forms, see the man page `?progress`. for instance, here is a progress bar in percent, stopped at 75% () you need to call `progress()` with a value higher than `max.value =` to dismiss it): ```{r} for (i in 0:75) { progress(i, progress.bar = TRUE) # Some process here... } ``` ## Subsettable functions The `$` operator is not applicable on functions. It is not meaningful in that context. Yet, it may be convenient to use it in certain conditions. From the example of `?subsettable`: ```{r} foo <- structure(function(x, type = c("histogram", "boxplot"), ...) { type <- match.arg(type, c("histogram", "boxplot")) switch(type, histogram = hist(x, ...), boxplot = boxplot(x, ...), stop("unknow type") ) }, class = c("function", "subsettable_type")) foo # This function can be used as usual: foo(rnorm(50), type = "histogram") # ... but also this way: foo$histogram(rnorm(50)) foo$boxplot(rnorm(50)) ``` ## Capture and parse R code The `capture.output()` function from the 'utils' package can capture output usually send to the R console, but it does so in an imperfect way. If you want to capture output *exactly* as it would appear at the R console, you could use `capture_all()`: ```{r} captured <- capture_all(parse_text('1:2 + 1:3'), split = FALSE) captured ``` Only the prompt is changed to `:>`. You can use that content, or print it somewhere, for instance: ```{r} writeLines(captured) ``` The `parse_text()` function parse one or more character strings exactly as if they were commands entered at the R prompt: ```{r} parse_text(c("1 + 1", "log(10)")) ``` ... and for an incomplete expression: ```{r} parse_text("log(") ``` The `source_clipboard()` source code directly from the clipboard. All these functions form the basis to simulate an R console in a different context (a console widget in your own GUI). You can combine this with `to_rjson()`/`eval_rjson` to encode and decode R objects on both sides of a pipeline between the R process and your GUI. ## Encode/decode R objects in Rjson Rjson is a version of [JSON](https://www.json.org/json-en.html) that allows to encore and decode rapidly almost all R objects. From the example at `?to_rjson`: ```{r} # A complex R object # Note: we round doubles to 14 digits because precision is lost in the process obj <- structure(list( a = as.double(c(1:5, 6)), LETTERS, c = c(c1 = 4.5, c2 = 7.8, c3 = Inf, c4 = -Inf, NA, c6 = NaN), c(TRUE, FALSE, NA), e = factor(c("a", "b", "a")), f = 'this is a "string" with quote', g = matrix(round(rnorm(4), 14), ncol = 2), `h&$@` = list(x = 1:3, y = round(rnorm(3), 14), fact = factor(c("b", "a", "b"))), i = Sys.Date(), j = list(1:5, y = "another item")), comment = "My comment", anAttrib = 1:10, anotherAttrib = list(TRUE, y = 1:4)) # Convert to RJSON (rjson1 <- to_rjson(obj, attributes = TRUE)) # Get back an R object from Rjson (obj2 <- eval_rjson(rjson1)) # Is it identical to obj? identical(obj, obj2) ``` ## Get system file or directory There are several different functions in R to access system files, or files inside R packages: `R.home()`, `system.file()`, `Sys.which()`, `tempdir()`. The `system_dir()` and `system_file()` functions centralize their functionalities. For instance: - Get the temporary directory used by this R process ```{r} system_dir("temp") ``` - Get the system temporary directory ```{r} system_dir("sysTemp") ``` - Get the home directory of the current user ```{r} system_dir("user") ``` - Get the R home directory ```{r} system_dir("home") ``` - Get the path to an executable ```{r} system_dir("zip", exec = TRUE) ``` - Get the file of that executable ```{r} system_file("zip", exec = TRUE) ``` - Get the root directory of a package ```{r} system_dir(package = "stats") ``` - Get a file from a package ```{r} system_file("help", "AnIndex", package = "splines") ``` There are other possibilities. See `?system_dir`. You may also be interested by `file_edit()` that allows to create and edit a text file from a template. ## Various information functions - `compare_r_version()` conveniently compares the current R version with a specified one. It returns 1 if it is newer, 0, if it is equal and -1 if it is older. ```{r} compare_r_version("5.6.0") # Probably older ``` ```{r} compare_r_version("0.6.0") # Probably newer ``` - Check the environment: ```{r} is_win() # Windows? is_mac() # MacOS? is_rgui() # Is it RGui under Windows? is_sdi() # Is RGui run in SDI mode (separate windows)? is_rstudio() # Is it RStudio? is_rstudio_desktop() # RStudio desktop? is_rstudio_server() # RStudio server? is_jgr() # Is R running under JGR? ``` ## Miscellaneous - Make sure a vector is of a defined mode and length (possibly by applying recycling rule) using `def()`: ```{r} def(0:2, mode = "logical", length.out = 5) # logical, size 5 ``` - Get a nicely formatted `args()` (see `?arg_tips` for other functions to get short textual information about functions): ```{r} args_tip("ls") ``` - Get the name of an (unused) temporary variable: ```{r} temp_var("my_var") ``` - Manage a temporary environment attached to the search path using `TempEnv()` and the `temp_XXX()` functions. The **temporary_environment** vignette gives more details on this series of functions. ```{r} search() # Assign a variable in a temporary environment assign_temp("my_var", 1:5) # The environment is named SciViews:TempEnv search() # Get the variable get_temp("my_var") # List variables in the temporary environment ls(envir = TempEnv()) # Delete the variable rm_temp("my_var") ``` svMisc/inst/doc/temporary_environment.Rmd0000644000176200001440000000242014614413255020355 0ustar liggesusers--- title: "Temporary environment" author: "Philippe Grosjean" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: toc: true toc_depth: 3 fig_caption: yes vignette: > %\VignetteIndexEntry{Temporary environment} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include=FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(svMisc) ``` {svMisc} attaches `SciViews:TempEnv` at the fore last position in the search path, so that its content is accessible from any loaded R package (except 'base'). This environment is a convenient place where temporary items that you do not want to see in the global environment, for instance, variables related to GUI (Graphical User Interface) and that are typically a nonsense to `save()` and re`load()` in the global environment. **TODO: show a couple of case where it is useful.** The following functions are available to ease access to these variables: - `temp_env()` get the environment itself, - `assign_temp()`, `add_temp()`, and `change_temp()` place or modify data in the temporary environment, - `rm_temp()` or `delete_temp()` eliminate variables from there, - `exists_temp()` tests for the existence of objects it this environment, - `get_temp()` retrieves objects from there. svMisc/inst/doc/temporary_environment.R0000644000176200001440000000023114715356216020037 0ustar liggesusers## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(svMisc) svMisc/inst/doc/svMisc.html0000644000176200001440000027123114715356216015412 0ustar liggesusers Miscellaneous Functions for ‘SciViews::R’

Miscellaneous Functions for ‘SciViews::R’

Philippe Grosjean

2024-11-14

The {svMisc} package contains a large collection of functions that are useful in the context of (G)UI (Graphical) User Interface development, and also, of more general usage. Here is a series of functions you should look at.

Help

In R, you access man pages for the various R objects with help(topic), or ?topic. But, if topic is not found, these function do not return a very useful information. For instance, if you want to make a Kalman filtering in R, you may be inclined to search for the topic kalman

?kalman
#> No documentation for 'kalman' in specified packages and libraries:
#> you could try '??kalman'

OK, it is suggested to use ?? to search the documentation for kalman. However, using about() instead immediately produces a more useful result:

library(svMisc)
about("kalman")
#> 'kalman' not found, do you mean?
#> stats::KalmanForecast, stats::KalmanLike, stats::KalmanRun, stats::KalmanSmooth
#> Searching keyword in all R help pages for ''...
#> Warning in readRDS(d_file): input string 'Demo for presentation at the satRday
#> Neuchâtel, March 2020' cannot be translated from 'ANSI_X3.4-1968' to UTF-8, but
#> is valid UTF-8

… and it also provides a list of potential man pages that could interest you. In case the topic is found, about() does the same as help() and shows the page (try with about("log"), for instance). If you still have not found what you are looking for, you could try to search on the Web by using search_web().

You may also be interested by is_help() that indicates if an object is associated with a man page, and if it has a running example.

Packages

In R, the use of library() to load a package is very confusing. Given the number of questions raised about it, one could consider another function to load R packages in memory. svMisc proposes package(). That function loads one or several R packages as silently as possible and it returns TRUE only if all the packages are loaded. Otherwise, the list of missing packages is recorded1, and one could simply issue Install() to install them. This is indeed a semi-automatic installation mechanisms for R packages. The UseR still masters the process, but it is more straightforward.

Analyses in batch and show progression

If you need to perform an analysis in batch mode, you may be happy with batch() and progress(). The first function runs a function sequentially on all items allowing for an informative message in case of failure. Also, batch() provides a mechanism to recover from the error, so that following items in the list are also analyzed. Indeed, if you use a simple for() loop or applyXXX() functions, the execution is stopped at the first error encountered. Imagine 500 items to process, and an error that appears at the second one… it leaves you 498 items unanalyzed! allows to continue to the next item.

The example shows a fake batch process of files, which fails randomly. Here is the function to run sequentially:

fake_process <- function(file) {
  message("Processing ", file, "...")
  flush.console()
  Sys.sleep(0.5)
  if (runif(1) > 0.7) {# Fail
    warning("fake_process was unable to process ", file)
    invisible(FALSE)
  } else invisible(TRUE)
}

The key aspect here is that you function, instead of using stop() must use warning() and return FALSE. Otherwise, in case of success, it should return TRUE. Then, calling your function on a series of objects is straightforward:

# Run it in batch mode on ten items
batch(paste0("file", 1:10), fake_process)
#> Running the batch process with fake_process...
#> 
#> Progress:  1 on 10  Progress:  2 on 10  Progress:  3 on 10  Progress:  4 on 10  Progress:  5 on 10  Progress:  6 on 10
#> Warning in fun(item, ...): fake_process was unable to process file6
#> 
#> Progress:  7 on 10
#> Warning in fun(item, ...): fake_process was unable to process file7
#> 
#> Progress:  8 on 10  Progress:  9 on 10
#> Warning in fun(item, ...): fake_process was unable to process file9
#> 
#> Progress: 10 on 10                      
#> Processed successfully 7 items on 10 (see .last.batch)

In case an error occurred, the information is recorded i, .last.batch:

.last.batch
#> [1] FALSE
#> attr(,"items")
#>  [1] "file1"  "file2"  "file3"  "file4"  "file5"  "file6"  "file7"  "file8" 
#>  [9] "file9"  "file10"
#> attr(,"ok")
#>  [1]  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE  TRUE FALSE  TRUE

The items and ok attributes are also available from that object for further inspection and action.

If you run batch() in R, you noted also the progress()ion message that appeared. Indeed the progress() function allows to display such a message, either as a text at the R console, or in a dialog box. There are many different forms, see the man page ?progress. for instance, here is a progress bar in percent, stopped at 75% () you need to call progress() with a value higher than max.value = to dismiss it):

for (i in 0:75) {
  progress(i, progress.bar = TRUE)
  # Some process here...
}
#>           0%---------25%---------50%---------75%--------100%
#> Progress: ||||||||||||||||||||||||||||||||||||||

Subsettable functions

The $ operator is not applicable on functions. It is not meaningful in that context. Yet, it may be convenient to use it in certain conditions. From the example of ?subsettable:

foo <- structure(function(x, type = c("histogram", "boxplot"), ...) {
  type <- match.arg(type, c("histogram", "boxplot"))
  switch(type,
    histogram = hist(x, ...),
    boxplot = boxplot(x, ...),
    stop("unknow type")
  )
}, class = c("function", "subsettable_type"))
foo
#> function(x, type = c("histogram", "boxplot"), ...) {
#>   type <- match.arg(type, c("histogram", "boxplot"))
#>   switch(type,
#>     histogram = hist(x, ...),
#>     boxplot = boxplot(x, ...),
#>     stop("unknow type")
#>   )
#> }
#> attr(,"class")
#> [1] "function"         "subsettable_type"

# This function can be used as usual:
foo(rnorm(50), type = "histogram")

# ... but also this way:
foo$histogram(rnorm(50))

foo$boxplot(rnorm(50))

Capture and parse R code

The capture.output() function from the ‘utils’ package can capture output usually send to the R console, but it does so in an imperfect way. If you want to capture output exactly as it would appear at the R console, you could use capture_all():

captured <- capture_all(parse_text('1:2 + 1:3'), split = FALSE)
#> Warning in 1:2 + 1:3: longer object length is not a multiple of shorter object
#> length
captured
#> [1] ":> 1:2 + 1:3" "[1] 2 4 4\n"

Only the prompt is changed to :>. You can use that content, or print it somewhere, for instance:

writeLines(captured)
#> :> 1:2 + 1:3
#> [1] 2 4 4

The parse_text() function parse one or more character strings exactly as if they were commands entered at the R prompt:

parse_text(c("1 + 1", "log(10)"))
#> expression(1 + 1, log(10))

… and for an incomplete expression:

parse_text("log(")
#> [1] NA

The source_clipboard() source code directly from the clipboard. All these functions form the basis to simulate an R console in a different context (a console widget in your own GUI). You can combine this with to_rjson()/eval_rjson to encode and decode R objects on both sides of a pipeline between the R process and your GUI.

Encode/decode R objects in Rjson

Rjson is a version of JSON that allows to encore and decode rapidly almost all R objects. From the example at ?to_rjson:

# A complex R object
# Note: we round doubles to 14 digits because precision is lost in the process
obj <- structure(list(
  a = as.double(c(1:5, 6)),
  LETTERS,
  c = c(c1 = 4.5, c2 = 7.8, c3 = Inf, c4 = -Inf, NA, c6 = NaN),
  c(TRUE, FALSE, NA),
  e = factor(c("a", "b", "a")),
  f = 'this is a "string" with quote',
  g = matrix(round(rnorm(4), 14), ncol = 2),
  `h&$@` = list(x = 1:3, y = round(rnorm(3), 14),
    fact = factor(c("b", "a", "b"))),
  i = Sys.Date(),
  j = list(1:5, y = "another item")),
  comment = "My comment",
  anAttrib = 1:10,
  anotherAttrib = list(TRUE, y = 1:4))

# Convert to RJSON
(rjson1 <- to_rjson(obj, attributes = TRUE))
#>  [1] list("Data_" := list("a" := c(1., 2., 3., 4., 5., 6.), "" := c("A",                                                                    
#>  [2] "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N",                                                                       
#>  [3] "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"),                                                                           
#>  [4]     "c" := c(c1 = 4.5, c2 = 7.8, c3 = Inf, c4 = -Inf,                                                                                  
#>  [5]     NA, c6 = NaN), "" := c(TRUE, FALSE, NA), "e" := list("Data_" := c(1,                                                               
#>  [6]     2, 1), "levels" := c("a", "b"), "class" := "factor"),                                                                              
#>  [7]     "f" := "this is a \\"string\\" with quote", "g" := list("Data_" := c(-0.9445239738966,                                             
#>  [8]     -0.87375993471215, 1.25204297144855, 0.10258080879307), "dim" := c(2,                                                              
#>  [9]     2)), "h&$@" := list("x" := seq(1, 3), "y" := c(-2.1200101987277,                                                                   
#> [10]     2.79409656471637, -0.42651350000428), "fact" := list("Data_" := c(2,                                                               
#> [11]     1, 2), "levels" := c("a", "b"), "class" := "factor")),                                                                             
#> [12]     "i" := list("Data_" := 20041., "class" := "Date"),                                                                                 
#> [13]     "j" := list("" := seq(1, 5), "y" := "another item")), "comment" := "My comment", "anAttrib" := seq(1, 10), "anotherAttrib" := list(
#> [14]     "" := TRUE, "y" := seq(1, 4)))
# Get back an R object from Rjson
(obj2 <- eval_rjson(rjson1))
#> $a
#> [1] 1 2 3 4 5 6
#> 
#> [[2]]
#>  [1] "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S"
#> [20] "T" "U" "V" "W" "X" "Y" "Z"
#> 
#> $c
#>   c1   c2   c3   c4        c6 
#>  4.5  7.8  Inf -Inf   NA  NaN 
#> 
#> [[4]]
#> [1]  TRUE FALSE    NA
#> 
#> $e
#> [1] a b a
#> Levels: a b
#> 
#> $f
#> [1] "this is a \"string\" with quote"
#> 
#> $g
#>            [,1]      [,2]
#> [1,] -0.9445240 1.2520430
#> [2,] -0.8737599 0.1025808
#> 
#> $`h&$@`
#> $`h&$@`$x
#> [1] 1 2 3
#> 
#> $`h&$@`$y
#> [1] -2.1200102  2.7940966 -0.4265135
#> 
#> $`h&$@`$fact
#> [1] b a b
#> Levels: a b
#> 
#> 
#> $i
#> [1] "2024-11-14"
#> 
#> $j
#> $j[[1]]
#> [1] 1 2 3 4 5
#> 
#> $j$y
#> [1] "another item"
#> 
#> 
#> attr(,"anAttrib")
#>  [1]  1  2  3  4  5  6  7  8  9 10
#> attr(,"anotherAttrib")
#> attr(,"anotherAttrib")[[1]]
#> [1] TRUE
#> 
#> attr(,"anotherAttrib")$y
#> [1] 1 2 3 4
# Is it identical to obj?
identical(obj, obj2)
#> [1] TRUE

Get system file or directory

There are several different functions in R to access system files, or files inside R packages: R.home(), system.file(), Sys.which(), tempdir(). The system_dir() and system_file() functions centralize their functionalities. For instance:

  • Get the temporary directory used by this R process
system_dir("temp")
#> [1] "/var/folders/vt/m9y9ytzj2wd894mq16b_vndr0000gn/T//Rtmph4kqgJ"
  • Get the system temporary directory
system_dir("sysTemp")
#> [1] "/tmp"
  • Get the home directory of the current user
system_dir("user")
#> [1] "/Users/phgrosjean"
  • Get the R home directory
system_dir("home")
#> [1] "/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources"
  • Get the path to an executable
system_dir("zip", exec = TRUE)
#> [1] "/usr/bin"
  • Get the file of that executable
system_file("zip", exec = TRUE)
#> [1] "/usr/bin/zip"
  • Get the root directory of a package
system_dir(package = "stats")
#> [1] "/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/stats"
  • Get a file from a package
system_file("help", "AnIndex", package = "splines")
#> [1] "/Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library/splines/help/AnIndex"

There are other possibilities. See ?system_dir. You may also be interested by file_edit() that allows to create and edit a text file from a template.

Various information functions

  • compare_r_version() conveniently compares the current R version with a specified one. It returns 1 if it is newer, 0, if it is equal and -1 if it is older.
compare_r_version("5.6.0") # Probably older
#> [1] -1
compare_r_version("0.6.0") # Probably newer
#> [1] 1
  • Check the environment:
is_win() # Windows?
#> [1] FALSE
is_mac() # MacOS?
#> [1] TRUE
is_rgui() # Is it RGui under Windows?
#> [1] FALSE
is_sdi() # Is RGui run in SDI mode (separate windows)?
#> [1] FALSE
is_rstudio() # Is it RStudio?
#> [1] FALSE
is_rstudio_desktop() # RStudio desktop?
#> [1] FALSE
is_rstudio_server() # RStudio server?
#> [1] FALSE
is_jgr() # Is R running under JGR?
#> [1] FALSE

Miscellaneous

  • Make sure a vector is of a defined mode and length (possibly by applying recycling rule) using def():
def(0:2, mode = "logical", length.out = 5) # logical, size 5
#> [1] FALSE  TRUE  TRUE FALSE  TRUE
  • Get a nicely formatted args() (see ?arg_tips for other functions to get short textual information about functions):
args_tip("ls")
#> [1] "ls(name, pos = -1L, envir = as.environment(pos), all.names = FALSE, pattern,\n    sorted = TRUE)"
  • Get the name of an (unused) temporary variable:
temp_var("my_var")
#> [1] "my_var25198"
  • Manage a temporary environment attached to the search path using TempEnv() and the temp_XXX() functions. The temporary_environment vignette gives more details on this series of functions.
search()
#>  [1] ".GlobalEnv"        "package:svMisc"    "package:stats"    
#>  [4] "package:graphics"  "package:grDevices" "package:utils"    
#>  [7] "package:datasets"  "package:methods"   "SciViews:TempEnv" 
#> [10] "Autoloads"         "package:base"
# Assign a variable in a temporary environment
assign_temp("my_var", 1:5)
# The environment is named SciViews:TempEnv
search()
#>  [1] ".GlobalEnv"        "package:svMisc"    "package:stats"    
#>  [4] "package:graphics"  "package:grDevices" "package:utils"    
#>  [7] "package:datasets"  "package:methods"   "SciViews:TempEnv" 
#> [10] "Autoloads"         "package:base"
# Get the variable
get_temp("my_var")
#> [1] 1 2 3 4 5
# List variables in the temporary environment
ls(envir = TempEnv())
#> [1] "my_var"
# Delete the variable
rm_temp("my_var")

  1. The list of missing packages is written in a variable named .packages_to_install located in the SciViews:TempEnv environment↩︎

svMisc/inst/doc/svMisc.R0000644000176200001440000001177714715356216014656 0ustar liggesusers## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(svMisc) ## ----------------------------------------------------------------------------- ?kalman ## ----------------------------------------------------------------------------- library(svMisc) about("kalman") ## ----------------------------------------------------------------------------- fake_process <- function(file) { message("Processing ", file, "...") flush.console() Sys.sleep(0.5) if (runif(1) > 0.7) {# Fail warning("fake_process was unable to process ", file) invisible(FALSE) } else invisible(TRUE) } ## ----------------------------------------------------------------------------- # Run it in batch mode on ten items batch(paste0("file", 1:10), fake_process) ## ----------------------------------------------------------------------------- .last.batch ## ----------------------------------------------------------------------------- for (i in 0:75) { progress(i, progress.bar = TRUE) # Some process here... } ## ----------------------------------------------------------------------------- foo <- structure(function(x, type = c("histogram", "boxplot"), ...) { type <- match.arg(type, c("histogram", "boxplot")) switch(type, histogram = hist(x, ...), boxplot = boxplot(x, ...), stop("unknow type") ) }, class = c("function", "subsettable_type")) foo # This function can be used as usual: foo(rnorm(50), type = "histogram") # ... but also this way: foo$histogram(rnorm(50)) foo$boxplot(rnorm(50)) ## ----------------------------------------------------------------------------- captured <- capture_all(parse_text('1:2 + 1:3'), split = FALSE) captured ## ----------------------------------------------------------------------------- writeLines(captured) ## ----------------------------------------------------------------------------- parse_text(c("1 + 1", "log(10)")) ## ----------------------------------------------------------------------------- parse_text("log(") ## ----------------------------------------------------------------------------- # A complex R object # Note: we round doubles to 14 digits because precision is lost in the process obj <- structure(list( a = as.double(c(1:5, 6)), LETTERS, c = c(c1 = 4.5, c2 = 7.8, c3 = Inf, c4 = -Inf, NA, c6 = NaN), c(TRUE, FALSE, NA), e = factor(c("a", "b", "a")), f = 'this is a "string" with quote', g = matrix(round(rnorm(4), 14), ncol = 2), `h&$@` = list(x = 1:3, y = round(rnorm(3), 14), fact = factor(c("b", "a", "b"))), i = Sys.Date(), j = list(1:5, y = "another item")), comment = "My comment", anAttrib = 1:10, anotherAttrib = list(TRUE, y = 1:4)) # Convert to RJSON (rjson1 <- to_rjson(obj, attributes = TRUE)) # Get back an R object from Rjson (obj2 <- eval_rjson(rjson1)) # Is it identical to obj? identical(obj, obj2) ## ----------------------------------------------------------------------------- system_dir("temp") ## ----------------------------------------------------------------------------- system_dir("sysTemp") ## ----------------------------------------------------------------------------- system_dir("user") ## ----------------------------------------------------------------------------- system_dir("home") ## ----------------------------------------------------------------------------- system_dir("zip", exec = TRUE) ## ----------------------------------------------------------------------------- system_file("zip", exec = TRUE) ## ----------------------------------------------------------------------------- system_dir(package = "stats") ## ----------------------------------------------------------------------------- system_file("help", "AnIndex", package = "splines") ## ----------------------------------------------------------------------------- compare_r_version("5.6.0") # Probably older ## ----------------------------------------------------------------------------- compare_r_version("0.6.0") # Probably newer ## ----------------------------------------------------------------------------- is_win() # Windows? is_mac() # MacOS? is_rgui() # Is it RGui under Windows? is_sdi() # Is RGui run in SDI mode (separate windows)? is_rstudio() # Is it RStudio? is_rstudio_desktop() # RStudio desktop? is_rstudio_server() # RStudio server? is_jgr() # Is R running under JGR? ## ----------------------------------------------------------------------------- def(0:2, mode = "logical", length.out = 5) # logical, size 5 ## ----------------------------------------------------------------------------- args_tip("ls") ## ----------------------------------------------------------------------------- temp_var("my_var") ## ----------------------------------------------------------------------------- search() # Assign a variable in a temporary environment assign_temp("my_var", 1:5) # The environment is named SciViews:TempEnv search() # Get the variable get_temp("my_var") # List variables in the temporary environment ls(envir = TempEnv()) # Delete the variable rm_temp("my_var") svMisc/inst/doc/temporary_environment.html0000644000176200001440000001351014715356216020606 0ustar liggesusers Temporary environment

Temporary environment

Philippe Grosjean

2024-11-14

{svMisc} attaches SciViews:TempEnv at the fore last position in the search path, so that its content is accessible from any loaded R package (except ‘base’). This environment is a convenient place where temporary items that you do not want to see in the global environment, for instance, variables related to GUI (Graphical User Interface) and that are typically a nonsense to save() and reload() in the global environment.

TODO: show a couple of case where it is useful.

The following functions are available to ease access to these variables:

  • temp_env() get the environment itself,
  • assign_temp(), add_temp(), and change_temp() place or modify data in the temporary environment,
  • rm_temp() or delete_temp() eliminate variables from there,
  • exists_temp() tests for the existence of objects it this environment,
  • get_temp() retrieves objects from there.
svMisc/inst/figures/0000755000176200001440000000000014614131727014145 5ustar liggesuserssvMisc/inst/figures/svMisc.png0000644000176200001440000013617014614131727016127 0ustar liggesusersPNG  IHDR `x?IDATx|WׇO݅$ݵ@R+5ߺ-R(^]͹a&;܇%3#wv̹rvww@|b/\އz| qA_Ȯ~ݓu,yh}]{x rym;Fqu^N/D..3{>EuwvCŸ1PW0pr!> BengG.(iKtwru!@1RD_ zA*]H;tH.+aK^CaNuѾ4F1g6yb}!wkJlm$u,{o X&~qO/Dcme]",ݭ)_il0+/.&?w9]eWtut~rh=buCQf]"]^-Lo+B#̣*l]ʆڼjuYǭυ_)6*s7=j?W _fKY(ډ?Pe)nV6%2E.dvf ֦]m -w>ŝ1x_W[i,w?,8GBYB e17ήc^8J]HVUK;N:X8J]w#\_]9J?Zzջbö2bAH:*O y"nV U>ٚZ+Ʈň?/x* JՅ] ^P}c8yuW'BU%2|UޟȺ+__ި#v $<*UʠhiŨe#}u!| [Ve[K[1N^.F<330;pRy߈\L_P1b/.ѻ.+c+Mx1_Z;zus-ؙ(honeH]:c g%ԭ' h/g.,%]`li*53lWhUU@>l[:Qp'LwOG~u}.1&?/R^.HtA75Go-)u_m{P0Crۣ%=Zһ>ύ|h򧲶W Y Sobw Y fOUz%^'&䝉s; XTQv (xWp4\ QfLmL!h]FW!nqwz6RUֺ/ƥí'^еQKAZ] ygs|&hVL>nb7.#ipZLaຸoAx"H`ml)S* >O[g{')u>t{h,Fb+ͮ/ek޲\nk2η?_5Q!r.D_͸^7=>WqQB.~~ ZWT86lfl:,oF X[)/^P{}JŤQB/% JlL1Hn@ǍՅ( /%^Z`2A=QBk<~TueB'Yr wظ /D.x@v1 YuǗBILli ~ȼ rߙJgDζi I>nwsjzc ӥ=nV&O$nNf$v027uL*h)Vշ/cΏ*)-V!9_Be.&xdq"Dw]8A3Zчhk*ْKP1{$J]4C7/jhr %Cx:KpRy: \ȿƬU% 1`T Beign06W}ۚc. (}! Սl;_=b^9TER"vs*EbmUQb!h#ղU!^DCzifXr<6k 9578t̻2'p28kR7>r|G"f e}>;~<8{J!ք}}O+"CGW'|sycg( Ldzγ>̛ae~ _IᏑWSR(}N^.ʑd'Jټm='[AlѪB:-Ebym!kIB[DA>CD{r\>ljtʓ ԋƦG@-sJ;_/:-]mþwx WDEb_/u!ؒ-jȮʨ$IVvXIL`˷2#EQO/<3/Z#VKPsp1G^&q{a'/\ʰeO_ JzӓIY^lI[㡳w}ŶGy 8);:?n 殖dШֆ߳ey.SY(|+UYEb}9F~Jaτº!KGlw)?+8/cݝ.rA#Aߐ}WRQr|H[_=l7.O*kj?>NWUY$xf|nʭ(/ucK'6(~ݝ8yd81fq6Qǭ\[ 3PZwHs uW HlMkl{=6{]Tz9?Z@Īѿh.g37DpCQ=d $ZR_\c;Ҿ#^.M]M3QNa cp5VݐJo,~sD1"6,FlSΚDiZYT!zp= !?{7Gwl/߻[9e~/n=r GuWa6ؘU?hr&֦7+PmvɎ|i՗鍕3ŗ߷w]zZk{.rCvެc }J}C[r} 7U)`q9g80+k=5FPDA(KQ])ZyQXW?^C}ńD"J Fsm=*ߐ}LJߖImؠ A4wh2I[㠳0&Y-9|(@b1 iN˻1A]̌Lᡑ[Uڈ|LuNDrϤڱҾ5U~t6"B!"DCuE?̳>wڤ#qCYd_cYa3N83-# }VΑh]CqPcd@b^T7D7f[8L9,ݔoґE6|t/Y^H,9oNhU!7XQڛSOg++k/7deHbNo:ı`ў#xdP;qzC䙼sSCxxj.O)X'灛3tWo4ׁr)ƇX0?x*קr+1wٝrs "ڏdT6ED}%E Pl"(U*ueD Z, Ɣ"^KY(MJm?x0]!/.F*`zC Y @>w$Ekx2"ĕ( 7OXpXFAE5u,8)6-Mc i: u'I( 7ăPR'u1$iZm đ8"\H,e qJHmK7.bY^)GF &}U92SL",Ae(| ×ך"vu*P H˃ju7Qvpi.(Mi򆈣뇋ל4P^I$=a?7Kls& LR?ZCkK*ZnV5ne㪒2?.,D437DPDL1u dt憌}G~◲}'H>)637Ֆ']ѕ!2swup雞b!tRmDϦ_.}UV)=_*9F6gC>!8=vᅼ>ª2%fّ=lvwC`DYJq:я!|\)ތv0Fh,eϯr2e +KGKˀ檾CZы}(733BH{O%7DU/}ﯴ'i7rQ=9oh_uf֟>yȉ'7W3063PE^;ϥi3Nzi Zu"4ehl{*XSsLzaIo~c!bXm4$"ܳɐoR!pyg.V6s#Yݽ5V~[K$Z?Tp[Oo =XCK}Qğܓ!m_p1]=Ŏyd1b'|u0<3k_FS)-l]+9ĿO ٟV?QYU;/)R)қV;ṈX9U;(zZ%n=ejsjȫH|`hX7;s"|?rCIcy}2'&5INPP %7d~ohfT;ꞇz#^nEMT$BP\Kɮ}μR1445j^$jsN|dUPxY"T/:)џg=Om^z!I"4e=-UMu8:ew8>5!->[)6XzOe*gB* ޸(~Yǒ>sK!lCk]mfȵcgu`?#l? YƖtnЪgG8ɑĿO疶wu.3Y/DZVq>3mL#fhCgnHuo䅮QޗDRl=Y }^N??OyR!ހ陬'/CE"O eL:lZQn7.Sv7<8rOc}8C },)R !^OFfF7;LMz?#*]9Fb7טސO|^n}.@~kMfK`m1ZwCgwqbⰑenYRo}z"r-ZsCZ {Cj-xMUI~p4u,e!ޘ.ef[<7D7+,&NH'ݏnBmx zCY0&]*4ɰ|0 Z|TA_%$,(Opݣ=IJ ]}[;Mƌ9o}z^3"Y'sso`n,֍^ F//bMԱI0!r%̧rS~*;+=i t3 7d/.<Ҿc'TQg} ̍oa,ޘCX =>PV]xŗu&X )O*83wS3`u4\|V~T!;pV6s';NfsR{(7Df=U_cooԴַH4pW*[V_LY+[20 2foH+~aOҾDsG_*m 7N1$%ly5Ì{nq̔:`!^Of7#@.BGė~'X1"D˅OIf7>@0L*MA5m.$mzC\;t )KBg-qn5äAcY6)I sC6㮹CSp@#j?gV0E5xco~pϤ#{oN͙K cOML3䣹CWPV`;%a ݌'!Si0Pyu.yE0);IF©cmM.9o,7VAqCmM].y5Vi ΤCr"RI9 CgzCT GnxQ0=ShZ?]E-z>*I܆x\JL)YPT2pvCEKWIpe#\BHB<.g&PUԇBsGQ̙s };yJ<4(˫Ã#_) R"NVU>{i|O]6ܔmnN`/5K;&OFiTAz%ozlA&17b \KŚ4KɻN\)|O:k8IqAWzlI2.)>{y톰){J5řܫ0Gi?ӧNFqevoGxH!O(`=dcx!XbsC7Wh,bBٛ䏘4uO4Z b4yJ೫V!cuU+ CK>T u|yw^I!XM}Ͱ`s.NO=9oIu3jV0!u8ۂ47+ޘg|"])4-끑t5(BI\ȗ:FI*c"oMqc'Դ^5$;Ͱ'S͵ե*h AX#qejYq%VȆ ZsC.%c,d( 府٦Tܼ(:\\57e99ƪz`ˤ+&JZuCWttKWc<~kG Qp5qKC͎fc_Bi︌ ZxCh s{C =F%UM)D|i QsyHR csgmkS.BvfZ~c;XUo>wY8cu*r)t \6ď)8.:sCQP#Fq⍡g4ԃǗֺuc Jߎ'Ԛ? ^o?Ä[ fH'^~78Gns7%~>jgKK|&\½`؝a:HT Y6'%}Cx@7뿫%]v] y}>;~JÇ=ʷw]M+M왟ҙ;J('T IݓDEf5q$q$y$LnMigjӣwmR:y t%:5UփOuN\y( f*WbKCad}> /}ߕ%Z>Tx+)pV$IȹOASE=Y>.Y{C]aLzqcb o0o(˃qO͓8>k'Ouʌ QYڻ D&4JΑ("_F?>=L_!'oPWpb[OVIb&qgr![Kdȍ6޶%S[shiFWdm/FH,)w;#fvۉ#+2S)U1H֍;MʛYAY7?nFMV5ˑ 9 Y&o[)iqm ID/\$U{ hxc~̲Pikf=NPSLJ0w,}슀7Q-ϓ}Y:rc;V]j-\ yݸeϴ}=L˯ܓWJ{HGNZ{\'mZ (.N: x4KE(bԣS>ʂ:'#9/C_kloj&71ܴtNDP|UvsS|6λ/xy2d,RTFRạ+M yAoiv؛RI5IZ:Xϼ`g>x55s٭'&UW4ØATr&GvK+<2]XOW݃If3Ls;1^|_3 zƣN5ӊ .3@hF, /8&o_${>aj[!Ht4˞c~O. J h\[e1~ST$_cSaJ"(O=m_-2Њ@>epx1 B^a͈6 yh Aa>)ťoCX]~ ̖(! zzzxcїv m 8|th퀜c\)e3373h 1l1}Fmk}{wWO3}#xD_|P1 ۟z_c@ko&ႲKUZI&?!!"mk:b=ੇ.efyjљX9?nmh*o\S7DČwK-&ӕד4tx.>0|#DvKy(°_dK^2}O)I~c: %?D}u K Fe)=V9P0G۸͗meC}9E*@xۨ;:8i@:H̻t?tUo]j5Ϗ~oFyȔ;$\|vak~7e"j iK[kgf >`gz!aw ].\J/nG1ᲾAco:[Գ/@T$qD/a VJm>Ɠ$ &C@W]&_;Og>e58ݜ6;]#n1y+n-T)sz7`eku1 e R@{:m?bj0u /d=ŗߗ,T5CƁTP_3{ pwf @iW Gڔγ#s#&S{3Xջu(d+@s?cekۜ/K&uAo eIEʼn1S >S?'w)C k|;)m|pP7_`}psXX2UPMan}k@W7K;d].C=+ /qyLU=S6w;xq]SW)Ik3:`cj x՚*W0RDi|>!0>>C`ҁza`ffw`PzH.$I3#S7v02PؓI?Ѭy~3[}/c m VFU6"p=~o1ȮW 4Wz&IsW>1R()Rjc \|ݖ :m ??yC:ق|}{e3w*悮.dT\4ԅ$rN]"M~ֻYysmA Dk] Y!\s4$v|eVO Tiʅo&r {B7B`@^ =ml@/abc PMw ?#V2ބ򈲸G{`LdR2fX~c37IJasN}p!l&e`k&!{)VLl˫Qj_,"V5`M!0Za !qZF}{|ewyL&ŶOG+X%l`yK Xֆqki-3C06Ghc?pWR^4"> XlT`.|rmLJG(703OB:(r߈p(NcdV◗;,2q**0 shfSA:MEda.C`/wj# )Q e %2ӊ`Eů.AcJ\i2Ik#n>PdDݜtVn @(r rJ3+z"4obCD+ qͩPT_MmMd&s#3pt0 u:(!7p8;&hl+Ymg;ԶAjEw>$t&605>:,ߢk@Ȧ[Sػ= =Z´$ X:a Hs42bA g`gj wE-옺>hgE{EĖ$ck@g TF@-uMMJ1il'#V9G(k/ 44<$k-sSt?] fj0?b%Sj_o7)[+_؄߯0XiAL,*\ Ig fn5cc J5輁xdPR:+L70ؚZM;M CP" 6zcY`ɜ$a3 2 D'lpXzN *@DweYO3#xh8,]eM'23hno%Qw@DORKgup$'O1<Ae 79s bJΎHkmXIJ+7(C Mq.88 - &xB1h DE`_q"88Kp.&]\{Mա 8m@x 2ZJ* *YaS я\jj bڛ'5Tؠ('MLm}4\,I=ԕΛeT`):K (qomQTmけ+a_qȪVzI8~tՆ۔E7r)+ ~ C Ҩ^Kp6] |s\PW z0yy;,rm;tҳCuN D ܆H֗}7+gV$UU뷵!"$"]55X>W%`^#1w+P۟z2Kw*CGGĩK@2Vf^*jAgWZSgnΎ%G"~]o=@dSq";99SXlBϠ,89ORG$|MQ >{)Y@K@KG+p/CaVDAέhTp5@8+÷6΅sbhTxo?8+#BvUUI.Aנ>Pp^R9Tq9'Z4{+ϛzcۦnMC Gpf'65 [pa4vu#|T2P 6uv0Bȫ.Rok"f֮m6=Ɍ "j cl`v>$Qj P(rBȁzGR<-f(Obr%XG^ =>B=E}LԚI!@OK dyp-儴 stO_Ci X6|*IbwN#SI|H~;|nfgknMs+D z=ٵ5CcCp|ǟ _+%uN5B5A1>B2(BLyVMOwWo7:m 3^z}GʵT7B{KyERylAndDEE!|={OG#ֻ|rE-MM>CPV[ 1ƃIg2)//ڛъa09.@ kgGtHsU涢-/BmAONyC/e@c ջ8LQ브9Qo&'7y} %^Øk]?nh.A?-fy,mC HB-!x7in;@7 hk쓉Rw!  w._EyF̓@ PoEI/,]h=qf0䆿_QII7",N$@EZVaΪT>Ğu ]^6l6;.1Z7C(zũɭ`硥F$:?r 9ӫˠ*U^ō GȄ[g[?>B.VAn@9}ǛEPCGKM 47B"hUM1syZ_KX|#/rOf.9X@ zM!Ip182oŽh u}E7}xo"X!pOT+V,M)j:%Y<ұ!npX/dW3EFHV]>끳/>d'ƊΥ{G3)w=`N0;k.$3ҊYяe*=Y҉_(?2?Sp!bݷy\΀Ѕ#IVQkC=8/XWl6ϱ>ed٘Y\;b7&GD`4Q;Ue_Or{շACI='ҍlaFn"c"ς2@6'<ֻln z~`\^˂<_,{G^U$yt,rCj䶇olSj[4wmQ`,tuyƍMݛ~fcs-җ,91ӍO}@3S|*S]μo2/,JJA?Rh9k}Ml2T_Tn07"x01es>=FM9gR ̌IˌOkOOLOOs!< )Wu/nlaz3+زgjkO"J$6)L!$"Z v>Jv#ca]J&cO]=.\m/.h_ R iG~!KoƄ]]?PT٨GKsK<'!z [=\"I;ߔ0KoʍǾ33V\&ނ F=kle>c-P I2Yo.$CRHFH-c|p&}BabB6K}AԶ@Bahbؼ.M'#sc9VPqQX$Zϼ#67L. C3#ysN;C[7'T6=Mc5L%KU{>~s\яL&\noj6riݝݐʪs p:-x⫅D0Gf`żk{*sgXYwYb)I0Rt|aIO`BUBEn];o>ŚڢÄM NߏPխt|g['$m]w CAFhf*%:U!viXl;FvY`E" %)>d9ʿM0g*5ѼNL\]˔Y- [!0ޓ|Wv+;鵩8WU1Os*8~❔V|wR+ 39#e pAHzhh$}tϱ 0[ҟ*Z.3~oX4Cu`60BQW MOѰx"(Y'Tz e]pYA $jsI<]8V_~c9̚9G/Bq0a鞇)o`jt̀ "Zk[U>δo{r0k"N܈Dn~CI-^}m|l{2iuZ%1E*ܸ7 L fKP"/!Z1jsk ~ 0Ҝtv@M^-TW w'8U XOńEUj8!e筱&N6ړrOCBBPve3x,vY ncHیuC.~y56ǨH)' Х``!0]]PT6)A+G2+0k:Ǡ4apۨ˻::m: i"gi*q<ʃ^W5~`♬zc-WXEKnqE>Áhu39MQfAL\WTwYnQ[nx4Z* H1JU}rKl!1J/@X`n/I㮟Je-8Gbjc Cerj*k էKvgդȅ,\rybQyݐ}pxt042?0oZȿ*BN1e/Org)H69y`j 5X^͝SiwAъWRnA DN >ݭˤ2kXMLkŮw74P= j FOO/Nԑ꽇& LxakOxG3D&\4q;~1T.p g*B jr*~?Op飾Gm2$f`ɯS>L3w,EfS"oPS^M .$_)Cj NwW}S_PC\j'==pf`F IDBY2ʇ`G|4/Ej jPSdv4 e`g047ՑPWY^DVԃ Q *\o} KK[_;V*'޶0d,{u&4lE=D^x, L u;Ysã"X/HەLV+=:] B( qPD'$D#xYֶmRYH8*T1;{p;EyLlL!bMTCV|{律h؊biK,f3;3q/00g*ej6аPwx;v!:g[']m]+ [51T q &v`cGFX e u]ɩ7l۵+а@~V!X3ОI--I0 h[Yi> [q3P}  7UCp)~!RfrX@ 1 W'uV2C{V&o 9 TgWa C\ax^1G\)Zɠ1!Ejf?GVmEͰx[qF[i 9䟛> ' 0Q#iJ=D99;Q:!7ovoq!a+]۰FO0leq_ .lE)3a˲oβO[CDg OؒHV ˰=11-fʐ[Ѩt~><Q<  yg%t6Imv u7ֻj0lEc}w/djDxq Za " [8ܧ! g>X8 QD;F}j C_W|e/\ G3gKGVDj+S7f  ?> JcK>2߮zDIǴjc#Ίa+U?|$AJHѕ 8ȅbo6BaϵxHȀG:+ba+y])uO의؄(4RMq@ VZ75 47"R454:;Փ\/DV:X(lEbi N`?o1;ΆR![\GЌ)LQJJwW! [wJa*2VsW3C2V$Ku,n4,r(d@hxpV81|{e3<&`Da+rx!xj;H%4C )j C}8eR8XƊ8& X{M"!~p4 t Xyr=JPrW2j_04oy>B 7B27, 4 5L"]@liɮ'zp+B "1Q;WڥA "3#n}|OGKPh /M.BgEi@pP"#U)0Mm "XlRTDyj -1(/sWgN8x&Xk:5ѥV-3I>cLeە7V7Ja͊P`u2-L)!<0r%`ꡋIQ qgh ?_ mrTN DUOW9:,R+2`:殍8[82"e ev v|dp"ėɗ7VVڰ( n _ae3u`3dUK7Zp.1+MyS96rEd\:zc;S LrCL+wh\hPYZiXƺ:tMu}j5 eٌ 5>h.imj$>Wǖ2g 6;3w0s=X:S0k˙:>\i+/ēu%]-Sh  ^]C bח a׃V0eyQɪKT6U|)>p(4,jZo Ȝp(غMBpra /l>϶DK!N@{i2fZN.@-,e~'f#'dP3'CLYh)"<}΋c"d5Y'PHa +JŖ9u@85dO1xhͧ,ZxVٙYfx6{X_t@np8cxm b@Pƛ>ټYMC2 >876Qrs0js*H`mF  v,N;-VM? j|wՍZ dnd h 7`pΏ+W@G ؛r|Nڻ"n/sZ:AIC9ǽR buMqxagr{<'{քdN4mBgC+ɧc‡W6 ꖭƶ&)N"M4dmmD9/PQwv|mr:5MN#JQ,/ohIr^ |Ǽ${`2{8ėF]PW %:k;9_:m N΢ē8sH$KܬΊ 輁 lAw|̕ur.oaΡW&[b?\kP6Z A,~F ak@T>2عRQajx2䞨{1`lؘZ^}XƠ1=}mlؕ|X Hj[!,œ Ap"@{o`9.E9fG?4ɠ2d~t2a[gYDŽtvuBESłjWtd5.],HR@Pn_ X2 ˠ4emPކr NUԤ:5 cs=]:+ZCfe.g{@4ZACRy:T64璟mGfP&6 ?g7Tpm~׋`{$@lu6E}]p`014:+*A zép w[7o{WlߧpLvu>QzGɟ*ZrGs;2:$Ic 2C I1M4'cu I%AޑxSuwf`ޜ MSqcof X $ͅHxa} ֖ 5~?rF:Tz[Kcsu Ls?;\Qs|}y#oǟ7>& b s7v=u'0by\ؑtGV5]T_j[IL@ D֮0)3J/PM8Vp?ք}dB]fLܚBTJ YxV ϸae !Jo{տT@xLļSjW5tխ̞{evPቖJ{2Y&1`A DOyǀi4`,^_|s{Jk!a‡wCr\J4ѱeeYniX׀My\D02541\gr~|Nr`__m]a}z ׭$Ff= ?xYXYHU@yDAcMn9T甓ߨ_ F{c ?gbR`t4E]~-hҫt&$`gx 2)kdn39gB*M2|* &>,`"l®]()ʷs'9ֻq凣2 VOS{>o Z JBg?+ygs@|.0.# fCMTYO*Vn,W甑oV$Y1$# lFu"U>D'ק+׹~i2E6{a̛6Fb dgW,8eRko@}>Ǘ@HzVΓME00]:Pz 8wQo5ihar c1 F{ Uf[p"hGTɔzBvI\MHxU7#;&|YvY=JǗE(cT'f^)t@ɞCht:[Zʳw񆋡Qc++RInVHEb7G`%  NS«B@ċY>C{? =43k=?X 1TǟB8~# xfڠJcYbY87|.ܢ/?s㯨roK#DxJku~x4iZa`K7; # 6W7]ة%)b#b?[+颊:l.E*{z>}m-yϣ*tw1ujͯBէ }s?Yugu/}?H)f=d٤mq̏i 5Il7" I(scABEV㷞c,Z!ZsF?>o6E {-mȲ[$ﺢآ!z22\ *զKx2.Q YIZjviWG|cYo"MO\Q`"s=6қ[Tzc|ۛo`[ё* ƍ\$ǠGE G[.%"\LݝO)mdN}%gg7,l[4ߊ~7u(lݽ9wi,"x\!>BԁZꚠEqFo=V^Ej&VX [/2'L i MQq86nxQēSDTf0Do,uLmKc IݺNƆbyX-"Wj|JӖ@9U9;_G؜z?pttq:ZF֥zץCI\nF19_z7%LW<*QWo$Zȱx8RM=!šOvRiAls£^GaYNsb/ c,}q!%؆ElHSqr\ƖEh,0lEKocon/\=Q.~} ?P˫eU ͕CDD?5cÄ缡N^0vwvSis,Ҥz `hhj 6UQ 9ds&V=ُ^qz9XAkm3 Ga ̋[SQn "-TU )S{]"K(\m ){Q [ vh/;R7 IZpe@1SR5<)EƬLCnx6#7/\2_EZIC;{n)ECY#wj{aIwq '?9ώT9IKTgSd8.eH*"bgA^^iϯ%WG_P9$i{IdV.vvB8i6l.DۖũejcV.b`0y)vww~QD{]tHsE4W51BC>PWvh9@ ggs?OqnCc\ʇ( mnJGs1E)?0ėg0kZÀ3aGnĴ?vfL`_HݓD0KOS:2󒪸z8̙1` D^i݈ (v6H3c<#4{bY?@D8$aoOtU*3&Q,lhzxj낚jɮdTkX oZ4Y n,|\eh"07h 5Yդu"Y2:f S JqEU  [pXR~P=Gndz`Pͧ5?1m?T]PBR 0wa=Y0gշAc%$TDU}zۆo0k:ˠ7^O`[{?gT9Ft006e}&,UgWA}~-Pö/nJPS* I[ݚ Rs3<$^;up3W5wŐGm(asԂ°^}JSyT7ABӦ)='a@`hYl)c8' a(EW󉈄yhngQuPR5Lym#PQ%Q[0{|ִi{ [,3*cߙU@X5X}#74W5.7Vsa+LzU԰y]웎FfN>}"rUYM(Uc`&I~`k+sIJMmLpR bS6 _6Dcs淆w1P[*|xS^[PQMߜ)#}W9`OwD07#:`-5*SUΓ}sʽǟ(PU;fm[-floj&b\*"zz]^B)b)}!X~*KY*P8|feȢ*L 5?x/s fW'Vqyl g/*.K 5 p ontn. [? .F5 afgQlin& S/zf>:oP0kc?7*gߙixPykwc; uR#5=Q" X~k?O SU;MwVQz8daogh('JvLQ(Si/~y# _97\ԁPtnW9w]J FmY9\643jG=2&-BBau Ի>H}Nw.t&wx&\rڛv s GPBj-?}/\`m8C023s' H()gV8X\66̷𕾡~o'PT:V\tooPwg3h郍-;[-}xΔ,e2vz&"'#DŽ3Ƣy;)@({:m{>,}S;3ajL ,a >ԉ$'t)Q*Y YǒbesG҉/{%|ը_ E(h!zζc{>XyZ3 [sa8;\f家.2e^ErtTr?cXYפWdfK%V(:F(3(/TF2D-LM,̝܈i IHciCcYKs'&\͙B*B@(n32^ڒ!ڄ5X2 ԞKm,\,NYj턲RJNYWPC%V(: g%G|kg  [_[02ő`hFew' F4W7!X u Aɐ/ {'I uPSLƟE1Pk^X( u dH+;M K`-ꃱ1̇5zd@#& JK6:#F?:#*Bu  k=ϼw1wo;0s0'8;*-s7I8 6JcKs =gcy;)EBH;w D2ćsɓ m=I%VmY .ؘU{zQRu 't!+/2l CBb%JyXm;O1ߌ!RA u "0sښ-.BaX q"  HdK^-Xq,X,PdϏvcHPa&J6R:%Cl}Z!\knoZmmhhN"b!ZH>0)#s2[3k1#X)kX͝XI):G!d[!DºRĤbko̜>d̖ssJUb4۴ oJ499XvR P'E|kg (Lhl;!LmZqUdCGfK"^-as( u SC #A-bhj7%VvN)\4X-:: cOZb$$CLq, 1%p0:~VۚBu;Sk3Y?X,X~/==kXnR+NB|!UK1_ _Tcdْ޶J$V}L2ʴu{RT:-Hlr}>] }i߁BS;ٕr,:1d<ha3 jQb%`ߜe#3яMpSĊ@ɐw'J( Ni$9’!ID[BbLJƄcN`)܍Ju &m) hӒ!单3ji_T6/׷, &Q+5b,9mOcpʴfޢ+:ijt< [BIZ6&\G?I@ǭ8aj>dI,!< B 6u.iާ7pʴvܳ>%V)-W! +հD hpQ9y)T՗AK2do)[|eXΨ҄R)m-6)!ĊN;3N *[Դk|0@ɱܬaQ ۡdA]1'TZҷ [S2N29=^p\}I$V'/Ą(2yjNJG27~=Tg[KD2,\z 0!i`|0캺;Ywvu0`Lz̿@{_2،j'}$Vڻ*5 rſ7%V&2%kXzRt%g‰Pɐ. 8fWe`4qS#%47@uKL~u! muDHl5!dW瓄yTƙ ֚ bOb%+_mں1zSbI/{T$V'E|{'}.cKc|!tȫ- 6F͢.Dc7US#:$  s ޣe"2$ K< R)IJ@: c~?ąOZak2S` ԴԒ$V,L"رט `G$tP*rm"Jy5}$V̷5-1RU|=gO! dnd3ƃ+7w1:XY9QK@nJwS2ę#ba NT2BMͰ7Yr%V&v_%Vڠ4NC+H|8fԏXԁɐw|7%C I_}d2Ld"(%Y ǗrJ$$VۘpsJ,z9=@Ǯ8aA%C(: ʁ|wO1 Regj CݝD()~%V.dN4Kq~s}7PMbint8w^ֈd X$CԖJP(DuK-lJ`L$V|ɲHb;XihXYXQʁhV2l}JP( Z3 tMX{0 d)S E !އ$.$$"|.*IA0wܠgE?2J/Wb{cq }$CJP(JLERsG+8M$߅",$_[OOHZCĊI(XR srwgd5XzZS EG134%p0VW6؀@yZYA'X)O`j'J@ ߡW2ld2 5#g!"C|wW6;q$FXqAtuC]A_+T{ZwʄD CP'XƑGS,FGR:` fͭE]9BQj[=e ۢQC<M-BԵ6׶tF|, Bge@pes`GA4U028 @> ed[9Il(u P!<\aAtU+ 2OUL(J&X✺u :M9EBgBaEc[3=F P!IsΤC٭R(9wFBgԁ8nVDS`IH:; +k)+tv(,d07x*fq{~aI 8qٿ'!ͦ(ԁ PkT%-I:; + KesYP:h[BS{١P9'G0=jXX#p>١PX3_`kj-tv(2d3c( s {NP?;/2d]KT6WCMsԵ5@c[#4j"Tv#f'rG`]Q )Mx wnL"%5!Z<zb0324/P2u'8SQ]١h9-W[(t6 mM-0o, u :;P2@9Aa] HT EY"Nd_TX KhxXwáSZ-tv(ZHLhnIE8 cö}&tv(ZFͭ^5|7zt@PB;Skxdp .3Bɮ }ܚBfX6\,Π:J/c= ulej#BgGM\ IX+v(׶º2*tVy|}MK=Է60D{::ak>pΠ:JL M!"g:;ckb ƃ+}1!$.\pcCHG{g)hT7@%SE@ǚPFf6Vc0AE*Aa wi~j;}#݆Bdq``Hrkk+qBgLm_C~σrؙ|4:Fp0D."؝|DkFskұ-\*L u Z9ccYI3W]kĎ; 63ؤVd ZS!G H( vP񈺩,tvX%4&A"S% BgC*Xܟv{QC΀: +,M $N\:;J;?˻m;P`ȯ7ٝgD u p_ ܑ/6jgSs[C=]teҌe&tV ԁPTPV ]u%9Alh׬#sieĂ>먟DB|Q* jI/Np&dmνwD>ԁP2nD؂L#2)abh&:tBV&$I_SX g=a/A3fNRj;KCnMyېټ 5fYcE2z sWE#u @E+1,M,  Tɿf6:+m'h>5:#GЎumym6 |>W4Uzu ֍Y ҎCEh8P1+Ԧ[hԁPӡ' EWK'X:dBvYJP3xHagfZM"(F|ȼ! E^vCEHrޥ1 &qpt$ YGjLj!5gBh f v^no (n(:K2%&`l`$)^-#]ɛj;i.sPߪ L+25 IȂWNu ~;Yjs ߱c8p*tf@DŽ֗‰DRY6ԁP f(tFzeS Ė$CFet ecb .A/[<\`mR1 2`AH%WSȔDHGl[gc15 G {vOWp4Au Ax۸DPԃ: Bu  BQ @( ԁP( E%P(JPBP(BP(*ABPT:1`jkpv8?ѩ\;I/af.wV&_;n=>BwAk=)PBY M |Y4o; _PԁPtH(M̃^c |2PBy—T aJ(364Cwg7mF"MYˣ!~+?MYaKǀݝ]ĹBeF I.CEw,ytW|4!L% ܇I|y4G=2xD gkt Ff`hjLgڛژ mLj,*RLWBd 3'> V.*w_tmP"ベHΎmAsHjj+&$`^~>NZ3K#W`?Eزhߕ&1~yҙ`ԗԐZqDlI4-aůBs05a$dJI?qT%k.:񺲎'r2U,cKSrS JJ!i}Jz6T0D`󖭷xMg) kj8aQˁ4W6AER)XyX)EhThi˔n7u2/Ūp+cLCWI:|y~hNҟ%Րq%  sMt|z`:qBvtwASE#5)PRɲF'1M٧4Jg'D=Y;8 9g:K5{V8MY[(96e$Gl}$>O`^Z2>C!я͑QuI>B۞!I!*($\D(q6> h,m̃d\]# &DÔe%ÏbS/|!T~ Ud$ļdd]< *Ӌ]#Sz㼏5@'1%KiRԔ0s(XH`Eh3daOƙH8&GRe Shmz5A|BUQcy l鄢E$! vf2 b QΔ x &XRV|1kL* ϧAy [a6}`v=Sge/QRoM41`i7e5](֊2'$eaX{84h.,=sW.ЖgL~KB=Tm8(eTAk YښWnϐM ung?~w1^u$!FfF2lAP5!]BC`;SZҲdy!$ʸq-R? _^* ed ! Cח]͂Y,B=%̓ - QX"H`z̚@gHXKT -dp' 8=!7=⚀}-.s?LLH?kνcqT[p)$xۂk;H(`+a;\Hl=&K1@Ez1RtH PH+ |#o3ErF% Kvv<̍; Gysgk+3!u5&+Y$Xid~@$X%U#[8RkYDE1oбC|~:!жgz쬷r$QuH+I FqVk1h:Z|h'OLܘUJQXwW|k粒ggr_$D{CgHCY-d"QWF?WH6K^\`i+K!q%*?xQwO!Mhb*&5EW[pikh' j( ׸o=;{Y5W|auS?Ą%Ok9+zr3{spnJ]ylD>pufw!rϤ(Fc= "}enIyRUo]A%{C`]~Yr uR-NDɈ1UgH9._QpS uhd󇃵tH$yƥ–1&vhrMN[_njɯ/Ya{: ]#cfq/_L Q2t' HbE1 +onQΐ9`gB(I@j {6c; ]_Ȩmm#aE&w8RkBvdl DJa)ĝ$U˯?D ZnJBCI"8ꮰ~W,52yFߠFƍ:&\Ͽ9[{>+O*TP,$قN̝,4&>/k|0g5RtR]'6:I/.O*(q0 C,B!`ҜF}Y'" QYnjhkj$/Vn6^Rm#=7 5.]fy# O0ơ9F<5WIxa#-P]aU)L:Y9@y/2ҿeAHU;0a74d„`).|.W5xژUO]YLu4y:Bg)Ihl'1:oJdWAk0fj35?3ÄM.><߄mWC͒y]XPXZdդP8)!_}V{[u ;Z0FWUg;a}a}ѕ|6beK&2X,B"RL-rE cKO|{402CEt8j &\+>RůME>0 2 llAHP(:JT5AsM hDɐ(.wwv}Y9=khk39dY@e+k t1#PH0 $C ڇ7ዱO`bmZh@M%FXYGq VUڛ-ݬhBaJ4Vb7Ι!t@)/zoZ迂d@@sG̪%zm׾?oO˚CKU3``Gp wDbBfPAG6AwGgD2D_3b'0U3{ Mdngf LDҸ y˒HB,,XhNbB&P2@yqo'8{(r Rh߳k=5 [[l.}y?yScbuGbEÜ1ԉȭP(2OFESdHW7AC`!ݡK5/YhЛ@LLk'2ELs*uΩ}Z^:DSybK+"i /:ۘRQmc/M s'T _1w[Lԁ%|rsUo_bJOAPZ{g005pW r 5 EDKe42NKꡁi`E: :5.{J;?ͯT:[:Z!IDbÆ@ښ E+h)LzS0 ZkeXՌ{n}!dbAGJ;0zCIǙ+f"EPb$\?hyoj&sL8e Hslio-~i[ Pօ>_*'zXV'}g@K$dC6>FFS(\т„MDtHTC@„Ffƍcȇ&}lhj}d !bop&2}gN\<`-1jLM;2BBa i&5 "RHt q2ugG$@!sO܆]F/>z#o4i*cw'4aDYBFW[O-H06mA'w-M:%&\H-8//dNTYQIbjkJ1ZyXSAN0ad93 qvM|'V5EPe8&t\hm7g/}նV M_'{D3 ppC3 tںIw]~-4 $bfw㟟y3@Q}#h1&F-c&\/7%VoEk*XH)' 1s 31ZZyMM=!PSIflޝڂD$VPCzcq7s3uuh, ;Kfe}#}p u!``B1 (FPWX%HAw'KW‰/ϐ#6)A2A@>}aRlwomXWGƪe yGE]!đJ h溞Q8 hnI/|>[ Px:Y< q&"HSy%7HBܭX "R7%CrH3ښWNx~CDSM P2.7׻}vwi*Eu$!(2lĊZ0& ia k tl[rrI$C ɪt+Ä$eW̝g?~}q%$H/[prc*IP:Iؗ!dIاfw?706C@1؁9d͘p;?ve jHB-yڒ1( nbDO_N4F ۅir{~ s}I P @(ഝ k.wuv&yszASyȠ$(o|c:0~-Z 2X F6eƙ1&qL1&q&,#1.~P1Ź) ȟ"@i)\C[%'yߤi7yz{s]}Dt$Wt"V`!Nb.c$c KJaA.͂<5΋B^~?Ŷx4DC: @E@nl:pp5E*P$kKz&jU-Ȣ b͔7g\*5d0 `6Rwꦟa% RםБ!`B-(S,kr֨o"wn pf^XAA80 KW@Zw'Sɔ8l pHL`݉jN}NG[LޖU*@4dެXݔzzG4c&ƣu IǔU3aQr=PBy.qԇ 6 aK(a*(5\N %h SZ `С(') 0}'\I YӘ xGD8{D$|&O~$dN5h Ȃy`=7:_:T]p̩I c-S=… %v(2_V;#A`X80P׀e-=)&U~R·? {?l kٲ Յ#.m }/,"c}F b7s6eojCj#&LJ,h  3T6͎We_>Ru ;b K.;a?{^;|-gO_),@%gO} !bڙ^ndK6ÀBODNT  6 䁈Wr`sZ{f?$uTv܁@fAl*<:IENDB`svMisc/inst/WORDLIST0000644000176200001440000000125314614426726013702 0ustar liggesusersappveyor args attr autoCShow barton batchable bbedit BBEdit BLAS calltip camelCase CLI CMD cran de desc devtools dir dirs DOI dontrun envir ETX gcbd gedit gest Github GlobalEnv http https infructuous isFirstArg JGR JSON JSS Kalman kamil kate Komodo MacOS Maechler MKL natively objList OpenBLAS ORCID os PhG phgrosjean pkgdown Porco rbenchmark Rdata reflow Rgui Rjson RJSON RJSONp Roxygen RStudio rJava Rterm RUnit sciviews SciViews seealso stddout stderr Steinhaus str STX subdirs subfolder subpath subpaths subsettable Subsettable SuppDists svFlow svSweave svUnit svXXX sysTemp textedit TextEdit tidyverse Tinn tooltip triggerPos UI unanalyzed Urbanek UseR useRs wuerzburg Zardetto svMisc/build/0000755000176200001440000000000014715356216012627 5ustar liggesuserssvMisc/build/vignette.rds0000644000176200001440000000041314715356216015164 0ustar liggesusersuOMK@vcA("zʭx""dIewЛqΖ{3oWs6 ~&}/tESN7th0kK_Z!(% ؍ϊ)g+G)?%~6[LI𰌓gSoOЊu}M[4d9;/I h<GD&T29T>~]muݵ~14M?wT*ᣣH"_9# 3svMisc/man/0000755000176200001440000000000014614427365012305 5ustar liggesuserssvMisc/man/pkgman_describe.Rd0000644000176200001440000000510714614425170015704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pkgMan.R \name{pkgman_describe} \alias{pkgman_describe} \alias{pkgman_get_mirrors} \alias{pkgman_get_available} \alias{pkgman_get_installed} \alias{pkgman_set_cran_mirror} \alias{pkgman_install} \alias{pkgman_remove} \alias{pkgman_load} \alias{pkgman_detach} \alias{pkgManDescribe} \alias{pkgManGetMirrors} \alias{pkgManGetAvailable} \alias{pkgManGetInstalled} \alias{pkgManSetCRANMirror} \alias{pkgManInstall} \alias{pkgManRemove} \alias{pkgManLoad} \alias{pkgManDetach} \title{Functions to manage R side of the SciViews R package manager} \usage{ pkgman_describe(pkgname, print.it = TRUE) pkgman_get_mirrors() pkgman_get_available( page = "next", pattern = "", n = 50, keep = c("Package", "Version", "InstalledVersion", "Status"), reload = FALSE, sep = ";", eol = "\\t\\n" ) pkgman_get_installed(sep = ";", eol = "\\t\\n") pkgman_set_cran_mirror(url) pkgman_install(pkgs, install.deps = FALSE, ask = TRUE) pkgman_remove(pkgname) pkgman_load(pkgname) pkgman_detach(pkgname) pkgManDescribe(pkgname, print.it = TRUE) pkgManGetMirrors() pkgManGetAvailable( page = "next", pattern = "", n = 50, keep = c("Package", "Version", "InstalledVersion", "Status"), reload = FALSE, sep = ";", eol = "\\t\\n" ) pkgManGetInstalled(sep = ";", eol = "\\t\\n") pkgManSetCRANMirror(url) pkgManInstall(pkgs, install.deps = FALSE, ask = TRUE) pkgManRemove(pkgname) pkgManLoad(pkgname) pkgManDetach(pkgname) } \arguments{ \item{pkgname}{The name of one R package (character string).} \item{print.it}{Should the result be printed?} \item{page}{Which page to get?} \item{pattern}{Selection pattern.} \item{n}{The number of items to retrieve.} \item{keep}{The columns to keep in the resulting data frame.} \item{reload}{Do we force reload of the data and ignore cache version?} \item{sep}{Field separator to use.} \item{eol}{End-of-line sequence to use.} \item{url}{The URL to use for the current CRAN mirror.} \item{pkgs}{A list of packages to install.} \item{install.deps}{Do we also install dependencies?} \item{ask}{Do we prompt the user for package installation?} } \value{ These functions return data that is intended to be used by the SciViews \R package manager. } \description{ These functions should not be used directly by the end-user. They implement the R-side code for the SciViews \R package manager. } \seealso{ \code{\link[=package]{package()}} } \author{ Kamil Barton \href{mailto:kamil.barton@uni-wuerzburg.de}{kamil.barton@uni-wuerzburg.de} } \concept{SciViews R package manager} \keyword{utilities} svMisc/man/Install.Rd0000644000176200001440000000231614614426200014167 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/install.R \name{Install} \alias{Install} \title{An easy package installation function that pairs with \code{package()}} \usage{ Install(pkgs = get_temp(".packages_to_install"), ..., ask = TRUE) } \arguments{ \item{pkgs}{The list of packages to install (character vector). If missing, the list is read from \code{packages_to_install}, which is cleared on success.} \item{...}{Further arguments passed to \code{\link[=install.packages]{install.packages()}}.} \item{ask}{If \code{TRUE} and \code{pkgs} is missing, ask first to install the packages.} } \value{ Returns \code{TRUE} in case of success, \code{FALSE} otherwise. The function is invoked for its side-effect of installing \R packages. } \description{ This is similar to \code{\link[=install.packages]{install.packages()}}, except it takes by default the list of packages from \code{.packages_to_install} in \code{SciViews:TempEnv}. That list is populated automatically by infructuous calls to \code{package()}, so that just a call to \code{Install()} without arguments is generally sufficient. } \seealso{ \code{\link[=package]{package()}} } \concept{package installation} \keyword{utilities} svMisc/man/progress.Rd0000644000176200001440000001336714614131727014444 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/progress.R \name{progress} \alias{progress} \title{Display progression of a long calculation at the R console and/or in a GUI} \usage{ progress( value, max.value = NULL, progress.bar = FALSE, char = "|", init = (value == 0), console = TRUE, gui = TRUE ) } \arguments{ \item{value}{Current value of the progression (use a value higher than \code{max.value} to dismiss the progression indication automatically.} \item{max.value}{Maximum value to be achieved.} \item{progress.bar}{Should we display a progression bar on the console? If \code{FALSE}, a temporary message is used.} \item{char}{The character to use to fill the progress bar in the console. not used for the alternate display, or for GUI display of progression.} \item{init}{Do we have to initialize the progress bar? It is usually done the first time the function is used, and the default value \code{init = (value == 0)} is correct most of the time. You must specify \code{init = TRUE} in two cases: (1) if the first value to display is different from zero, and (2) if your code issues some text on screen during progression display. Hence, you must force redraw of the progression bar.} \item{console}{Do we display progression on the console?} \item{gui}{Do we display progression in a dialog box, or any other GUI widget? See "details" and "examples" hereunder to know how to implement your own GUI progression indicator.} } \value{ This function returns \code{NULL} invisibly. It is invoked for its side effects. } \description{ Display progression level of a long-running task in the console. Two mode can be used: either percent of achievement (55\\%), or the number of items or steps done on a total (1 file on 10 done...). This is displayed either through a message, or through a text-based "progression bar" on the console, or a true progression bar widget in a GUI. } \details{ The function \code{progress()} proposes different styles of progression indicators than the standard \code{\link[=txtProgressBar]{txtProgressBar()}} in package 'utils'. The function uses backspace (\\8) to erase characters at the console. With \code{gui = TRUE}, it looks for all functions defined in the \code{.progress} list located in the \code{SciViews:TempEnv} environment. Each function is executed in turn with following call: \code{the_gui_function(value, max.value)}. You are responsible to create \code{the_gui_function()} and to add it as an element in the \code{.progress} list. See also example (5) hereunder. If your GUI display of the progression offers the possibility to stop calculation (for instance, using a 'Cancel' button), you are responsible to pass this info to your code doing the long calculation and to stop it there. Example (5) shows how to do this. } \examples{ # 1) A simple progress indicator in percent for (i in 0:101) { progress(i) Sys.sleep(0.01) if (i == 101) message("Done!") } \dontrun{ # 2) A progress indicator with 'x on y' for (i in 0:31) { progress(i, 30) Sys.sleep(0.02) if (i == 31) message("Done!") } # 3) A progress bar in percent for (i in 0:101) { progress(i, progress.bar = TRUE) Sys.sleep(0.01) if (i == 101) message("Done!") } # 4) A progress indicator with 'x on y' for (i in 0:21) { progress(i, 20, progress.bar = TRUE) Sys.sleep(0.03) if (i == 21) message("Done!") } } # 5) A progression dialog box with Tcl/Tk \dontrun{ if (require(tcltk)) { gui_progress <- function(value, max.value) { # Do we need to destroy the progression dialog box? if (value > max.value) { try(tkdestroy(get_temp("gui_progress_window")), silent = TRUE) delete_temp(c("gui_progress_state", "gui_progress_window", "gui_progress_cancel")) return(invisible(FALSE)) } else if (exists_temp("gui_progress_window") && !inherits(try(tkwm.deiconify(tt <- get_temp("gui_progress_window")), silent = TRUE), "try-error")) { # The progression dialog box exists # Focus on it and change progress value tkfocus(tt) state <- get_temp("gui_progress_state") tclvalue(state) <- value } else { # The progression dialog box must be (re)created # First, make sure there is no remaining "gui_progress_cancel" delete_temp("gui_progress_cancel") # Create a Tcl variable to hold current progression state state <- tclVar(value) assign_temp("gui_progress_state", state) # Create the progression dialog box tt <- tktoplevel() assign_temp("gui_progress_window", tt) tktitle(tt) <- "Waiting..." sc <- tkscale(tt, orient = "h", state = "disabled", to = max.value, label = "Progress:", length = 200, variable = state) tkpack(sc) but <- tkbutton(tt, text = "Cancel", command = function() { # Set a flag telling to stop running calculation assign_temp("gui_progress_cancel", TRUE) # Content is not important! tkdestroy(tt) }) tkpack(but) } invisible(TRUE) } # Register it as function to use in progress() change_temp(".progress", "gui_progress", gui_progress, replace.existing = TRUE) rm(gui_progress) # Don't need this any more # Test it... for (i in 0:101) { progress(i) # Could also set console = FALSE for using the GUI only Sys.sleep(0.05) # The code to stop long calc when user presses "Cancel" if (exists_temp("gui_progress_cancel")) { progress(101, console = FALSE) # Make sure to clean up everything break } if (i == 101) message("Done!") } # Unregister the GUI for progress change_temp(".progress", "gui_progress", NULL) } } } \seealso{ \code{\link[=batch]{batch()}}, \code{\link[=txtProgressBar]{txtProgressBar()}} } \concept{graphical user interface (GUI) long process progression and feedback} \keyword{utilities} svMisc/man/add_actions.Rd0000644000176200001440000000406614614131727015044 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/add_actions.R \name{add_actions} \alias{add_actions} \alias{get_actions} \alias{add_icons} \alias{add_methods} \alias{addActions} \alias{addIcons} \alias{addMethods} \title{Add GUI elements like actions (menu items), icons, or methods in a predefined list} \usage{ add_actions( obj = get_actions(), text = NULL, code = NULL, state = NULL, options = NULL, replace = TRUE ) get_actions() add_icons(obj = ".svIcons", icons, replace = TRUE) add_methods(methods) addActions( obj = get_actions(), text = NULL, code = NULL, state = NULL, options = NULL, replace = TRUE ) addIcons(obj = ".svIcons", icons, replace = TRUE) addMethods(methods) } \arguments{ \item{obj}{The name of the object in \code{SciViews:TempEnv} to manipulate.} \item{text}{The text of actions to add (label on first line, tip on other lines).} \item{code}{The R code of actions to add.} \item{state}{The default (initial) state of an action, as a succession of letters: \code{c} = checked, \code{u} = unchecked (default); \code{d} = disabled, \code{e} = enabled (default); \code{h} = hidden, \code{v} = visible (default). Default values are optional. Ex: \code{udv} means: unchecked - disabled - visible and it equals to simply \code{d}, given the defaults for the other properties.} \item{options}{A character vector with other options to pass to the graphical toolkit for this action.} \item{replace}{Do we replace existing items in 'x'?} \item{icons}{The description of the icons to add.} \item{methods}{The list of methods to add (character string).} } \value{ The modified object is returned invisibly. } \description{ Manage lists of GUI actions, icons and methods. } \examples{ # This is useful to add actions, icons, descriptions, shortcuts or methods # TODO: examples and use for functions add_actions(), add_icons() and # add_methods() } \seealso{ \code{\link[=add_items]{add_items()}}, \code{\link[=obj_menu]{obj_menu()}}, \code{\link[=temp_env]{temp_env()}} } \concept{list of GUI elements} \keyword{utilities} svMisc/man/rbenchmark.Rd0000644000176200001440000000433114614447025014704 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rbenchmark.R \name{rbenchmark} \alias{rbenchmark} \alias{print.rbenchmark} \title{R Benchmark 2.6} \usage{ rbenchmark(runs = 3L) \method{print}{rbenchmark}(x, ...) } \arguments{ \item{runs}{Number of times each test is run (3 by default).} \item{x}{A \strong{rbenchmark} object} \item{...}{Further arguments (not used yet)} } \value{ An \strong{rbenchmark} object with the timing of all 15 tests. } \description{ This is a benchmark of base R with 15 tests of various common (matrix) calculations and programming techniques like loops, vector calculation, recursion, etc. } \details{ This code is reworked from the R Benchmark 2.5 adapted by Simon Urbanek (https://mac.r-project.org/benchmarks/) from my initial implementation , itself inspired from Matlab code by Stephan Steinhaus. In comparison to version 2.5, this one is included in a function and returns a \strong{rbenchmark} objects that prints in a very similar way to the original code. However, only functions from base R packages (including \{stats\} and \{utils\}) are used, where previous versions also used recommended package \{Matrix\} and possibly CRAN package \{SuppDists\}. Expect some slight differences. Some tests in sections I and II use BLAS/LAPACK code. Their results are heavily dependent on the BLAS implementation that you choose. The default R BLAS is single-threaded and is rather slow, but it well tested and certified to be accurate. Use a good multi-threaded BLAS alternative for much improved results (sometimes 10x faster or more), like ATLAS, OpenBLAS, Intel MKL, ... See https://cran.r-project.org/web/packages/gcbd/vignettes/gcbd.pdf. Use \code{utils::sessionInfo()} to know which BLAS version R currently uses. Beside multi-threaded BLAS, all tests are single-threaded. This benchmark does not test full parallel potential of R. Also, other key aspects like read and write of data on disk of from databases are not tested. As usual, take these artificial benchmarks with a grain of salt: it may not represent the speed of your actual calculations since it depends mainly on the functions you use and on your programming style... } \examples{ \dontrun{ # This can be slow rbenchmark() } } svMisc/man/section.Rd0000644000176200001440000000245014614131727014233 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/section.R \name{section} \alias{section} \alias{print.section} \alias{str.section} \alias{get_section} \title{Create a section in a list (collection of functions and other objects).} \usage{ section(obj, title) \method{print}{section}(x, ...) \method{str}{section}(object, ...) get_section(x, title) } \arguments{ \item{obj}{A list object.} \item{title}{The title of the section. It must match the name of the list item. For a title "My section title", the name must be "0__MY_SECTION_NAME__" that is both a syntactically correct name and something that emphasizes the entry as a title.} \item{x}{A list containing the section} \item{...}{Further arguments (not used yet)} \item{object}{A list to use for section extraction} } \value{ A function that is able to extract the corresponding section from the list. } \description{ A section tags a list to sort its items. It is particularly useful when you create a collection of function (or other objects) to ease the access to these functions. Sections are displayed in printed and "str"ed versions of the list and are also functions that cut the list to the section content only. \code{get_section()} is the workhorse function that does the section extraction. } \examples{ #TODO... } svMisc/man/aka.Rd0000644000176200001440000000522114614131727013322 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aka.R \name{aka} \alias{aka} \alias{print.aka} \alias{str.aka} \title{Create an alias (also known as) for an object whose a short help page and/or original help page can be viewed with .?obj.} \usage{ aka( obj, alias = NULL, comment = "", description = NULL, seealso = NULL, example = NULL, url = NULL ) \method{print}{aka}( x, hyperlink_type = getOption("hyperlink_type", default = .hyperlink_type()), ... ) \method{str}{aka}(object, ...) } \arguments{ \item{obj}{An R object.} \item{alias}{The full qualified name of the alias object whose help page should be retained as \code{pkg::name}. If \code{NULL} (by default), use \code{obj}.} \item{comment}{A comment to place in \code{obj} (will also be printed when calling \code{.?obj}).} \item{description}{A description of the function for the sort man page.} \item{seealso}{A character string of functions in the form \code{fun} or \code{pkg::fun}.} \item{example}{A character string with code for a short example.} \item{url}{An http or https URL pointing to the help page for the function on the Internet.} \item{x}{An aka object} \item{hyperlink_type}{The type of hyperlink supported. The default value should be ok. Use \code{"none"} to suppress hyperlink, \code{"href"} for http(s):// link that opens a web page, or \code{"help"} in RStudio to open the corresponding help page in the Help tab.} \item{...}{Further arguments (not used yet)} \item{object}{An aka object} } \value{ The original \code{obj} with the \code{comment} attribute set or replaced with \verb{comment =} plus a \code{src} attribute set to \verb{alias =} and \code{description}, \code{seealso}, \code{example}, and \code{url} attributes also possibly populated. If the object is a function, its class becomes \strong{aka} and \strong{function}. } \description{ When a function or object is renamed, the link to its original help page is lost in R. Using \code{aka()} (also known as) with correct \verb{alias=} allows to keep track of the original help page and get it with \code{.?obj}. Moreover, one can also populate a short man page with description, seealso and example or add a short comment message that is displayed at the same time in the R console. } \examples{ # Say you prefer is.true() similar to is.na() or is.null() # but R provides isTRUE(). library(svMisc) # Also defining a short man page is.true <- aka(isTRUE, description = "Check if an object is TRUE.", seealso = c("is.false", "logical"), example = c("is.true(TRUE)", "is.true(FALSE)", "is.true(NA)")) # This way, you still got access to the right help page for is.true() \dontrun{ .?is.true } } svMisc/man/source_clipboard.Rd0000644000176200001440000000144414614131727016110 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/source_clipboard.R \name{source_clipboard} \alias{source_clipboard} \alias{sourceClipboard} \title{Source code from the clipboard} \usage{ source_clipboard(primary = TRUE, ...) sourceClipboard(primary = TRUE, ...) } \arguments{ \item{primary}{Only valid on *nix: read the primary (or secondary) clipboard.} \item{...}{Further parameters passed to \code{\link[=source]{source()}}.} } \value{ Same result as \code{\link[=source]{source()}}. } \description{ This function reads R code from the clipboard, and then source it. Clipboard is managed correctly depending on the OS (Windows, MacOS, or *nix) } \seealso{ \code{\link[=source]{source()}}, \code{\link[=file]{file()}} } \concept{Source code from clipboard} \keyword{IO} svMisc/man/cut_quantile.Rd0000644000176200001440000000242114614131727015262 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cut_quantile.R \name{cut_quantile} \alias{cut_quantile} \title{Convert numeric to factor with intervals of equal number of items by using quantiles} \usage{ cut_quantile(x, breaks, labels = NULL, ...) } \arguments{ \item{x}{An R object, usually a numeric vector.} \item{breaks}{A single integer with the number of breaks to use.} \item{labels}{Labels for the resulting category or \code{NULL} (by default) to construct them automatically like "(a,b]". If \code{labels = FALSE}, simple integer codes are returned instead of factor.} \item{...}{Further arguments passed to \code{\link[=cut]{cut()}}.} } \value{ A \code{\link[=factor]{factor()}} is returned, unless \code{labels = FALSE} (in this case, a integer vector is obtained). } \description{ \code{cut_quantile()} is like \code{\link[=cut]{cut()}}, but it calculates intervals from quantiles such that each interval has approximately the same number of items from the original vector. \code{x} must have both \code{\link[=quantile]{quantile()}} and \code{\link[=cut]{cut()}} methods implemented. } \examples{ # Transform a numeric vector into a factor with 5 levels of same item numbers vec <- rnorm(20) fact <- cut_quantile(vec, breaks = 5) fact table(fact) } svMisc/man/temp_env.Rd0000644000176200001440000001007614614131727014407 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/temp_env.R \name{temp_env} \alias{temp_env} \alias{add_items} \alias{add_temp} \alias{assign_temp} \alias{change_temp} \alias{exists_temp} \alias{get_temp} \alias{delete_temp} \alias{rm_temp} \alias{TempEnv} \alias{addItems} \alias{addTemp} \alias{assignTemp} \alias{changeTemp} \alias{existsTemp} \alias{getTemp} \alias{rmTemp} \title{Get an environment dedicated to temporary variables (and create it if needed)} \usage{ temp_env() add_items(x, y, use.names = TRUE, replace = TRUE) add_temp(x, item, value, use.names = TRUE, replace = TRUE) assign_temp(x, value, replace.existing = TRUE) change_temp(x, item, value, replace.existing = TRUE) exists_temp(x, mode = "any") get_temp(x, default = NULL, mode = "any", item = NULL) delete_temp(x) rm_temp(x) TempEnv() addItems(x, y, use.names = TRUE, replace = TRUE) addTemp(x, item, value, use.names = TRUE, replace = TRUE) assignTemp(x, value, replace.existing = TRUE) changeTemp(x, item, value, replace.existing = TRUE) existsTemp(x, mode = "any") getTemp(x, default = NULL, mode = "any", item = NULL) rmTemp(x) } \arguments{ \item{x}{The vector to add items to for \code{add_items()} or any object. for \code{delete_temp()}, it is the name of the variable (character string), or a vector of characters with the name of all variables to remove from \code{SciViews:TempEnv}.} \item{y}{The vector of which we want to inject missing items in 'x'.} \item{use.names}{Use names of items to determine which one is unique, otherwise, the selection is done on the items themselves.} \item{replace}{Do we replace existing items in 'x'?} \item{item}{The item to add data to in the list.} \item{value}{The value to add in the item, it must be a named vector and element matching is done according to name of items.} \item{replace.existing}{Do we replace an existing variable?} \item{mode}{The mode of the seek variable} \item{default}{The default value to return, in case the variable or the item does not exist.} } \value{ The temporary environment for \code{temp-env()}, the value assigned, added or changed for \code{assign_temp()}, \code{add_temp()}, \code{change_temp()}, or \code{get_temp()}. \code{TRUE} or \code{FALSE} for \code{exists_temp()}, \code{delete_temp()} or \code{rm_temp()}. } \description{ Create and manage a temporary environment \code{SciViews:TempEnv} low enough on the search path so that all loaded packages (except \strong{base}) could easily access objects there. } \details{ The temporary environment is attached to the search path for easier access to its objects. } \examples{ ls(temp_env()) # I have a vector v1 with this: v1 <- c(a = "some v1 text", b = "another v1 text") # I want to add items whose name is missing in v1 from v2 v2 <- c(a = "v2 text", c = "the missign item") add_items(v1, v2, replace = FALSE) # Not the same as add_items(v1, v2, replace = TRUE) # This yield different result (names not used and lost!) add_items(v1, v2, use.names = FALSE) add_temp("tst", "item1", c(a = 1, b = 2)) # Retrieve this variable get_temp("tst") # Add to item1 in this list without replacement add_temp("tst", "item1", c(a = 45, c = 3), replace = FALSE) get_temp("tst") # Same but with replacement of existing items add_temp("tst", "item1", c(a = 45, c = 3), replace = TRUE) get_temp("tst") # Delete the whole variable delete_temp("tst") assign_temp("test", 1:10) # Retrieve this variable get_temp("test") change_temp("tst", "item1", 1:10) # Retrieve this variable get_temp("tst") # Create another item in the list change_temp("tst", "item2", TRUE) get_temp("tst") # Change it change_temp("tst", "item2", FALSE) get_temp("tst") # Delete it (= assign NULL to the item) change_temp("tst", "item2", NULL) get_temp("tst") # Delete the whole variable delete_temp("tst") assign_temp("test", 1:10) # Check if this variable exists exists_temp("test") # Remove it delete_temp("test") # Does it still exists? exists_temp("test") } \seealso{ \code{\link[=assign]{assign()}}, \code{\link[=search]{search()}}, \code{\link[=temp_var]{temp_var()}} } \concept{temporary variables} \keyword{utilities} svMisc/man/svMisc-package.Rd0000644000176200001440000000272114715134454015427 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/svMisc-package.R \docType{package} \name{svMisc-package} \alias{svMisc} \alias{svMisc-package} \title{Miscellaneous Functions for 'SciViews::R'} \description{ The \{svMisc\} package is of general use among SciViews::R, a layer on top of R, and the tidyverse. This package collects together a series of general functions to manage a centralized environment for temporary variables, a progress bar and batch analysis mode, etc. } \section{Important functions}{ \itemize{ \item \code{\link[=temp_env]{temp_env()}} for using a temporary environment attached to the search path, \item \code{\link[=temp_var]{temp_var()}} create the name of temporary variables, \item \code{\link[=capture_all]{capture_all()}} to capture R output, errors, warnings and messages, \item \code{\link[=parse_text]{parse_text()}} to parse any R expression, including partial or incorrect ones (fails gracefully). } } \seealso{ Useful links: \itemize{ \item \url{https://github.com/SciViews/svMisc} \item \url{https://www.sciviews.org/svMisc/} \item Report bugs at \url{https://github.com/SciViews/svMisc/issues} } } \author{ \strong{Maintainer}: Philippe Grosjean \email{phgrosjean@sciviews.org} (\href{https://orcid.org/0000-0002-2694-9471}{ORCID}) Other contributors: \itemize{ \item Romain Francois \email{romain@r-enthusiasts.com} [contributor] \item Kamil Barton \email{kamil.barton@uni-wuerzburg.de} [contributor] } } svMisc/man/batch.Rd0000644000176200001440000000340314614131727013647 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/batch.R \name{batch} \alias{batch} \title{Run a function in batch mode} \usage{ batch( items, fun, ..., show.progress = !is_aqua() && !is_jgr(), suppress.messages = show.progress, verbose = TRUE ) } \arguments{ \item{items}{The items (usually, arguments vector of character strings) on which to apply \code{fun} sequentially.} \item{fun}{The function to run (must return \code{TRUE} or \code{FALSE} and issue only warnings or messages to be a good candidate, batchable, function).} \item{...}{Further arguments to pass the \code{fun}.} \item{show.progress}{Do we show progression as item x on y... message? This uses the \code{\link[=progress]{progress()}} function.} \item{suppress.messages}{Are messages from the batchable function suppressed? Only warnings will be issued. Recommended if \code{show.progress = TRUE}.} \item{verbose}{Display start and end messages if \code{TRUE} (default).} } \value{ Returns invisibly the number of items that were correctly processed with attributes \code{items} and \code{ok} giving more details. } \description{ A function can be run in batch mode if it never fails (replace errors by warnings) and returns \code{TRUE} in case of success, or \code{FALSE} otherwise. } \examples{ \dontrun{ # Here is a fake batchable process fake_process <- function(file) { message("Processing ", file, "...") flush.console() Sys.sleep(0.5) if (runif(1) > 0.7) { # Fails warning("fake_process was unable to process ", file) invisible(FALSE) } else invisible(TRUE) } # Run it in batch mode on five items files <- paste0("file", 1:5) batch(files, fake_process) } } \seealso{ \code{\link[=progress]{progress()}} } \concept{batch processing} \keyword{utilities} svMisc/man/def.Rd0000644000176200001440000000405214614131727013325 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/def.R \name{def} \alias{def} \title{Define a vector of a given mode and length (possibly filling it with default values)} \usage{ def(value, default = "", mode = "character", length.out = NULL) } \arguments{ \item{value}{The value to pass with default.} \item{default}{The default value to use, in case of \code{NULL}, or \code{length(value) == 0}.} \item{mode}{The mode of the resulting object: 'character', 'logical', 'numeric' (and, if you want to be more precise: 'double', 'integer' or 'single') or 'complex'. Although not being a mode by itself, you can also specify 'factor' to make sure the result is a factor (thus, of mode 'numeric', storage mode 'integer', with a levels attribute). Other modes are ignored, and \code{value} is NOT coerced (silently) in this case, i.e., if you don't want to force coercion of the resulting object, use anything else.} \item{length.out}{The desired length of the returned vector; use \code{length.out = NULL} (default) if you don't want to change the length of the vector.} } \value{ A vector of given mode and length, with either \code{value} or \code{default}. } \description{ This function makes sure that a vector of a given mode and length is returned. If the value provided is \code{NULL}, or empty, the default value is used instead. If \code{length.out = NULL}, the length of the vector is not constrained, otherwise, it is fixed (possibly cutting or recycling \code{value}). } \examples{ def(1:3, length.out = 5) # Convert into character and recycle def(0:2, mode = "logical") # Numbers to logical def(c("TRUE", "FALSE"), mode = "logical") # Text to logical def(NULL, "default text") # Default value used def(character(0), "default text") # Idem def(NA, 10, mode = "numeric", length.out = 2) # Vector of two numbers } \seealso{ \code{\link[=mode]{mode()}}, \code{\link[=rep]{rep()}}, \code{\link[=temp_env]{temp_env()}} } \concept{coercion and default values} \keyword{utilities} svMisc/man/about.Rd0000644000176200001440000000514614614131727013706 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/about.R \name{about} \alias{about} \alias{?} \alias{ex} \alias{print.runnable} \title{Get information and help about \R objects} \usage{ about(topic, ...) `?`(type, topic) ex() \method{print}{runnable}(x, ...) } \arguments{ \item{topic}{The name of an object, or the topic to search for, if this is not the name of a known object.} \item{...}{Further arguments passed to \code{\link[=help]{help()}}.} \item{type}{First argument to \verb{?}. If it is a dot, like \code{.?topic}, the second argument is a topic passed to the \code{about()} function. Otherwise, it is the first argument to restrict help pages, like \code{class}, \code{methods}, or \code{method}. See examples for how to use it.} \item{x}{The name of a function.} } \value{ A string with the location of all objects named \code{topic} are found is returned invisibly. } \description{ Help obtained with this function is wider than with \code{\link[=help]{help()}}. If a man page is not found, it suggests related topics. If an object is an S3 generic function, it also lists all its known methods. Also, one can track the help page of an object even if its name is changed, by using the \code{src} or \code{srcfile} attribute of the object's comment. By the way, if the object has a comment, it is also displayed. This can be used as a quick and dirty way to provide short hints to custom objects. Finally, it is possible to track down the source of an object into a file with the \code{srcfile} attribute of its comment. In this case, it is the source file that is displayed. So, you can also further document your custom objects easily in their source files! } \examples{ \dontrun{ about("nonexisting") # Not found on search path, but help pages about("htgdsfgfdsgf") # Not found anywhere #library(tidyverse) #about("group_by") # Just one page #about("filter") # Several items about("stats::filter") # OK #about("dplyr::filter") # OK too about("base::filter") # Not found there # Objects with comment: print comment vec <- structure(1:10, comment = "A simple vector") about("vec") # If there is a srcfile attribute in the comment, also display the file # Hint: integrate some help in the header! #library(data) #(iris <- read(data_example("iris.csv"))) #about("iris") # If the comment has a src attribute, change the topic to that one #urchin <- read("urchin_bio", package = "data") #about("urchin") .?filter .?stats::filter } } \seealso{ \code{\link[=help]{help()}}, \code{\link[=help.search]{help.search()}}, \code{\link[=apropos]{apropos()}} } \concept{help and information about objects} \keyword{utilities} svMisc/man/capture_all.Rd0000644000176200001440000000667714614131727015101 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/capture_all.R \name{capture_all} \alias{capture_all} \alias{captureAll} \alias{warnings2} \title{Run an R expression and capture output and messages in a similar way as it would be done at the command line} \usage{ capture_all(expr, split = TRUE, echo = TRUE, file = NULL, markStdErr = FALSE) captureAll(expr, split = TRUE, echo = TRUE, file = NULL, markStdErr = FALSE) warnings2(...) } \arguments{ \item{expr}{A valid R expression to evaluate (names and calls are also accepted).} \item{split}{Do we split output, that is, do we also issue it at the R console too, or do we only capture it silently?} \item{echo}{Do we echo each expression in front of the results (like in the console)? In case the expression spans on more than 7 lines, only first and last three lines are echoed, separated by \verb{[...]}.} \item{file}{A file, or a valid opened connection where output is sunk. It is closed at the end, and the function returns \code{NULL} in this case. If \code{file = NULL} (by default), a \code{textConnection()} captures the output and it is returned as a character string by the function.} \item{markStdErr}{If \code{TRUE}, stderr is separated from stddout by STX/ETX characters.} \item{...}{Items passed directly to \code{warnings2()}.} } \value{ Returns a string with the result of the evaluation done in the user workspace. } \description{ This function captures results of evaluating one or several R expressions the same way as it would be issued at the prompt in a R console. The result is returned in a character string. Errors, warnings and other conditions are treated as usual, including the delayed display of the warnings if \code{options(warn = 0)}. } \note{ If the expression is provided as a character string that should be evaluated, and you need a similar behavior as at the prompt for incomplete lines of code (that is, to prompt for more), you should not parse the expression with \code{parse(text = "")} because it returns an error instead of an indication of an incomplete code line. Use \code{parse_text("")} instead, like in the examples bellow. Of course, you have to deal with incomplete line management in your GUI/CLI application... the function only returns \code{NA} instead of a character string. Starting from version 1.1.3, \code{.Traceback} is not set any more in the base environment, but it is \code{.Traceback_capture_all} that is set in \code{temp_env()}. You can get its value with \code{get_temp(".Traceback_capture_all")}. Also, if there are many warnings, those are now assigned in \code{temp_env()} instead of \code{baseenv()}. Consequently, they cannot be viewer with \code{\link[=warnings]{warnings()}} but use \code{warnings2()} in this case. } \examples{ writeLines(capture_all(expression(1 + 1), split = FALSE)) writeLines(capture_all(expression(1 + 1), split = TRUE)) writeLines(capture_all(parse_text("search()"), split = FALSE)) \dontrun{ writeLines(capture_all(parse_text('1:2 + 1:3'), split = FALSE)) writeLines(capture_all(parse_text("badname"), split = FALSE)) } # Management of incomplete lines capt_res <- capture_all(parse_text("1 +")) # Clearly an incomplete command if (is.na(capt_res)) cat("Incomplete line!\n") else writeLines(capt_res) rm(capt_res) } \seealso{ \code{\link[=parse]{parse()}}, \code{\link[=expression]{expression()}}, \code{\link[=capture.output]{capture.output()}} } \concept{capturing output for GUI clients} \keyword{IO} svMisc/man/completion.Rd0000644000176200001440000001211414614131727014736 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/completion.R \name{completion} \alias{completion} \title{Get a completion list for a R code fragment} \usage{ completion( code, pos = nchar(code), min.length = 2, print = FALSE, types = c("default", "scintilla"), addition = FALSE, sort = TRUE, what = c("arguments", "functions", "packages"), description = FALSE, max.fun = 100, skip.used.args = TRUE, sep = "\\n", field.sep = "\\t", name.or.addition = c("name", "addition", "both") ) } \arguments{ \item{code}{A partial R code to be completed.} \item{pos}{The position of the cursor in this code.} \item{min.length}{The minimal length in characters of \code{code} required before the completion list is calculated.} \item{print}{Logical, print result and return invisibly. See details.} \item{types}{A named list giving names of types. Set to \code{NA} to give only names. See details.} \item{addition}{Should only addition string be returned?} \item{sort}{Do we sort the list of completions alphabetically?} \item{what}{What are we looking for? Allow to restrict search for faster calculation.} \item{description}{Do we describe items in the completion list (could be slow)?} \item{max.fun}{In the case where we describe items, the maximum number of functions to process (if longer, no description is returned for function) because it can be very slow otherwise.} \item{skip.used.args}{Logical, if completion is within function arguments, should the already used named arguments be omitted?} \item{sep}{The separator to use between returned items.} \item{field.sep}{Character string to separate fields for each entry.} \item{name.or.addition}{Should we return the completion name, addition string, or both?} } \value{ If \code{types == NA} and \code{description = FALSE}, a character vector giving the completions, otherwise a data frame with two columns: 'completion', and 'type' when \code{description = FALSE}, or with four columns: 'completion', 'type', 'desc' and 'context' when \code{description = TRUE}. If name.or.addition == 'both', an 'addition' column is also returned.\cr Attributes:\cr \code{attr(, "token")} - a completed token.\cr \code{attr(, "triggerPos")} - number of already typed characters.\cr \code{attr(, "fguess")} - name of guessed function.\cr `attr(, "isFirstArg")`` - is this a first argument? } \description{ Returns names of objects/arguments/namespaces matching a code fragment. } \details{ The completion list is context-dependent, and it is calculated as if the code was entered at the command line. If the code ends with \code{$} or \code{[[}, then the function look for items in a list or data.frame whose name is the last identifier. If the code ends with \code{@}, then the function look for slots of the corresponding S4 object. If the code ends with \code{::}, then it looks for objects in a namespace. If the code ends with a partial identifier name, the function returns all matching keywords visible from .GlobalEnv. If the code is empty or parses into an empty last token, the list of objects currently in the global environment is returned. } \note{ Take care: depending on the context, the completion list could be incorrect (but it should work for code entered at the command line). For instance, inside a function call, the context is very different, and arguments and local variables should be returned instead. This may be implemented in the future, but for now, we focus on completion that should be most useful for novice useRs that are using R expressions entered one after the other at the R console or in a script (and considering the script is run or sourced line after line in R). There are other situations where the completion can be calculated, see the help of \code{\link[=rc.settings]{rc.settings()}}. If \code{print == TRUE}, results are returned invisibly, and printed in a form: triggerPos \emph{newline} completions separated by \code{sep}. If \code{types} are supplied, a completion will consist of name and type, separated by \code{type.sep}. \code{types} may me a vector of length 5, giving the type codes for "function", "variable", "environment", "argument" and "keyword". If \code{types == "default"}, above type names are given; \code{types == "scintilla"} will give numeric codes that can be used with "scintilla.autoCShow" function (e.g., with the SciViews-K Komodo Edit plugin). } \examples{ # A data frame data(iris) completion("item <- iris$") completion("item <- iris[[") # An S4 object setClass("track", representation(x = "numeric", y = "numeric")) t1 <- new("track", x = 1:20, y = (1:20)^2) completion("item2 <- t1@") # A namespace completion("utils::", description = TRUE) # A partial identifier completion("item3 <- va", description = TRUE) # Otherwise, a list with the content of .GlobalEnv completion("item4 <- ") # TODO: directory and filename completion! rm(iris, t1) } \seealso{ \code{\link[=rc.settings]{rc.settings()}} } \author{ Philippe Grosjean \href{mailto:phgrosjean@sciviews.org}{phgrosjean@sciviews.org} & Kamil Barton \href{mailto:kamil.barton@uni-wuerzburg.de}{kamil.barton@uni-wuerzburg.de} } \keyword{utilities} svMisc/man/pcloud.Rd0000644000176200001440000000310514614131727014053 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pcloud.R \name{pcloud} \alias{pcloud} \alias{pcloud_crypto} \title{Create the path to a file in the p-Cloud drive} \usage{ pcloud(...) pcloud_crypto(...) } \arguments{ \item{...}{The folder, subfolder and file to form the path, starting to the root of the p-Cloud drive, or the \verb{Crypto Folder}.} } \value{ A character string with the absolute path to the file or folder. } \description{ Similar to \code{\link[=file.path]{file.path()}} but creates a path to a file located somewhere in a p-Cloud drive. \href{https://www.pcloud.com/eu.html}{p-Cloud} is a cloud storage system that comes with an application for Windows, MacOS or Linux. It creates a virtual drive on the PC where files can be managed as if they were local. However, the path to these files differ between OSes. This function abstracts out the first part of the path for you. So, you just have to provide the folders and files and it constructs a valid absolute path, no matter which OS you are using. The \code{\link[=pcloud_crypto]{pcloud_crypto()}} function does the same for the special \verb{Crypo Folder} that p-Cloud creates if you subscribe to the encryption option. } \examples{ \dontrun{ pcloud("subfolder", "file.txt") # Only valid with the encryption option and the Crypto Folder is unlocked pcloud_crypto("subfolder1", "subfolder2", "crypted_file.txt") } } \seealso{ \code{\link[=system_file]{system_file()}}, \code{\link[=source_clipboard]{source_clipboard()}}, \code{\link[=file.path]{file.path()}} } \concept{file path} \keyword{utilities} svMisc/man/is_help.Rd0000644000176200001440000000562514614131727014221 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/is_xxx.R \name{is_help} \alias{is_help} \alias{is_win} \alias{is_rgui} \alias{is_sdi} \alias{is_mac} \alias{is_aqua} \alias{is_rstudio} \alias{is_rstudio_desktop} \alias{is_rstudio_server} \alias{is_jgr} \alias{isHelp} \alias{isWin} \alias{isRgui} \alias{isSDI} \alias{isMac} \alias{isAqua} \alias{isJGR} \title{Check for the existence of an help file, or some context} \usage{ is_help(topic, package = NULL, lib.loc = NULL) is_win() is_rgui() is_sdi() is_mac() is_aqua() is_rstudio() is_rstudio_desktop() is_rstudio_server() is_jgr() isHelp(topic, package = NULL, lib.loc = NULL) isWin() isRgui() isSDI() isMac() isAqua() isJGR() } \arguments{ \item{topic}{Name or literal character string: the online help topic to look for.} \item{package}{A character vector giving the package names to look into for help or example code, or \code{NULL}. By default, all packages in the search path are used.} \item{lib.loc}{A character vector of directory names of \R libraries, or \code{NULL}. The default value of \code{NULL} corresponds to all libraries currently known. If the default is used, the loaded packages are searched before the libraries.} } \value{ All these functions return either \code{TRUE} or \code{FALSE} depending on the tested item, except for \code{is_help()}, which returns a logical vector with two elements. The first one indicating if there is a help file, and the second one indicating if there are examples associated with this help file. } \description{ For \code{is_help()}, determine if 'topic' has a help file and example to run. For \code{is_win()} and \code{is_mac()}, determine if the platform is Windows or MacOS. For \code{is_aqua()}, is the R UI is AQUA, the standard R GUI under Macintosh? For \code{is_rgui()}, determine if the default Rgui under Windows is in use, and with \code{is_sdi()} in this case, you can check if it is in SDI (single-document interface) \emph{versus} MDI (multi-document interface, by default). \code{is_rstudio()} and \code{is_rstudio_server()} check if R is run under RStudio (server), and \code{is_jgr()} indicate if the R GUI is JGR. } \note{ The code of \code{is_help()} is largely inspired from the first part of \code{example()}. Under \strong{Rgui}, to switch fro MDI to SDI more, go to the menu entry 'Edit' -> 'GUI preferences' to change the Rgui mode, or start Rgui with the '--SDI' argument line parameter. Under another platform than Windows or if it is not Rgui, then \code{is_sdi()} always returns \code{FALSE}.` } \examples{ is_help("help") # Help and example is_help("Rtangle") # Help but no example is_help("notopic") # No help or example is_win() is_mac() is_aqua() is_rgui() is_sdi() is_rstudio() is_rstudio_desktop() is_rstudio_server() is_jgr() } \seealso{ \code{\link[=example]{example()}}, \code{\link[=help]{help()}}, \code{\link[=capabilities]{capabilities()}} } \keyword{utilities} svMisc/man/gui_cmd.Rd0000644000176200001440000000336514614131727014204 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/gui_cmd.R \name{gui_cmd} \alias{gui_cmd} \alias{gui_load} \alias{gui_source} \alias{gui_save} \alias{gui_import} \alias{gui_export} \alias{gui_report} \alias{gui_setwd} \alias{guiCmd} \alias{guiLoad} \alias{guiSource} \alias{guiSave} \alias{guiImport} \alias{guiExport} \alias{guiReport} \alias{guiSetwd} \title{Execute a command in the GUI client} \usage{ gui_cmd(command, ...) gui_load(...) gui_source(...) gui_save(...) gui_import(...) gui_export(...) gui_report(...) gui_setwd(...) guiCmd(command, ...) guiLoad(...) guiSource(...) guiSave(...) guiImport(...) guiExport(...) guiReport(...) guiSetwd(...) } \arguments{ \item{command}{The command string to execute in the GUI client.} \item{...}{Parameters provided for the command to execute in the GUI client.} } \value{ The result of the command if it succeed, or \code{NULL} if the command cannot be run (i.e., \code{.guiCmd()} is not defined in \code{SciViews:TempEnv}). } \description{ This function is not intended to be used at the command line (except for debugging purposes). It executes a command string to a (compatible) GUI client. } \details{ You must define a function \code{.guiCmd()} in the \code{SciViews:TempEnv} environment that will take first argument as the name of the command to execute (like \code{source}, \code{save}, \code{import}, etc.), and ... with arguments to the command to send. Depending on your GUI, you should have code that delegates the GUI elements (ex: display a dialog asking for a .Rdata file to source) and then, execute the command in \R with the selected file as attribute. } \seealso{ \code{\link[=get_temp]{get_temp()}} } \concept{graphical user interface (GUI) control} \keyword{misc} svMisc/man/figures/0000755000176200001440000000000014614131727013743 5ustar liggesuserssvMisc/man/figures/logo.png0000644000176200001440000013617014614131727015421 0ustar liggesusersPNG  IHDR `x?IDATx|WׇO݅$ݵ@R+5ߺ-R(^]͹a&;܇%3#wv̹rvww@|b/\އz| qA_Ȯ~ݓu,yh}]{x rym;Fqu^N/D..3{>EuwvCŸ1PW0pr!> BengG.(iKtwru!@1RD_ zA*]H;tH.+aK^CaNuѾ4F1g6yb}!wkJlm$u,{o X&~qO/Dcme]",ݭ)_il0+/.&?w9]eWtut~rh=buCQf]"]^-Lo+B#̣*l]ʆڼjuYǭυ_)6*s7=j?W _fKY(ډ?Pe)nV6%2E.dvf ֦]m -w>ŝ1x_W[i,w?,8GBYB e17ήc^8J]HVUK;N:X8J]w#\_]9J?Zzջbö2bAH:*O y"nV U>ٚZ+Ʈň?/x* JՅ] ^P}c8yuW'BU%2|UޟȺ+__ި#v $<*UʠhiŨe#}u!| [Ve[K[1N^.F<330;pRy߈\L_P1b/.ѻ.+c+Mx1_Z;zus-ؙ(honeH]:c g%ԭ' h/g.,%]`li*53lWhUU@>l[:Qp'LwOG~u}.1&?/R^.HtA75Go-)u_m{P0Crۣ%=Zһ>ύ|h򧲶W Y Sobw Y fOUz%^'&䝉s; XTQv (xWp4\ QfLmL!h]FW!nqwz6RUֺ/ƥí'^еQKAZ] ygs|&hVL>nb7.#ipZLaຸoAx"H`ml)S* >O[g{')u>t{h,Fb+ͮ/ek޲\nk2η?_5Q!r.D_͸^7=>WqQB.~~ ZWT86lfl:,oF X[)/^P{}JŤQB/% JlL1Hn@ǍՅ( /%^Z`2A=QBk<~TueB'Yr wظ /D.x@v1 YuǗBILli ~ȼ rߙJgDζi I>nwsjzc ӥ=nV&O$nNf$v027uL*h)Vշ/cΏ*)-V!9_Be.&xdq"Dw]8A3Zчhk*ْKP1{$J]4C7/jhr %Cx:KpRy: \ȿƬU% 1`T Beign06W}ۚc. (}! Սl;_=b^9TER"vs*EbmUQb!h#ղU!^DCzifXr<6k 9578t̻2'p28kR7>r|G"f e}>;~<8{J!ք}}O+"CGW'|sycg( Ldzγ>̛ae~ _IᏑWSR(}N^.ʑd'Jټm='[AlѪB:-Ebym!kIB[DA>CD{r\>ljtʓ ԋƦG@-sJ;_/:-]mþwx WDEb_/u!ؒ-jȮʨ$IVvXIL`˷2#EQO/<3/Z#VKPsp1G^&q{a'/\ʰeO_ JzӓIY^lI[㡳w}ŶGy 8);:?n 殖dШֆ߳ey.SY(|+UYEb}9F~Jaτº!KGlw)?+8/cݝ.rA#Aߐ}WRQr|H[_=l7.O*kj?>NWUY$xf|nʭ(/ucK'6(~ݝ8yd81fq6Qǭ\[ 3PZwHs uW HlMkl{=6{]Tz9?Z@Īѿh.g37DpCQ=d $ZR_\c;Ҿ#^.M]M3QNa cp5VݐJo,~sD1"6,FlSΚDiZYT!zp= !?{7Gwl/߻[9e~/n=r GuWa6ؘU?hr&֦7+PmvɎ|i՗鍕3ŗ߷w]zZk{.rCvެc }J}C[r} 7U)`q9g80+k=5FPDA(KQ])ZyQXW?^C}ńD"J Fsm=*ߐ}LJߖImؠ A4wh2I[㠳0&Y-9|(@b1 iN˻1A]̌Lᡑ[Uڈ|LuNDrϤڱҾ5U~t6"B!"DCuE?̳>wڤ#qCYd_cYa3N83-# }VΑh]CqPcd@b^T7D7f[8L9,ݔoґE6|t/Y^H,9oNhU!7XQڛSOg++k/7deHbNo:ı`ў#xdP;qzC䙼sSCxxj.O)X'灛3tWo4ׁr)ƇX0?x*קr+1wٝrs "ڏdT6ED}%E Pl"(U*ueD Z, Ɣ"^KY(MJm?x0]!/.F*`zC Y @>w$Ekx2"ĕ( 7OXpXFAE5u,8)6-Mc i: u'I( 7ăPR'u1$iZm đ8"\H,e qJHmK7.bY^)GF &}U92SL",Ae(| ×ך"vu*P H˃ju7Qvpi.(Mi򆈣뇋ל4P^I$=a?7Kls& LR?ZCkK*ZnV5ne㪒2?.,D437DPDL1u dt憌}G~◲}'H>)637Ֆ']ѕ!2swup雞b!tRmDϦ_.}UV)=_*9F6gC>!8=vᅼ>ª2%fّ=lvwC`DYJq:я!|\)ތv0Fh,eϯr2e +KGKˀ檾CZы}(733BH{O%7DU/}ﯴ'i7rQ=9oh_uf֟>yȉ'7W3063PE^;ϥi3Nzi Zu"4ehl{*XSsLzaIo~c!bXm4$"ܳɐoR!pyg.V6s#Yݽ5V~[K$Z?Tp[Oo =XCK}Qğܓ!m_p1]=Ŏyd1b'|u0<3k_FS)-l]+9ĿO ٟV?QYU;/)R)қV;ṈX9U;(zZ%n=ejsjȫH|`hX7;s"|?rCIcy}2'&5INPP %7d~ohfT;ꞇz#^nEMT$BP\Kɮ}μR1445j^$jsN|dUPxY"T/:)џg=Om^z!I"4e=-UMu8:ew8>5!->[)6XzOe*gB* ޸(~Yǒ>sK!lCk]mfȵcgu`?#l? YƖtnЪgG8ɑĿO疶wu.3Y/DZVq>3mL#fhCgnHuo䅮QޗDRl=Y }^N??OyR!ހ陬'/CE"O eL:lZQn7.Sv7<8rOc}8C },)R !^OFfF7;LMz?#*]9Fb7טސO|^n}.@~kMfK`m1ZwCgwqbⰑenYRo}z"r-ZsCZ {Cj-xMUI~p4u,e!ޘ.ef[<7D7+,&NH'ݏnBmx zCY0&]*4ɰ|0 Z|TA_%$,(Opݣ=IJ ]}[;Mƌ9o}z^3"Y'sso`n,֍^ F//bMԱI0!r%̧rS~*;+=i t3 7d/.<Ҿc'TQg} ̍oa,ޘCX =>PV]xŗu&X )O*83wS3`u4\|V~T!;pV6s';NfsR{(7Df=U_cooԴַH4pW*[V_LY+[20 2foH+~aOҾDsG_*m 7N1$%ly5Ì{nq̔:`!^Of7#@.BGė~'X1"D˅OIf7>@0L*MA5m.$mzC\;t )KBg-qn5äAcY6)I sC6㮹CSp@#j?gV0E5xco~pϤ#{oN͙K cOML3䣹CWPV`;%a ݌'!Si0Pyu.yE0);IF©cmM.9o,7VAqCmM].y5Vi ΤCr"RI9 CgzCT GnxQ0=ShZ?]E-z>*I܆x\JL)YPT2pvCEKWIpe#\BHB<.g&PUԇBsGQ̙s };yJ<4(˫Ã#_) R"NVU>{i|O]6ܔmnN`/5K;&OFiTAz%ozlA&17b \KŚ4KɻN\)|O:k8IqAWzlI2.)>{y톰){J5řܫ0Gi?ӧNFqevoGxH!O(`=dcx!XbsC7Wh,bBٛ䏘4uO4Z b4yJ೫V!cuU+ CK>T u|yw^I!XM}Ͱ`s.NO=9oIu3jV0!u8ۂ47+ޘg|"])4-끑t5(BI\ȗ:FI*c"oMqc'Դ^5$;Ͱ'S͵ե*h AX#qejYq%VȆ ZsC.%c,d( 府٦Tܼ(:\\57e99ƪz`ˤ+&JZuCWttKWc<~kG Qp5qKC͎fc_Bi︌ ZxCh s{C =F%UM)D|i QsyHR csgmkS.BvfZ~c;XUo>wY8cu*r)t \6ď)8.:sCQP#Fq⍡g4ԃǗֺuc Jߎ'Ԛ? ^o?Ä[ fH'^~78Gns7%~>jgKK|&\½`؝a:HT Y6'%}Cx@7뿫%]v] y}>;~JÇ=ʷw]M+M왟ҙ;J('T IݓDEf5q$q$y$LnMigjӣwmR:y t%:5UփOuN\y( f*WbKCad}> /}ߕ%Z>Tx+)pV$IȹOASE=Y>.Y{C]aLzqcb o0o(˃qO͓8>k'Ouʌ QYڻ D&4JΑ("_F?>=L_!'oPWpb[OVIb&qgr![Kdȍ6޶%S[shiFWdm/FH,)w;#fvۉ#+2S)U1H֍;MʛYAY7?nFMV5ˑ 9 Y&o[)iqm ID/\$U{ hxc~̲Pikf=NPSLJ0w,}슀7Q-ϓ}Y:rc;V]j-\ yݸeϴ}=L˯ܓWJ{HGNZ{\'mZ (.N: x4KE(bԣS>ʂ:'#9/C_kloj&71ܴtNDP|UvsS|6λ/xy2d,RTFRạ+M yAoiv؛RI5IZ:Xϼ`g>x55s٭'&UW4ØATr&GvK+<2]XOW݃If3Ls;1^|_3 zƣN5ӊ .3@hF, /8&o_${>aj[!Ht4˞c~O. J h\[e1~ST$_cSaJ"(O=m_-2Њ@>epx1 B^a͈6 yh Aa>)ťoCX]~ ̖(! zzzxcїv m 8|th퀜c\)e3373h 1l1}Fmk}{wWO3}#xD_|P1 ۟z_c@ko&ႲKUZI&?!!"mk:b=ੇ.efyjљX9?nmh*o\S7DČwK-&ӕד4tx.>0|#DvKy(°_dK^2}O)I~c: %?D}u K Fe)=V9P0G۸͗meC}9E*@xۨ;:8i@:H̻t?tUo]j5Ϗ~oFyȔ;$\|vak~7e"j iK[kgf >`gz!aw ].\J/nG1ᲾAco:[Գ/@T$qD/a VJm>Ɠ$ &C@W]&_;Og>e58ݜ6;]#n1y+n-T)sz7`eku1 e R@{:m?bj0u /d=ŗߗ,T5CƁTP_3{ pwf @iW Gڔγ#s#&S{3Xջu(d+@s?cekۜ/K&uAo eIEʼn1S >S?'w)C k|;)m|pP7_`}psXX2UPMan}k@W7K;d].C=+ /qyLU=S6w;xq]SW)Ik3:`cj x՚*W0RDi|>!0>>C`ҁza`ffw`PzH.$I3#S7v02PؓI?Ѭy~3[}/c m VFU6"p=~o1ȮW 4Wz&IsW>1R()Rjc \|ݖ :m ??yC:ق|}{e3w*悮.dT\4ԅ$rN]"M~ֻYysmA Dk] Y!\s4$v|eVO Tiʅo&r {B7B`@^ =ml@/abc PMw ?#V2ބ򈲸G{`LdR2fX~c37IJasN}p!l&e`k&!{)VLl˫Qj_,"V5`M!0Za !qZF}{|ewyL&ŶOG+X%l`yK Xֆqki-3C06Ghc?pWR^4"> XlT`.|rmLJG(703OB:(r߈p(NcdV◗;,2q**0 shfSA:MEda.C`/wj# )Q e %2ӊ`Eů.AcJ\i2Ik#n>PdDݜtVn @(r rJ3+z"4obCD+ qͩPT_MmMd&s#3pt0 u:(!7p8;&hl+Ymg;ԶAjEw>$t&605>:,ߢk@Ȧ[Sػ= =Z´$ X:a Hs42bA g`gj wE-옺>hgE{EĖ$ck@g TF@-uMMJ1il'#V9G(k/ 44<$k-sSt?] fj0?b%Sj_o7)[+_؄߯0XiAL,*\ Ig fn5cc J5輁xdPR:+L70ؚZM;M CP" 6zcY`ɜ$a3 2 D'lpXzN *@DweYO3#xh8,]eM'23hno%Qw@DORKgup$'O1<Ae 79s bJΎHkmXIJ+7(C Mq.88 - &xB1h DE`_q"88Kp.&]\{Mա 8m@x 2ZJ* *YaS я\jj bڛ'5Tؠ('MLm}4\,I=ԕΛeT`):K (qomQTmけ+a_qȪVzI8~tՆ۔E7r)+ ~ C Ҩ^Kp6] |s\PW z0yy;,rm;tҳCuN D ܆H֗}7+gV$UU뷵!"$"]55X>W%`^#1w+P۟z2Kw*CGGĩK@2Vf^*jAgWZSgnΎ%G"~]o=@dSq";99SXlBϠ,89ORG$|MQ >{)Y@K@KG+p/CaVDAέhTp5@8+÷6΅sbhTxo?8+#BvUUI.Aנ>Pp^R9Tq9'Z4{+ϛzcۦnMC Gpf'65 [pa4vu#|T2P 6uv0Bȫ.Rok"f֮m6=Ɍ "j cl`v>$Qj P(rBȁzGR<-f(Obr%XG^ =>B=E}LԚI!@OK dyp-儴 stO_Ci X6|*IbwN#SI|H~;|nfgknMs+D z=ٵ5CcCp|ǟ _+%uN5B5A1>B2(BLyVMOwWo7:m 3^z}GʵT7B{KyERylAndDEE!|={OG#ֻ|rE-MM>CPV[ 1ƃIg2)//ڛъa09.@ kgGtHsU涢-/BmAONyC/e@c ջ8LQ브9Qo&'7y} %^Øk]?nh.A?-fy,mC HB-!x7in;@7 hk쓉Rw!  w._EyF̓@ PoEI/,]h=qf0䆿_QII7",N$@EZVaΪT>Ğu ]^6l6;.1Z7C(zũɭ`硥F$:?r 9ӫˠ*U^ō GȄ[g[?>B.VAn@9}ǛEPCGKM 47B"hUM1syZ_KX|#/rOf.9X@ zM!Ip182oŽh u}E7}xo"X!pOT+V,M)j:%Y<ұ!npX/dW3EFHV]>끳/>d'ƊΥ{G3)w=`N0;k.$3ҊYяe*=Y҉_(?2?Sp!bݷy\΀Ѕ#IVQkC=8/XWl6ϱ>ed٘Y\;b7&GD`4Q;Ue_Or{շACI='ҍlaFn"c"ς2@6'<ֻln z~`\^˂<_,{G^U$yt,rCj䶇olSj[4wmQ`,tuyƍMݛ~fcs-җ,91ӍO}@3S|*S]μo2/,JJA?Rh9k}Ml2T_Tn07"x01es>=FM9gR ̌IˌOkOOLOOs!< )Wu/nlaz3+زgjkO"J$6)L!$"Z v>Jv#ca]J&cO]=.\m/.h_ R iG~!KoƄ]]?PT٨GKsK<'!z [=\"I;ߔ0KoʍǾ33V\&ނ F=kle>c-P I2Yo.$CRHFH-c|p&}BabB6K}AԶ@Bahbؼ.M'#sc9VPqQX$Zϼ#67L. C3#ysN;C[7'T6=Mc5L%KU{>~s\яL&\noj6riݝݐʪs p:-x⫅D0Gf`żk{*sgXYwYb)I0Rt|aIO`BUBEn];o>ŚڢÄM NߏPխt|g['$m]w CAFhf*%:U!viXl;FvY`E" %)>d9ʿM0g*5ѼNL\]˔Y- [!0ޓ|Wv+;鵩8WU1Os*8~❔V|wR+ 39#e pAHzhh$}tϱ 0[ҟ*Z.3~oX4Cu`60BQW MOѰx"(Y'Tz e]pYA $jsI<]8V_~c9̚9G/Bq0a鞇)o`jt̀ "Zk[U>δo{r0k"N܈Dn~CI-^}m|l{2iuZ%1E*ܸ7 L fKP"/!Z1jsk ~ 0Ҝtv@M^-TW w'8U XOńEUj8!e筱&N6ړrOCBBPve3x,vY ncHیuC.~y56ǨH)' Х``!0]]PT6)A+G2+0k:Ǡ4apۨ˻::m: i"gi*q<ʃ^W5~`♬zc-WXEKnqE>Áhu39MQfAL\WTwYnQ[nx4Z* H1JU}rKl!1J/@X`n/I㮟Je-8Gbjc Cerj*k էKvgդȅ,\rybQyݐ}pxt042?0oZȿ*BN1e/Org)H69y`j 5X^͝SiwAъWRnA DN >ݭˤ2kXMLkŮw74P= j FOO/Nԑ꽇& LxakOxG3D&\4q;~1T.p g*B jr*~?Op飾Gm2$f`ɯS>L3w,EfS"oPS^M .$_)Cj NwW}S_PC\j'==pf`F IDBY2ʇ`G|4/Ej jPSdv4 e`g047ՑPWY^DVԃ Q *\o} KK[_;V*'޶0d,{u&4lE=D^x, L u;Ysã"X/HەLV+=:] B( qPD'$D#xYֶmRYH8*T1;{p;EyLlL!bMTCV|{律h؊biK,f3;3q/00g*ej6аPwx;v!:g[']m]+ [51T q &v`cGFX e u]ɩ7l۵+а@~V!X3ОI--I0 h[Yi> [q3P}  7UCp)~!RfrX@ 1 W'uV2C{V&o 9 TgWa C\ax^1G\)Zɠ1!Ejf?GVmEͰx[qF[i 9䟛> ' 0Q#iJ=D99;Q:!7ovoq!a+]۰FO0leq_ .lE)3a˲oβO[CDg OؒHV ˰=11-fʐ[Ѩt~><Q<  yg%t6Imv u7ֻj0lEc}w/djDxq Za " [8ܧ! g>X8 QD;F}j C_W|e/\ G3gKGVDj+S7f  ?> JcK>2߮zDIǴjc#Ίa+U?|$AJHѕ 8ȅbo6BaϵxHȀG:+ba+y])uO의؄(4RMq@ VZ75 47"R454:;Փ\/DV:X(lEbi N`?o1;ΆR![\GЌ)LQJJwW! [wJa*2VsW3C2V$Ku,n4,r(d@hxpV81|{e3<&`Da+rx!xj;H%4C )j C}8eR8XƊ8& X{M"!~p4 t Xyr=JPrW2j_04oy>B 7B27, 4 5L"]@liɮ'zp+B "1Q;WڥA "3#n}|OGKPh /M.BgEi@pP"#U)0Mm "XlRTDyj -1(/sWgN8x&Xk:5ѥV-3I>cLeە7V7Ja͊P`u2-L)!<0r%`ꡋIQ qgh ?_ mrTN DUOW9:,R+2`:殍8[82"e ev v|dp"ėɗ7VVڰ( n _ae3u`3dUK7Zp.1+MyS96rEd\:zc;S LrCL+wh\hPYZiXƺ:tMu}j5 eٌ 5>h.imj$>Wǖ2g 6;3w0s=X:S0k˙:>\i+/ēu%]-Sh  ^]C bח a׃V0eyQɪKT6U|)>p(4,jZo Ȝp(غMBpra /l>϶DK!N@{i2fZN.@-,e~'f#'dP3'CLYh)"<}΋c"d5Y'PHa +JŖ9u@85dO1xhͧ,ZxVٙYfx6{X_t@np8cxm b@Pƛ>ټYMC2 >876Qrs0js*H`mF  v,N;-VM? j|wՍZ dnd h 7`pΏ+W@G ؛r|Nڻ"n/sZ:AIC9ǽR buMqxagr{<'{քdN4mBgC+ɧc‡W6 ꖭƶ&)N"M4dmmD9/PQwv|mr:5MN#JQ,/ohIr^ |Ǽ${`2{8ėF]PW %:k;9_:m N΢ē8sH$KܬΊ 輁 lAw|̕ur.oaΡW&[b?\kP6Z A,~F ak@T>2عRQajx2䞨{1`lؘZ^}XƠ1=}mlؕ|X Hj[!,œ Ap"@{o`9.E9fG?4ɠ2d~t2a[gYDŽtvuBESłjWtd5.],HR@Pn_ X2 ˠ4emPކr NUԤ:5 cs=]:+ZCfe.g{@4ZACRy:T64璟mGfP&6 ?g7Tpm~׋`{$@lu6E}]p`014:+*A zép w[7o{WlߧpLvu>QzGɟ*ZrGs;2:$Ic 2C I1M4'cu I%AޑxSuwf`ޜ MSqcof X $ͅHxa} ֖ 5~?rF:Tz[Kcsu Ls?;\Qs|}y#oǟ7>& b s7v=u'0by\ؑtGV5]T_j[IL@ D֮0)3J/PM8Vp?ք}dB]fLܚBTJ YxV ϸae !Jo{տT@xLļSjW5tխ̞{evPቖJ{2Y&1`A DOyǀi4`,^_|s{Jk!a‡wCr\J4ѱeeYniX׀My\D02541\gr~|Nr`__m]a}z ׭$Ff= ?xYXYHU@yDAcMn9T甓ߨ_ F{c ?gbR`t4E]~-hҫt&$`gx 2)kdn39gB*M2|* &>,`"l®]()ʷs'9ֻq凣2 VOS{>o Z JBg?+ygs@|.0.# fCMTYO*Vn,W甑oV$Y1$# lFu"U>D'ק+׹~i2E6{a̛6Fb dgW,8eRko@}>Ǘ@HzVΓME00]:Pz 8wQo5ihar c1 F{ Uf[p"hGTɔzBvI\MHxU7#;&|YvY=JǗE(cT'f^)t@ɞCht:[Zʳw񆋡Qc++RInVHEb7G`%  NS«B@ċY>C{? =43k=?X 1TǟB8~# xfڠJcYbY87|.ܢ/?s㯨roK#DxJku~x4iZa`K7; # 6W7]ة%)b#b?[+颊:l.E*{z>}m-yϣ*tw1ujͯBէ }s?Yugu/}?H)f=d٤mq̏i 5Il7" I(scABEV㷞c,Z!ZsF?>o6E {-mȲ[$ﺢآ!z22\ *զKx2.Q YIZjviWG|cYo"MO\Q`"s=6қ[Tzc|ۛo`[ё* ƍ\$ǠGE G[.%"\LݝO)mdN}%gg7,l[4ߊ~7u(lݽ9wi,"x\!>BԁZꚠEqFo=V^Ej&VX [/2'L i MQq86nxQēSDTf0Do,uLmKc IݺNƆbyX-"Wj|JӖ@9U9;_G؜z?pttq:ZF֥zץCI\nF19_z7%LW<*QWo$Zȱx8RM=!šOvRiAls£^GaYNsb/ c,}q!%؆ElHSqr\ƖEh,0lEKocon/\=Q.~} ?P˫eU ͕CDD?5cÄ缡N^0vwvSis,Ҥz `hhj 6UQ 9ds&V=ُ^qz9XAkm3 Ga ̋[SQn "-TU )S{]"K(\m ){Q [ vh/;R7 IZpe@1SR5<)EƬLCnx6#7/\2_EZIC;{n)ECY#wj{aIwq '?9ώT9IKTgSd8.eH*"bgA^^iϯ%WG_P9$i{IdV.vvB8i6l.DۖũejcV.b`0y)vww~QD{]tHsE4W51BC>PWvh9@ ggs?OqnCc\ʇ( mnJGs1E)?0ėg0kZÀ3aGnĴ?vfL`_HݓD0KOS:2󒪸z8̙1` D^i݈ (v6H3c<#4{bY?@D8$aoOtU*3&Q,lhzxj낚jɮdTkX oZ4Y n,|\eh"07h 5Yդu"Y2:f S JqEU  [pXR~P=Gndz`Pͧ5?1m?T]PBR 0wa=Y0gշAc%$TDU}zۆo0k:ˠ7^O`[{?gT9Ft006e}&,UgWA}~-Pö/nJPS* I[ݚ Rs3<$^;up3W5wŐGm(asԂ°^}JSyT7ABӦ)='a@`hYl)c8' a(EW󉈄yhngQuPR5Lym#PQ%Q[0{|ִi{ [,3*cߙU@X5X}#74W5.7Vsa+LzU԰y]웎FfN>}"rUYM(Uc`&I~`k+sIJMmLpR bS6 _6Dcs淆w1P[*|xS^[PQMߜ)#}W9`OwD07#:`-5*SUΓ}sʽǟ(PU;fm[-floj&b\*"zz]^B)b)}!X~*KY*P8|feȢ*L 5?x/s fW'Vqyl g/*.K 5 p ontn. [? .F5 afgQlin& S/zf>:oP0kc?7*gߙixPykwc; uR#5=Q" X~k?O SU;MwVQz8daogh('JvLQ(Si/~y# _97\ԁPtnW9w]J FmY9\643jG=2&-BBau Ի>H}Nw.t&wx&\rڛv s GPBj-?}/\`m8C023s' H()gV8X\66̷𕾡~o'PT:V\tooPwg3h郍-;[-}xΔ,e2vz&"'#DŽ3Ƣy;)@({:m{>,}S;3ajL ,a >ԉ$'t)Q*Y YǒbesG҉/{%|ը_ E(h!zζc{>XyZ3 [sa8;\f家.2e^ErtTr?cXYפWdfK%V(:F(3(/TF2D-LM,̝܈i IHciCcYKs'&\͙B*B@(n32^ڒ!ڄ5X2 ԞKm,\,NYj턲RJNYWPC%V(: g%G|kg  [_[02ő`hFew' F4W7!X u Aɐ/ {'I uPSLƟE1Pk^X( u dH+;M K`-ꃱ1̇5zd@#& JK6:#F?:#*Bu  k=ϼw1wo;0s0'8;*-s7I8 6JcKs =gcy;)EBH;w D2ćsɓ m=I%VmY .ؘU{zQRu 't!+/2l CBb%JyXm;O1ߌ!RA u "0sښ-.BaX q"  HdK^-Xq,X,PdϏvcHPa&J6R:%Cl}Z!\knoZmmhhN"b!ZH>0)#s2[3k1#X)kX͝XI):G!d[!DºRĤbko̜>d̖ssJUb4۴ oJ499XvR P'E|kg (Lhl;!LmZqUdCGfK"^-as( u SC #A-bhj7%VvN)\4X-:: cOZb$$CLq, 1%p0:~VۚBu;Sk3Y?X,X~/==kXnR+NB|!UK1_ _Tcdْ޶J$V}L2ʴu{RT:-Hlr}>] }i߁BS;ٕr,:1d<ha3 jQb%`ߜe#3яMpSĊ@ɐw'J( Ni$9’!ID[BbLJƄcN`)܍Ju &m) hӒ!单3ji_T6/׷, &Q+5b,9mOcpʴfޢ+:ijt< [BIZ6&\G?I@ǭ8aj>dI,!< B 6u.iާ7pʴvܳ>%V)-W! +հD hpQ9y)T՗AK2do)[|eXΨ҄R)m-6)!ĊN;3N *[Դk|0@ɱܬaQ ۡdA]1'TZҷ [S2N29=^p\}I$V'/Ą(2yjNJG27~=Tg[KD2,\z 0!i`|0캺;Ywvu0`Lz̿@{_2،j'}$Vڻ*5 rſ7%V&2%kXzRt%g‰Pɐ. 8fWe`4qS#%47@uKL~u! muDHl5!dW瓄yTƙ ֚ bOb%+_mں1zSbI/{T$V'E|{'}.cKc|!tȫ- 6F͢.Dc7US#:$  s ޣe"2$ K< R)IJ@: c~?ąOZak2S` ԴԒ$V,L"رט `G$tP*rm"Jy5}$V̷5-1RU|=gO! dnd3ƃ+7w1:XY9QK@nJwS2ę#ba NT2BMͰ7Yr%V&v_%Vڠ4NC+H|8fԏXԁɐw|7%C I_}d2Ld"(%Y ǗrJ$$VۘpsJ,z9=@Ǯ8aA%C(: ʁ|wO1 Regj CݝD()~%V.dN4Kq~s}7PMbint8w^ֈd X$CԖJP(DuK-lJ`L$V|ɲHb;XihXYXQʁhV2l}JP( Z3 tMX{0 d)S E !އ$.$$"|.*IA0wܠgE?2J/Wb{cq }$CJP(JLERsG+8M$߅",$_[OOHZCĊI(XR srwgd5XzZS EG134%p0VW6؀@yZYA'X)O`j'J@ ߡW2ld2 5#g!"C|wW6;q$FXqAtuC]A_+T{ZwʄD CP'XƑGS,FGR:` fͭE]9BQj[=e ۢQC<M-BԵ6׶tF|, Bge@pes`GA4U028 @> ed[9Il(u P!<\aAtU+ 2OUL(J&X✺u :M9EBgBaEc[3=F P!IsΤC٭R(9wFBgԁ8nVDS`IH:; +k)+tv(,d07x*fq{~aI 8qٿ'!ͦ(ԁ PkT%-I:; + KesYP:h[BS{١P9'G0=jXX#p>١PX3_`kj-tv(2d3c( s {NP?;/2d]KT6WCMsԵ5@c[#4j"Tv#f'rG`]Q )Mx wnL"%5!Z<zb0324/P2u'8SQ]١h9-W[(t6 mM-0o, u :;P2@9Aa] HT EY"Nd_TX KhxXwáSZ-tv(ZHLhnIE8 cö}&tv(ZFͭ^5|7zt@PB;Skxdp .3Bɮ }ܚBfX6\,Π:J/c= ulej#BgGM\ IX+v(׶º2*tVy|}MK=Է60D{::ak>pΠ:JL M!"g:;ckb ƃ+}1!$.\pcCHG{g)hT7@%SE@ǚPFf6Vc0AE*Aa wi~j;}#݆Bdq``Hrkk+qBgLm_C~σrؙ|4:Fp0D."؝|DkFskұ-\*L u Z9ccYI3W]kĎ; 63ؤVd ZS!G H( vP񈺩,tvX%4&A"S% BgC*Xܟv{QC΀: +,M $N\:;J;?˻m;P`ȯ7ٝgD u p_ ܑ/6jgSs[C=]teҌe&tV ԁPTPV ]u%9Alh׬#sieĂ>먟DB|Q* jI/Np&dmνwD>ԁP2nD؂L#2)abh&:tBV&$I_SX g=a/A3fNRj;KCnMyېټ 5fYcE2z sWE#u @E+1,M,  Tɿf6:+m'h>5:#GЎumym6 |>W4Uzu ֍Y ҎCEh8P1+Ԧ[hԁPӡ' EWK'X:dBvYJP3xHagfZM"(F|ȼ! E^vCEHrޥ1 &qpt$ YGjLj!5gBh f v^no (n(:K2%&`l`$)^-#]ɛj;i.sPߪ L+25 IȂWNu ~;Yjs ߱c8p*tf@DŽ֗‰DRY6ԁP f(tFzeS Ė$CFet ecb .A/[<\`mR1 2`AH%WSȔDHGl[gc15 G {vOWp4Au Ax۸DPԃ: Bu  BQ @( ԁP( E%P(JPBP(BP(*ABPT:1`jkpv8?ѩ\;I/af.wV&_;n=>BwAk=)PBY M |Y4o; _PԁPtH(M̃^c |2PBy—T aJ(364Cwg7mF"MYˣ!~+?MYaKǀݝ]ĹBeF I.CEw,ytW|4!L% ܇I|y4G=2xD gkt Ff`hjLgڛژ mLj,*RLWBd 3'> V.*w_tmP"ベHΎmAsHjj+&$`^~>NZ3K#W`?Eزhߕ&1~yҙ`ԗԐZqDlI4-aůBs05a$dJI?qT%k.:񺲎'r2U,cKSrS JJ!i}Jz6T0D`󖭷xMg) kj8aQˁ4W6AER)XyX)EhThi˔n7u2/Ūp+cLCWI:|y~hNҟ%Րq%  sMt|z`:qBvtwASE#5)PRɲF'1M٧4Jg'D=Y;8 9g:K5{V8MY[(96e$Gl}$>O`^Z2>C!я͑QuI>B۞!I!*($\D(q6> h,m̃d\]# &DÔe%ÏbS/|!T~ Ud$ļdd]< *Ӌ]#Sz㼏5@'1%KiRԔ0s(XH`Eh3daOƙH8&GRe Shmz5A|BUQcy l鄢E$! vf2 b QΔ x &XRV|1kL* ϧAy [a6}`v=Sge/QRoM41`i7e5](֊2'$eaX{84h.,=sW.ЖgL~KB=Tm8(eTAk YښWnϐM ung?~w1^u$!FfF2lAP5!]BC`;SZҲdy!$ʸq-R? _^* ed ! Cח]͂Y,B=%̓ - QX"H`z̚@gHXKT -dp' 8=!7=⚀}-.s?LLH?kνcqT[p)$xۂk;H(`+a;\Hl=&K1@Ez1RtH PH+ |#o3ErF% Kvv<̍; Gysgk+3!u5&+Y$Xid~@$X%U#[8RkYDE1oбC|~:!жgz쬷r$QuH+I FqVk1h:Z|h'OLܘUJQXwW|k粒ggr_$D{CgHCY-d"QWF?WH6K^\`i+K!q%*?xQwO!Mhb*&5EW[pikh' j( ׸o=;{Y5W|auS?Ą%Ok9+zr3{spnJ]ylD>pufw!rϤ(Fc= "}enIyRUo]A%{C`]~Yr uR-NDɈ1UgH9._QpS uhd󇃵tH$yƥ–1&vhrMN[_njɯ/Ya{: ]#cfq/_L Q2t' HbE1 +onQΐ9`gB(I@j {6c; ]_Ȩmm#aE&w8RkBvdl DJa)ĝ$U˯?D ZnJBCI"8ꮰ~W,52yFߠFƍ:&\Ͽ9[{>+O*TP,$قN̝,4&>/k|0g5RtR]'6:I/.O*(q0 C,B!`ҜF}Y'" QYnjhkj$/Vn6^Rm#=7 5.]fy# O0ơ9F<5WIxa#-P]aU)L:Y9@y/2ҿeAHU;0a74d„`).|.W5xژUO]YLu4y:Bg)Ihl'1:oJdWAk0fj35?3ÄM.><߄mWC͒y]XPXZdդP8)!_}V{[u ;Z0FWUg;a}a}ѕ|6beK&2X,B"RL-rE cKO|{402CEt8j &\+>RůME>0 2 llAHP(:JT5AsM hDɐ(.wwv}Y9=khk39dY@e+k t1#PH0 $C ڇ7ዱO`bmZh@M%FXYGq VUڛ-ݬhBaJ4Vb7Ι!t@)/zoZ迂d@@sG̪%zm׾?oO˚CKU3``Gp wDbBfPAG6AwGgD2D_3b'0U3{ Mdngf LDҸ y˒HB,,XhNbB&P2@yqo'8{(r Rh߳k=5 [[l.}y?yScbuGbEÜ1ԉȭP(2OFESdHW7AC`!ݡK5/YhЛ@LLk'2ELs*uΩ}Z^:DSybK+"i /:ۘRQmc/M s'T _1w[Lԁ%|rsUo_bJOAPZ{g005pW r 5 EDKe42NKꡁi`E: :5.{J;?ͯT:[:Z!IDbÆ@ښ E+h)LzS0 ZkeXՌ{n}!dbAGJ;0zCIǙ+f"EPb$\?hyoj&sL8e Hslio-~i[ Pօ>_*'zXV'}g@K$dC6>FFS(\т„MDtHTC@„Ffƍcȇ&}lhj}d !bop&2}gN\<`-1jLM;2BBa i&5 "RHt q2ugG$@!sO܆]F/>z#o4i*cw'4aDYBFW[O-H06mA'w-M:%&\H-8//dNTYQIbjkJ1ZyXSAN0ad93 qvM|'V5EPe8&t\hm7g/}նV M_'{D3 ppC3 tںIw]~-4 $bfw㟟y3@Q}#h1&F-c&\/7%VoEk*XH)' 1s 31ZZyMM=!PSIflޝڂD$VPCzcq7s3uuh, ;Kfe}#}p u!``B1 (FPWX%HAw'KW‰/ϐ#6)A2A@>}aRlwomXWGƪe yGE]!đJ h溞Q8 hnI/|>[ Px:Y< q&"HSy%7HBܭX "R7%CrH3ښWNx~CDSM P2.7׻}vwi*Eu$!(2lĊZ0& ia k tl[rrI$C ɪt+Ä$eW̝g?~}q%$H/[prc*IP:Iؗ!dIاfw?706C@1؁9d͘p;?ve jHB-yڒ1( nbDO_N4F ۅir{~ s}I P @(ഝ k.wuv&yszASyȠ$(o|c:0~-Z 2X F6eƙ1&qL1&q&,#1.~P1Ź) ȟ"@i)\C[%'yߤi7yz{s]}Dt$Wt"V`!Nb.c$c KJaA.͂<5΋B^~?Ŷx4DC: @E@nl:pp5E*P$kKz&jU-Ȣ b͔7g\*5d0 `6Rwꦟa% RםБ!`B-(S,kr֨o"wn pf^XAA80 KW@Zw'Sɔ8l pHL`݉jN}NG[LޖU*@4dެXݔzzG4c&ƣu IǔU3aQr=PBy.qԇ 6 aK(a*(5\N %h SZ `С(') 0}'\I YӘ xGD8{D$|&O~$dN5h Ȃy`=7:_:T]p̩I c-S=… %v(2_V;#A`X80P׀e-=)&U~R·? {?l kٲ Յ#.m }/,"c}F b7s6eojCj#&LJ,h  3T6͎We_>Ru ;b K.;a?{^;|-gO_),@%gO} !bڙ^ndK6ÀBODNT  6 䁈Wr`sZ{f?$uTv܁@fAl*<:IENDB`svMisc/man/search_web.Rd0000644000176200001440000000324614614131727014675 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/search_web.R \name{search_web} \alias{search_web} \alias{helpSearchWeb} \title{Search web documents about R and R functions} \usage{ search_web(what, type = c("R", "google"), browse = TRUE, msg = browse, ...) helpSearchWeb(what, type = c("R", "google"), browse = TRUE, msg = browse, ...) } \arguments{ \item{what}{The string(s) to search. In case of several strings, or several words, any of these words are searched.} \item{type}{The search engine, or location to use.} \item{browse}{Do we actually show the page in the Web browser? If \code{type = "R"}, this argument is ignored and the result is always displayed in the Web browser.} \item{msg}{Do we issue a message indicating that a page should be displayed shortly in the Web browser? If \code{type = "R"}, this argument is ignored and a message is always displayed.} \item{...}{Further arguments to format the result page in case of \code{type = "R"}. These are the same arguments as for \code{\link[=RSiteSearch]{RSiteSearch()}}.} } \value{ Returns the URL used invisibly (invoked for its side effect of opening the Web browser with the search result, when \code{browse = TRUE}). } \description{ Retrieve web documents, or search with Google for \code{what} string. } \note{ The \code{\link[=RSiteSearch]{RSiteSearch()}} function in the 'utils' package is used when \code{type = "R"}. } \examples{ \dontrun{ search_web("volatility") # R site search, by default search_web("volatility", type = "google") # Google search } } \seealso{ \code{\link[=RSiteSearch]{RSiteSearch()}}, \code{\link[=help.search]{help.search()}} } \keyword{utilities} svMisc/man/compare_r_version.Rd0000644000176200001440000000162714614131727016310 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/compare_r_version.R \name{compare_r_version} \alias{compare_r_version} \alias{compareRVersion} \title{Compare current R version with a specified one} \usage{ compare_r_version(version) compareRVersion(version) } \arguments{ \item{version}{A string defining the version to compare to, like '2.0.0' or '1.9.1'.} } \value{ -1 if R is older, 0 if equal, 1 if newer. Take care: if you specify version as "2.11", and R is version "2.11.0", then the function will return 1 (newer)! } \description{ Determine if R is older (return -1), or not (return 0 if equal, or 1 if newer) than a given version number. } \examples{ compare_r_version("2.11.0") # Note that we strongly advise to use R > 2.11.0! } \seealso{ \code{\link[=compareVersion]{compareVersion()}}, \code{\link[=R.version]{R.version()}} } \concept{version comparison} \keyword{utilities} svMisc/man/system_file.Rd0000644000176200001440000000614214614131727015114 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/system_file.R \name{system_file} \alias{system_file} \alias{system_dir} \alias{systemFile} \alias{systemDir} \title{Get a system file or directory} \usage{ system_file(..., exec = FALSE, package = NULL, lib.loc = NULL) system_dir(..., exec = FALSE, package = NULL, lib.loc = NULL) systemFile(..., exec = FALSE, package = NULL, lib.loc = NULL) systemDir(..., exec = FALSE, package = NULL, lib.loc = NULL) } \arguments{ \item{...}{One or several executables if \code{exec = TRUE}, or subpath to a file or dir in a package directory if \code{package != NULL}, or a list of paths and subpaths for testing the existence of a file on disk, or a list of directory components to retrieve in 'temp', 'sysTemp', 'user', 'home', 'bin', 'doc', 'etc' and/or 'share' to retrieve special system directories.} \item{exec}{If \code{TRUE} (default) search for executables on the search path. It supersedes all other arguments.} \item{package}{The name of one package to look for files or subdirs in its main directory (use \code{exec = FALSE} to search inside package dirs).} \item{lib.loc}{A character vector with path names of \R libraries or \code{NULL} (search all currently known libraries in this case).} } \value{ A string with the path to the directories or files, or \code{""} if they are not found, or of the wrong type (a dir for \code{system_file()} or or a file for \code{system_dir()}). } \description{ Get system files or directories, in R subdirectories, in package subdirectories, or elsewhere on the disk (including executables that are accessible on the search path). } \note{ These function aggregate the features of several \R functions in package base: \code{\link[=system.file]{system.file()}}, \code{\link[=R.home]{R.home()}}, \code{\link[=tempdir]{tempdir()}}, \code{\link[=Sys.which]{Sys.which()}}, and aims to provide a unified and convenient single interface to all of them. We make sure also to check that returned components are respectively directories and files for \code{system_dir()} and \code{system_file()}. } \examples{ system_file("INDEX", package = "base") system_file("help", "AnIndex", package = "splines") system_file(package = "base") # This is a dir, not a file! system_file("zip", exec = TRUE) system_file("ftp", "ping", "zip", "nonexistingexe", exec = TRUE) system_dir("temp") # The R temporary directory system_dir("sysTemp") # The system temporary directory system_dir("user") # The user directory system_dir("home", "bin", "doc", "etc", "share") # Various R dirs system_dir("zip", exec = TRUE) # Look for the dir of an executable system_dir("ftp", "ping", "zip", "nonexistingexe", exec = TRUE) system_dir(package = "base") # The root of the 'base' package system_dir(package = "stats") # The root of package 'stats' system_dir("INDEX", package = "stats") # This is a file, not a dir! system_dir("help", package = "splines") } \seealso{ \code{\link[=file_edit]{file_edit()}}, \code{\link[=file.path]{file.path()}}, \code{\link[=file.exists]{file.exists()}} } \concept{system files and directories} \keyword{utilities} svMisc/man/subsettable.Rd0000644000176200001440000000233514614131727015106 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/subsettable.R \name{subsettable} \alias{subsettable} \alias{$.subsettable_type} \alias{$.subsettable_which} \title{Define a function as being 'subsettable' using $ operator} \usage{ \method{$}{subsettable_type}(x, name) \method{$}{subsettable_which}(x, name) } \arguments{ \item{x}{A \code{subsettable_type} function.} \item{name}{The value to use for the \verb{type=} argument.} } \description{ In case a textual argument allows for selecting the result, for instance, if \code{plot()} allows for several charts that you can choose with a \verb{type=} or \verb{which=}, making the function 'subsettable' also allows to indicate \code{fun$variant()}. See examples. } \examples{ foo <- structure(function(x, type = c("histogram", "boxplot"), ...) { type <- match.arg(type, c("histogram", "boxplot")) switch(type, histogram = hist(x, ...), boxplot = boxplot(x, ...), stop("unknow type") ) }, class = c("function", "subsettable_type")) foo # This function can be used as usual: foo(rnorm(50), type = "histogram") # ... but also this way: foo$histogram(rnorm(50)) foo$boxplot(rnorm(50)) } \concept{create 'subsettable' functions} \keyword{utilities} svMisc/man/parse_text.Rd0000644000176200001440000000372514614131727014753 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse_text.R \name{parse_text} \alias{parse_text} \alias{parseText} \title{Parse a character string as if it was a command entered at the command line} \usage{ parse_text(text, firstline = 1, srcfilename = NULL, encoding = "unknown") parseText(text, firstline = 1, srcfilename = NULL, encoding = "unknown") } \arguments{ \item{text}{The character string vector to parse into an R expression.} \item{firstline}{The index of first line being parsed in the file. If this is larger than \code{1}, empty lines are added in front of \code{text} in order to match the correct position in the file.} \item{srcfilename}{A character string with the name of the source file.} \item{encoding}{Encoding of `text``, as in \code{\link[=parse]{parse()}}.} } \value{ Returns an expression with the parsed code or \code{NA} if the last instruction is correct but incomplete, or an object of class 'try-error' with the error message if the code is incorrect. } \description{ Parse R instructions provided as a string and return the expression if it is correct, or an object of class 'try-error' if it is an incorrect code, or \code{NA} if the (last) instruction is incomplete. } \note{ On the contrary to \code{parse()}, \code{parse_text()} recovers from incorrect code and also detects incomplete code. It is also easier to use in case you pass a character string to it, because you don't have to name the argument explicitly (\code{text = ...}). } \examples{ parse_text("1 + 1") parse_text("1 + 1; log(10)") parse_text(c("1 + 1", "log(10)")) # Incomplete instruction parse_text("log(") # Incomplete strings parse_text("text <- \"some string") parse_text("text <- 'some string") # Incomplete names (don't write backtick quoted names on several lines!) # ...but just in case parse_text("`myvar") # Incorrect expression parse_text("log)") } \seealso{ \code{\link[=parse]{parse()}}, \code{\link[=capture_all]{capture_all()}} } \keyword{IO} svMisc/man/to_rjson.Rd0000644000176200001440000001201614614131727014423 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/rjson.R \name{to_rjson} \alias{to_rjson} \alias{eval_rjson} \alias{list_to_json} \alias{toRjson} \alias{evalRjson} \alias{listToJson} \title{Convert R object to and from RJSON specification} \usage{ to_rjson(x, attributes = FALSE) eval_rjson(rjson) list_to_json(x) toRjson(x, attributes = FALSE) evalRjson(rjson) listToJson(x) } \arguments{ \item{x}{Any \R object to be converted into RJSON (do not work with objects containing C pointers, environments, promises or expressions, but should work with almost all other \R objects).} \item{attributes}{If \code{FALSE} (by default), a simple object is created by ignoring all attributes. This is usually the suitable option to transfer data to another language, like JavaScript that do not understand R attributes anyway. With \code{attributes = TRUE}, the complete information about the object is written, so that the object could be recreated (almost) identical when evaluated in \R (but prefer \code{\link[=save]{save()}} and \code{\link[=load]{load()}} to transfer objects between \R sessions!).} \item{rjson}{A string containing an object specified in RJSON notation. The specification is evaluated in \R... and it can contain also R code. There is no protection provided against execution of bad code. So, you must trust the source!} } \value{ For \code{to_rjson()}, a character string vector with the RJSON specification of the argument. For \code{eval_rjson()}, the corresponding \R object in case of a pure RJSON object specification, or the result of evaluating the code, if it contains \R commands (for instance, a RJSONp -RJSON with padding- item where a RJSON object is an argument of an \R function that is evaluated. In this case, the result of the evaluation is returned). For \code{list_to_json()}, correct (standard) JSON code is generated if \code{x} is a list of character strings, or lists. } \description{ RJSON is an object specification that is not unlike JSON, but better adapted to represent \R objects (i.e., richer than JSON). It is also easier to parse and evaluate in both \R and JavaScript to render the objects in both languages. RJSON objects are used by SciViews to exchange data between \R and SciViews GUIs like Komodo/SciViews-K. } \details{ JSON (JavaScript Object Notation) allows to specify fairly complex objects that can be rather easily exchanged between languages. The notation is also human-readable and not too difficult to edit manually (although not advised, of course). However, JSON has too many limitations to represent \R objects (no \code{NA} versus \code{NaN}, no infinite numbers, no distinction between lists and objects with attributes, or S4 objects, etc.). Moreover, JSON is not very easy to interpret in \R and the existing implementations can convert only specified objects (simple objects, lists, data frames, ...). RJSON slightly modifies and enhances JSON to make it: (1) more complete to represent almost any \R object (except objects with pointers, environments, ..., of course), and (2) to make it very easy to parse and evaluate in both \R and JavaScript (and probably many other) languages. With \code{attributes = FALSE}, factors and Dates are converted to their usual character representation before encoding the RJSON object. If \code{attributes = TRUE}, they are left as numbers and their attributes (class, -and levels for factor-) completely characterize them (i.e., using \code{eval_rjson()} and such objects recreate factors or Dates, respectively). However, they are probably less easy to handle in JavaScript of other language where you import the RJSON representation. Note also that a series of objects are not yet handled correctly. These include: complex numbers, the different date flavors other that Date, functions, expressions, environments, pointers. Do not use such items in objects that you want to convert to RJSON notation. A last restriction: you cannot have any special characters like linefeed, tabulation, etc. in names. If you want to make your names most compatible with JavaScript, note that the dot is not allowed in syntactically valid names, but the dollar sign is allowed. } \examples{ # A complex R object obj <- structure(list( a = as.double(c(1:5, 6)), LETTERS, c = c(c1 = 4.5, c2 = 7.8, c3 = Inf, c4 = -Inf, NA, c6 = NaN), c(TRUE, FALSE, NA), e = factor(c("a", "b", "a")), f = 'this is a "string" with quote', g = matrix(rnorm(4), ncol = 2), `h&$@` = data.frame(x = 1:3, y = rnorm(3), fact = factor(c("b", "a", "b"))), i = Sys.Date(), j = list(1:5, y = "another item")), comment = "My comment", anAttrib = 1:10, anotherAttrib = list(TRUE, y = 1:4)) # Convert to simplest RJSON, without attributes rjson1 <- to_rjson(obj) rjson1 eval_rjson(rjson1) # More complex RJSON, with attributes rjson2 <- to_rjson(obj, TRUE) rjson2 obj2 <- eval_rjson(rjson2) obj2 # Numbers near equivalence comparison (note: identical(Robj, Robj2) is FALSE) all.equal(obj, obj2) rm(obj, obj2, rjson1, rjson2) } \seealso{ \code{\link[=parse_text]{parse_text()}} } \keyword{utilities} svMisc/man/describe_function.Rd0000644000176200001440000001027414614131727016257 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/describe_function.R \name{describe_function} \alias{describe_function} \alias{describe_args} \alias{args_tip} \alias{call_tip} \alias{descFun} \alias{descArgs} \alias{argsTip} \alias{callTip} \title{Get textual help on function or function arguments, or get a call tip} \usage{ describe_function(fun, package, lib.loc = NULL) describe_args(fun, args = NULL, package = NULL, lib.loc = NULL) args_tip(name, only.args = FALSE, width = getOption("width")) call_tip( code, only.args = FALSE, location = FALSE, description = FALSE, methods = FALSE, width = getOption("width") ) descFun(fun, package, lib.loc = NULL) descArgs(fun, args = NULL, package = NULL, lib.loc = NULL) argsTip(name, only.args = FALSE, width = getOption("width")) callTip( code, only.args = FALSE, location = FALSE, description = FALSE, methods = FALSE, width = getOption("width") ) } \arguments{ \item{fun}{A character string with the name of a function (several functions accepted too for \code{describe_function()}.} \item{package}{A character string with the name of the package that contains \code{fun}, or \code{NULL} for searching in all loaded packages.} \item{lib.loc}{A character vector of directory names of \R libraries, or \code{NULL}. The default value of \code{NULL} corresponds to all libraries currently known. If the default is used, the loaded packages are searched before the libraries.} \item{args}{Either \code{NULL} (by default) to return the description of all arguments from the corresponding man page, or a character vector with names of the arguments to search for.} \item{name}{A string with the name of a function.} \item{only.args}{Do we return only arguments of the function (\verb{arg1, arg2 = TRUE, ...}), or the full call, like (\code{myfun(arg1, arg2 = TRUE, ...)}).} \item{width}{Reformat the tip to fit to fit in that width, except if \code{width = NULL}.} \item{code}{A fraction of R code ending with the name of a function, eventually followed by '('.} \item{location}{If \code{TRUE} then the location (in which package the function resides) is appended to the calltip between square brackets.} \item{description}{If \code{TRUE} then a short description of the function is added to the call_tip (in fact, the title of the corresponding help page, if it exists).} \item{methods}{If \code{TRUE} then a short message indicating if this is a generic function and that lists, in this case, available methods.} } \value{ A string with the description of the function or of its arguments, or the calling syntax of the function, plus additional information depending on the flags used. If the man page is not found, a vector of empty strings is returned. Empty strings are also returned for arguments that are not found in the man page. } \description{ Textual help on functions or their arguments is extracted for text online help for a given function. By default, all arguments from the online help are returned for \code{describe_args()}. If the file contains help for several functions, one probably gets also some irrelevant information. Use of 'args' to limit result is strongly encouraged. \code{args_tip()} provides a human-readable textual description of function arguments in a better way than \code{args()} does. It is primarily intended for code tips in GUIs. \code{call_tip()} has a similar purpose to show how some code could be completed. } \note{ \code{args_tip()} is supposed to display S3 and S4 methods, and primitives adequately,... but this is not implemented yet in the current version! For \code{call_tip()}, the use of \code{methods = TRUE} slows down the execution of the function, especially for generic functions that have many methods like \code{print()} or \code{summary()}. } \examples{ describe_function("ls", "base") describe_function("library", "base") describe_function("descFun", "svMisc") describe_function("descArgs") describe_args("ls") describe_args("library", args = c("package", "pos")) args_tip("ls") call_tip("myvar <- lm(") } \seealso{ \code{\link[=completion]{completion()}}, \code{\link[=args]{args()}}, \code{\link[=argsAnywhere]{argsAnywhere()}} } \concept{graphical user interface (GUI) control} \keyword{utilities} svMisc/man/obj_browse.Rd0000644000176200001440000001274014614131727014725 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/obj_browse.R \name{obj_browse} \alias{obj_browse} \alias{obj_clear} \alias{obj_dir} \alias{obj_info} \alias{obj_list} \alias{write.objList} \alias{print.objList} \alias{obj_search} \alias{obj_menu} \alias{objBrowse} \alias{objClear} \alias{objDir} \alias{objInfo} \alias{objList} \alias{objSearch} \alias{objMenu} \title{Functions to implement an object browser} \usage{ obj_browse( id = "default", envir = .GlobalEnv, all.names = NULL, pattern = NULL, group = NULL, sep = "\\t", path = NULL, regenerate = FALSE ) obj_clear(id = "default") obj_dir() obj_info(id = "default", envir = .GlobalEnv, object = "", path = NULL) obj_list( id = "default", envir = .GlobalEnv, object = NULL, all.names = FALSE, pattern = "", group = "", all.info = FALSE, sep = "\\t", path = NULL, compare = TRUE, ... ) write.objList(x, path, sep = "\\t", ...) \method{print}{objList}( x, sep = NA, eol = "\\n", header = !attr(x, "all.info"), raw.output = !is.na(sep), ... ) obj_search(sep = "\\t", path = NULL, compare = TRUE) obj_menu( id = "default", envir = .GlobalEnv, objects = "", sep = "\\t", path = NULL ) objBrowse( id = "default", envir = .GlobalEnv, all.names = NULL, pattern = NULL, group = NULL, sep = "\\t", path = NULL, regenerate = FALSE ) objClear(id = "default") objDir() objInfo(id = "default", envir = .GlobalEnv, object = "", path = NULL) objList( id = "default", envir = .GlobalEnv, object = NULL, all.names = FALSE, pattern = "", group = "", all.info = FALSE, sep = "\\t", path = NULL, compare = TRUE, ... ) objSearch(sep = "\\t", path = NULL, compare = TRUE) objMenu( id = "default", envir = .GlobalEnv, objects = "", sep = "\\t", path = NULL ) } \arguments{ \item{id}{The id of the object browser (you can run several ones concurrently, providing you give them different ids).} \item{envir}{An environment, or the name of the environment, or the position in the \code{\link[=search]{search()}} path.} \item{all.names}{Do we display all names (including hidden variables starting with '.')?} \item{pattern}{A pattern to match for selecting variables.} \item{group}{A group to filter.} \item{sep}{Separator to use between items (if path is not \code{NULL}).} \item{path}{The path where to write a temporary file with the requested information. Set to NULL (default) if you don't pass this data to your GUI client by mean of a file.} \item{regenerate}{Do we force to regenerate the information?} \item{object}{Name of the object selected in the object browser, components/arguments of which should be listed.} \item{all.info}{Do we return all the information (envir as first column or not (by default).} \item{compare}{If TRUE, result is compared with last cached value and the client is updated only if something changed.} \item{...}{Further arguments, passed to \code{\link[=write.table]{write.table()}}.} \item{x}{Object returned by \code{obj_list()}.} \item{eol}{Separator to use between object entries, default is to list each item in a separate line.} \item{header}{If \code{TRUE}, two-line header is printed, of the form: \cr Environment = environment name \cr Object = object name \cr Default is not to print header if \code{all.info == TRUE}.} \item{raw.output}{If \code{TRUE}, a compact, better suited for parsing output is produced.} \item{objects}{A list with selected items in the object browser.} } \value{ Depending on the function, a list, a string, a reference to an external, temporary file or \code{TRUE} in case of success or \code{FALSE} otherwise is returned invisibly. } \description{ These functions provide features required to implement a complete object browser in a GUI client. } \details{ \code{obj_browse()} does the horse work. \code{obj_dir()} gets the temporary directory where exchange files with the GUI client are stored, in case you exchange data through files. You can use a better way to communicate with your GUI (you have to provide your code) and disable writing to files by using \code{path = NULL}. \code{obj_list()} lists objects in a given environment, elements of a recursive object or function argument. \code{obj_search()} lists the search path. \code{obj_clear()} clears any reference to a given object browser. \code{obj_info()} computes a tooltip info for a given object. obj_menu()` computes a context menu for selected object(s) in the object explorer managed by the GUI client. \code{print.objList()} print method for \code{objList} objects. } \examples{ # Create various context menus data(iris) (obj_info(object = "iris")) data(trees) # For one object (obj_menu(objects = "iris")) # For multiple objects (obj_menu(objects = c("iris", "trees"))) # For inexistant object (return "") (obj_info(object = "noobject")) (obj_menu(objects = "noobject")) rm(iris, trees) # For environments (obj_info(envir = ".GlobalEnv")) (obj_menu(envir = ".GlobalEnv")) (obj_info(envir = "SciViews:TempEnv")) (obj_menu(envir = "SciViews:TempEnv")) (obj_info(envir = "package:datasets")) (obj_menu(envir = "package:datasets")) # For an environment that does not exist on the search path (return "") (obj_info(envir = "noenvir")) (obj_menu(envir = "noenvir")) } \seealso{ \code{\link[=completion]{completion()}}, \code{\link[=call_tip]{call_tip()}} } \author{ Philippe Grosjean \href{mailto:phgrosjean@sciviews.org}{phgrosjean@sciviews.org} & Kamil Barton \href{mailto:kamil.barton@uni-wuerzburg.de}{kamil.barton@uni-wuerzburg.de} } \keyword{misc} svMisc/man/package.Rd0000644000176200001440000000713314614131727014165 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/package.R \name{package} \alias{package} \title{A (possibly) very silent and multi-package library()/require() function} \usage{ package( ..., stop = TRUE, message = stop, warn.conflicts = message, pos = 2L, lib.loc = NULL, verbose = getOption("verbose") ) } \arguments{ \item{...}{The name of one or several R packages to load (character strings).} \item{stop}{If \code{TRUE}, issue an error in case the package(s) cannot be loaded.} \item{message}{Do we display introductory message of the package? If a package displays such a message, there is often a good reason. So, it is \strong{not} a good idea to disable it in \emph{interactive} sessions. However, in other contexts, like in non-interactive use, inside an R Markdown document, etc., it is more convenient not to display it.} \item{warn.conflicts}{As for \code{\link[=library]{library()}}: "logical. If TRUE, warnings are printed about conflicts from attaching the new package. A conflict is a function masking a function, or a non-function masking a non-function.} \item{pos}{As for \code{\link[=library]{library()}}: "the position on the search list at which to attach the loaded namespace. Can also be the name of a position on the current search list as given by \code{\link[=search]{search()}}". Only one position can be provided here, even if several packages, and they will be all inserted one after the other at the given position.} \item{lib.loc}{As for \code{\link[=library]{library()}}: "a character vector describing the location of \R library trees to search through, or \code{NULL}. The default value of \code{NULL} corresponds to all libraries currently known to \code{\link[=.libPaths]{.libPaths()}}. Non-existent library trees are silently ignored".} \item{verbose}{A logical indicating if additional diagnostic messages are printed.} } \value{ \code{TRUE} if all packages are loaded correctly, \code{FALSE} otherwise, with a \code{details} attribute indicating which package was loaded or not. } \description{ This function loads one or several R packages as silently as possible (with \code{warn/message = FALSE}) and it returns \code{TRUE} only if all packages are loaded successfully. If at least one loading fails, a short message is printed, by default. For all packages that were not found, an entry is recorded in \code{.packages_to_install} in \code{SciViews:TempEnv}, and that list can be automatically used by \code{\link[=Install]{Install()}}. } \note{ This function is designed to concisely and possibly quietly (with \code{warn = FALSE}) load packages and attach them to the search path. Also, on the contrary to \code{\link[=library]{library()}}, or \code{\link[=require]{require()}}, it is \strong{not} possible to use unquoted names of the packages. This is cleaner, and avoids the contrived work-around to pass name(s) of packages as a variable with an arguments \code{character.only = TRUE}! If several packages are provided, they are loaded and attached in reverse order, so that the order in the search path is the same one as the order in the provided vector. The \code{library(help = ...)} version is not implemented here. } \examples{ # This should work... if (package('tools', 'methods', stop = FALSE)) message("Fine!") # ... but this not (note that there are no details here!) if (!package('tools', 'badname', stop = FALSE)) message("Not fine!") \dontrun{ # Get an error package('badname') } } \seealso{ \code{\link[=require]{require()}}, \code{\link[=library]{library()}}, \code{\link[=Install]{Install()}} } \concept{package requirement and loading} \keyword{utilities} svMisc/man/file_edit.Rd0000644000176200001440000001322114614426200014502 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/file_edit.R \name{file_edit} \alias{file_edit} \alias{fileEdit} \title{Invoke an external text editor for a file} \usage{ file_edit( ..., title = files, editor = getOption("fileEditor"), file.encoding = "", template = NULL, replace = FALSE, wait = FALSE ) fileEdit( ..., title = files, editor = getOption("fileEditor"), file.encoding = "", template = NULL, replace = FALSE, wait = FALSE ) } \arguments{ \item{...}{Path to one or more files to edit.} \item{title}{The title of the editor window (not honored by all editors, most external editors only display the file name or path).} \item{editor}{Editor to use. Either the name of the program, or a string containing the command to run, using \\%s as replacement tag where to place the filename in the command, or a function with 'file', 'title' and 'wait' arguments to delegate process of the files.} \item{file.encoding}{Encoding of the files. If \code{""} or \code{native.enc}, the files are considered as being already in the right encoding.} \item{template}{One or more files to use as template if files must be created. If \code{NULL}, an empty file is created. This argument is recycled for all files to edit.} \item{replace}{Force replacement of files if \verb{template=} is not null.} \item{wait}{Wait for edition to complete. If more than one file is edited, the program waits sequentially for each file to be edited in turn (with a message in the R console).} } \value{ The function returns \code{TRUE} if it was able to edit the files or \code{FALSE} otherwise, invisibly. Encountered errors are reported as warnings. } \description{ Edit a text file using an external editor. Possibly wait for the end of the program and care about creating the file (from a template) if it does not exists yet. } \note{ The default editor program, or the command to run is in the \code{fileEditor} option (use \code{getOption("fileEditor")} to retrieve it, and \code{options(fileEditor = "")} to change it). Default values are determined automatically. On Unixes, "gedit", "kate" and "vi" are looked for in that order. Note that there is a gedit plugin to submit code directly to R: \url{https://rgedit.sourceforge.net/}. Since, gedit natively supports a lot of different syntax highlighting, including R, and is lightweight but feature rich, it is recommended as default text editor for \code{file_edit()} on Unixes. On MacOS, if the "bbedit" program exists, it is used (it is the command line program installed by BBEdit, see \url{http://www.barebones.com/products/}, a much more capable text editor than the default TextEdit program), otherwise, the default text editor used by MacOS is chosen (default usually to TextEdit). BBEdit can be configured to highlight and submit R code.It features also several tools that makes it a much better choice than TextEdit for \code{file_edit()} on MacOS. Specify "bbedit" to force using it. The default value is "textedit", the MacOS default text editor, but on R.app, and with \code{wait = FALSE}, the internal R.app editor is used instead in that case. If RStudio is run, and the editor is "textedit", "internal" or "vi", then, the RStudio internal editor is used instead. If \code{wait = TRUE} with an RStudio editor, it is enough to switch to another editor to continue. On Windows, if Notepad++ is installed in its default location, it is used, otherwise, the default "notepad" is used in Rterm and the internal editors are chosen for Rgui. Notepad++ is a free text editor that is much better suited to edit code or text files that the default Windows' notepad application, in particular because it can handle various line end types (Unix, Mac or Windows) and encodings. It also supports syntax highlighting, code completion and much more. So, it is strongly recommended to install it (see \url{https://notepad-plus-plus.org/}) and use it with \code{file-edit()}. There is also a plugin to submit code to R directly from Notepad++: \url{https://sourceforge.net/projects/npptor/}. Of course, you can use your own text editor, just indicate it in the \code{fileEditor} option. Note, however, that you should use only lightweight and fast starting programs. Also, for the \code{wait = TRUE} argument of \code{file_edit()}, you must check that R waits for the editor to be closed before further processing code. In some cases, a little command line program is used to start a larger application (like for Komodo Edit/IDE), or the program delegates to an existing instances and exits immediately, even if the file is still edited. Such editors are not recommended at all for \code{file_edit()}. If you want to use files that are compatibles between all platforms supported by R itself, you should think about using ASCII encoding as much as possible and the Windows style of line-ending. That way, you ensure that all the default editors will handle those files correctly, including the broken default editor on Windows, notepad, which does not understand at all MacOS or Unix line ending characters! } \examples{ \dontrun{ # Create a template file in the tempdir... template <- tempfile("template", fileext = ".txt") cat("Example template file to be used with file_edit()", file = template) # ... and edit a new file, starting from that template: new_file <- tempfile("test", fileext = ".txt") file_edit(new_file, template = template, wait = TRUE) message("Your file contains:") readLines(new_file) # Eliminate both the file and template unlink(new_file) unlink(template) } } \seealso{ \code{\link[=system_file]{system_file()}}, \code{\link[=file.path]{file.path()}}, \code{\link[=file.edit]{file.edit()}} } \concept{file edition} \keyword{utilities} svMisc/man/temp_var.Rd0000644000176200001440000000115414614131727014404 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/temp_var.R \name{temp_var} \alias{temp_var} \alias{tempvar} \title{Get an arbitrary name for a temporary variable} \usage{ temp_var(pattern = ".var") tempvar(pattern = ".var") } \arguments{ \item{pattern}{The prefix for the variable (the rest is a random number).} } \value{ A string with the name of a variable. } \description{ This function ensures that the variable name is cryptic enough and is not already used. } \examples{ temp_var() } \seealso{ \code{\link[=tempfile]{tempfile()}} } \concept{temporary variables} \keyword{utilities} svMisc/man/list_methods.Rd0000644000176200001440000000651514614131727015273 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/list_methods.R \name{list_methods} \alias{list_methods} \alias{list_types} \alias{listMethods} \alias{listTypes} \title{List all methods associated with a generic function or a class, or all types associated with a method} \usage{ list_methods( f = character(), class = NULL, S3 = TRUE, S4 = TRUE, mixed = TRUE, filter = getOption("svGUI.methods") ) list_types(method, class = "default", strict = FALSE) listMethods( f = character(), class = NULL, S3 = TRUE, S4 = TRUE, mixed = TRUE, filter = getOption("svGUI.methods") ) listTypes(method, class = "default", strict = FALSE) } \arguments{ \item{f}{The name of the generic function (character string), used only when \code{class = NULL}.} \item{class}{The name of a class.} \item{S3}{If \code{TRUE}, list of S3 methods.} \item{S4}{If \code{TRUE}, list of S4 methods.} \item{mixed}{If \code{TRUE}, S3 and S4 methods are mixed together in a character vector, otherwise, S3 and S4 methods are reported separately in a list.} \item{filter}{A list of methods to consider when listing class methods. Only classes in this list that are defined for the class are returned. Store the list of methods you want in the options \code{"svGUI.methods"}. The package proposes a reasonable starting point on loading if this option is not defined yet.} \item{method}{The method name.} \item{strict}{Do we list only types for the class (\code{TRUE}), or all possible types, including for inherited objects, and default ones \code{FALSE}, by default)?} } \value{ For \code{list_methods()}, if \code{mixed = TRUE}, a list with components: \itemize{ \item \code{S3} The S3 methods for the generic function or the class, or \code{character(0)} if none \item \code{S4} The S4 methods for the generic function or the class, or \code{character(0)} if none. } Otherwise, a character vector with the requested methods. For \code{list_types()}, a vector with character strings with methods' type names. } \description{ List all S3 and/or S4 methods for a generic function or for a class. List all types for a method; types are variants for a given method defined in a way it is easy to add other variants dynamically (on the contrary to a usual \verb{type =} or \verb{which =} argument, like in \code{\link[=plot.ts]{plot.ts()}} or \code{\link[=plot.lm]{plot.lm()}}, respectively. } \note{ \code{list_types()} is only useful for special generic functions with type argument like \code{view}, \code{copy} or \code{export}. These functions offer a mechanism to easily add custom types, and the present function list them. For S3 objects a type is simply a function whose name is : \emph{method}_\emph{type}.\emph{class}. So, adding new \emph{type}s for \emph{method} is very easy to implement. } \examples{ # Generic functions list_methods("t.test") # S3 list_methods("show", mixed = FALSE) # S4 list_methods("ls") # None, not a generic function! # Classes # Only the following methods are considered getOption("gui.methods") list_methods(class = "data.frame") list_methods(class = "lm") # List method types list_types("view") # All default view types currently defined list_types("view", "data.frame") list_types("view", "data.frame", TRUE) # None, except if you defined custom views! } \seealso{ \code{\link[=obj_menu]{obj_menu()}} } \keyword{utilities} svMisc/DESCRIPTION0000644000176200001440000000275314715413575013247 0ustar liggesusersPackage: svMisc Type: Package Version: 1.4.3 Title: Miscellaneous Functions for 'SciViews::R' Description: Functions required for the 'SciViews::R' dialect or for general use: manage a temporary environment attached to the search path, define synonyms for R functions using aka(), test if 'Aqua', 'Mac', 'Win' ... Show progress bar, etc. Authors@R: c( person("Philippe", "Grosjean", role = c("aut", "cre"), email = "phgrosjean@sciviews.org", comment = c(ORCID = "0000-0002-2694-9471")), person("Romain", "Francois", role = "ctb", email = "romain@r-enthusiasts.com"), person("Kamil", "Barton", role = "ctb", email = "kamil.barton@uni-wuerzburg.de")) Maintainer: Philippe Grosjean Depends: R (>= 4.2.0) Imports: cli (>= 3.6.1), methods (>= 4.2.0), rlang (>= 1.1.1), stats (>= 4.2.0), tools (>= 4.2.0), utils (>= 4.2.0) Suggests: tcltk (>= 4.2.0), knitr (>= 1.42), rmarkdown (>= 2.21), spelling (>= 2.2.1), testthat (>= 3.0.0) License: GPL-2 URL: https://github.com/SciViews/svMisc, https://www.sciviews.org/svMisc/ BugReports: https://github.com/SciViews/svMisc/issues RoxygenNote: 7.3.1 VignetteBuilder: knitr Encoding: UTF-8 Language: en-US ByteCompile: yes Config/testthat/edition: 3 NeedsCompilation: no Packaged: 2024-11-14 11:18:38 UTC; phgrosjean Author: Philippe Grosjean [aut, cre] (), Romain Francois [ctb], Kamil Barton [ctb] Repository: CRAN Date/Publication: 2024-11-14 15:30:05 UTC