gtools/0000755000176200001440000000000013314447705011571 5ustar liggesusersgtools/tests/0000755000176200001440000000000013003720436012721 5ustar liggesusersgtools/tests/test_setTCPNoDelay.R0000644000176200001440000000043313120244716016523 0ustar liggesuserslibrary('gtools') host <- "www.r-project.org" socket <- make.socket(host, 80) print(socket) setTCPNoDelay(socket, TRUE) write.socket(socket, "GET /\n\n") write.socket(socket, "A") write.socket(socket, "B\n") while( (str <- read.socket(socket)) > "") cat(str) close.socket(socket) gtools/tests/test_mixedorder.R0000644000176200001440000000170413003720436016247 0ustar liggesuserslibrary(gtools) ## Examples from man page Treatment <- c("Control", "Asprin 10mg/day", "Asprin 50mg/day", "Asprin 100mg/day", "Acetomycin 100mg/day", "Acetomycin 1000mg/day") stopifnot( mixedorder(Treatment)==c(5, 6, 2, 3, 4, 1) ) x <- rev(c("AA 0.50 ml", "AA 1.5 ml", "AA 500 ml", "AA 1500 ml", "EXP 1", "AA 1e3 ml", "A A A", "1 2 3 A", "NA", NA, "1e2", "", "-", "1A", "1 A", "100", "100A", "Inf")) stopifnot( mixedorder(x)==c(7, 11, 4, 5, 3, 8, 2, 1, 6, 12, 18, 17, 16, 13, 15, 14, 10, 9) ) ## Bug reported by Aaron Taudt on 2014-03-01 tmp <- c("uniresult_simulated_H3k27ac_binsize_200_chr1.RData", "uniresult_simulated_H3k27me3_binsize_200_chr1.RData", "uniresult_simulated_H3k36me3_binsize_200_chr1.RData", "uniresult_simulated_H3k4me3_binsize_200_chr1.RData", "uniresult_simulated_H3k9me3_binsize_200_chr1.RData") stopifnot( mixedorder(tmp)==c(4, 5, 1, 2, 3) ) gtools/tests/smartbind_emptynames.R0000644000176200001440000000033313117607512017275 0ustar liggesuserslibrary(gtools) df1 <- data.frame(a=1, b=2, d=TRUE ) df2 <- data.frame( b=7, c="YES", d=FALSE) df3 <- data.frame( b=7, c="YES" ) smartbind( df1, df2, df3 ) smartbind( df1=df1, df2, df3=df3 ) gtools/tests/smartbind_Dates.R0000644000176200001440000000041113003720436016143 0ustar liggesuserslibrary(gtools) today <- Sys.Date() tenweeks <- seq(today, length.out=10, by="1 week") df1 <- data.frame(dates=tenweeks, chars=letters[1:10], ints=1:10, numeric=1.1:10.1) df2 <- data.frame(chars=letters[11:20], ints=11:20, numeric=11.1:20.1) smartbind(df1, df2) gtools/tests/test_ddirichlet.R0000644000176200001440000000063313003720436016220 0ustar liggesusers## Regression test for bug reported by John Nolan: ## ## Whenever the pair (x[i], a[i]) == (0,1), NA would be returned, due ## to an internal computation of ( 0 * -Inf ) => NaN ## ## The code now checks for this particular issue and sets the value of ## ( 0 * -Inf ) to 0, which is correct for this calculation. ## library(gtools) x = c(0,0,1) alpha = c(1,2,3) stopifnot( ddirichlet(x=x, alpha=alpha) == 0 ) gtools/tests/test_binsearch.R0000644000176200001440000000315413003720436016044 0ustar liggesuserslibrary(gtools) ############################## ### Examples from man page ### ############################## ### Toy examples # search for x=10 s <- binsearch( function(x) x-10, range=c(0,20) ) stopifnot(s$where==10) # search for x=10.1 s <- binsearch( function(x) x-10.1, range=c(0,20) ) stopifnot( s$where==c(10,11) ) ### Classical toy example # binary search for the index of 'M' among the sorted letters fun <- function(X) ifelse(LETTERS[X] > 'M', 1, ifelse(LETTERS[X] < 'M', -1, 0 ) ) s = binsearch( fun, range=1:26 ) stopifnot( LETTERS[s$where]=="M") ################################## ### Test boundary contiditions ### ################################## s = binsearch(fun = function(x) x-10, range=c(1,10) ) with(s, stopifnot(where==10, value==0, flag=="Found") ) s = binsearch(fun = function(x) x-1, range=c(1,10) ) with(s, stopifnot(where==1, value==0, flag=="Found") ) checkWarning <- function( expr ) { myEnv <- environment() catchWarning <- function(w) { assign("warningValue", w, pos=myEnv) invokeRestart("muffleWarning") } retval <- withCallingHandlers(expr = expr, warning = catchWarning) if( !exists("warningValue", where=myEnv, inherits=FALSE) ) stop("Expected a warning message") } checkWarning( s <- binsearch(fun = function(x) x-10, range=c(1,9) ) ) with(s, stopifnot(where==9, value==-1, flag=="Upper Boundary" ) ) checkWarning( s <- binsearch(fun = function(x) x-1, range=c(2,10) ) ) with(s, stopifnot(where==2, value==1, flag=="Lower Boundary" ) ) gtools/src/0000755000176200001440000000000013314200567012351 5ustar liggesusersgtools/src/gtools_load.c0000644000176200001440000000043313314200570015015 0ustar liggesusers#include "gtools.h" void R_init_gtools(DllInfo *info) { /* Register C routines */ R_registerRoutines (info, cMethods, NULL, NULL, NULL); R_useDynamicSymbols(info, FALSE); R_forceSymbols (info, TRUE); } void R_unload_gtools(DllInfo *info) { /* Release resources. */ } gtools/src/roman2int.c0000644000176200001440000000206713314200570014425 0ustar liggesusers#include void convert( char** letters, int* nchar, int* values ) { if(*nchar<1) return; for(int i=0; i<*nchar; i++) { if(letters[0][i]== 'I') values[i]=1; else if(letters[0][i]== 'V') values[i]=5; else if(letters[0][i]== 'X') values[i]=10; else if(letters[0][i]== 'L') values[i]=50; else if(letters[0][i]== 'C') values[i]=100; else if(letters[0][i]== 'D') values[i]=500; else if(letters[0][i]== 'M') values[i]=1000; else error("Invalid roman numeral '%c'", letters[0][i]); } } void roman2int(char** str, int* nchar, int* retval) { if (*nchar < 1) { *retval = NA_INTEGER; return; } int* values = (int*) R_alloc(*nchar, sizeof(int)); convert(str, nchar, values); int total=0; if (*nchar > 1) { for(int n=0; n<*nchar-1; n++) { if(values[n] #include # include #ifdef WIN32 # include /*#include */ #else # include # include #endif #include #define TCP_NODELAY 1 /* Macro to: 1: Check if the constant is defined. If not, omit. 2: Generate a case statement for the constant, which creates a string error description constructed from the constant name and the supplied error message. */ #define CASE_ERR(ERRNO, DESCR) #ifdef ERRNO case ERRNO strncpy( status_str, ERRNO ":" DESCR, status_len); break; #endif /* Convert integer status into a string error code */ void checkStatus(int status, char* status_str, int status_len) { status_len = status_len>1000?1000:status_len; switch(status) { /* Unix messages */ CASE_ERR(EBADF, "Invalid descriptor."); CASE_ERR(ENOTSOCK, "Descriptor is a file, not a socket."); CASE_ERR(ENOPROTOOPT, "The option is unknown at the level indicated."); CASE_ERR(EFAULT, "invalid pointer"); CASE_ERR(EINVAL, "optlen invalid in setsockopt"); /* Windows messages */ CASE_ERR(WSANOTINITIALISED, "A successful WSAStartup call must occur before using this function."); CASE_ERR(WSAENETDOWN, "The network subsystem has failed."); CASE_ERR(WSAEFAULT, "optval is not in a valid part of the process address space or optlen parameter is too small."); CASE_ERR(WSAEINPROGRESS, "A blocking Windows Sockets 1.1 call is in progress, or the service provider is still processing a callback function."); CASE_ERR(WSAEINVAL, "level is not valid, or the information in optval is not valid."); CASE_ERR(WSAENETRESET, "onnection has timed out when SO_KEEPALIVE is set."); CASE_ERR(WSAENOPROTOOPT, "he option is unknown or unsupported for the specified provider or socket (see SO_GROUP_PRIORITY limitations)."); CASE_ERR(WSAENOTCONN, "Connection has been reset when SO_KEEPALIVE is set."); CASE_ERR(WSAENOTSOCK, "The descriptor is not a socket."); case 0: strncpy( status_str, "SUCCESS", status_len); break; default: strncpy(status_str, strerror(status), status_len); break; } status_str[status_len-1] = 0x0; /* Just in case... */ } /* Function to de-nagle a TCP socket connection */ void setTCPNoDelay(int *socket, int* flag, int* status, char** status_str, int* status_len) { int off; /* ensure that we use only 0,1 values */ off = (*flag) ? 1 : 0; *status = setsockopt( *socket, IPPROTO_TCP, TCP_NODELAY, (char * )&off, sizeof ( off ) ); checkStatus(errno, status_str[0], *status_len); return; } gtools/src/Makevars.win0000644000176200001440000000002413314200570014627 0ustar liggesusersPKG_LIBS = -lws2_32 gtools/src/gtools.h0000644000176200001440000000115513314200570014025 0ustar liggesusers#include #include #include void setTCPNoDelay(int *socket, int* flag, int* status, char** status_str, int* status_len ); void convert(char** letters, int* nchar, int* values ); void roman2int(char** str, int* nchar, int* retval); R_CMethodDef cMethods[] = { {"setTCPNoDelay", (DL_FUNC) &setTCPNoDelay, 5}, {"convert", (DL_FUNC) &convert, 3}, {"roman2int", (DL_FUNC) &roman2int, 3}, {NULL, NULL, 0} }; gtools/NAMESPACE0000644000176200001440000000227113256741547013020 0ustar liggesusersuseDynLib(gtools) export( addLast, asc, ASCIIfy, ask, assert, assignEdgewise, baseOf, binsearch, capture, capwords, chr, checkRVersion, combinations, ddirichlet, defmacro, even, foldchange, foldchange2logratio, getDependencies, inv.logit, invalid, keywords, lastAdd, loadedPackages, logit, logratio2foldchange, mixedorder, mixedsort, na.replace, odd, permutations, permute, quantcut, rdirichlet, roman2int, running, scat, setTCPNoDelay, smartbind, split_path, sprint, stars.pval, strmacro, unByteCode, unByteCodeAssign ) importFrom("methods", "new") importFrom("stats", "na.omit", "quantile", "rgamma", "symnum") importFrom("utils", "available.packages", "flush.console", "head", "help.search", "installed.packages", "modifyList", "packageVersion") # Refer to all C routines by their name prefixed by C_ useDynLib(gtools, .registration = TRUE, .fixes = "C_") gtools/NEWS0000644000176200001440000002301613312757116012270 0ustar liggesusersgtools 3.8.1 - 2018-06-21 ------------------------- Behind the scenes: - Remove softlinks per request from Uwe Ligges gtools 3.8.0 - 2018-06-20 ------------------------- New functions: - spit_path(): converts a file path into a vector of path components - baseOf(): Transform an integer to an array of base-n digits Behind the scenes: - Update C calls to use correct 'PACKAGE=' parameter. - Explicitly register C routines used by the package - Update link for taxise::taxize_capwords in gtools::capwords man page - Corrections to typographical errors gtools 3.7.0 - 2017-06-14 ------------------------- New functions: - Add capwords() function to apply standard capitalization rules to a character string. Enhancements: - Add 'con' argument to ask() to allow specification of the connection to query for input. For use under RStudio, use ask(..., con=file('stdin')). - R/na.replace.R, man/na.replace.Rd: na.replace() now accepts a function to provide the replcement value. - smartbind() has a new argument 'list' to pass a list of data frames, /instead of/in addition to/ data frames as arguments. - Internal changes to bring code up to current CRAN guidelines. Bug Fixes: - smartbind() now works properly with empty column names - Correct error in smartbind() when column types don't match. - Fix bug in smartbind's handling of factor levels. - Improve assignment of default names in smartbind(). - loadedPackages() to return data silently so that the results don't get printed twice. gtools 3.5.0 - 2015-04-28 ------------------------- New Functions: - New roman2int() functon to convert roman numerals to integers without the range restriction of utils::as.roman(). - New asc() and chr() functions to convert between ASCII codes and characters. (Based on the 'Data Debrief' blog entry for 2011-03-09 at http://datadebrief.blogspot.com/2011/03/ascii-code-table-in-r.html). - New unByteCode() and unByteCodeAssign() functions to convert a byte-code functon to an interpeted code function. - New assignEdgewise() function for making assignments into locked environments. (Used by unByteCodeAssign().) Enhancements: - mixedsort() and mixedorder() now have arguments 'decreasing', 'na.last', and 'blank.last' arguments to control sort ordering. - mixedsort() and mixedirdeR() now support Roman numerals via the arguments 'numeric.type', and 'roman.case'. (Request by David Winsemius, suggested code changes by Henrik Bengtsson.) - speed up mixedorder() (and hence mixedsort()) by moving suppressWarnings() outside of lapply loops. (Suggestion by Henrik Bengtsson.) - The 'q' argument to quantcut() now accept an integer indicating the number of equally spaced quantile groups to create. (Suggestion and patch submitted by Ryan C. Thompson.) Bug fixes: - Removed stray browser() call in smartbind(). - ddirichlet(x, alpha) was incorrectly returning NA when for any i, x[i]=0 and alpha[i]=1. (Bug report by John Nolan.) Other changes: - Correct typographical errors in package description. gtools 3.4.2 - 2015-04-06 ------------------------- New features: - New function loadedPackages() to display name, version, and path of loaded packages (package namespaces). - New function: na.replace() to replace missing values within a vector with a specified value.` Bug fixes: - Modify keywords() to work properly in R 3.4.X and later. gtools 3.4.1 - 2014-05-27 ------------------------- Bug fixes: - smartbind() now converts all non-atomic type columns (except factor) to type character instead of generating an opaque error message. Other changes: - the argument to ASCIIfy() is now named 'x' instead of 'string'. - minor formatting changes to ASCIIfy() man page. gtools 3.4.0 - 2014-04-14 ------------------------- New features: - New ASCIIfy() function to converts character vectors to ASCII representation by escaping them as \x00 or \u0000 codes. Contributed by Arni Magnusson. gtools 3.3.1 - 2014-03-01 ------------------------- Bug fixes: - 'mixedorder' (and hence 'mixedsort') not properly handling single-character strings between numbers, so that '1a2' was being handled as a single string rather than being properly handled as c('1', 'a', '2'). gtools 3.3.0 - 2014-02-11 ------------------------- New features: - Add the getDependencies() function to return a list of dependencies for the specified package(s). Includes arguments to control whether these dependencies should be constructed using information from locally installed packages ('installed', default is TRUE), avilable CRAN packages ('available', default is TRUE) and whether to include base ('base', default=FALSE) and recommended ('recommended', default is FALSE) packages. Bug fixes: - binsearch() was returning the wrong endpoint & value when the found value was at the upper endpoint. gtools 3.2.1 - 2014-01-13 ------------------------- Bug fixes: - Resolve circular dependency with gdata gtools 3.2.0 - 2014-01-11 ------------------------- New features: - The keywords() function now accepts a function or function name as an argument and will return the list of keywords associated with the named function. - New function stars.pval() which will generate p-value significance symbols ('***', '**', etc.) Bug fixes: - R/mixedsort.R: mixedorder() was failing to correctly handle numbers including decimals due to a faulty regular expression. Other changes: - capture() and sprint() are now defunct. gtools 3.1.1 - 2013-11-06 ------------------------- Bug fixes: - Fix problem with mixedorder/mixedsort when there is zero or one elements in the argument vector. gtools 3.1.0 - 2013-09-22 ------------------------- Major changes: - The function 'addLast()' (deprecated since gtools 3.0.0) is no longer available, and has been marked defunct. Bug fixes: - Modified 'mixedorder()' to use Use 'suppressWarnings() instead of 'options(warn=-1)'. This will avoid egregious warning messages when called from within a nested environment, such as when run from within 'knitr' gtools 3.0.0 - 2013-07-06 ------------------------- Major changes: - The function 'addLast()' has been deprecated because it directly manipulates the global environment, which is expressly prohibited by the CRAN policies. - A new function, 'lastAdd()' has been created to replace 'addLast()'. The name has been changed because the two functions require different syntax. 'addLast()' was used like this: byeWorld <- function() cat("\nGoodbye World!\n") addLast(byeWorld) The new 'lastAdd()' function is used like this: byeWorld <- function() cat("\nGoodbye World!\n") .Last <- lastAdd(byeWorld) Bug fixes: - Update checkRVersion() to work with R version 3.0.0 and later. Other changes: - Remove cross-reference to (obsolete?) moc package - The function 'assert()' (deprecated since gtools 2.5.0) is no longer available and has been marked defunct. gtools 2.7.1 - 2013-03-17 ------------------------- Bug fixes: - smartbind() was not properly handling factor columns when the first data frame did not include the relevant column. gtools 2.7.0 - 2012-06-19 ------------------------- New features: - smartbind() has a new 'sep' argument to allow specification of the character(s) used to separate components of constructed column names - smartbind() has a new 'verbose' argument to provide details on how coluumns are being processed Bug fixes: - smartbind() has been enhanced to improve handling of factor and ordered factor columns. gtools 2.6.2 - 2011-09-28 ------------------------- New features: - Add 'fill' argument to smartbind() to specify a value to use for missing entries. gtools 2.6.1 ------------ New features: - Add newVersionAvailable() function to compare running and latest available R versions. - Add keywords() function to show $RHOME/doc/KEYWORDS file Bug fixes: - Correct windows make flags as suggested by Brian Ripley. - Update Greg's email address and fix Rd syntax errors gtools 2.5.0 ------------ New features: - Add checkRVersion() function to determin if a newer version of R is available. - Deprecated assert() in favor of base::stopifnot Bug fixes: - Fix bug in binsearch() identified by 2.6.0 R CMD CHECK Other changes: - Improve text explanation of how defmacro() and strmacro() differ from function(). - Update definitions of odd() and even() to use modulus operator instead of division. gtools 2.4.0 ------------ - Add binsearch() function, previously in the genetics() package. gtools 2.3.1 ------------ - Add ask() function to prompt the user and collect a single response. gtools 2.3.0 ------------ - Update email address for Greg - Add new 'smartbind' function, which combines data frames efficiently, even if they have different column names. gtools 2.2.3 ------------ - setTCPNoDelay now compiles & works properly on Windows gtools 2.2.2 ------------ - src/setTCPNoDelay.c: Add C source code for setTCPNoDelay. - NAMESPACE: Add UseDynLib to NAMESPACE so the shared library gets properly loaded. - Updated Greg's email address. gtools 2.2.1 ------------ - New function 'addLast' that adds functions to R's .Last() so that they will be executed when R is terminating. - New function setTCPNoDelay() that allows the TCP_NODELAY flag to be changed on socket objects. gtools 2.1.0 ------------ - Added assert.R (and documentation) - Added the defmacro() function, extracted from Lumley T. "Programmer's Niche: Macros in {R}", R News, 2001, Vol 1, No. 3, pp 11--13, \url{http://CRAN.R-project.org/doc/Rnews/} - Added DESCRIPTION and removed DESCRIPTION.in gtools/data/0000755000176200001440000000000013003720437012471 5ustar liggesusersgtools/data/ELISA.rda0000644000176200001440000000663313003720437014026 0ustar liggesusers}lUotpA"oUA~} !m*"PBBHή C%(ACA5b!("]nַ /kQ;Swcqc{k[6 $Gɺ'랬{ɺXP}8¶$P?*uCCx':4wۋ-m*K\~ɑ.Nb k[[Z[67mKn^yE}sSK{CzZl%%25H.]]'yW9[>IUUKhEw$*:ɻʹNrn/ZG;/Kn'yWyIU$uws{d҄8y]r;ɻʻNrnWJޝ~OpW!ܜ[^=,+^'>N.125Uyer7^-b%w) :wLLLLLLLLLLLLLL|'ʔ;>(*a 73xMܗuû/t~߹Kz?Fέ?^u(?Tq}nGnAw|ܳkx']OVYϮn%r?F82ԇ_.W \N {7W~ՓZm:}tP8ݠ>?\[zຳ^zkXۧ> FӸnsqs}.jԿ5sC:7_+ tLGֻNS?q;w;>v\M~k|p4 gqn|sm܃zQKuu P<3\Cܘǵ/ZkyZ@.n/輦u9zk;a= Noϸt8Y7 jFak~_p]:Ύhs:>S (lтqmLjQ}Pݴ{}nTbD}yKa\&\ƁnϞ( 8y9q73n"~D{@r@eWP!4lMnJ9ϳwOd㮤 {/3OhnB}9dUi~xKF?zt=!fŹ7>GS929n$mn23~꾶7/XPV5f4Fs;{u?ҸW^<0r+)9Wt?uد~#ν:>͓՟7rD5~Ϳ!ǟ3~?:w qV*ǦC۷O^=?~>.tOF8 )]Cڿǡh9ZOg WOgJoY\{?gu5?5.9YXwogyS Sbۯ\qi~K_|D:BJz~.'-ꧏO~yQSu\3:Өwkx-)=?#^뺕|yi}MU^OQ~7-yn~?<ݥS1㨖ks!?yNav~м<%ZϨ>j>O?l~&z7?\NOzI?>z>]OwQΧNv:}/꧶ytj>y4?'^t7Tw]?G_aROoӟwuq@̹R} Zm~q]q{* &Z״mc[[鄵-ZۊokkbjijbjeiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiF`iF`iF421idL#cȘF425idM#kYȚF45iL#g9șF4r3iL#gyțF47iM#oy{G5*ʨ TPZjiZjiZjij5AFP#j 5CPc1j 5@M&P j5@M@-ZjP @-ZjeZjeZjeZjYeZjYeZj9堖Zj9堖Zj9塖Zjy塖ZjyXB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %XB` %0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % 0X` % X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%X"`%`I`I!K+6ۋVҔ).$pgtools/data/badDend.rda0000644000176200001440000036337213003720437014520 0ustar liggesusersdu\T_>l*3sbRQĎei t)6""؂b!b~7}?<Y:ޫӗ軴o.]u޵[n݅٣vѥ {ۯZ3atYmrk J9(TCRAɡEPF(H&(Gr ʱ(ǡrʉ(' ?9?OST< ?Ot<?3L< ?ϳl<?s\<?Ϧ?g3l~ϖPWVx [x}>^x}^_x}!^_Ex}^_x}1^_%x} ^_חx})^_חex}^_חukn׭5^6xx}9^_חx}^_Wu[nm-^_Wx}%^vb=;;}"d]U~_WU~_Wz{\oq=ո~5_Wո~5_W5~ _5~ _z\pw;zG\q#w;~-_~-_u~_u~_~=_~=_ ~߀7 ~߀7~#߈7~#߈7M~߄7M~߄7z'\pwN ;͸~3ߌ7͸~3ߌ7zg\q3wθ;z\%%J].I(QK)JRm?]Q+wE~W]Q+wE~WPwCn ~7PwCn ~7Q;wG~wQ;wG~w=P@{~=P@{~=Q'D{~O=Q'D{~OPB^ {~/PB^ {~/Q7Fި{~oQ7Fި{~o}PA>~}PA>~}Q/E~_}Q/E~_ԿoA[PԿoA[PԿoA[PԿoA[PԿoE[QVԿoE[QVԿoE[QVԿoE[QVPC~~?PC~~?Q?G~Q?G~P@?P@?Q D?@Q D?@P} E4%_lxAKQC?( %BxD\A(_3JԌn?0F?#`0F?#`0F?#`0F?#`CA!? CA!? CA!? CA!? C(E?"PC(E?"PC(E?"PC(E?"PCa? !0Ca? !0Ca? !0Ca? !08G?#p8G?#p8G?#p8G?#p#@?G #@?G #@?G #@?G #$D?G"H#$D?G"H#$D?G"H#$D?G"HBQ? G!(BQ? G!(BQ? G!(BQ? G!(4Fш?G#h4Fш?G#h4Fш?G#h4Fш?G#hc A1? c A1? c A1? c A1? c,E?"Xc,E?"Xc,E?"Xc,E?"XCq?!8Cq?!8Cq?!8Cq?!8($iġdHܒ&QsL2Eir!J|IQڡ\s&.(=PsOC2 %2 eJ%)eʝ((KQDޒNBy%te-ʻ(פ'(QB<'lE %.(d?OVD'#%'#F(d?O2'[Dd?%'#.(d?OB'#rJ?OFP"2\OF*2'עDd?%'#ɭ(d?OOASE Q") bOAS@ )%J?OASP") OAS  $DS?% )(?OB )J-J?OASQ") ҊOAS.(T?OUD"%"F(T?O*ZDST?%".(T?O B"jJ?OESP"*ZOES**֢DST?%"(T??XDӐ4?M%!ibDӐ4? P"ifOCӐ4;DӐ4?-%!iI(4? O+B!iZ)J? OCӪP"iVOCӐFDӐ4? J?OGQ":.F#J?OG%#(t?OC# J?OGӃP":򟞄OGӑ":Dӑt? %#(t?OoD#z+J?OG3D3 ?C%g bgD3 ?P"a@3 ;gD3 ?#%g I( ?(Bg F)J?@3P"Q@3FgD3 ? J?D3Q"&)Fg"J?D3%g"(L?ϴCg" J?D3P"&򟙄D3"&gD3L? %g"(L?lDg"f+J?D ,? RDg!Y%g!YF(,? gYD,?%g!Y.(,? Bg!YVJ? BP"YUB*gբD,?%g!Y(,? FlE6gQ"6mFl@g#%J?FP"6F 6g'Dl?%g#٥(l?ϮBg#v-J?FQ"6݊F.(?QD 9% 9F(?XDs?% 9.(? B 9NJ?AsP"9SAs*ԢDs?% 9(?Es\E.Q".kEs\@"%J?EsP".Es .&Ds\?%"(\?ϭB"n-J?EsQ".ۊEs!H?CQ"y'F!yJ?C%!y(D|?P">oG|;>绠D|??%#I(|?/B#~)J?GP">_GF>緢D|俠 J/@ Q"_ F J/@ %_ (/C  J/@ P"_/@ "_D 俠 %_ (/hD A+J/@ D BP%_"b!_D BP"!_h/D B;!_D B0%_"I(B/,B"a)J/D P"!_X/D F!_D B俟qzw{SX(tY+ Ԗ?;SE'Ms!nr .q[ ;՞Ou>h(K9djog| 4) *}L+f{lU$0% {e~LfCɨ`zZ+G7TGב [a 궶KI\v;]wi{ ֆtxIi۬^t ~V>\T{ |tKFPS7_}@܋~wuwZJ|L}huWv}yL48}%hjw|T/+اw] ڙ̦ӀSȞs~_b}wBl4aFu- )~Rh/~P[%W3xDUqzynb{[#a%nr~i-GᡶimH\$>z%Uwaѿz) ~ț̃scƩ,n=-C A::V#&8>cN{hǤJ: n6=@k9fݸ=Fj&9:+ޛYCĞC:ƃt}Oh ^=ρ8EG~>wga#v¨!UXmZ5r_ݶu:ɭ&o 鏦G}hWU)h*M2*V`R$H?-դ'O=!ayҒ![~b}M|4xVԢ+Z}@:oP׉ 5??ְKb>&bp_`Yϊҵ}$sb$]NpWi:M;Su^?>hUW_pn,v~K@>YB\~!K9uSC^j_د>"7yWā g,rgn{AT~pD`.ߟ \j6';YV2Ntj>K&s-hiբ;녺ZS)hp`[MKȘR D6ɽ@=t>]-hW1]ۨ Z]r^-Qݹ {7/V;7}I#sLGԟ ; qrZSt<8m>$zknٔ$ ~3k{S̔sp^<,~[5}=<'LjI@eԞ|]J]ǁھƭodɤjT j鮒. i МA$:qH>]:[U+O5-5NEz,:ܕ$#v_*v#OqFz`SweV>vK[{vzdI,߮W=Uwx8[;!r88,wrx|eH$_xAdّ_;?GSyet8q!侈}Ɖ2Ņ5@g ݿqfK+}@g>(S?g }@$gB;bMÔ%7P^OZg3{Ηr~?6z?X[:J#Sbuķ9O,ᑜC/Od&Co,JԏE+-ǻӞ |y=/ūlJ$tW]+︺ EWeM`l1= U|^pاVZ~ݍ. 1Л0t}$j^i\Kaoqê$vsVgD.ok@܃@pΔOb%]s+&ģOtwq7$^$ "Z,=P֊ @id':C]_1<|lbzYcįȹbN hU[/~e=:ǫfO$/'썗×/t*Hnx`STJ*͒vS{@ Gmk@Z}-m]7>8EE#s#\gǩޱ}Pt+WS+݀qEMjuOyi,Rfn]7AxL ^eQa=XH0.3k@﷽Oxhb3`֭14a֖+$#+_gߛ#roJ.YM+ؗKsqc^5{KƶKw7HO @U6;^`aMٶBiQg= H~L ƴGfdow&|k;ީ~KXϯ'kl )8^vQrFi}5ӂ~ԋ@;aShPA’ >MeVo>%kYk>_ܤBd~t_|:|Invڥ8nxwl!H>,QGS31 .\~>,^].9xwgN.蕳n0D.Sc ] 1 \;6̲8{b%ZEF$ ;֛ Ҟ޸΃dPȁ@r}8hϟp'O'gˋ7FO=I]SOeg6Vun:w[N[ė^nk$qLE43hH^U@'Uut }1H;.MGw 8Om4 $eDvNm~%Sy.`=߮v*(NBwEmވr.1=}wQwm&3;K~z%.~-򱶚Ch\$;U!w(J.Ut:\#YxKhMrݢ S;k`w厁*\f^|Aڙ 9&kT~t"ƨMscnjI̳qi:uɉ| |U-k[]' F8ۜrG9Ht.] #o&߄^q vCZ7 >n= !B* ^xz|IPՍ_fT3wW1 i4"vE|1} h}=c98w^:8Y1$}pkwurn-u4.#[ыy'}!ķڹμmu߀{mTny[,>4xj.ƝS(s6Mf7ע6Z"q0yޜpY3HIw"vks~z`b7\{毢ž<-qk,ݘeƼ^Ѻ ;z%zx||0Z&h>L61!w"C~8=LIɲ%Mo4WMqWw'bO\AC"d 2Ch|뭑et?e/Wz>ݻm>8 QM4M>/~Y:[o7n3YuK@ 0kNh 7?({I  $ i-l|8naҳ?ך=hAK}[mY0sk!;M$67l%' Ѣ1.ksa+78[edz]۫֓yq M `]Fl싛˺VقqmN˘8J_+sVu*doHOu^z]'W> ̵qϓ[daDKٲV!׵;;0jT##H"u&CI6{]]xz@.#s} 9hџ1j޵P/youi}o[^Z?<Н{7cKDV鿟Un#5On.~hOzu@ZsF3)˷81+f?>?ƙc˥t:zҵ1ԮY뤢VoeznK=h}O* :TG璶B^r|o;+^zm̞yP?ѯPH͎o 7Ҕ@a{mR{~~iEݝ{}'{7E}1Ծ05~~HB%1w=*4E%&дاF`0]z]WvmcG&pA4yޤ_p䗊gYo~BTqi.iy6jgRg{GZ?$}aٛZk%Hn[wc|Zfր[?UOe~ZU`>s^C'}ÿl+];~Eՠ;IWdG<2]2-#ڮWWטVax۟xpm􎥴n>_8M:PZ!]i6'EբpcCo>Y_f1͝ xؓmq:'ɱ/IO̺mV^CRO"uhִ>J_UTϻBwlYjI-ynOt=}".?s >"7(*?@٧,}W!/9̿4-3/pe3>L(麿uq *ԾAJB3LsMh}=d+mct:krR9 O//T7W){x/h=#Y!QZ4 q>f硫p3^u*G$hBuǑOtqKGHU߯Alʝ{Z8a;?[rA[Hlu_/{i'w'.[:lyGSbdsǿs|6`N}C;8Xtn)w>J|r.`G] őr|.sQ ;nsojXdo /Hv0g.G\ סnNnݮqNJc.kK?y9n/@ohW S H6JGDM#ɈCٯ s5eMѷ3fgK)g~+ZZM@ToScͳ%&[[w%Y.2Ǘ?j1oo{=L˄:7 e_퍳yf  _o}]~lj]A_+A=y'gx!O0R*aG?߳Q;t=ZAuD' ,ג߻/- 80Q|3ͮ2r0 F+WIJrlIZ%,Fn vK9e,axj;{꤆B3[ӥeMy$cN%ޜ䬙V-^ Mւρjj~4hL<)Hx77)<λ'Wf-2 S齎 kg7X̧lН·z8K̈Yjy H[F嫛R&vip+Lg덲Aaob:/ ݺxe+W3w$٧Wc<+?`cջDEͷ-Wm{gӍ@wqߊ'NaZ4 f|^ZLUvμh~[tn{= ~/ro` [Ɵ )Vee ۗ;G:vt?dT_Z/`=~#ϣv]vZa4^v3|+yNUΌu :_jAE7֊ \@wT9 &te'N^2`= 5끱ϋk $}s Gᄡ@/50 Y$9g㷌-kL0X2+3[6[ί5^z:iB`J۟n&o<{L8rCYuyύ+t̹p{=y}"%^B<¬I^lR2KQh. ݇ygOoQERѢ; u\i8΋ 7U7]nꬷ<3:BQNJwgGwO '}%&W.;ϗƴ+ˇ)zYq"pK]C}Qt@`ݟ%w?{ݐ:FxzZ7_LK5]EÚAP|ss翷.T7?/틓z7V9M: x1t_b*COY-ߞla70XZ)CI^] $-Y^v_IQ|ht>3IFH]8 zS8ygݱ?!N;ѹZcߕ6|Z?dޏ+~2"{W Z| j󜰜xGwIשnt~"UM{gsIsY |+g>G 6=sO1-Fc\B]Y\jKgLM/ypFɒ>!g7:?M>~)-tZMW̺uqA]^y!6$B|jw?8nO7tiHBM9C/EtiOy_Q>S &AgAM"[g2m- ش;{!dnyR!s6Fi߾}: GJNaC_\1;w?+i>j0n SWIΦjM`KGނlƌIiRy  9{x=Z!^u;ZgRxL?GVleBv:__T}{o$CR"HTCv{{_gC4Z=̥_Mmy `p"0{3hF@t%+xW2G >y5jW Z8"dcMwW>Ȝ*6w3܍Eq>~6@o35|T=>LYUO)vy,ɫȜ 3>,s/2 |Jjns9vcSCwic,LMXIɜ+`rbN*/N)=*_a{`?[v\F /ێXL=V* Q;enΐ8BH<+]v2/3q^!9 m^CT#{ʣ`vF]Z mo4WMYkVslO>{E]:wLyd'y$C'Ǟ桕]gN~qzt$iZ ~Y~ߺO%uyRrc&O`H~{'"vV/G?oG ޾k׿\ښ<ܚ8}6v|C2FA_vDۜ-31^T(\J_|S;߷޴a:`tɼ2P]_V8(mlξx.*(#0cIשjh.ZMtT#-nYޟm2XB[x`Odm];)ʝmcx>ǯnoy P=qP*U)+w:i z<lTrqh~A 򹟵A[{-w|pP0֥ǀ^Vc߹6+@ُ=A6VSyTdVſ8iɯLyP3ߦ J7YNiG)A>ȩ0B [?$Zۛɝ. u@l >;5ޯxZ?w[s~b Kv֖>oҿ=Zv?JST˙:_. OA4oy&GZI]m(&^b_Ej0v=аnм#_+}Kf5%/ eA}B>;o%* u7󮬣;oH~_Q J #sМh/Y $cbN. <H3≓ՌFP:}5"(ߚss.vm=4g(0VT~UAV>~<7+؞ov=#mC)_d?H)0r.sNװ}3{ ✪ů@4BqEu_xؔʓ67Atq}M:GYv ~]PF$٧Y%_AʗtV矐!7L&P"dh)$ XY͟YOk?tߑ&ŜNؤ fѪ^z}sP-M񴕞I_K @j/|ʙֶT'^tNoq hMYgGKz?+}aGܺ:RNϢO/IsA׏__eP1`PQZ{[=ݍ0Ed u6*uC=(^lx5ore3m oT6*]ȯ. Fiܒn>A삧_~:H%3<[{K{ v~Rå_ρ^t+rk<@Nquy4D7P?_?II: yyB`%=刺[ć(I ;}]=w[.ktwX'x=kO0R[eewhyv&'[LnY!{w_@KǨ!׹yw.O.< KMKOP7)OՋ; ż~Q;g! isZA fO>soLZzQ[Nvw@\|3_Y>A_` iR։ǽ̓e+ۧM"KGR+˅?q%,0!..]zv9)b=Wo7}pmVj#uݶx/^!x\ޠv}Y1~\U܀! `ɺK\7w/'?֍[.VF0$^oU VC#uf,)JC m##+?HHox!Yu񕝻M7Mw.ULqJn>b)40;;EzEZI\ҩuΑY_9Ot͘Q 4f:4]/08X,oi\1 %zt t&?KqW7'o)]=JՑ( H;&n:s=kEmvM}=]Kv[Zb-Q 4J[=]y 0&=kf"ԏ:b1:}\=;t]GkR9b@A쾕4.FXb?-=3IAee4~"ɹ+T _jYNOEi?@u;$TM~I!yDB0Y:%*}$v J`xһn;t&9 =C9MQ残Aj\X)؃U-nKhwC) 4REStC:q~,Y5.4_V,HO]쉕ez7k%h/>RYbs6P!Մә_󉿐74\p/[nr_]. +We,i-r@M2%;{o?>}3ZF&?F9#c0ESAssv[~@|mUlW1wqpgˆZB~3H݆,1> %{&6_sSm/Ku7M@:?O_]bj`zw]kj6Wus 7 ei<&Qfݛŋ8n7S[4$o6 $ܫrmz4q5'j{G"˽= {OOuGD4/F;M u&qBB .gC!11-o+cNKkfz$qAJ 8jq2עIZIJ|>Ld-׋>`@lwX8orۣMïѕ洮l6u%s~gN}:}^ X/Ul[S=4wӸou}L2?Bļ&j8t K6@נv P+:l%9 iw(YvMKFwoՎ>皊IXʑ}wl(wWnhsв6j30gO9o?o1m. eQԟ>j ZɭF>A}'\ux@{.Gs-uwm;::QmPd_ҕk<P;9ga\r֞¹Vx t U'uƍW \3IQ8F?sxQypT{Jmy=Ƿi%soÉMLݦqo;8"//LJTIi%=`ض a'xOHB]>c Ęe;ݹiK'>?U]Mlԝw-qIXX>eKر)U4#1u-o\t+`2C> ?h<=:rl-pc{{E+4?nd38[`l ]Q=$.f{L2-VY7VKaHE-|c 𶯵iC7+ΠoYНc|r>[~L ջuw4|}iv~֜y9sy^4)*Ik=/AgÃ^+I~A2+G>6l3'dk1=z.Hy|5Xܕ74qKI.+OyjAl=c;pE?wz!G[>q_o={b5oQГuq'VLhξBhVUe22ώ\;XNv{F7Yigώ . ,:c)4%~=―5N&C#)1)j<Zliŵ vKdXL=ɿI]zb~pst`w`^}[' sGAYNsF/;߯9$UhDν^g'ffp_!&Ov :, $w+p.,V/Z_fI]bxU~ o0"^7B-H-bǮ}g]a٤X?g/m|(عqW6,>N벌zONrrWFu:0'#)k$UAקi<#8YI3[/`=u4z1o9-|oΰ~]hRYU mSiN"vSwz|G!oxg>cHi/p< #㛁ު2,&|aIu+A%g3f |w/vs%8/AܽZ쯫(\,ةbZߜs`[+n j~Ja_[5`:~//+w_ vcs_ɾ{Kb|\hڂ=_0h70ߍ="SZJ vDѵ #+N~l\|9'0 dć{Lsm3QEyjs g[0W ;[0E[_(uDfE*t:g.'xqv>٠@4sӆ[@R\ljڰoN>mgH {DdNɁZ!~zl~/.nRřL sZ7BZm|rU*,Nf|*Ym)]5l`g?v8<=+HFIPqt3#ׯZܑ-gv;Μ a'a/'4F~:1A$̶;Q1ٝsM}[q`̰/~Z6>߽:u=Zы[gp ݜpws߼QAs+ƂKyw?"ǠfrZκNz> W;AJ9-ək@-h}A:̮o)Kη8K[r: U4DTz ~_1.cK4o$y;9_Gϳ?q{f+ڴʥޯsVB\zݺF{ k_bEy|BY#Ӏ~x`܌Glbs+2_ꋥp}`{ r)WKFޑqaꔩAjyNEuYMٶus;$FՔΓ~#zvWo>vf7uoq$_ ܽ!}tj> qvs7xk9s;g0fݡuauI7a:XNyC&_#}s: h.p?iplShߞXXWƃt%@" }AѾ#ӵrpg~,ԇkOmWvS-c9c%5oK/'\i?Aph*+Tѹҥ?~+tԻHz[B H^h6|d~]<k pϷEY!9x75UA[Ⱦ֯<$ۛnK? ػgdS}yj_?G{4BRl wIht6 >h+,ُڟǨg^8VnB !6E%hQhZt>Bj>y0ul6RV/*dީ5s\ԢJboHOtޫtg9Pҏ1{yE_!gyh'ڤɆt>[}oo?:$;<4n3^[Wo]R}NS\ۦӺ;9C2'CsѹQ=7B Z%x>Eoik| xZOҼS|ew}i4T|H\U96tAvqę$$}jYnhݛAVRF_Ĺ_m@27g2}ωcs0ݏdOR}?.`p{| |5▓nVh?{j~U>ʫiz c֏UZNs#_޶eSg]Br>˔pi}g{etg~XCȼ@<~}ڟǺ57;7 )[AZr$SZ%}n]O=;tcPdslx3?NO9mKtH^5kx{Zjo&4*isťnj&h~Q,qHlMGHVwaJxOnxCFZn-ĕ,ޢ1{IcFmsIx{ XF^ZҿU|_ԋ3gg_OsS\ZaN[HIj=__ߩ)w{T}튜bY"z"sSvƶWZ| ?xm MS'-ixygA'a *iޡ,;L*UCOnta*7Mľ2'vX-o=ߵؤ[Vpj哭`[1)3q5FW~E,tΟb<;|n.:WN5Ͳ;Ȕ zMh#-A:uϯ.?,s[mAd: 6h4_Ԟm:`bo[ܰ3[`vVO!#|J25YL몤_C5%.0n͞/5W/J Onh7ڣ9#y)Q?6:g>7eȮ.Klo߰*OgS_|ֱdC bڀ_Ҟ΅#ò:%|Ȃ 1}YވH*Z#!s$.${lS9+ie;͝a{ q\Ԥԟ_V~Ž~z w}Ɲ_J4J`=~62~Hގsp'Nz4ͣ&[<"j(`>/8' _ܺ*Ed.[e-p=N'{ =9lycwWJAfn,V~>lӋAis0p듶C=bAZ'\:(ߖa Yl1;`/;fJ͠TTz8^Oa)?AK-h J-"?3UA(0@lA5GϿI?KU  ZvdĮVS[gnO=0mNiSB?+|{vFo0htq?O'>ԧӫkYɁB~Ӟ|]Ϟ)~t9~zLhB NMׂTρ_o}Lݢ&9=!s>0S.o3.v=xa)VwG#-fe[Ď(NsbW]r(oB]3ނXiñƍ~1ގr2!^l,Z ~x@CVҵ®jЩoˮuwW:}9>5AN׾} g8J%ppptQO}HחN}it]иSR$NµysR:3l>(.Lq2N?TSWu4}Z0C;%r6elezkՆqt>[ֺAyd !x|ɢI N9)cn]s {ӡ?s|0I~$[V40L.CxBnA%*Thiђ+@e`f:?53jȑ6zu͋#~?Wֹ_o vV2`]TFԿBm{}b}]A[Qg--UYe,F$)IޠGjk> K뿉BłjN!P;Mlee/Aor;h՛w8vDݥQUQ;B?Zjƹnף4~̃篚@r>$Kj~cN[}ՁZh5 Oo=Ș~- R{]a5[a>]^q[y`n)5Yc]&>A١:yTO;*.6u^B<3g#d#ϕ<'y'WX>.|^zKb6y;ɕL~Y[~ v`D#gcg-W)2J~mo6z;`3}nľN{mTIy~ځ G>:ӝ˗ yviJ .)ؕKG=LUGDΧvX2n듉 z^R4sо?k7!33=V~Az#`ܘmSk:|v#vM$QyNZLj"v<ٺ!#@2yВ 8ٟG2/ܞ]{#q'EoQö(T镙N{ɦQnMJ/\xse pC 3neLq8h4jͽT?Fy4)p }6-{ىwqڴ8q7eƂdWYWw)I_/⌌.Wqj[k ~Y_E©*J;q! 8XBxeKÛe:>ȮgK<@<`]+|lYfۯ84%h 7LK ]Ǔ#MuWK\7g]v훪 6#@[2ѯC[1ҫqn*4yܸo;yY87H+A^/\7%d=y,H A|ܢIA. ~wkƣ ڴl'ՅuwEfzOa)ʼ}*ƿי S_L $nvn7h HuZ ҿ*ؗn2Ij؞kjR"~Ivmk{rLE 9[/UfCйp`#As߭p(9"S{+1lKtA'O&hY ;gH=HsN+jJBO{mOtA{׆٠ռ֥+3UWS{FZ"xؾs+xp"G 1Ҟt|?0=n_׌WTweǕ=#IW[.͛}.kX0d)3gxXhĸE4g}˷U? \ӽɓA: 9mjPݩۯvzR#nq`.`sgW./ac|{R=Jξn9}[$/ yYѺ{o;)|h9)WAؕŏ!IӒMyNuo#Bc7z|6 hh50{'o~hqNտK·,9gLKW)yhh^x]5u'WF~r{T0IWU_@s#0pjsxkڦ$4$K`#svyݿE8X~"k#`,}5LQ =Y9'utڨ'<]ۣoq+}ۏ5 DTCs{ -4Z֟"'x^W:5u݌\W2k9!QdW=E mРu f cl/9?/ y17'xi0B8>u]y^I=W^<͉?9d;vmS…aTE'r~{ H+I>8v1:k!njVԃVB6ҸvBWL3} H KN싺0)T(.<5FQBGh]yI)I:&Sȗ-S̕ ~R3!d\ij{b<ƓS*o`̷Ԡ`b9ݮE1fvvнq{v̉^ӜZtׁbbp_Z{gVy>Ln8+T>u-dm? ;ͣG4r .^m$#\fA)GsH)/Oq]WDw$7 OI{N§ >O-Hn~˷gԥυ6, S'z􅞺8`3bɐׅj݁-:y纥{pǠWg;w/&O{z)_ Nz9Zm??o3/m)fgf'S=*)ۜ4ngF:zJ%MF=2yD!f8Fк?9|x;^͹EЫr@B7:t?s4F_MָFܺc̝@:GS Z"q'H9Yǡج;fӆ |W.u?֯r)8vB^1p }x=6oD=$hϙ5 xǛLS+:?ɇIy׳= Kca5e(0&^?֙ vz޲Z ~IyK #wPxЛeL )QWmko=[DD4Ilے:4|uSyx5|ot!eP?rҳ~+O\~w_& =42f]oI4|'+;-3.߸7=HnϹ7ֻj[AǏ1B<5o娝b[heh~EѲ;n#>2/4_N녺% Cɼo{_=%ɐ6wCZ78z2}gtAwn iKfmajH|꥚.8Of€:`kQqtW!nϓi؛t^%99c~ ߃Ch|vz "`n] uGC/ݠ۹ͫ |K^Jjl`se,ȢUWՖ_g ]C^Zc-FezȾXgPWH^Y9hj`'7\Ze]ޣftﱁBzW6+_ok\ߡxw}> Y!i^79"saOs;Y]9 r^Wz6wɊ]Π!u.Z:qZg|!moNٺפq9)Z+>~gW@~}>o@} HZ;u,6,si3GyEgH@k3@t}7`Q#Y-?{6{!ȳw L ܢ!d^ )첄yK:ܕ/6yҾ׹E{Ux}8B7gәK~Hwyw`+_[KfS^x$-ah([2Zൻ.%&읤Ε_YO^cOo+^hL|xUUp0aUw|O1$^M|5RG.~+;>,y-V{eD\vtNkߖ).11(xaaN43kq^iC{0aQO,?+[āG\۟IABS~YMZ$[:B6.vI {:@}˿W%iK.Y %WQdd'2q96=ڙd>oŊm"+Jz1|*!g[nG%,S.Jؤ+gR5ù~.)=z [~{892){b ,a e=a~Ow#>:gbA;2B|ξ"!tN䚽R&ҹ]ܿagQNVbW~k4ZA'ʕ yUޝRcor^AނMצy^7zBgBc:)7{J'uk2G̬>3'+ϪQ ٦;V>޾1q?=eƫǴ<\SB EϢ.cL$n$zӟh{U vÄvT}BL=}<@EiM5D_i]ysҏcwS8?t>\ejs`>ev`M/mh? ŗN*рF0a3? H_ZzpfɅʹMmRs'x3j؈ƉM; yTgH氺 CrOy5{y_BCx fɼ=hlt`7j/$O/y&ם.$(TƨZ ~.c|.`C- <-ǫBuZ~ +W^VqL{yN!.ܑk|ӣ5иgz VUw \,u&:/u#'!]'dtI~*Wcʫ4>"?g(mu]2C>$KKB/hrƥ|<#f8%5ӑ^NW|ti)~53aZ_V%=i߉>6$$<)'$C\\kwI?3[{:E۲ݎ\׿RCguf#-OOkxGKȧJUu>&U<ݒU=ixNTs/Gѓε|Ձc 8.9ihZ%} R'% s3ҡCI},7:?޽:sWdYK>R?Gd|ʖxi~_t] HG9`btZ'E_yB󋿟X0pg޴#á~DQ̼$*-'!""UBE!-hSh5JJJD R*D*JڴXo9󻾟\j5r}3rk"9KH+ޓJby𗍙1W._H;z؀Sl+} 1JWZ'0dWs2{|҆r!jƬG\"8O֙o|rT[utxDpu3ˁx`M üIW~FϤ/飡'7%BH|oQ٩tgo0=/l4s$:xN`9|7k`!xD|Gasc>J0_hm4Ʒ4e`ݞ5ʷb5lzO()ND}%ApZ+طG5'NM 5뀒>M㆙OAPNKA~viwo\iyro1-~<*/_,EճH29X)7>[-ඌm-ןvt q:pgn:L/7:1"&T.hKtVQr_4Z);=ISg!}Ȥ/'SOԭI|u\*z_}ycXFx?%]r/_EZݧ쫏=X?&|NKDN0sS>@xGH09]ηAL=2>ٳ}㗯u}G~qg"?%˄+ѤkGZYłb}rq)֟y#9K׌hmFWӪ,>`h sfft! ۔z~j`%\_' &{Tʢ_Bb>;źz2|}fj`?`Iy@GG1\SzP%2͛! qI:oĬ[aX!u&r|DI_;{K4/a_*HxZ (ǻ뉟Odx!!W.BYˮaQGqy7HsA#JGGeX|ة%~1kGn>Ld{S-uFD2PkG(+JTG⿛mjbstt}݁C oAqвoML0Ud.ܤ Š$'GǞ]SAChs3FMiv_r /.> S&'x;bs"|W5.bP7pZP /N8x__LACo Ƚ>tLtv;; Is(6N ⯻}.g~vZ hNW qݥίoAhl՘Q &܇5?RTCU/QaofAMOqۏeʢ_(|l0hܑ.[ Z'&O0i}; %ٹyUK5uM%s @Y~ɻm֍ndS{aE*h"봹oתa1†=Qy&sq_^qQ8oZE o,s*&6G$)28&P7Cć:~6;]8sĞ^ z ?#-_f3xU̕AmDr5:>|.3 CᾑM?<?nb/{xd4?h|v2 ?q|k K[A,<$3#yMe _ӌJp?`kT>pg}X Q1y)-=m]G0zGY7]5Oyg?n]q 4WG% i)| EOkݾcͶ}Qx8oڋvOM} Zdw9%qLOއC2שIQdv1M}:M{ޓ4G$ϰ["g 卖NEyW`|CM+#Eoŧw"eco9ogv!>(>8;~3O5e6ǁߣDq!Sf0ǭ}R/Jr *n/*%ϋw_~v5⧎cid|Tl#HGxiͯwZYq叞s]{kkz!鏞ץN{i!/y~ȶ>ܥL[ cfqL vTe`FOT"#q;ʒ7vIα|K8BɫQioAw|7~q3/~mOAЯ]rIw%1oME_}ɜ(K .nky?\=[Mkש6JLy;_ǭSx~xQ>Y F;` 8^|YzIOcO/jﺷ5nfC! J5#@wd׹?)U /5(| ]CE+h-[(wHkSzMΕ z\Dz2k*ViL^Ⱥ>F N1$^mCI֟={)_$^u̹3P9~WRvԊcMøKc<˱T݀9tkfQ\O.M:t ]+8x4Pǧxy{y@|49EƋ3Ku;>$8H)bz?tGg哷0̯a! oN}v+gz97m2Jbܵ%;EMP_lxvc~*ȋtjyg"^Yx&Ӧ.?w]osMUcYfx5}+%k*-=$" &)Y`kT3Mg=ͦz(DN[4xWغ F6oc {hJ1\8%1]7n!>+Wi)?hu!iW._= t-p^Nx^y.99畈|4\ƈqs~R=G)p|o17&]WU%!cʏH0m;|+SmsX0ws;d|ߨhmJz~ao'1 V"/|mۣ,t_G?q5 ׼,D}I)+͊39G\~3̿D`Kk#W xbTu7sM]~带hzs V~ .ACօb=(RtR;-/n98]E^Ζx7rL]%{{dPpq)FYAȻg0~Z}SX 78y* 5noe P}[_I@^C#`k@?]o%Y׋wS*`ޗ@Mjz3k00/<P]}->`$A` Rڣ4xW,y7hL:m,xkm:jziӮ].ߞ m}y*:]'U]m떓oݭ"#+^nuW|CvEˆm6r9n$1ujʼ3eS1|ojoS/tAx"Qy<kJt8fN5PVG6g`µ@yYȨ̚3/\L}k |ſC"3A@3\orf]rϪ[f#q^{{M`L x~{78 Շ}h֫mL>: &}άAgը>SgD\WL6;ʹ TZ_Qx]e`)?#]EWqqeÉkRz-IPwڂ qןLQ̘.DX]%y'7I^qLLKlHY6g7t [- +[RpjY ȷDž)Ypy5FN|@ o!W.+0=ڰ)M2#j3 }y _I+Ϣg]Y;g<KqٿDdVy RN6in 1|LWAR1?9ZVZH m` +OH=H !n`4?nՑ{SC%V"?!?.ƳmwU[IDg 7o6D'*(g P Vn<>=w+'}Q6k% 㕲L;tʛJn{^rsM|^.8_w.ayL=S- vQwDy̨b^3k+vvIFy[o5'G=NA3{I7-GeO_xT<[_ $6[RV5n%@G'\W_icˁ=,m}߅%&@1[xn F1p C‘Exv-@k|kz0j66sMOYUwP 0ڦ8EWPIRG"X%!nWhgfEq:qwQ`/*͏:38J |WE_؜/uF#+GWQr+.{hxy:R%eyM?'z/CbZnWs@iJp9mF}l!Zw!ObBzJ8O8 t;EJJ@Yv$^˵b 8wGԓODsnKqh)yƜs{~` M9Y&ȥE'ja9>s啵=?zM~/\h_F}!zޘmvUI]Lh'焱͔ryYd]]( G|93}^?g6ʮlT`ڜU AgS/䔗Iw;6n鼑?o.ƾYs":v`3_xϥгag /[WG6Ivq7ަ_X,F]"<5}]yi'56GE_Nf lf.u|#"]6&f>W\y@Kt#ss%ՙX`~)5/ݗoW{k{l"cu[B ;aaֹ9ȌkԺcǜȶ噿μNX_$gmFFTpO֏h$T=ᴚXg 6mmSrU6 S'j _+I[rG{$Tt_D}-L;oI'3m{%9y!h04Q- ܌]q푘'16\+*Ǵ*Gx}`>dcQ//dO@wt1R?6<%H?!8n*0Mgzﰤ' R~"Ŭ.}jz/&Zӝ|}3W_ց2~J,ώ"y:PZd'\UX7`W'%N-PnEr8svĝ}n؇zҳ @_&%1楦;"|zFtڗ=oׂ`nEoe鶝dxc=W*_WEۀ^SH[In;^Ug$x~m{G2kxJ\uyu5<OWBD:lֶk@4ҭ7>.5VAm0Ǡ w(QjIŸL᲌tO [n_[ipHY'ä{U^qjzZ|>=~hǬZg yxX _XB}=^G6[ymWm쬨ȝN@o~i'9u߈'gR/?+ (_S[~#=)҅=03nެLÐt/_73G_5[R:y̟uޤ]y"mm|N_t㾽z=e(y4>u3ʹۅ+!/Ųۓ>`2+Ӂ-{<_9on Ts7ԅb>\$)!6N酅I.xSk=x7pR01"ĢoO9u`)/ųbN`yGߙm_^. EɟebRX]Ә? sh2a]#U.cFn= Ke'w?kI9Rb2"M^^2H>,X^O-%N14ADbр_EOq-}ȢV*lE7'c}let~~M`XpSY\KZ}9uDsv}}hO}"?%:wUlKG%-˓%I28Q(Zy6gSB^(}0TҶ&{Iމ0,/` yT+w3IPтxЛuუx䈓7}ww#Ƒ 73 Ꚇ̗mX@^>ЗD'# >7Wm?LtE*Ӂ~gWYŕcxnL}p0_PMR&7zuZU ;uFZEU o<+N qV #}sՖE>LgV)N:.%J2O9Y/?TB%l L!2Uk@8Zrs.֫H2G4ꧪ{T_Fþ_mL8cR_߅C@cF`l>>\Gʍ < 3]i:)gD|5Uy!o"uҧA} NM.5$ yݘYէ*ܰo NQը>q }Ė`ݒ']H=s2,nhEd _ &}I|dzR"< YW~bSWtRdHFz7leP :ћtDܞA||5Ñ \xG?0܏`3oL t1W"mY κR C!|^i㭯q: 'iٳc³X qH̗=kf q_z$yAZΡOCq9O|h9?d^f)z?F [p]یtn2Ge `CH_a :CB? ~ߡ+&O"Ia??0f M w)_Ix">MpF ?[+Q>TT>E>}mׇV|.ME^N|5Uur۴kX=ky`><-/(º;Nz_<$c\MןC!AX!DhjB+۞P.2*^GpǷ:جXdO /ӅْVb?f$%?LJzڞO1t֌o#'v>dDi; 8I?u3I&un^oP[iyn)Űz@Ev  |3)xQ⚠gwY%# ٨z@='r?QՔ+n VEB3HpZr&#i͟0b`ۇ95s6`|&|j{;: 5o˟j7$ ~쑽}m~שl<*˿a XWuė!?/_tRj>]>=rŅu@ wMp{>a3y6 ئ}nfޞm_VʣNǾ>H:>%u[0Γo`?jnnz! ϡ-|'[/nCF}v~#]S8&u̴7_,wH]gڬg`?OeZj"Fx?5C-Sy8&+1>1*cjL,v|=z@/ho\?s8#:;AJ#ħ"sS[j>{'g;";<\$LܰpE+-9^LM,.%ai\OZUG A]W-=k\_gs }k4PT޵Z$Ye" ̑VƙIC3 ,O\\v /&kL-ڹȪh'lF؄./ }|Fw4e?9v'@bk<-1#=O$U1ѡ쿡9_+<=t[ŠY!i\(>V,>f #' O“afT`4yu+4Z S%&uݓLxߢr޺,y&|5rshX;4WMmx4Ht&o߃#и"֟>y8eı횀.?e%{uƼ~\My,GGעF=o ҃>8ٻW§7Vs=l翱3SgNM#z,sjТ6 > :x Mf1"}>ˋs5h|5OzO:vuj3&ެ`9רxbNBKEՋq(Μ֘7rn*(^bi4\a1 yVby,v751kh[h揹 O7'>ԥ{t}HA԰\E>TT5X;aP6t^qeВ xk;'A'J̅j[+3'3I~0Wp2g,J_]_':_OzDi}ךy#KcΎD8'pժ㷆N |Ty|寐Mj~Q :1c2 qkdpX{`h:jĚ?YG@=ЖF%~ZD뒓?qTF -U}{8.UW :nMMy/)&vWȟ67E_g8VcA,snt^#C_u/e%pZ6,y,|r^uӉ\|{2ɮu˜|c-pt/ƇѠxp.X2Ѕ| u777 eLF 5Pg;b\ fKk7~uǴ"p [gwa!>Q;O?獬DyS^\?ocǸڳg`\p.Ff繳f:`%+q&J t$Fw%(k `Yl@VۄIV Hi^<˙g=Q7Z?0gphyA?)5{#1$.x4hE*-_yƗztZk?d0*緥[?^]/Ʊ7җ0sng#)ou}qRG,2in8xhgߦsxR<+sď1!qҮI;8G|@eb"/~aq~7.7,+M;0 @ݕl - g;~kjYpscנ>2ef\o⨉N!ģ8שyb _a 45X?vI|yYt›;_-麦h 0?[@mЦ֒[SvZ<$#~,;.73thzݑ767>-9u tf:4>cWt~9:u4p^v7Q d#D"xH_/ji$#Q:#@=bޓ1/Zao4-Y.]n?8X0g0OLؽR}k^`&7)n0^ P*t?G\J>ΫÚu_$oUA%gàUPzM+G81/;~>}gq*5+NUKZ@!_d8e<ΙAtƕ"#He|C eNPSZ=7uroxXvm}Ԃv jڒ7wvw{~gC\zh[Z%NWɜ>zd9Yv#Xlz1.:q[.5 ^D(nfm℗d];L{zQr\Y_Ɂ>^$. =DD&N.7 x zOtrh _VVZZy@$73`UIod4S>OMt?$[BjtZep_&s0EWQaিX 9@t99DNG&["5UD~T[RНkdԞ+w[(w;P^ uq etn yuH uk%=(lPhDoy%㧁 k;Zhra@}ҿղ1[oZE7 DqgJ+Q=uO}M'q̛G~{CPӟMCZ#y W L̓9x);;:e%; oMxk- 呭O240msG k7+a# ECQ;Ps &IF׫|E;M* E~@_??M*JE!=~Bk~P4i&@@]kAw[n^ሇK1ΏI`%%zM5:f׭2 *6y`0[6|<7dGd-1o֓Npn}pDiTnyl;nwbޘ7}}x?U?e>E9Ct?O {&jY)X6fPQ*rV.d T44D>@!nݧ F[R<[qB,n+o>jezQW7F=Ljq\pH: |Uz;$0r+ݽ}gvJ.2~ڙ8v{cvyajTݽ@Ǫ|} t25;e X7e`Њ睝= c{t yףÕ5rI}?^"߂qHx%$}D:}Vz^ѣoyLG@pQ hRc?p1ed#sv tEce -Eʜi*Gp[ԁ|rH6׷G`ri@y88%yZIVu`(aWd[,Ape1>>.D@t*$o.Q[Oq0[lZHhړiwqOܝz>*qkۖW $&uD<&drൟi(ȔM5w8 4ltsfq{z)pM?]m `y&,}̺i'  7`pcJҐ,&Ze[;+ӏw8.^ f}ygwJ p}̗ߨ7;xE-. .GvOaNaя7}yд}EJ7;e䕌(Bh:ըGԟh:|q^]K{m;=J|Osmgg7] S 46Zb(]l ̱K}O,y H&}In=FGbVH{؏{"?O}u #ԁc2-zp'oR%ft}Vi)`6M\-_;!VVý57Mz%| ?XJF>@ g Hao/”z`LH_y)}.$scoq٫:Zİjз%_: ~2NBtgra0^cY)7y=CBEW>@-ȟR?xZwݒ ωļ"7Qe,Kl ~F딚$YlGe"/9JC&k9uo;C,| !婲N\Wk5x[EA_w6M7:jGP:XFЇ!q낭wE/mޣNz]uK Ʌ|f.Y88\nxX~v4=2.hWsSk4C!x>_&Z*FEfwPJRocsdOXg3~ 6}}؜Y By{wEEփIz(#m n1:j³.aDo5T;(3 ^֮ڠ85a$P6)S #~b@ B^z~6Pp7;>+ҿ:>%ׄG%%Tywn:%yFKp h޼ArY~ũ7bݍ>i \jr`E2VoHH'}ZX8B}Xkݷb7~Riwx\[ E~Q= =I係m@gº׺FC%0žWtQ緛Ah}Ak9KGLrkZT_ Z{׾XpҷJ,M΍ UL?=҇yz gb|Y/1) :NtW^3%ED"}σ@~(^ !.AZ"vUg9-&uMG@򵞒#? TD"#q s~#|iw&R:@/ˀ߳i_{4LԝɁJ@ũ͚7e;b4 7X?<4w$N/yoWipCi߫x:w/pxG5 ^mnk珱q[v##[_=︀A$Ozc bV`u.+~-£V3P9'bݙ%C͉?ן_1Ѓ>;mFe ؒT/z_~QjTA'|gnk H0 1)WiԈ'E|qor/$qHGWO6 $?b>}HCCA5[w"GS " #?>>MG^#/8D"?鹹j$R''ڱO%uܦ׏CḉEp;;g#\^ׅԹx` Ow-3еj7³Zp4E_09<}[  Q]O/Qg)%=Gx@Q椱[:ۋ"}}31(T5:QpZEӟ}ف:W+~9?|y?@>sP+:Vxxgem''}X[Q/z]c Pˊ,uxdi)+?w-uDr^8,qZ~#$ȺDX"0>>J|9ҟ,ٽUJ⎍rǸs_yLJ>[Fzt*$I~!,;.-a/c DĿ^[7 |دqWe彁qzTNWŃ0KgwL;|yajM^|l⩑@|;Otl2ׄy_jPa2{9ZNģnZx4n]/.$x7b(oF|gNH/\FK\ Ož,7[]>/ҧŗ;l8#+ @;g0?u6HͿp wkʒ =H+cfuA/ؕ˵FUly 2',G~ږWjM7lAO|"BH^813S- l_ɂԲ*zJvH-*X<\ث>~X_c_͌}θ O&v RCsť@`]6̹q/Sjhie8= Mn *PsЄGZ7K7q*?=0+S@c°SqBy?y~.K=sկYP]&q.g F_~!gJ[9cAyf):a:,+v>]zk#[@gՕYm,5lzDsr3P*l`n^lr(OMvm(%M ZK7_6jK摮Jvh OuY@iPn>M9rGH׋̋^dҧ:V@1qٝĉ8;}sQ]1V 8\>TO/HV+|.'#㡭7n_ラ O;;dc:Ձ:;J4%SN7[U:g3A{޳"KվPese+=ӕZ;oA2,[?NM}IwjF&  a3MZmKIƖNYx7neF~]}Eo$.|~~4 ضeߏ~wxoRcWp_o$/Lk`%W:jMH_{ 7-_2h5_2iBi0pb6|qF.K}T5_~KYs}`Z?2'o>8-ֻ<~Qvs(`\YTzJ"A; 7p@HSּK;Dy5Kn8./^ }B>:jM}EzYN¬gvFμ+4p~^R@D9(ߝݽz0Ο8/AΓƹOw[IaӵԍWxW(0)+zA]7;v'w_:9P = y^zsV!nj_TomyMt 8afcyx$<$SseWޞ)0,g~I ȳOV`ͤ@sdtC<7Ss^5Xԡ+XQqqQwsox+%mz.oO4^c~[ 8e)q??i}&o Oç:ڀ0?߱ x=~cύRv+_¼@IZ$}! H~ ZewSDs1EQ4y[v9 /I/=wJ`ԣ.#:T#s/wco?eZXb<!S8EX? KS]3-/צzc懮"]<+x5/ uGߕslVA)jxK/8*}KsSi8z;Z ?d:>LG, lnݞ%~z̿ܠ>a߀߶ys_^ܛNJ4|}A}9/#|[ 7Y?n3 6C}@|p&l̯" |w:ٓuW{Lz;}參Ugu.sMO&Y5hRb}g土("pیx^gtpo+w^\w,hTlňcu{ of B۵?MvQcH/MÁcѱ7'|;nn Zoorn'\"nn>+b'D_;+!>k1\m`9p}Ӂ6gm)ɏߏuڋMQ\C+p yr{!}eVy4wfk VO8lH@{C7}ֈ^?*9̘$׽wTЩs`.rT7^shwIj&nd'K˜{mt&'jC>Dt X_Emό۰ʄ ez6lTZ1A~nI/PS埪!g">Qoa|g'leh_\)=M6VեtcL[ ;c x߀=p>ߒ^0H[>B9? OM'Po gekZ#>{9sybu!ΤM=UUxFgR'ޑ&m0kY w Q/2NM tAЩSk L3O?^|z#%A0CaM ,\orubv:iaAco,,E{},{gD2OX!U*ӊ1FmA 5K*Mg1-\UyJ_NE8TG`{G(j>諲ˋ^/Zk+aYT(q#S8ۀ֭+x9}ȹ"qoDpu?譫M\mſn\*WGjN!{tdRtZ㜧$_ ?i-g@iPO[&bSq 0ߑCʾz~ #{nS0 Jb~aV-+z^x)\汬}-0[~ޢL;75R K;//>|C T{̡cOIFKӭ9"ݔ.H89O?ɍľu |eC,C3 ?EyDq4Vt3<¿ V l̺#?$eNiE$oK߶y^sHwaDo=ZyXSY7X2lC$^+\"U@>"MܷOҨ?-gX'g`!,=& xng3T9VOV=&7RGfW رaSus30SvΨjfvTa(`[<@_ FT~SeǰOr|wVLPǻf̦bY7w֕3@)dVuQgXKs:d|M#Wzv CT ?:o}O䛴v:sҫ爾Ѳ)Pƺb]WsA= o_W 3U3_~7۵jxv|g΂rNTxj'a_ +rag+G).9A, mK* 9ԏ)寁]K=h7op Ƶv_1ow$ `ƷXK{⺽ؠCѯ`I㠯M>[E` N-w~o;i؋uX%xvs:}ScTpL&NXp>)TE54ts `[M? Q5 O{7R G&حH sw]EQE&.(e6t''ȱ+'wAg2oCJR0Z*g%`I~'O/p!XsױM`ݜ#A^j7| z̃$o•VaÉMZ,G!E'G|^w{1בϡַ+ՈZ(7^N^RK]ہRhb#l埰oiLn|4%UrnOD$E"'^[w ztа^X/fX7"I wБeXoC wkvQa@g?WLӫ:ȳ3*JOI6laDZK}jvL"E梵(O:z͈6oTx<^i!;Jmh qI=_[ѤL)0'Uln#EwQ+`3?g"^=t@OWd#g7_ފ1 c~OŇ3-7mWmߜGL?}nzŻ#mv/pЧg>l/l,"=Jx֓c:* Cc :.@_ul ~Fl:sSyU8I-\[}'z?'v1StGvĸ Om|'֝gOh6IcӅT`|Q:+_։''O~wvL7)T9^; gً~ <.=+-:*}W?4ոj\BLo93Md>-(c'AaQq-b%Q>:oOpr= BGod= ͧ'a][w ydCFe`7@M6=7̿¾*zǷOtյq®3[yrawIx=%i3?y}lB8..q-IW~G7[f93Axbkc@~YRG%wbHǺ^x*?8*j >nÇgST}#oD@19/I%{"}O*W͝c#Ϡ3@|Qʛ/T`tɣ}Ivzc>y?@H'wFw ׁ$^>JStx/sHǑKu'A3O~fƐNC"J!zps*1/yk>\⫓}|p򅈟dd_xen>pG}!#h'z Q¾#Onw/\ۮ4R~6*}WZ7> 멄3jX~4١r~+;rѸ&m9+,Zי# D3뤟{pb=Oi ̦$y)s/IpyX/_4=[ qA 72P%J#[|kF֓fK=1A^b^5# :vGw b$mY>1 <ꉷ.ݚ/p]ҋ}(/q_x˟xˉ\,f?B 3`}fpxnI#VQj z#ޙ=OHW)LtK1>T EIDyCyK^\;b\'=E∎R"*O$[T'}N  G?l}?rLyltls8'? z <Æ=myqJBgGܧ)4v =Y}kak/cozVލ03g';?M! ϱ2j. HGc?}A|gj~>}fo&RX076TrWe h{EqHݎiTM[En8.Rulo=h^ώ6q{+^F|/V6rM0O:zaC P_5wa|n4Ʀ("e]t^mV}>k^ CUsP@'ɇ(7gg_w?F; W+;s" +FHZ,͗#/Hc}qS _6x&]mJ}>]y@WE^Q:03_|ov3#ߓ֎/,v;z_{`=gֽJqW9-_ ]w/Ycu2*wl~e:*{ת:g~H}Gkhuo/VaVYԺQSz5ګ/n:8UCөxIoL7a }U|'nz2oGp`d CphǣCNl_aڵ/r@ dEb!<9J׫\E0͸?#4~:ӧ䵑* q&U"cIyқ ~#v04-.޲@W\{w05hк9'EGv~@Na#>ڬ XORxo.m A!m՜# ?Xu^bvf z1hf9SIfw,$WM׭=>= ]9n~C?=kgH+l%qjs]g'Mjֻ/vPjR/n *t!yY셻Z754LW?d+ ^8n J5ޥ8?S@놦81i.UXPw{z;C8p9f3 TB;zϢ'> ִzʃjwfXԬ38t7gbo蕖WN\}StЗb9zȭ!_ԶH ]߬_Am%oudRV*q29Y?Nq:zWxMv Iގ&WycߌxǮ0@R#* 4u[lllQ:۹8%:3aKWw:甜/ǭ[+}W7w~̇/:w"p;N~gu _LtUq@ۤ@9R[VPT>}P#bDRhUiuuR`nU]Phn4f?j#_lўbA#aڕ;slozꑩ˾{8:Cָ:W8>|Z0d̐`l<8RyrS׸\/(Gb># %S;#3!|"t3 xM7rn삨OczJME6V`-<ݠ!}}.dl}>4H Iմ|t g [uIK=ψy:pvlSV C_ TX?k.puM@}L}FֹU5c;\/ٍ V=yu*>=]R櫢^2ȧjO8qi߈;+vڂPf'NhUF[:4WOjEhA~ smN}) >у6x;g>ƀٽ8rb|]) S|–#\s]X]ԩ̜1S^VBtCI\?1n8>ҟ){gCg8O~y H?Iw+ }C?Fo\yә2ↇ8>c}NNZ˖_o:g?~ AuKl_P"Rp4)/7$ۛP Yn e1+ uGWeK<лWzδK,ny膤Tc`_~ رoz?5u&9L2]٨(B^܅/}o>)8gs}w 1N>XOl se)梱_7<>֦NtwuxJi:PfNT_Nrii:B6p{"ncLP75z7wv^톏Eyh_䎔|ol iouh ܨ/|~{?D!M\䗌pܟM*g?CFy8otG;mӠpRQ,~א#¿E_U؉9T_ta#m'؃0&2uF+dq m'>3'l5E}kpxlD\ =aᄴUz\g-KW9Φ+]>60[2/0z#٣ݻ;3mre(;Y_NJ(2O1K%eZ4Ei"4L)IRʐH42&4hBRII}>e^_]yk6 gslOO Q;XwW.y;/NG=>KIqC\c$hIh8!9Fݵly]0OcVg0ZV`fs?FY& xV_[7@Ω{<l wAmXuw>'+k]M|D f~0m|F}:N '%D;)pn`s:ǟV특ތ@=-ɿoPy4-أiϷX ]%-fs@ Oc|xWV/t1z#$"~X4~55`>&g"%&s`۽Ł˽f`8`Vxm.\0ަjXt D 9|:w?EKtw(/=i(dCR Gcⱳ91WT:<1sFn^ȓ୿{`HuNk3m\ch^q'>t@6PȀ3%nSS5x/J[WrI;!7W 4v,nEGc"LoNR72ޘ_0%zFrn4=H_z&L 23Мr b k/ڂҞҌ֣߰}:N?H2[Gֱxs],ߦbJ[&㸥-M`_NLx|)P >>4k>n*87q\|>8a׬iէh,uNu~3uz@ζk2bk]U}P K cp^z=b|7g~"`JL`a{Qyz}䀬3>؆_+ye@ H&, &>rX39=,%mf*:'-F;=g>jn\ ~]Vksҥ*!dN`d/xALh+rgf7q34{0N ? h2sޫ{^"Sn@u40L@U˃@z_8gZ#=#r)slyy_#j[fZ#c7,W<.nlǾ]$(]+6 _ѾY.Ic Ow\_㜾վSHcԳ@i=1K]_dѸW~{0uVxr 29.ћg]muPa7۔Enz* L˟J^}մp#YlrjmEK7Wzvv/ F7 4䙔sLٔ]R:4|P.[s~}$U\PG{dow:N,`< QEXGGp_᧤ix ֯]^#s/@G~%m& &r:|EWFƂqF1g>"9~0nߩP_ǝ8}'4U T7khZXvk׾ Tkt;T8gv*j<tr*q\05WA{scY +cAs@ig9,ي\ݷ; _44AoQӱޥ*Gs,`e.Y [)r˙uWB0?G4Z=t{EZ=ҩ_@p~2Pw,9?YtU@[_̸?qEA^3þM@O;[&f& v 7²I WN ^ׁjl %f+1KY=n?^aF3eoms%-6:1R9%aS(-Gxz^'"]1v9k2 fm,& ȁ6aC&Ϩ@ װC>>mq֪^yqEw/Lf2]` -'A'uj[߯ w.W$]*r7hWub7.ga}JrAhvFruSM>̧ȵwZ/Y_ON;GI޸?K6,9; 7/{t?;F_Xws/9}Wqy_ǭB0{`ɒ0'(_Q3E?+!p )3Of^uoknd>ζT^_ =_˼ҍ)uQq)O=6}>y\wR8(KI/䖆^.(ßۍ?j) N9vn|Uy q:7V\QYnmP8 hgٯ^ |f/-oW;\|v`"nߥaFȭh$M%Pۉ~AZ{|_̞0 z>Ͼ=krv\~\\|j?甑i,H{ ,F`$wz>}+4/Bg^>uψ]slMTP *7?q5-|E鋸:ʘ~X`7liЗ"7qLٕ tO{|wVHȄg&59WKEr;xt4̗IөjQ*Psص + ͂ɋT9`{r3Cϋ.;w!k(38T߻"x>˟į|iѻ9_z.a%ܗS?[aK>rؗZ?2Z-0 ot-H|]7|-RW/z吝C_@ _/ w#gq|p\A`>]01G.\ gߘ/Q3`~z КGO=e96~{O {5s1fii_?VSYס_ҍ&ۀVVgӚ#}f c VaeXݛ}y_#'IqT!tX? 3$1A}%8EAt(^OKWx".1 GohJ!"݅| oLs!)WoA}q?AcM%U5r4לus?g<'&.XqGqO&AFodTό&y!OsPZyv~\CSy=kx|ܖdqp _n>Ɯq@/L`?>nF:hyQM~b'>^S߻D&?Zy79u70 ,r`͜+X2%Z1iÈxNS\UlXŶM.g_lk.ηIVZo1ѵA8>5D-ER2rA+Y-҃y(7FoVl W.SC9sg`իGpݱ>Dg6pmH,i:WE_ y`_<ª%9>Hmڋ}Fz揗s}JM~$= xYV >' x+'0rtoGL~@߉M\ ω~/W[66濟o)TiD9 Qw ݛQy gcNF^wZos<+3/GTن%X"]c_em,ђ=@npܢG3_x!4|<Ǻ38\R޵:fstRBu?t N<a:zu!^tqm[>J},4ץexzܗFt .wҲ|zO~l33am:M9sdH0Q U-9HgsA0%NV{MgGfMpxF_FBo\{e'Nt_!ķSM~*k İ/3iک_[溇 粇?E|'U/kvt6 ~._瑆"&n.oms>ԨVG<?.|"T[O1[FQK"oȖL<򨂇4+m7Ӏ#/%h>m~d5>A}3c"gqx^Y}Tq2E9:fz2[ 0u45Pc^l+!ג]qwWN9~ƿ.X}d'8<yѶp3yS+ġaU1-AkەxqFa] uˌ75*6w.)QaIv'k-hM]7>oAηy6C{ |}I+30.{'׮&je棇}0.1d lJ_؇Ŀ1߼]L\v|K ~AQ ^՞M z/腘 PFj}3~NF>zKh͕:|VS\*\\es~vm({/Axo=vHVǻ{ɡ 0>Ng86+_S wfc0ĹJۼUN\^.>GX + Ծҍ"s ?#EM ʑݖR}YqOgoBnZp<\MC &l>>uCyRפʎ0UZeĝ0!^b_A$=}Tk1M1OT0h]+m1?rhJ-os0얏#%Ĵ1{[qZx1^gF*Oq_t3*VxnK\{#T$ފU@sfD7^| Tv(j +]=;>a9_ǥ \S4OxqE]=5#~k=R%Ӆ!cߓCIϧʙzV^s ?/wf|޼ƅn3>{6K/O9ix5sTn=5"^Ͻ|K$n8 wfPvms'(pv&>\ͳ䁊ʱ.AE{8dߪw]dAi/ys0W'輤.wĸ;y,Lzm!_o ̡QbdAAJKe.Fh 1>]ݷ8A媝:ӛn3ބ׭8Oց~9 {wY9<,E*&,*#UhO*W:5]+֊݃6?gw{+FV|~#k qp#h?}}P ԼڥUӾ'z_;:WT{3/us=q; 3>fs2[^X?P{1oOw;?;*ªFJu{U hyI\q7y͜IB9= aqR.!?(Qܡx4y~Ԃ4/yh*7v< !םzkgYK7tk ]5" EX<4#K"Xs}0 4'UdNelxP]v*^1bb:F[;!̨yf7'jwm<"V3OU3霠[=@ <|?(PUٷ*{^\̣޻? a6>ƍ C\o d 3k..aGT-qf9_ 7}K{ ~&EE5~@:~YkexLTM݋?-hz|o{`-xlެXV;;%$Be$uW0 wmP7y~e8yԶ@x6bJua8~#ҷ(Rra^[nz #(_QL?+>34}{Se7+&;czY[ g-`sz1u׃ %Ny4%'{D2Mp|!aKr 8#xƎNom0[jdw~5v03w[)y@3;taBǯJn`2:V{ͪz/ySGwFP8q7 }?u>[j!ک=b.ND֥ qN?^<$0IrNReU 1P4hI\ Nqkbӻ.򙬑ԏq oPEza}8(.Wܺ;؛X>1v68oI0t8g6,>_R:4~Ny:պc/ p fhX&5Lrv46 uߗ Q ~X#>RzV> zv{\kJny#@vIϓqP (Cp~ }.͹p91T_JUĂrݚC۾ ^*f;'O׼Rٺ/8QFK/1Sssqq׳=h}@MmP1*;|ax;?eviC._y'gS/<ږ=\ 4佹165$&08rT| hE62p~ zO*MaQawβgoTUY~a#w"|׾|4$0xn<ߥ,be-_>Z濹&ikbC>@ Qwl].I!v ֩53oyo0doh:5w^n\':NM51w`x ~\j{Иd[C4b7FN%zoY1oVlJQ1/N7`?k'OfShW >p x5taWOF :x1rdhq" -^0asNfPݛ^'J>_l( VjΞ/ lPl웛"zH1Jec053/>$As#+ kn?GU ?aD2w7]6&x+ɾq-G9ݖ7D)x֩~|ݦ;縉ޏ%R*Zba H[WvO[)CsV;0KAh](/P=fY,߇1J|nߢ| R:Ւ3 ZSzzSv ]ݮq8T\w4O3(t:#B +ݾ:m;< |jnE9 nVoh|dfvgx/Pl w5?ǀFY5WXa_8Q7?؏sIfF-`%U(NDgz\Nܚre]Nﮫk@ϊXRa~:zӈ8lr W/xۜ_sEB8{~}_ \<޼:.ab1P1@=:KEi| u9.q{`T7%'0brξXd2 <ہ5j^*x}PKS&tלw%IW gj|p-RӃ}&SKZDpޱF7~f7]rM͚Fow\Mfs0Q%&.(:"w>d;(?[jqtH8D$?DdD">-6a 6{t<ϰ_!upXخ/ğvZT5GJN: Mˬ,`6gdUM}=Ce&ք|p:0C>%smIv@OJ>Wjݖ}'"fNzmq}_^"evRU؎&U'JrS}C.0spKT9`NYo.g!5&nFaO@su[.Ún8E53U~H,ko 6@5`W/{hK'uf]瞧}!G^i-)np:`z]`v)p?aά5.oj!n{>? ΋Zx^-Vc >%^rB3X t?/r뇡] O+kl){):R1zT.OXs KVbߕң?Fx uϖ(lz pOTzT)yg0tš X"}LI>f߯^Գ-+a[' 1|JY`oeK0'h|"j+ 9'K.D|C gє{>?߉ŝX }GΎGM/yG!R3|+뻖7/Ag S7yU{/E{>'7|g~~|Avx3r X|}g1b@elt e_&ߙ{":ag Ox[YYw /Fp: MX:F>y*,TL#:*v`;= a 0j2 zx>Ut3 {Hw!æ{݋q+#[v(/?Y݄eyjt; 揹0='f֯|-#VθuT_N+% yuC/X2U0xpk5⋘N"whvZۏo_]?]Xz~.Sl{4} fr좷@_Udequ!8n6fK>M@Rp>? ]^N1ɐuOw}1\',.}; Sjc)̇~ڜC@->Nz#E0޿|SlY-.7y"Yܫ"Џ7Ұp}Mk nc?~k'65許?CŁq,w1~Z]o|'(sT.` x  vrŵ4Gܱ8w *"L{ZxO;K&Z䥤(7zȖVKǣWu x((M2_ WW25`#sMʪO\]3^Q+'PZ[6 5rw1/D4i9J7}M&| ac7i|I #}A~3"?PCڶ;0b DqܳRw#싚qT*;^/;功Nmq-@Kdح{(}Qݩ~=/>տAӒp?ߺ}6 >.)a f\ltW-mGˏB~(aȪ 9ť~4?;\xA$mjӆWyC@2V"}^(mb<_9!̷t5K͌p:p4]j6˪NUZ+8ڛ>}zt&b"uo1G4Oj/c|}g8X?Z'Zv2`o,s  8vȿ(?p)*eĬ !W`5}*!} /*O3o!{e{DMFnrleI::abctG՝smNCY%-?çHV}Sẍe@Ϩ.E&?I+5ཿVp摂m"uL}z:Ktxץi3>{;eTMnͨnhM8rI.O^֓ Mө>\kOL9ݐ3_c+P˃|`]\jOg+M#FO1w9]Αya%:aFnn] DRSjy}=wo6[KClsR(D~2gyv]>z1 *pNzAcMw fw#q~!x,q|fT`$錂 Yu0z̿~?YOFl5/wJU BMz/C.|D[ > ?a?Y@3%)o*PM>j2=ʮH2*J;W!?ײ. !!\GLy߀[HAHZ _UOsgAfzn^5@w,)g #\7N|jy{A# <}kI7Á 6gZ;>fӖ@o y 5y4|=%lp%a (QvI/3/OҔL˚]Yxϧw$+mw-^isPh=}牜71~b`]T1v E~8Q &4 $aLLyĻ?&XU!) y>";Ayeƶ~n`Tͮ &v@n4wp7ұ(Bn4=t26v~‘D*}a?FKvܗBDjz1g/͸CB a:N Pq]Ӣ}x}dH9[G$@ arHLqATe*ds SPyj<35<;[K.S1~jNVircɭ΢B`aa_dasm.}P[#'̓ا"D4 m5Oc.{_)}wVOi& b-n @W-aӜԵqac҆7b̛֮,3o/ ;݃Sf}UC'8cw'3ۜk~جup6N8-e5]d7h. YB퀺[o/@%+D<,%s T>~]/G̬"*ޛy5bo' Vqw7/}P3\Nsl[f~pgϬE{e~Ur<0/gZU؉uɻ&x곽_~w9a PCy4K}{op f˘xay]\;]qui_П\Cy-_WtA_ɟǍ9G>":7BqýU8 F8p ߛ~]3Qه&̔ebw)G4'l˶j{$+h>_u8NՇ7x9]~hI5.>d/h26=/PJڽʃQ>9ECs?BPܠ~S 3:0K29ǯ q6if`|*_zn<tx={)h4}X)|JRGNQ¹Cu59l.08oly.u١s.-ğ:ie]Wפqk3$3~8(Fb 9_^ S+@U/8_OP~8gsb5'8DZv&<}[oX-<z8"`1;mo;ycM,CzTNyD}M4WFN+>X!h_jޚs ˇ ;tT|Bsw4u }>`z4Oy@Kgy1J\||QRAG- ?oZ~ua޳xVz?}XW:mtZs9w& xhf]vMΘ9g4RWC ~ R(SGTY6a(0=WG`6'ya1b^M{CDB;T.YCL~;Y h3Mެ1jm2s+߈o{h>O!SnnszG?6^$Q]m`Ʌo.xo''H?8c.~_o;xwT1-[8}}c&g!2+5H);P;sh?= d6&у}98.s 'E5C ;WNI=AjA{M{q|5/g?Ή=<ߢ{y>d??Iﯙ`L_O'we<7卮G9<+cp_Uoi~@+V4xN\?/V?֪#B j^-;{C-x*1|0bD\pGp<1`zffw)Y|]_~b} ]|1?kpٵa8&*˜YH؍y^{% q|:rOm| -joa_Mj$>(_(.oշ. K?52d!L<*;I=v[3тBsջ˫{^.^bOZ8i~J\%Y`^d(]\袙 ^ ~񯃲'gZ.zO^͇@IeT#?ykKS`h>c7;Oיl4eaLӉqኛTaBү͡؈ M{%/oŸcV6~LwJaT}4߿ iV1>Ag=jJ}ޡ0X@1x=Wjg>fܞ_&&6ZǣQ>KljB~lP\4xOƫVv?^c{3^A| ~4=ğ i[%1{8L;ftӫܖPf0B$'5mP|,dLx)|Ac[ubӲ.}A3⓷ނ /fAM\^o}(7UVcrI̢g X'9+\TTƩE8P_QY(Xׇi!A1a?x?3]w-5K5M̓\=5UNgv ~r)@9x oƙz)1sޗOsP^W7 C@UX͂6d~ (ۦWGL5-zVh/=p~S~yf@u~_|@jU҆PR`/ze L'X y9[L8#M*Թ\\\~Z/drޛEb˄F7o0'wuok~s*LԀI>;]L{qjtYy2ߜ$T 7UݞG~hڹ7[_bۀgs Tvgm]X{ZɣS1NN,< .~.Q-kZٷY_5mv }런'S?EurLp @=BO5GlTuv,ЛmOcuYi9󹱲zTYɊ(\\E@m]';~d]Y6i1?9'vW@jǠ^`8eݛ%o\5lw{ק<1D|>=˥98֬)h6+5?,9\Ҿx𾨿>h~8련4|taDPgMfʹbG`s7*4ـe#S@cӵZ{eu|-J Aih O?= S>_2yYJ'>{ HWLT0g=we:RQܺnh01D-e Mߙ:ӑp!=7)~*o0q/njb i TIӍ8Q?3d 0'?f:bV>UEHeqU]MM϶@'`טJ`XEckF#cl`؉AB^፣5/ zI̋|=w*~?c2POcxnwooߊd3m!1NmYы}c~"3.-dCOtsi6,Nvdq`%/堾$F 7k@^.C6t+Lj Ob@e޿=g.$bn;}xó yEL-Zx;O_k}8g:~ug9i̡}54[5Tꨣgwz$-y pV8ۜhco$zς1;,5e\go9 pKXr0/ ɓyӓy|lnh&?=iܲ27޿n:t vH|?ߔށQes*Χ @. |KF[zz͚官w"}xHQo;'泂w> ״`H ~>Qt_Ko{/N<=@)%@YH2v%rUU<G ̜!U>+ek;kG?[7%gW ťܟ'fx|?_zXh}7nX9qbcX2n&n 34l>e ru]e} X%k6>gq2J9kj` =%5ػjBTto$ Opx9Rȫ]33:\lË5Oq| g.cd[7/*ꅵsGhy#ÒXh z5=0_go ľ5oMWf>_X@ID/Vk NoVd6>^~ K]< ubqb+ϱʿTRb`t״N*^7Vgn5;HzWVcTQ .4شR?3|Pu׊V,-)2X߰#䴼97NܵOsEr=={i` )-QhCw9fWk[uaޏ sKo ^ \]h_?c._]qV2ԟw P[%k͒C7&.ebC|4T̉l1l{-6mgNj^xwڻj0>dX/F {~H"W]獘dnew1VmǾ1yR#}{1Q9鬶sK:'^?Pb> z>qk8{fR)Hkb7pP7<yXS #޻V-? ᇁPX'KK{1t G|*;|6s)OPfKq7R7or`\(꟱Z7K[9ga{]|qF_aŒW:g-y/7j<#P7?vKɭ@"UlkdUm7~ڧ>UUQ&ctr~1 A^(Zvs 7c^-=E4꺷8 Usqx8=z]`̟Mݯ-eȝ5 #rdcGTjkzdg&.?.LSnÆL`Vȝr0-M*2Q@5NKՋ2`yJ@9k8A0)' %%Y;m8%'y~2;u Ng>kk[Qϣ?=(e[^A[y-G[Pو0|NO>kW^sf|qoIvsӀ}Ain~v.ߋ+61=r@m4ڤ& 1xd2>f^1~]na$?}jZ{~]> S컃U_S/6+Nj]C3kmlx`~n>m](+~yG|v|9zlTEo=m`҄=@~[k $n 6q8,d=fZ@J^"  <ҙDcاbO K z~XݒF$e '=[h1c]h%mwDsYw`o]8{3Jn)vtǶױ2tfV %~u߂fSz͝>q<Sr*w1lӋz,1~}0h"W=`5B_Nfs싛 ]Lq _'o7>Xe/}u Egd-|U-8ϻ7w du039aZ(}Bn:JߙmYg1J/hJyEp?hkMͯSp?;/Ϭ?"ܡg"TҸgoz<'Dz$-r'C P~/GK`Nu [!C|WXSf߯:^ko)IBعOw苿>}A7EV`_VʥkŠ8~3cxO9il @&Z/YXt`uӅJ@pD2!9c'y@w|ߚv%QъR9 +TG]2}슳}y pҙJc|j-z{LTMr6o;W(ލbg&KE K?ԃl>l/"| /~wIjFSU &}ppв kd[4b6Զj;9DkGZľ##ujxu a->S9+MںtV凔fQ@L_u|'ףnv#z?GOqa[<%%N\ֻPu 9?-#R<=3\8I9<< S͢7>.^[3TwuXnh 嗦Qayqn}T4/|DClYf-'4՗[E x=A؞|oJ1HzNfqW6wQdV$ h yJ8^oL뜵0|ڏ 1d9#&7B˂u3Ѕf#-Vo,U.t4PثԼx2(~ҹo:UZO?,wO)>~ce4^j 1#uQ#/''떶7>{F0^PA0sEo!4M~?HԧE|Zt(~ME;Ԅsso0nmkZrz}6)+a5:b?{:N8J. |^tϟҷ(&W E'*pn7x=a^ÈW#4sxr]2P!AO|YijpCKӽ$ֱhm.{ +:"]\+4^PF4-R#?h:Nqo:z_4}k9׻a_ 8G|J[> q sn9}*yčak{!*5%WcAEkp[[#C~`~Or=`y\rՋ;F|C P~J1 8jMi"9(.|+:Wb Y":M6'[0#1OOa 7F䉧]"sQSe|aE:X)U(u?7Azw*zu7KðDzεHіc[ffί<#5=ioFxX޷pfg#rzrdI8 Ӭ='4Qm5<Zއh>{ +J8{n+(+t}P JU@+ev@V?<9YeWqhEx9&c MӀ+6llxy7~; 絩g+o{;hހ)M~/(qhՆH<4n /?Gljb?a@sXIM瀾w3t(tqB-+->¤;g0mK?pwF8'<=t+`y &\zFj巶:ˁãqNmK[-3]3hMmы/n?#ZNmҚsrp5'F88dT$gR8: }=}X&*A~gXjg'{ jşºE[<\=(Yg_h9Sfv[L#WqƁ[=)_Gb(u4ιmSz=ϙ? uIå닕w Te m/@7bZ v V'p2mlz s$o4A6u:o_iXG}sfZqπorb<?@sBDsU}"͢o?7zL.^} u}ǨP]`( >O6cz8A 7<\FYgǿ;'F-fi'ne 0˿q;_>yY.)Q\ Z^.{?Le)@(jߏQ(ON݊̐ Kw3>rja|OsOYnEtr!LX7k?~uD `- ?<:4Qyq59u P]=ŵ0S „wbAiiӂcAz;*>7yd_04 -:끰iV߾2La~OsLxW].؂ׯL+jku{*vszẇ7~C-$~mW?Xj9ZPY9ueo7ioШ(!.46 Yt(4vYuY;J=F:)˂s\߂+x<.%K]0Νr4} ~VRcJ;OzkBoNvJmWRzӚ2b&rd}eiKĔ&.T]2 4^ii-Ϲcg|~:OЄ:6[quSƴ펻]Cy8xJ#վjܱ#7& k۬WS]3T/J_͏sU7ia%o5E]fƜo_>"S# TojHhӺgR @ď1sA#X1,25{AqI5FDGbO%mm5낾1;$7YQߗgXy 21{6[G=%O}G7rbLާg^Uz bDnmZrwdNWqNLL򜶧ʦQvm-[W(y(Ť͗~j׌X5]PҚeT)IPߒ:*4zw[({=7_=Uڇ>[7,_}%Xr W. Y =ML'1ݤ+M?|$| FVEDi11x2{vRjͤ{8/;t5/e 7Ɲg>}Ҳ\P0b}l!fTŌ|Rޑ >w-+q}Pap8V;%:rI i7ny.Z& ~:аT}Kځ["f3ɇv/Kxq`e>CWr5oĉh9Ϡqwz7uUʄ߉fJP?XZiZkb0ΨKp7{W]zT2V>qlM0nYA2[G齋q5DE$2=o!jatޚOϒ{So:h4iܣ8T$6oNy*݊SW|K>YOn\6}O\"qFB_&71 xK^^zy0f_@,{{)C%_㋏0O/h:MT&é5yG1P\S_[.) 2 98KK]mul>Vd~49O|6tyc- xݼ6=+yx$/{5m[ư,As*U͈%x?ESо\f x" kgWAU ~BPW.z/P?x,0@ڿI/\x|/RUr+1JNOL6k |3V)O5 eǸΑ쮝Ӗ&r-7>Ǽ˯y#4.V_8=8Rp$wwxO^o~1^N3T E}U Ӎ~00"S&DO4 ؒvLj'XZ tew@`Tah&hZ2'` :mね9'R咅Ehz"P"3=*\XvϧWqǿ-[#~WTiZ̿ЯGMWH=i2H}W湼 ݶ懨dž7}L>),5BηjvjW#л z@+dAPW\慨~w" >5Ob@JmT?|TrSYaviK O:}i-+P9q,Ĵ{7i0 _AxWso[%^G$=R>ͯ>| ݌@Jەok:m0?t$ݤ/͠3[*굳FpUM-ô?uċf<sJG`fOfhYqmD>&gNw͏ uȸob.3p!})L߹ru\wl93?;\W )3JsKs?|"&} ʪTt>g78{юh9$ ť'j@|s30ṭLG"9P\J&9kY@߻ )n|-1HAqhIet.9G:6ܸx,岕`xZrTY~R R.J{H>U=:VҀmni ˜OCeH' Tm<KmM G9J+}bhKI?q;@`٩8xxKUτ7UN\0_xZULGQ*83PǕ Z}WzD(%dQz1@mD#|a{EԍO7Kc3D;ȃ%"AxM"/KHo+y|X=UO>F]Y'V9aRړ5vf6@EWK}Adt穫\Mtlk]N٥sҀ rJ5K[͐4Po~,35Co#ksp/][puoW1OdiZ;2 ޥEcP *~7tBQOh raMgVc۷_r+Oޭ>S7A[eX'zLyhS 4W@;\mpy{uq/Lq}? <~Un=8_vhp~MG_O^F[ ZN3d-(OOLߕ%s92PD5h;倵w3AVIw(\/Ӽ L锋䨵5@<g"P#i0Nl?0 unduUc?گMr@+!i8Q}f8.6G@;K h,O5ÑoԈme{ w6lο#H޸[' Gb|u#q{-/^cT$4oc>kЫ#lux FbX)q oyo7?塦G˶C;n6ؿmo  ?~Q@?\gq˂[܀]= (qqg̶Y85/dۆ٠铼u0ON'䏇l_};f>S#SuZTBu RPwKVtֹ gqq@i׻vbH2\&P7 Np|XH4Yx W7GD1ϡMʽυLjOZ'-gs#/'Y|G~( H+IL8W/&32xE8fi+3ZA;,KIcm\0ևR,-X{ +jwa/I~9اC+/{/Wq'dJi ^A@5(jCݬq1揥MNNgLrU y•1j@֟} =lܓ }F{.V9FNGy| } lF~֍N:_OYGQgmϛe˱/x-))[q8Yۘ~ vmJyfۭ>j`E_Ϳ/^ *8ohAo=yc|v*W>}[uO'c'WWݵz*l{?'Q HH2cotfΪ:@kZԻ p8p߮+O1\JQ-,(ߔ TX!?D EwWmtU{X 6M69غqa@o_+ŭU1jQa@AU_Кq}# loAEsMF4JKK_Bލw qJW+XWŻ/Ύx<%&rj82_nG2ͣ70#a ; \RoTчWuPNw"tH $ [W(@>3ɵ,}}U.2sm]ӿKg-J4ey 'ړqSViItuPvm- meo9{i2eZexr^B m?mk_ro~4Wż y x;-.j#Y\W=)XEA{R95qVֹxcMO]{ݹu|쫨鳰_^f90U4W"9_<}엪_(9jXTehXOSk}^F ]ExS!Wꬼp4x,υ*9|cK]>hm|A #o~D֫5fx~u6ۦEӢV/W}HE`cz57@2/6V ESnN~;ۗVJʲ8[f'}6w?ϧ:fVCy8*o#5syP)%t8mOX%x;HW E~eS GvB gK|{rDŽSzszOP2OƼĚo}2;Ni.w~x6ďOZ8TE],toW8ծe`\*e&f u~5C9кO"'OK+y7L AplBY>2/6thĪ'0S;6~8o篖t?{rmթgnLG2.YmuiJ U^>͘?O*2k|ψZ%i D8 /hs[L* 2a# R#(NIs{ FǩN;xIMPvJZ 'k}""/>'ė|1[=tk%@}Ȫsߖ4e.hiYXngnЃ-j-)'`,8!NtJ o؂7\{hLؘШ*cQE@,<6q>~7Z o; e&q?zsyˠ~/ӴZq"+69>ay v*PwMr؃|5q @P^PG=h7Y98Du+cav/fɤxNPԛZf\ P~i/j%w< dמ|s"ų۵⾨`=?7pdnk=C2~q{/Wмz(FXG'oby*ecM=3B[+\UqP~=EŵCdě^MIcY@-`<$ҁ6ugL*fܟ' \m<3OXbݬm;bF6=QFqbd.>'e2@"F/>oZy>PߕBkW࿊dף>iw@ @iJpt3?;LE|%/=|"%aZiUTU??Bdj5˵ "OLvk;{Xؚl(oټ%oA`z(/WgҞʬ1޼ܹݒR5X6 Ȭxy 溱`o}[//95eX~5!= 9e-*k0wk]Y;d̿Fq_l9ŏs![R')c?t)3KP~-ɖ}7fmflmgRVkJTV!E+ZD%dP*JTT{~9g~3}sy e#[>2q>Qrυu \"}>B>@ ͜760rl_LҺ`wQ=אIo28[ϯ> 8=~L4_Lh7>sc=Yl_ w_RWG~Uu]r[_?QaI)dό`!c`51DhRSx^5CWZ_Hs Á2-n%=þTWƭfa_ft}b缚3;Ӗ/H`Y7Q鲷z/q$ 6s-bnh`'#)GrhUo} حȳ.L]6##Y*Fہݽǰo!]NnpM ',ҧk Kd^}7Oߙ7]wD8նlk:WU:=0)7>UKuS9a"9~Ws<@phd w>HA&-Ȓ6]`ja}/BģѼČMCt VW? ??? H:_x 3qx~E!3_Nj HGstHBt}Dz,iǶĜHy)G#Ƣ>=o]F6?h}8L4Fw!^`4Ӻ5%ۋy sHc}]c|~bh2J~ (傃pVl9 Cl>W#B_Y܄bσuę .-xQ_Yss>\t^H]w˒#]ϋ?aKjno+ODKu} tϜ'_HFӬkƖ#p! B'ΑJvͻ}P^y]Ӷc o>ҙPqF9/IetiYNE;jKw<`W~c͉uwW0w')hطHwN<kԓm}:z|hLn c~7 r Vng3bB6_pV%Œ O t0v89ui z˧fԪyc{ 5$!^[3;H4ϥ^L^}.]708 VrEuL߂fb{vu n0PFGq۳gz9Ogy݅t4.jX5"|D(dy CS/a?j.4 ZAݽ Q܁4^\GM̒b~/dNlG`4Uϑůb_ 4 p~'NL^I׍z=oPϣ0g*Kd T_Bcܸ3J:i>jt8k3Ί?W0@+V}?E?/Sؙ8o TDФ8yE2eo x^md. #~DO៴ ̇ [[ A5|>o,(pdR] V~7Mx^h׈Dgp ?A2iM)]J""aWtZvΘiNFH?x>`pZ͟8NE, 8n?nf#l?)jV+~ k Kc#4{EMN6د(y&?IȿtCȟ}oya=Wbe.ߣx}W48`XV`|X;?kN (wB /_3#h\w e4< yAvuc(eUtO'{j<0GȁI}IXF #W'ߚ1F8Եiq\1~goƝxӛ+UfV4+zهǁjQ!ܱY-pÆW1]Q稄ovdz?W/#\Skp4"6 Ԟ tvք?WHz >'o j.7T4,C(bxEg~::麟=c`eM_Sk_)^:m}ziaA)q^/`'ɥO|=2və=,.n^t {4l4;NǏAТ<}B)wk|Hk zK,J>^P|)6[4+S3s}v@d.ڏ?!b |_zN:7zܮ%8>]9acpO`uZB_s=ז9x)6 AuM'!W._~ J{QlAx?|T:k%iC QS ?7ǃfu gMLs۠B7Onw0u;]EqyNQ^[]Їq6~g;'Ф@EMX[E{{!D4;izέRq<`(~O)8ѝ>MgDt\ ]j!NccڀmMдy<{Wh[Y 5y5,onR}.gӘ^q F5W8ۿvI~h8 n䭗<8^u)+Νq-7 -'c>,ތOh:W4Kay]Yо%g. 8MM\b wVT1n+`dwOivew >OET+7kj!hΫl%0[zl]ή+VI HϷ<| ӲM5:5S+5:< 3u s;`Ȏvn`kf, jM ?lץ}>n[Q`xo[y# f ?jecAcΛPh.W̮ NJ/)ۑnh[b7*5^5JTq|~7<|/4,s zuR{.|_TGyփk&NòD`z7xjUW1`,0~)u|_Qcm{q^/J׏o8fNrʼn8>{%, f +9-\uՆ`&I3`|kέfCƜԭԗcG>nL笙>/_r]FZO"=\Z|>\n|\Y.>ش)uso@l0x711?TWQ4`~1Wz 1{usRݍP~g:PY9s+{U 0ed0\Ck!0R`-V6wGyzwiJ;2`@H{ϖelwظܥ {ζ[@:/dW iG ։YwP;/ŝnG|rw ׭MkjFz7(Q||/Ts%oʞ,Op=V7Q[NtN^u-@+߇*>l9 M _(OC#]Xrn]S~ae S7|~d{=|#}aYVo_|S1_rw(8CuY{T@{yi/eqŘxв 80 /BUmw'_ڢ2q^7!ɝ1^|,'d/ܺs layJȉiF:H7jZj'~ڶhZTڒ+ib<&]jhhѺ򔝯IzZhP)_By@%]c|Sqȕc8?ʱO"R .*P 7ŧO㈛K8eˈDQ.w]=X|t= Y<ah@D{eeC[?߆Jmho_׼=;.l ۫rB-й')򼝯 ;5dwRp/0g[璕fz#1UӬҲP7cgM -xW.rZn|5n6 _fhL4ZiM_ӿ= 1̮˖/*14jP/*OM6E s(R F*ֹ~8@ׁ6m9Y0 7gĒKF6('6ξAafxQf_kDkδN\!c@=|RPW^3woWCۻ봁<__7^On&b@k&e[@]`#yog0|ʯ8>-\|Q{Qjx\މ+N@N94fEc^Cޞ {x뽈3/MO'*m$őljvPoO yt3UK 䴂JQA|{:fsF ْ]/0=*]Q0$GxT%O_*7|̮X0騶tkB?7?zT`\46X wFnqImg %S~x,:$33ri^H VHڂ)տۀ0q~_Ԑiv% ng_HzR5#P>ηGx5nxx>X\@XD7MA?@+zoYR9Z1a]* F2V27 FV=I nj_x3va^ʶ2@|%u|NXJh7mSZ>V'b6oE/Us -/.31x1~ +~)7;tN} ;5|ػ|w`-[df?6P 4/^؝sA)FɰpUx**{6'p -B =lS' jwָ୿Pk71AфT̯Q =sa\rZ/:$>I͈E'vA_Ɉ@.;=᫧D|2ey0?Jmwp=4-ly2 :kj,Ŋ 7ݿ_߿7qxb5S2ͷlٻ4vnTpL<2n-Y>+281K-|i;pP>)|u%=B_ɉ'Rֽm $Ub]<\i#tx.{pq6Iedy#$9<Zvƺ'?A ;XwAp G8K9 Ojb'xkf=&qйj}OmsZw1ʐzx( y&gW߇޹ o.|zP"{ -aZ (vMR#c<'(s^\ /l.KLO뛣M/g>U|_ppMPɭ5qu F-7>j> ^}ޱM\.&Ͱ&䲰Jg \Ia_]Q #[ź J> |FQcGH@ͿqcJ%c8>NdNgOWUzq:jGo'#y"vdM UEeR!qb:nڡ:x:xM+߱,zCjñH.Ľ`|z/ݗ%7r70#އD"GI!RްY @ʭ 1B|%<ѳ!xnE9Yϕ¼ؒ9j cT6ׅ{jyx2{/]!  1&v;֑(SjMձN5~/DxՂgϿKm+:gc]z:yt쌝X@HRt׉L7LW׌s64t,Ѹ ~CZbiXc;8JcyA㕢}n#^.X鶢#޶kTUw Sx)F܍w0_!="la3]@Zd3'X:`ڽxnwkW1=~7'VwC/mq͇7oWOs{:exUŁsAPkjXX pl?Yk ;4~ƌ>< i@i ?aaͽm#@뱱?/pwgiNH wd\udEMpagk$jǯ ^Dfo؜q{҉{&y@gmb'obt.=`7*JxΧZV;M̟-7OlnH욠(gKd\ĕM}ncfc,Ndg^ ϰ:x"}ŋ~LsE]޹=XOct&a {^z3qr R]t⼤Z ;獋K"〠z+,B{K!vX7^_)qYi:}f;HA|+:ySUWm? q[1GJ=z#%:W< / +aS+o4w:z=RVP XWcnGgġ! Pc?0ϛ,iDZ?+|᾵lY '\|Qq +_?͈$[a _uncqkof <4h40&??1;! pb:*~iv MeE?OƸIV)9ugx @Tks>_hNꨠZ4D\Μ*γ;ﰸJ.nv du[D a}S4@׍}d"]n#޹{eƿOa9oiH"7q}?j-)0t614q%(Y%4>NQTw)ޅqdyهG>5[J8EEX7C$\|?_ܦE{1)vHI\?}0QIWOk/ l;c(!>k߇l 2Q.rק= )iec{?j7< rEQХR{~'g KNq~~bh?<<@hǥS s窝i2 -!.jbgX˫0Ӛ̶.Oc\>#?'x~0]Ԛ )ߧ`NfI?4$Vtw!.^#n9"_p[<m@--'i,;" q=YccZMM>\ї2]\^Z] $}H?7؏5mgj|f*8dČGq=Gz ?u_ _ކ w|+b=R|O_ ¥i*ok% TIPoNNS. 䀅f` _[Lbq&O8Lf:oZGOs];|s?ܴ|얾 HoC~;Ey୳xtA'P3ɾfJNć .9TB9fdz ǩW_]4Gqc|puJN|-w[YZ]=I<*զ= @,'~.#0w6%YIIXA-b-sM 'J~߬7mş ;=ry r+R*\/<ӽY4nM쓡2ZD, ;զf|C5Y.uey0f}w)~|_k =9*ߜZFfl2|DCOwqݯ8As>Q]~]u R|wd[!&^? KTIc( OO"=gss}"I3swp.'Ox/Q (?QޠA7F9'nۈvoW0K5kO1Qَ9lRP|7yn_m9y&ߔ>'AsC'LƆ綟yԨng//Tk#eo.]3Ev@z;|ī|O`b#J ԩðX$hnK|/m%O,?OrzW7`yφX/r>J|#ALeq  1pOb!UG8t ˻˨F ZЇ'4;STjEORQ; Y 9A*ʮb5zHigަدϹ8s/ žq!ɋ!9lyV4S꭬~7h&%fD>%=)C Y>? ׃|-6E+8o)7Z?кkn1:2;?rY$~(?Q%. *~7OeS4dُz t$k'>dzπYɴNA:gqȗ6 mu˻_7 /sOjȵ.%w0$>gm̶˗g $lr:ǏyrxcK"7dLSz]wT l#d3T\N |]=T:O|>W3?ń9`"~kliw+,}E[m/49GVf%C#Gb}H`X-js=!ɮzZ`>ta V/ !L=Nd0L O.y 㿔 nP,A;WToHs#> o2MU[4@Y FJùgܺ ?}w>UJUT\{145D|Ed汁Xf6?VT׉t%76iv]Pl&P%R.::hٺ7~f"/z$0X/>_p_*}z_^"ǾdUk:!{Լ1Xh~dYG DhycF]Ogtools/R/0000755000176200001440000000000013312231010011744 5ustar liggesusersgtools/R/loadedPackages.R0000644000176200001440000000112613003720436014772 0ustar liggesusersloadedPackages <- function(silent=FALSE) { packageNames <- loadedNamespaces() packageVersions <- sapply(packageNames, function(package) paste(packageVersion(package), sep=".") ) packagePaths <- find.package(packageNames) inSearchPath <- match(packageNames, gsub('^package:', '', grep('^package:', search(), value=TRUE))) retval <- data.frame(Name=packageNames, Version=packageVersions, Path=packagePaths, SearchPath=inSearchPath) retval$SearchPath <- na.replace(retval$SearchPath, '-') retval <- retval[order(inSearchPath),] if(!silent) print(retval) invisible(retval) } gtools/R/logit.R0000644000176200001440000000050313003720436013217 0ustar liggesusers# $Id: logit.R 625 2005-06-09 14:20:30Z nj7w $ logit <- function(x, min=0, max=1) { p <- (x-min)/(max-min) log(p/(1-p)) } inv.logit <- function(x, min=0, max=1) { p <- exp(x)/(1+exp(x)) p <- ifelse( is.na(p) & !is.na(x), 1, p ) # fix problems with +Inf p * (max-min) + min } gtools/R/unByteCode.R0000644000176200001440000000150713003720436014147 0ustar liggesusers## Convert a byte-compiled function to an interpreted-code function unByteCode <- function(fun) { FUN <- eval(parse(text=deparse(fun))) environment(FUN) <- environment(fun) FUN } ## Replace function definition inside of a locked environment **HACK** assignEdgewise <- function(name, env, value) { unlockBinding(name, env=env) assign( name, envir=env, value=value) lockBinding(name, env=env) invisible(value) } ## Replace byte-compiled function in a locked environment with an ## interpreted-code function unByteCodeAssign <- function(fun) { name <- gsub('^.*::+','', deparse(substitute(fun))) FUN <- unByteCode(fun) retval <- assignEdgewise(name=name, env=environment(FUN), value=FUN ) invisible(retval) } gtools/R/mixedsort.R0000644000176200001440000001116613003720436014126 0ustar liggesusersmixedsort <- function(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE, numeric.type=c("decimal", "roman"), roman.case=c("upper","lower","both") ) { ord <- mixedorder(x, decreasing=decreasing, na.last=na.last, blank.last=blank.last, numeric.type=numeric.type, roman.case=roman.case ) x[ord] } mixedorder <- function(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE, numeric.type=c("decimal", "roman"), roman.case=c("upper","lower","both") ) { # - Split each each character string into an vector of strings and # numbers # - Separately rank numbers and strings # - Combine orders so that strings follow numbers numeric.type <- match.arg(numeric.type) roman.case <- match.arg(roman.case) if(length(x)<1) return(NULL) else if(length(x)==1) return(1) if( !is.character(x) ) return( order(x, decreasing=decreasing, na.last=na.last) ) delim="\\$\\@\\$" if(numeric.type=="decimal") { regex <- "((?:(?i)(?:[-+]?)(?:(?=[.]?[0123456789])(?:[0123456789]*)(?:(?:[.])(?:[0123456789]{0,}))?)(?:(?:[eE])(?:(?:[-+]?)(?:[0123456789]+))|)))" # uses PERL syntax numeric <- function(x) as.numeric(x) } else if (numeric.type=="roman") { regex <- switch(roman.case, "both" = "([IVXCLDMivxcldm]+)", "upper" = "([IVXCLDM]+)", "lower" = "([ivxcldm]+)" ) numeric <- function(x) roman2int(x) } else stop("Unknown value for numeric.type: ", numeric.type) nonnumeric <- function(x) { ifelse(is.na(numeric(x)), toupper(x), NA) } x <- as.character(x) which.nas <- which(is.na(x)) which.blanks <- which(x=="") #### # - Convert each character string into an vector containing single # character and numeric values. #### # find and mark numbers in the form of +1.23e+45.67 delimited <- gsub(regex, paste(delim,"\\1",delim,sep=""), x, perl=TRUE) # separate out numbers step1 <- strsplit(delimited, delim) # remove empty elements step1 <- lapply( step1, function(x) x[x>""] ) # create numeric version of data suppressWarnings( step1.numeric <- lapply( step1, numeric ) ) # create non-numeric version of data suppressWarnings( step1.character <- lapply( step1, nonnumeric ) ) # now transpose so that 1st vector contains 1st element from each # original string maxelem <- max(sapply(step1, length)) step1.numeric.t <- lapply(1:maxelem, function(i) sapply(step1.numeric, function(x)x[i]) ) step1.character.t <- lapply(1:maxelem, function(i) sapply(step1.character, function(x)x[i]) ) # now order them rank.numeric <- sapply(step1.numeric.t, rank) rank.character <- sapply(step1.character.t, function(x) as.numeric(factor(x))) # and merge rank.numeric[!is.na(rank.character)] <- 0 # mask off string values rank.character <- t( t(rank.character) + apply(matrix(rank.numeric),2,max,na.rm=TRUE) ) rank.overall <- ifelse(is.na(rank.character),rank.numeric,rank.character) order.frame <- as.data.frame(rank.overall) if(length(which.nas) > 0) if(is.na(na.last)) order.frame[which.nas,] <- NA else if(na.last) order.frame[which.nas,] <- Inf else order.frame[which.nas,] <- -Inf if(length(which.blanks) > 0) if(is.na(blank.last)) order.frame[which.blanks,] <- NA else if(blank.last) order.frame[which.blanks,] <- 1e99 else order.frame[which.blanks,] <- -1e99 order.frame <- as.list(order.frame) order.frame$decreasing <- decreasing order.frame$na.last <- NA retval <- do.call("order", order.frame) return(retval) } gtools/R/asc.R0000644000176200001440000000027113003720436012651 0ustar liggesusersasc <- function(char, simplify=TRUE) sapply(char, function(x) strtoi(charToRaw(x),16L), simplify=simplify ) chr <- function(ascii) sapply(ascii, function(x) rawToChar(as.raw(x)) ) gtools/R/binsearch.R0000644000176200001440000000647313003720436014053 0ustar liggesusers# $Id: binsearch.R 1295 2007-08-08 13:38:18Z warnes $ binsearch <- function(fun, range, ..., target=0, lower=ceiling(min(range)),upper=floor(max(range)), maxiter=100, showiter=FALSE) { # initialize lo <- lower hi <- upper counter <- 0 val.lo <- fun(lo,...) val.hi <- fun(hi,...) # check whether function is increasing or decreasing, & set sign # appropriately. if( val.lo > val.hi ) sign <- -1 else sign <- 1 # check if value is outside specified range if(target * sign < val.lo * sign) outside.range <- TRUE else if(target * sign > val.hi * sign) outside.range <- TRUE else outside.range <- FALSE # iteratively move lo & high closer together until we run out of # iterations, or they are adjacent, or they are identical while(counter < maxiter && !outside.range ) { counter <- counter+1 if(hi-lo<=1 || loupper) break; center <- round((hi - lo)/2 + lo ,0 ) val <- fun(center, ...) if(showiter) { cat("--------------\n") cat("Iteration #", counter, "\n") cat("lo=",lo,"\n") cat("hi=",hi,"\n") cat("center=",center,"\n") cat("fun(lo)=",val.lo,"\n") cat("fun(hi)=",val.hi,"\n") cat("fun(center)=",val,"\n") } if( val==target ) { val.lo <- val.hi <- val lo <- hi <- center break; } else if( sign*val < sign*target ) { lo <- center val.lo <- val } else #( val > target ) { hi <- center val.hi <- val } if(showiter) { cat("new lo=",lo,"\n") cat("new hi=",hi,"\n") cat("--------------\n") } } # Create return value retval <- list() retval$call <- match.call() retval$numiter <- counter if( outside.range ) { if(target * sign < val.lo * sign) { warning("Reached lower boundary") retval$flag="Lower Boundary" retval$where=lo retval$value=val.lo } else #(target * sign > val.hi * sign) { warning("Reached upper boundary") retval$flag="Upper Boundary" retval$where=hi retval$value=val.hi } } else if( counter >= maxiter ) { warning("Maximum number of iterations reached") retval$flag="Maximum number of iterations reached" retval$where=c(lo,hi) retval$value=c(val.lo,val.hi) } else if( val.lo==target ) { retval$flag="Found" retval$where=lo retval$value=val.lo } else if( val.hi==target ) { retval$flag="Found" retval$where=hi retval$value=val.hi } else { retval$flag="Between Elements" retval$where=c(lo, hi) retval$value=c(val.lo, val.hi) } return(retval) } gtools/R/ASCIIfy.R0000644000176200001440000000270413003720436013275 0ustar liggesusersASCIIfy <- function(x, bytes=2, fallback="?") { bytes <- match.arg(as.character(bytes), 1:2) convert <- function(char) # convert to ASCII, e.g. "z", "\xfe", or "\u00fe" { raw <- charToRaw(char) if(length(raw)==1 && raw<=127) # 7-bit ascii <- char else if(length(raw)==1 && bytes==1) # 8-bit to \x00 ascii <- paste0("\\x", raw) else if(length(raw)==1 && bytes==2) # 8-bit to \u0000 ascii <- paste0("\\u", chartr(" ","0",formatC(as.character(raw),width=4))) else if(length(raw)==2 && bytes==1) # 16-bit to \x00, if possible if(utf8ToInt(char) <= 255) ascii <- paste0("\\x", format.hexmode(utf8ToInt(char))) else { ascii <- fallback; warning(char, " could not be converted to 1 byte")} else if(length(raw)==2 && bytes==2) # UTF-8 to \u0000 ascii <- paste0("\\u", format.hexmode(utf8ToInt(char),width=4)) else { ascii <- fallback warning(char, " could not be converted to ", bytes, " byte")} return(ascii) } if(length(x) > 1) { sapply(x, ASCIIfy, bytes=bytes, fallback=fallback, USE.NAMES=FALSE) } else { input <- unlist(strsplit(x,"")) # "c" "a" "f" "<\'e>" output <- character(length(input)) # "" "" "" "" for(i in seq_along(input)) output[i] <- convert(input[i]) # "c" "a" "f" "\\u00e9" output <- paste(output, collapse="") # "caf\\u00e9" return(output) } } gtools/R/oddeven.R0000644000176200001440000000022013003720436013521 0ustar liggesusers# $Id: oddeven.R 1228 2007-11-30 18:05:43Z warnes $ # detect odd/even integers odd <- function(x) x %% 2 == 1 even <- function(x) x %% 2 == 0 gtools/R/defmacro.R0000644000176200001440000000300013003720436013654 0ustar liggesusers## Code from ## ## @Article{Rnews:Lumley:2001, ## author = {Thomas Lumley}, ## title = {Programmer's Niche: Macros in {R}}, ## journal = {R News}, ## year = 2001, ## volume = 1, ## number = 3, ## pages = {11--13}, ## month = {September}, ## url = {http://CRAN.R-project.org/doc/Rnews/} ##} defmacro <- function(..., expr) #, DOTS=FALSE) { expr <- substitute(expr) a <- substitute(list(...))[-1] ## process the argument list nn <- names(a) if (is.null(nn)) nn <- rep("", length(a)) for(i in 1:length(a)) { if (nn[i] == "") { nn[i] <- paste(a[[i]]) msg <- paste(a[[i]], "not supplied") a[[i]] <- substitute(stop(foo), list(foo = msg)) } if (nn[i] == "DOTS") { nn[i] <- "..." a[[i]] <- formals(function(...){})[[1]] } } names(a) <- nn a <- as.list(a) ## this is where the work is done ff <- eval(substitute( function() { tmp <- substitute(body) eval(tmp, parent.frame()) }, list(body = expr))) ## add the argument list formals(ff) <- a ## create a fake source attribute mm <- match.call() mm$expr <- NULL mm[[1]] <- as.name("macro") attr(ff, "source") <- c(deparse(mm), deparse(expr)) ## return the 'macro' ff } gtools/R/baseOf.R0000644000176200001440000000273413312232317013307 0ustar liggesusers# Transform integer to array of digits in specified base baseOf <- function(v, base=10, len=1) { if (is.null(v)) stop("v is null") if(length(v)==0) return(integer(0)) if(any(as.integer(v) != v)) stop("non-integer value(s) provided for v.") if (length(v) > 1) { # this returns a list which may have vectors of varying lenths val.list <- lapply(X=v, FUN=baseOf.inner, base=base, len=len) longest <- max(sapply(val.list, length)) # call again, forcing all elements to have the same lenth retval <- t(sapply(X=v, FUN=baseOf.inner, base=base, len=longest)) # add informative row and column names rownames(retval) <- paste0('v.', v) colnames(retval) <- paste0('b.', c(0, base^(1: (longest- 1) ) ) ) retval } else retval <- baseOf.inner(v=v, base=base, len=len) retval } # Transform integer to array of digits in specified baseOf.inner <- function(v, base=10, len=1) { if (is.na(v)) return(rep(NA, len)) if(v==0) return(rep(0, len)) remainder <- v i <- len ret <- NULL while(remainder > 0 || i >0) { #print(paste("i=",i," remainder=",remainder)) m <- remainder%%base if (is.null(ret)) { ret <- m } else { ret <- c(m,ret) } remainder <- remainder %/% base i <- i-1 } if(length(ret)>1) names(ret) <- c(0, base^( 1:(length(ret)- 1 ) ) ) return(ret) } gtools/R/roman2int.R0000644000176200001440000000224413147401511014015 0ustar liggesuserstestConvert <- function() { roman <- 'IVXLCDM' retval <- romandigit.convert(roman) stopifnot(retval==c(1,5,10,50,100,500,1000)) return(TRUE) } romandigit.convert <- function(roman) { retval <- .C(C_convert, roman=as.character(roman), nchar=as.integer(nchar(roman)), values=integer(nchar(roman)), PACKAGE="gtools" ) retval$values } roman2int.inner <- function(roman) { results <- .C(C_roman2int, roman = as.character(roman), nchar = as.integer(nchar(roman)), value = integer(1), PACKAGE="gtools") return(results$value) } roman2int <- function(roman) { roman <- trimws(toupper(as.character(roman))) tryIt <- function(x) { retval <- try(roman2int.inner(x), silent=TRUE) if(is.numeric(retval)) retval else NA } retval <- sapply(roman, tryIt) retval } gtools/R/quantcut.R0000644000176200001440000000541613312231004013744 0ustar liggesusers# $Id: quantcut.R 2145 2017-05-23 15:55:37Z warnes $ quantcut <- function(x, q=4, na.rm=TRUE, ... ) { if(length(q)==1) q <- seq(0,1, length.out=q+1) quant <- quantile(x, q, na.rm=na.rm) dups <- duplicated(quant) if(any(dups)) { flag <- x %in% unique(quant[dups]) retval <- ifelse(flag, paste("[", as.character(x), "]", sep=''), NA) uniqs <- unique(quant) # move cut points over a bit... reposition <- function(cut) { flag <- x>=cut if(sum(flag, na.rm=na.rm)==0) return(cut) else return(min(x[flag], na.rm=na.rm)) } newquant <- sapply(uniqs, reposition) retval[!flag] <- as.character(cut(x[!flag], breaks=newquant, include.lowest=TRUE,...)) levs <- unique(retval[order(x)]) # ensure factor levels are # properly ordered retval <- factor(retval, levels=levs) ## determine open/closed interval ends mkpairs <- function(x) # make table of lower, upper sapply(x, function(y) if(length(y)==2) y[c(2,2)] else y[2:3] ) pairs <- mkpairs(strsplit(levs, '[^0-9+\\.\\-]+')) rownames(pairs) <- c("lower.bound","upper.bound") colnames(pairs) <- levs closed.lower <- rep(F,ncol(pairs)) # default lower is open closed.upper <- rep(T,ncol(pairs)) # default upper is closed closed.lower[1] <- TRUE # lowest interval is always closed for(i in 2:ncol(pairs)) # open lower interval if above singlet if(pairs[1,i]==pairs[1,i-1] && pairs[1,i]==pairs[2,i-1]) closed.lower[i] <- FALSE for(i in 1:(ncol(pairs)-1)) # open upper inteval if below singlet if(pairs[2,i]==pairs[1,i+1] && pairs[2,i]==pairs[2,i+1]) closed.upper[i] <- FALSE levs <- ifelse(pairs[1,]==pairs[2,], pairs[1,], paste(ifelse(closed.lower,"[","("), pairs[1,], ",", pairs[2,], ifelse(closed.upper,"]",")"), sep='') ) levels(retval) <- levs } else retval <- cut( x, quant, include.lowest=TRUE, ... ) return(retval) } gtools/R/checkReverseDependencies.R0000644000176200001440000000134013003720436017021 0ustar liggesuserspackagefile="gdata_2.16.0.tar.gz" destdir=tempdir() checkReverseDependencies <- function(packagefile, destdir=tempdir(), cleanup=FALSE ) { if(!file.exists(packagefile)) stop(packagefile, " does not exist!") cat("Using directory '", destdir, "'. Remember to delete it when done.\n", sep='') file.copy(packagefile, destdir) package <- gsub("_.*$", "", packagefile) rdeps <- tools::package_dependencies(package, db=available.packages(), reverse = TRUE)[[1]] cat( length(rdeps), "reverse dependencies:\n") print(rdeps) tools::check_packages_in_dir(destdir, reverse=list(), Ncpus=6) if(cleanup) unlink(destdir, recursive=TRUE, force=TRUE) } gtools/R/combinations.R0000644000176200001440000000556613003720436014604 0ustar liggesusers# $Id: combinations.R 1083 2007-03-23 22:53:00Z warnes $ # ## ## From email by Brian D Ripley to r-help ## dated Tue, 14 Dec 1999 11:14:04 +0000 (GMT) in response to ## Alex Ahgarin . Original version was ## named "subsets" and was Written by Bill Venables. ## combinations <- function(n, r, v = 1:n, set = TRUE, repeats.allowed=FALSE) { if(mode(n) != "numeric" || length(n) != 1 || n < 1 || (n %% 1) != 0) stop("bad value of n") if(mode(r) != "numeric" || length(r) != 1 || r < 1 || (r %% 1) != 0) stop("bad value of r") if(!is.atomic(v) || length(v) < n) stop("v is either non-atomic or too short") if( (r > n) & repeats.allowed==FALSE) stop("r > n and repeats.allowed=FALSE") if(set) { v <- unique(sort(v)) if (length(v) < n) stop("too few different elements") } v0 <- vector(mode(v), 0) ## Inner workhorse if(repeats.allowed) sub <- function(n, r, v) { if(r == 0) v0 else if(r == 1) matrix(v, n, 1) else if(n == 1) matrix(v, 1, r) else rbind( cbind(v[1], Recall(n, r-1, v)), Recall(n-1, r, v[-1])) } else sub <- function(n, r, v) { if(r == 0) v0 else if(r == 1) matrix(v, n, 1) else if(r == n) matrix(v, 1, n) else rbind(cbind(v[1], Recall(n-1, r-1, v[-1])), Recall(n-1, r, v[-1])) } sub(n, r, v[1:n]) } ## ## Original version by Bill Venables and cited by by Matthew ## Wiener (mcw@ln.nimh.nih.gov) in an email to R-help dated ## Tue, 14 Dec 1999 09:11:32 -0500 (EST) in response to ## Alex Ahgarin ## ## permutations <- function(n, r, v = 1:n, set = TRUE, repeats.allowed=FALSE) { if(mode(n) != "numeric" || length(n) != 1 || n < 1 || (n %% 1) != 0) stop("bad value of n") if(mode(r) != "numeric" || length(r) != 1 || r < 1 || (r %% 1) != 0) stop("bad value of r") if(!is.atomic(v) || length(v) < n) stop("v is either non-atomic or too short") if( (r > n) & repeats.allowed==FALSE) stop("r > n and repeats.allowed=FALSE") if(set) { v <- unique(sort(v)) if (length(v) < n) stop("too few different elements") } v0 <- vector(mode(v), 0) ## Inner workhorse if(repeats.allowed) sub <- function(n, r, v) { if(r==1) matrix(v,n,1) else if(n==1) matrix(v,1,r) else { inner <- Recall(n, r-1, v) cbind( rep( v, rep(nrow(inner),n) ), matrix( t(inner), ncol=ncol(inner), nrow=nrow(inner) * n , byrow=TRUE ) ) } } else sub <- function(n, r, v) { if(r==1) matrix(v,n,1) else if(n==1) matrix(v,1,r) else { X <- NULL for(i in 1:n) X <- rbind( X, cbind( v[i], Recall(n-1, r - 1, v[-i]))) X } } sub(n, r, v[1:n]) } gtools/R/capwords.R0000644000176200001440000000277513117613340013741 0ustar liggesuserscapwords <- function(s, strict=FALSE, AP=TRUE, onlyfirst=FALSE, preserveMixed=FALSE, sep=" ") { # worker functions cap <- function(s) paste(toupper(substring(s, 1, 1)), { s <- substring(s, 2); if(strict) tolower(s) else s }, sep = "" ) # test if there is a lowercase letter followed by an uppercase letter isMixedCase <- function(s) grepl("[a-z][A-Z]", s) words <- unlist(strsplit(s, split = sep)) mixedCaseFlag <- sapply(words, isMixedCase) # First, capitalize *every* word if(!onlyfirst) { newWords <- sapply(words, cap ) if(preserveMixed==TRUE) newWords[mixedCaseFlag] <- words[mixedCaseFlag] words <- newWords } # Next (optionally) uncapitalize prepositions and conjunctions # recommended by the Associated Press. AP.nocap <- c("a", "an", "and", "at", "but", "by", "for", "in", "nor", "of", "on", "or", "so", "the", "to", "up", "yet") if(AP && !onlyfirst) for(word in AP.nocap) words <- gsub(paste0("^",word,"$"), word, words, ignore.case=TRUE) # Finally, ensure that the first word is capitalized if(length(words)>0 && mixedCaseFlag[1]==FALSE) words[1] <- cap(words[1]) retval <- paste(words, collapse=sep) retval } gtools/R/na.replace.R0000644000176200001440000000020613003720436014111 0ustar liggesusersna.replace <- function(x, replace, ...) { if(is.function(replace)) replace <- replace(x, ...) x[is.na(x)] <- replace x } gtools/R/keywords.R0000644000176200001440000000206713003720436013757 0ustar liggesuserskeywords <- function( topic ) { file <- file.path(R.home("doc"),"KEYWORDS") if(missing(topic)) { file.show(file) } else { kw <- scan(file=file, what=character(), sep="\n", quiet=TRUE) kw <- grep("&", kw, value=TRUE) kw <- gsub("&[^&]*$","", kw) kw <- gsub("&+"," ", kw) kw <- na.omit(trimws(kw)) ischar <- tryCatch(is.character(topic) && length(topic) == 1L, error = identity) if (inherits(ischar, "error")) ischar <- FALSE if (!ischar) topic <- deparse(substitute(topic)) item <- paste("^",topic,"$", sep="") topics <- function(k) { matches <- help.search(keyword=k)$matches matches[ , match("topic", tolower(colnames(matches)))] } matches <- lapply(kw, topics) names(matches) <- kw tmp <- unlist(lapply( matches, function(m) grep(item, m, value=TRUE) )) names(tmp) } } gtools/R/dirichlet.R0000644000176200001440000000370313003720436014055 0ustar liggesusers# $Id: dirichlet.R 2020 2015-05-23 22:12:57Z warnes $ # Posted by Ben Bolker to R-News on Fri Dec 15 2000 # http://www.r-project.org/nocvs/mail/r-help/2000/3865.html # # Some code (originally contributed by Ian Wilson # # functions for the "Dirichlet function", the multidimensional # generalization of the beta distribution: it's the Bayesian # canonical # distribution for the parameter estimates of a # multinomial distribution. # "pdirichlet" and "qdirichlet" (distribution function and quantiles) # would be more difficult because you'd first have to decide how to # define the distribution function for a multivariate distribution # ... I'm sure this could be done but I don't know how ddirichlet<-function(x,alpha) ## probability density for the Dirichlet function, where x=vector of ## probabilities ## and (alpha-1)=vector of observed samples of each type ## ddirichlet(c(p,1-p),c(x1,x2)) == dbeta(p,x1,x2) { dirichlet1 <- function(x, alpha) { logD <- sum(lgamma(alpha)) - lgamma(sum(alpha)) s <-(alpha-1)*log(x) s <- ifelse(alpha==1 & x==0, -Inf, s) exp(sum(s)-logD) } # make sure x is a matrix if(!is.matrix(x)) if(is.data.frame(x)) x <- as.matrix(x) else x <- t(x) if(!is.matrix(alpha)) alpha <- matrix( alpha, ncol=length(alpha), nrow=nrow(x), byrow=TRUE) if( any(dim(x) != dim(alpha)) ) stop("Mismatch between dimensions of 'x' and 'alpha'.") pd <- vector(length=nrow(x)) for(i in 1:nrow(x)) pd[i] <- dirichlet1(x[i,],alpha[i,]) # Enforce 0 <= x[i,j] <= 1, sum(x[i,]) = 1 pd[ apply( x, 1, function(z) any( z <0 | z > 1)) ] <- 0 pd[ apply( x, 1, function(z) all.equal(sum( z ),1) !=TRUE) ] <- 0 pd } rdirichlet<-function(n,alpha) ## generate n random deviates from the Dirichlet function with shape ## parameters alpha { l<-length(alpha); x<-matrix(rgamma(l*n,alpha),ncol=l,byrow=TRUE); sm<-x%*%rep(1,l); x/as.vector(sm); } gtools/R/deprecated.R0000644000176200001440000000022013003720436014175 0ustar liggesusers## useful function, raises an error if the FLAG expression is FALSE assert <- function( FLAG ) .Defunct(new="stopifnot", package="gtools") gtools/R/lastAdd.R0000644000176200001440000000063513003720436013463 0ustar liggesusers## ## Replaces the (defunct) addLast() function. ## lastAdd <- function( fun ) { if (!is.function(fun)) stop("fun must be a function") if(!exists(".Last", envir=.GlobalEnv)) { return(fun) } else { Last <- get(".Last", envir=.GlobalEnv) newfun <- function(...) { fun() Last() } return(newfun) } } gtools/R/invalid.R0000644000176200001440000000044213003720436013531 0ustar liggesusers# $Id: invalid.R 625 2005-06-09 14:20:30Z nj7w $ invalid <- function(x) { if( missing(x) || is.null(x) || length(x)==0 ) return(TRUE) if(is.list(x)) return(all(sapply(x,invalid))) else if(is.vector(x)) return(all(is.na(x))) else return(FALSE) } gtools/R/smartbind.R0000644000176200001440000001676713154611660014114 0ustar liggesusers## ## Function to do rbind of data frames quickly, even if the columns don't match ## smartbind <- function(..., list, fill=NA, sep=':', verbose=FALSE) { data <- base::list(...) if(!missing(list)) { data <- modifyList(list, data) } data <- data[!sapply(data, function(l) is.null(l) | (ncol(l)==0) | (nrow(l)==0) )] defaultNames <- seq.int(length(data)) if(is.null(names(data))) names(data) <- defaultNames emptyNames <- names(data)=="" if (any(emptyNames) ) names(data)[emptyNames] <- defaultNames[emptyNames] data <- lapply(data, function(x) if(is.matrix(x) || is.data.frame(x)) x else data.frame(as.list(x), check.names=FALSE) ) #retval <- new.env() retval <- base::list() rowLens <- unlist(lapply(data, nrow)) nrows <- sum(rowLens) rowNameList <- unlist(lapply( names(data), function(x) if(rowLens[x]<=1) x else paste(x, seq(1,rowLens[x]),sep=sep)) ) colClassList <- vector(mode="list", length=length(data)) factorColumnList <- vector(mode="list", length=length(data)) factorLevelList <- vector(mode="list", length=length(data)) start <- 1 blockIndex <- 1 for(block in data) { colClassList [[blockIndex]] <- base::list() factorColumnList[[blockIndex]] <- character(length=0) factorLevelList [[blockIndex]] <- base::list() if(verbose) print(head(block)) end <- start+nrow(block)-1 for(col in colnames(block)) { classVec <- class(block[,col]) ## store class and factor level information for later use colClassList[[blockIndex]][[col]] <- classVec if("factor" %in% classVec) { factorColumnList[[blockIndex]] <- c(factorColumnList[[blockIndex]], col) factorLevelList[[blockIndex]][[col]] <- levels(block[,col]) } if(verbose) cat("Start:", start, " End:", end, " Column:", col, "\n", sep="") if ("factor" %in% classVec) { newclass <- "character" } else newclass <- classVec[1] ## Coerce everything that isn't a native type to character if(! (newclass %in% c("logical", "integer", "numeric", "complex", "character", "raw") )) { newclass <- "character" warning("Converting non-atomic type column '", col, "' to type character.") } if(! (col %in% names(retval) ) ) retval[[col]] <- as.vector(rep(fill,nrows), mode=newclass) ## Handle case when current and previous native types differ oldclass <- class(retval[[col]]) if(oldclass != newclass) { # handle conversions in case of conflicts # numeric vs integer --> numeric # complex vs numeric or integer --> complex # anything else: --> character if(oldclass %in% c("integer", "numeric") && newclass %in% c("integer", "numeric") ) class(retval[[col]]) <- mode <- "numeric" else if(oldclass=="complex" && newclass %in% c("integer", "numeric") ) class(retval[[col]]) <- mode <- "complex" else if(oldclass %in% c("integer", "numeric") && newclass=="complex") class(retval[[col]]) <- mode <- "complex" else { class(retval[[col]]) <- mode <- "character" warning("Column class mismatch for '", col, "'. ", "Converting column to class 'character'.") } } else mode <- oldclass if(mode=="character") vals <- as.character(block[,col]) else vals <- block[,col] retval[[col]][start:end] <- as.vector(vals, mode=mode) } start <- end+1 blockIndex <- blockIndex+1 } all.equal.or.null <- function(x,y) { if(is.null(x) || is.null(y) ) return(TRUE) else return(all.equal(x,y)) } ## Handle factors, merging levels for( col in unique(unlist(factorColumnList)) ) { ## Ensure column classes match across blocks colClasses <- lapply(colClassList, function(x) x[[col]]) firstNotNull <- which(!sapply(colClasses, is.null))[1] allSameOrNull <- all(sapply(colClasses[-firstNotNull], function(x) isTRUE(all.equal.or.null(colClasses[[firstNotNull]], x)) ) ) if(allSameOrNull) { # grab the first *non-NULL* class information colClass <- colClasses[[firstNotNull]] } else { warning("Column class mismatch for '", col, "'. ", "Converting column to class 'character'.") next() } ## check if factor levels are all the same colLevels <- lapply(factorLevelList, function(x) x[[col]]) firstNotNull <- which(!sapply(colLevels, is.null))[1] allSameOrNull <- all(sapply(colLevels[-firstNotNull], function(x) isTRUE(all.equal.or.null(colLevels[[firstNotNull]], x)) ) ) if(allSameOrNull) { if("ordered" %in% colClass) retval[[col]] <- ordered(retval[[col]], levels=colLevels[[firstNotNull]] ) else retval[[col]] <- factor(retval[[col]], levels=colLevels[[firstNotNull]] ) } else { ## Check if longest set of levels is a superset of all others, ## and use that one longestIndex <- which.max( sapply(colLevels, length) ) longestLevels <- colLevels[[longestIndex]] allSubset <- all(sapply(colLevels[-longestIndex], function(l) all(l %in% longestLevels) )) if(allSubset) { if("ordered" %in% colClass) retval[[col]] <- ordered(retval[[col]], levels=longestLevels ) else retval[[col]] <- factor(retval[[col]], levels=longestLevels ) } else { # form superset by appending to longest level set levelSuperSet <- unique(c(longestLevels, unlist(colLevels))) retval[[col]] <- factor(retval[[col]], levels=levelSuperSet ) if(length(colClass)>1) # not just plain factor { warning( "column '", col, "' of class ", paste("'", colClass, "'", collapse=":", sep="'"), " converted to class 'factor'. Check level ordering." ) } } } } attr(retval,"row.names") <- rowNameList class(retval) <- "data.frame" return(retval) } gtools/R/split_path.R0000644000176200001440000000157613312232566014270 0ustar liggesusers#' Split a File Path into Components #' #' @description This function converts a character scalar containing a #' \emph{valid} file path into a character vector of path components #' (e.g. directories). #' #' @param x character scalar. Path to be processed. #' @param depth_first logical. Should path be returned depth first? Defaults #' to \code{TRUE}. #' #' @return Character vector of path components, depth first. #' #' @export #' split_path <- function(x, depth_first=TRUE) { if(length(x)>1) warning("This function is not vectorized.", "Only processing the first element of x.") retval <- split_path_inner(x) if(!depth_first) retval <- rev(retval) retval[retval>""] } split_path_inner <- function(path) { if (dirname(path) %in% c(".", path)) return(basename(path)) return(c(basename(path), split_path_inner(dirname(path)))) } gtools/R/strmacro.R0000644000176200001440000000322213003720436013734 0ustar liggesusers strmacro <- function(..., expr, strexpr) { if(!missing(expr)) strexpr <- deparse(substitute(expr)) a <- substitute(list(...))[-1] nn <- names(a) if (is.null(nn)) nn <- rep("", length(a)) for(i in 1:length(a)) { if (nn[i] == "") { nn[i] <- paste(a[[i]]) msg <- paste(a[[i]], "not supplied") a[[i]] <- substitute(stop(foo), list(foo = msg)) } else { a[[i]] <- a[[i]] } } names(a) <- nn a <- as.list(a) ## this is where the work is done ff <- function(...) { ## build replacement list reptab <- a # copy defaults first reptab$"..." <- NULL args <- match.call(expand.dots=TRUE)[-1] for(item in names(args)) reptab[[item]] <- args[[item]] ## do the replacements body <- strexpr for(i in 1:length(reptab)) { pattern <- paste("\\b", names(reptab)[i], "\\b",sep='') value <- reptab[[i]] if(missing(value)) value <- "" body <- gsub(pattern, value, body) } fun <- parse(text=body) eval(fun, parent.frame()) } ## add the argument list formals(ff) <- a ## create a fake source attribute mm <- match.call() mm$expr <- NULL mm[[1]] <- as.name("macro") attr(ff, "source") <- c(deparse(mm), strexpr) ## return the 'macro' ff } gtools/R/trimws.R0000644000176200001440000000056113003720436013432 0ustar liggesusers## trimws was added in R 2.3.0. If we're using a previous version of ## R we need to define it. if(!exists('trimws', mode='function')) trimws <- function(s) { s <- sub(pattern="^[[:blank:]]+", replacement="", x=s) s <- sub(pattern="[[:blank:]]+$", replacement="", x=s) s } gtools/R/running.R0000644000176200001440000000460113003720436013564 0ustar liggesusers# $Id: running.R 1568 2012-06-19 13:56:52Z warnes $ "running" <- function(X, Y=NULL, fun=mean, width=min(length(X), 20), allow.fewer=FALSE, pad=FALSE, align=c("right", "center", "left"), simplify=TRUE, by, # added a parameter ...) { align=match.arg(align) n <- length(X) if (align=="left") { from <- 1:n to <- pmin( (1:n)+width-1, n) } else if (align=="right") { from <- pmax( (1:n)-width+1, 1) to <- 1:n } else #align=="center" { from <- pmax((2-width):n,1) to <- pmin(1:(n+width-1),n) if(!odd(width)) stop("width must be odd for center alignment") } elements <- apply(cbind(from, to), 1, function(x) seq(x[1], x[2]) ) if(is.matrix(elements)) elements <- as.data.frame(elements) # ensure its a list! names(elements) <- paste(from,to,sep=':') if(!allow.fewer) { len <- sapply(elements, length) skip <- (len < width) } else { skip <- 0 } run.elements <- elements[!skip] if(!invalid(by)) run.elements <- run.elements[seq(from=1, to=length(run.elements), by=by)] if(is.null(Y)) # univariate { funct.uni <- function(which,what,fun,...) fun(what[which],...) if(simplify) Xvar <- sapply(run.elements, funct.uni, what=X, fun=fun, ...) else Xvar <- lapply(run.elements, funct.uni, what=X, fun=fun, ...) } else # bivariate { funct.bi <- function(which,XX,YY,fun,...) fun(XX[which],YY[which], ...) if(simplify) Xvar <- sapply(run.elements, funct.bi, XX=X, YY=Y, fun=fun, ...) else Xvar <- lapply(run.elements, funct.bi, XX=X, YY=Y, fun=fun, ...) } if(allow.fewer || !pad) return(Xvar) if(simplify) if(is.matrix(Xvar)) { wholemat <- matrix( new(class(Xvar[1,1]), NA), ncol=length(to), nrow=nrow(Xvar) ) colnames(wholemat) <- paste(from,to,sep=':') wholemat[,-skip] <- Xvar Xvar <- wholemat } else { wholelist <- rep(new(class(Xvar[1]),NA),length(from)) names(wholelist) <- names(elements) wholelist[ names(Xvar) ] <- Xvar Xvar <- wholelist } return(Xvar) } gtools/R/addLast.R0000644000176200001440000000023413003720436013456 0ustar liggesusersaddLast <- function( fun ) .Defunct(new=paste(".Last <- lastAdd(", deparse(substitute(fun)), ")", sep=''), package='gtools' ) gtools/R/newVersionAvailable.R0000644000176200001440000000144013120260054016035 0ustar liggesusersnewVersionAvailable <- function(quiet=FALSE) { page <- scan(file="https://cran.r-project.org/src/base/R-2", what="", quiet=TRUE) matches <- grep("R-[0-9]\\.[0-9]+\\.[0-9]+", page, value=TRUE) versionList <- gsub("^.*R-([0-9].[0-9]+.[0-9]+).*$","\\1",matches) versionList <- numeric_version(versionList) if( max(versionList) > getRversion() ) { if(!quiet) { cat("A newer version of R is now available: ") cat(max(versionList)) cat("\n") } invisible( max(versionList) ) } else { if(!quiet) { cat("The latest version of R is installed: ") cat(as.character(getRversion())) cat("\n") } invisible( NULL ); } } gtools/R/setTCPNoDelay.R0000644000176200001440000000140513147403124014522 0ustar liggesuserssetTCPNoDelay <- function( socket, value=TRUE ) { if(!any(c("socket","sockconn") %in% class(socket))) stop("socket must be a socket object") buffer <- paste(rep(" ", 1000), sep='', collapse='') if("sockconn" %in% class(socket)) conn <- getConnection(socket[1]) else conn <- socket retval <- .C(C_setTCPNoDelay, socket = as.integer(socket[1]), flag = as.integer(value), status = integer(1), status.str = as.character(buffer), status.len = as.integer(nchar(buffer)), PACKAGE = "gtools" ) if(retval$status != 0) stop( retval$status.str ) else invisible(retval$status.str) } gtools/R/foldchange.R0000644000176200001440000000100713003720436014173 0ustar liggesusers# $Id: foldchange.R 625 2005-06-09 14:20:30Z nj7w $ foldchange <- function(num,denom) { ifelse(num >= denom, num/denom, -denom/num) } # Compute foldchange from log-ratio values logratio2foldchange <- function(logratio, base=2) { retval <- base^(logratio) retval <- ifelse(retval < 1, -1/retval, retval) retval } # vice versa foldchange2logratio <- function(foldchange, base=2) { retval <- ifelse( foldchange<0, 1/-foldchange, foldchange) retval <- log(retval,base) retval } gtools/R/defunct.R0000644000176200001440000000023213003720436013530 0ustar liggesuserscapture <- function( expression, collapse="\n") .Defunct("capture.output", "base") sprint <- function(x,...) .Defunct("capture.output", "base") gtools/R/getDependencies.R0000644000176200001440000000665713003720436015207 0ustar liggesusers## This function determines the dependencies for the specified ## package, exluding only packages found in "base". getDependencies <- function (pkgs, dependencies = c("Depends", "Imports", "LinkingTo"), installed=TRUE, available=TRUE, base=FALSE, recommended=FALSE) { pkgs.in = pkgs if (is.null(dependencies)) return(unique(pkgs)) dep2 <- c("Depends", "Imports", "LinkingTo") if(installed && !available) all.packages <- installed.packages() else if (available && !installed) all.packages <- available.packages() else all.packages <- as.matrix(smartbind(## installed.packages(), available.packages() )) rownames(all.packages) <- all.packages[,"Package"] p0 <- unique(pkgs) miss <- !p0 %in% row.names(all.packages) if (sum(miss)) { warning(sprintf(ngettext(sum(miss), "package %s is not available (for %s)", "packages %s are not available (for %s)"), paste(sQuote(p0[miss]), collapse = ", "), sub(" *\\(.*", "", R.version.string)), domain = NA, call. = FALSE) if (sum(miss) == 1L && !is.na(w <- match(tolower(p0[miss]), tolower(row.names(all.packages))))) { warning(sprintf("Perhaps you meant %s ?", sQuote(row.names(all.packages)[w])), call. = FALSE, domain = NA) } flush.console() } ## Whether to exclude base and recommended packages if(!base || !recommended) { priority <- NULL if(!base) priority <- c("base", priority) if(!recommended) priority <- c("recommended", priority) installed <- installed.packages(priority=priority) } else installed <- installed.packages()[FALSE,] p0 <- p0[!miss] p1 <- p0 not_avail <- character() repeat { deps <- apply(all.packages[p1, dependencies, drop = FALSE], 1L, function(x) paste(x[!is.na(x)], collapse = ", ")) res <- .clean_up_dependencies2( deps, installed=installed, all.packages) not_avail <- c(not_avail, res[[2L]]) deps <- unique(res[[1L]]) deps <- deps[!deps %in% c("R", pkgs)] if (!length(deps)) break pkgs <- c(deps, pkgs) p1 <- deps if (!is.null(dep2)) { dependencies <- dep2 dep2 <- NULL } } if (length(not_avail)) { not_avail <- unique(not_avail) warning(sprintf(ngettext(length(not_avail), "dependency %s is not available", "dependencies %s are not available"), paste(sQuote(not_avail), collapse = ", ")), domain = NA, call. = FALSE, immediate. = TRUE) flush.console() } pkgs <- unique(pkgs) pkgs <- pkgs[pkgs %in% row.names(all.packages)] p0 <- pkgs p0[ ! p0 %in% pkgs.in ] } gtools/R/RSCompat.S0000644000176200001440000001227313003720436013601 0ustar liggesusers# $Id: RSCompat.S 625 2005-06-09 14:20:30Z nj7w $ # # $Log$ # Revision 1.9 2005/06/09 14:20:28 nj7w # Updating the version number, and various help files to synchronize splitting of gregmisc bundle in 4 individual components. # # Revision 1.1.1.1 2005/05/25 22:17:28 nj7w # Initial submision as individual package # # Revision 1.8 2003/04/04 13:58:59 warnes # # - Replace 'T' with 'TRUE' # # Revision 1.7 2003/03/07 15:48:35 warnes # # - Minor changes to code to allow the package to be provided as an # S-Plus chapter. # # Revision 1.6 2003/01/02 15:42:00 warnes # - Add nlevels function. # # Revision 1.5 2002/03/20 03:44:32 warneg # - Added definition of is.R function. # # - Added boxplot.formula # # Revision 1.4 2002/02/05 02:20:07 warneg # # - Fix typo that caused code meant to run only under S-Plus to run # under R, causing problems. # # Revision 1.3 2001/12/19 22:45:44 warneg # - Added code for %in%. # # Revision 1.2 2001/09/18 14:15:44 warneg # # Release 0.3.2 # # Revision 1.1 2001/09/01 19:19:13 warneg # # Initial checkin. # # # Code necessary for contrast.lm, boxplot.n to work in S-Plus if(!exists("is.R") || !is.R() ) { is.R <- function() FALSE getOption <- function(...) options(...) if(!exists("parent.frame")) parent.frame <- sys.parent colnames <- function (x, do.NULL = TRUE, prefix = "col") { dn <- dimnames(x) if (!is.null(dn[[2]])) dn[[2]] else { if (do.NULL) NULL else paste(prefix, seq(length = NCOL(x)), sep = "") } } rownames <- function (x, do.NULL = TRUE, prefix = "row") { dn <- dimnames(x) if (!is.null(dn[[1]])) dn[[1]] else { if (do.NULL) NULL else paste(prefix, seq(length = NROW(x)), sep = "") } } "rownames<-" <- function (x, value) { dn <- dimnames(x) ndn <- names(dn) dn <- list(value, if (!is.null(dn)) dn[[2]]) names(dn) <- ndn dimnames(x) <- dn x } "colnames<-" <- function (x, value) { dn <- dimnames(x) ndn <- names(dn) dn <- list(if (!is.null(dn)) dn[[1]], value) names(dn) <- ndn dimnames(x) <- dn x } # from the MASS library by Venables & Ripley ginv <- function (X, tol = sqrt(.Machine$double.eps)) { if (length(dim(X)) > 2 || !(is.numeric(X) || is.complex(X))) stop("X must be a numeric or complex matrix") if (!is.matrix(X)) X <- as.matrix(X) Xsvd <- svd(X) if (is.complex(X)) Xsvd$u <- Conj(Xsvd$u) Positive <- Xsvd$d > max(tol * Xsvd$d[1], 0) if (all(Positive)) Xsvd$v %*% (1/Xsvd$d * t(Xsvd$u)) else if (!any(Positive)) array(0, dim(X)[2:1]) else Xsvd$v[, Positive] %*% ((1/Xsvd$d[Positive]) * t(Xsvd$u[, Positive])) } "format.pval" <- function (pv, digits = max(1, getOption("digits") - 2), eps = .Machine$double.eps, na.form = "NA") { if ((has.na <- any(ina <- is.na(pv)))) pv <- pv[!ina] r <- character(length(is0 <- pv < eps)) if (any(!is0)) { rr <- pv <- pv[!is0] expo <- floor(log10(pv)) fixp <- expo >= -3 | (expo == -4 & digits > 1) if (any(fixp)) rr[fixp] <- format(pv[fixp], dig = digits) if (any(!fixp)) rr[!fixp] <- format(pv[!fixp], dig = digits) r[!is0] <- rr } if (any(is0)) { digits <- max(1, digits - 2) if (any(!is0)) { nc <- max(nchar(rr)) if (digits > 1 && digits + 6 > nc) digits <- max(1, nc - 7) sep <- if (digits == 1 && nc <= 6) "" else " " } else sep <- if (digits == 1) "" else " " r[is0] <- paste("<", format(eps, digits = digits), sep = sep) } if (has.na) { rok <- r r <- character(length(ina)) r[!ina] <- rok r[ina] <- na.form } r } "%in%" <- function (x, table) match(x, table, nomatch = 0) > 0 strwidth <- function(...) { par("cin")[1] / par("fin")[1] * (par("usr")[2] - par("usr")[1]) } strheight <- function(...) { par("cin")[2] / par("fin")[2] * (par("usr")[4] - par("usr")[3]) } boxplot.formula <- function(x, data = sys.parent(), ..., ask = TRUE) { if(!inherits(x, "formula")) x <- as.formula(x) mf <- model.frame(x, data, na.action = function(z) z) if(length(names(mf)) > 2) stop("boxplot.formula only accepts models with 1 predictor") resp <- attr(attr(mf, "terms"), "response") class(mf) <- NULL y <- mf[[resp]] x <- mf[[-resp]] xlab <- names(mf)[-resp] ylab <- names(mf)[resp] boxplot(split(y, x), xlab = xlab, ylab = ylab, ...) } nlevels <- function(x) length(levels(x)) NULL } gtools/R/ask.R0000644000176200001440000000021213061553406012661 0ustar liggesusersask <- function(msg="Press to continue: ", con=stdin()) { cat(msg); readLines(con=con,n=1) } gtools/R/stars.pval.R0000644000176200001440000000040513003720436014177 0ustar liggesusersstars.pval <- function(p.value) { unclass( symnum(p.value, corr = FALSE, na = FALSE, cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), symbols = c("***", "**", "*", ".", " ")) ) } gtools/R/permute.R0000644000176200001440000000016413003720436013565 0ustar liggesusers# $Id: permute.R 625 2005-06-09 14:20:30Z nj7w $ permute <- function(x) sample( x, size=length(x), replace=FALSE ) gtools/R/scat.R0000644000176200001440000000052613003720436013040 0ustar liggesusers# $Id: scat.R 625 2005-06-09 14:20:30Z nj7w $ # cat to stdout and immediately flush scat <- function(...) { DEBUG <- options()$DEBUG if( !is.null(DEBUG) && DEBUG) { cat("### ", file=stderr()) cat(..., file=stderr()) cat(" ###\n", file=stderr()) flush(stderr()) } invisible(NULL) } gtools/R/clean_up_dependencies2.R0000644000176200001440000000557713003720436016477 0ustar liggesusers.clean_up_dependencies2 <- function (x, installed, available) { .split_op_version <- function (x) { pat <- "^([^\\([:space:]]+)[[:space:]]*\\(([^\\)]+)\\).*" x1 <- sub(pat, "\\1", x) x2 <- sub(pat, "\\2", x) if (x2 != x1) { pat <- "[[:space:]]*([[<>=!]+)[[:space:]]+(.*)" version <- sub(pat, "\\2", x2) if (!grepl("^r", version)) version <- package_version(version) list(name = x1, op = sub(pat, "\\1", x2), version = version) } else list(name = x1) } .split_dependencies <- function(x) { .split2 <- function(x) { x <- sub("[[:space:]]+$", "", x) x <- unique(sub("^[[:space:]]*(.*)", "\\1", x)) names(x) <- sub("^([[:alnum:].]+).*$", "\\1", x) x <- x[names(x) != "R"] x <- x[nzchar(x)] x <- x[!duplicated(names(x))] lapply(x, .split_op_version) } if (!any(nzchar(x))) return(list()) unlist(lapply(strsplit(x, ","), .split2), FALSE, FALSE) } x <- x[!is.na(x)] if (!length(x)) return(list(character(), character())) xx <- .split_dependencies(x) if (!length(xx)) return(list(character(), character())) pkgs <- installed[, "Package"] have <- sapply(xx, function(x) { if (length(x) == 3L) { if (!x[[1L]] %in% pkgs) return(FALSE) if (x[[2L]] != ">=") return(TRUE) current <- as.package_version(installed[pkgs == x[[1L]], "Version"]) target <- as.package_version(x[[3L]]) eval(parse(text = paste("any(current", x$op, "target)"))) } else x[[1L]] %in% pkgs }) xx <- xx[!have] if (!length(xx)) return(list(character(), character())) pkgs <- row.names(available) canget <- miss <- character() for (i in seq_along(xx)) { x <- xx[[i]] if (length(x) == 3L) { if (!x[[1L]] %in% pkgs) { miss <- c(miss, x[[1L]]) next } if (x[[2L]] != ">=") { canget <- c(canget, x[[1L]]) next } current <- as.package_version(available[pkgs == x[[1L]], "Version"]) target <- as.package_version(x[[3L]]) res <- eval(parse(text = paste("any(current", x$op, "target)"))) if (res) canget <- c(canget, x[[1L]]) else miss <- c(miss, paste0(x[[1L]], " (>= ", x[[3L]], ")")) } else if (x[[1L]] %in% pkgs) canget <- c(canget, x[[1L]]) else miss <- c(miss, x[[1L]]) } list(canget, miss) } gtools/R/checkRVersion.R0000644000176200001440000000171513120260041014643 0ustar liggesuserscheckRVersion <- function(quiet=FALSE) { page2 <- scan(file="https://cran.r-project.org/src/base/R-2", what="", quiet=TRUE) page3 <- scan(file="https://cran.r-project.org/src/base/R-3", what="", quiet=TRUE) combined <- c(page2, page3) matches <- grep("R-[0-9]\\.[0-9]+\\.[0-9]+", combined, value=TRUE) versionList <- gsub("^.*R-([0-9].[0-9]+.[0-9]+).*$","\\1",matches) versionList <- numeric_version(versionList) if( max(versionList) > getRversion() ) { if(!quiet) { cat("A newer version of R is now available: ") cat(as.character(max(versionList))) cat("\n") } invisible( max(versionList) ) } else { if(!quiet) { cat("The latest version of R is installed: ") cat(as.character(max(versionList))) cat("\n") } invisible( NULL ); } } gtools/MD50000644000176200001440000001062313314447705012103 0ustar liggesusers75c40aa58ce61c005172af9dad043d5a *ChangeLog 4c34c290a4a8a49255c52523613ae8f6 *DESCRIPTION 732b522e5be4a9a4ad220f3a4454b089 *NAMESPACE f065df747e9f6ae287175dbeb4d1f5b3 *NEWS 40be776640196133aebff67618b08dec *R/ASCIIfy.R 9eb418fd95aa09ba85aed159545dea61 *R/RSCompat.S a86a74ba04089ad58ea22e3a994a9b14 *R/addLast.R c6b3619410daf7b88dfc6e852fe1c322 *R/asc.R 2aeffe30b23905abf9cbc55089bfe366 *R/ask.R ec4f11d1d5d9cb26cf37eddea043939f *R/baseOf.R 7e3c03026275ec8e336c73314cb73a69 *R/binsearch.R 86ff5d2041d9005ccafb2bb4a142b870 *R/capwords.R 37c40b27db2c271d0e6b97e319578b3d *R/checkRVersion.R b1dfaaaf624c59b2ee5eeb680a412be7 *R/checkReverseDependencies.R 421b9d08ece06f33c20d21ad62ad768b *R/clean_up_dependencies2.R 529f69b81b6b734a4f637d250b5b71f9 *R/combinations.R 1c333b16a59dcaf7ccf20151962b6375 *R/defmacro.R 28d70252e7e25f8e3743fc07434acba9 *R/defunct.R 344b58e1976792a3295238c17df7e917 *R/deprecated.R e5149cd525adc83044c3a3eed1d432bf *R/dirichlet.R 1da2198e1d194c705ca89381159b7b63 *R/foldchange.R e759eb4772cb9ce930a0c570279155b3 *R/getDependencies.R 71212f4c14003458fc3e30638f339629 *R/invalid.R d7058406d6e00cdae229c8ee030df465 *R/keywords.R f00dfc3263a5854151f244493b3f04d0 *R/lastAdd.R 213e4d00fa800a3c4b3b4a32b2ddf508 *R/loadedPackages.R 2bb525e1930ec3ba2afefa2ff43d74e0 *R/logit.R a93b94a3690a900de1eb5145194a34f2 *R/mixedsort.R c11574f71a7705a17601364a06afcd9b *R/na.replace.R b67555ff2ba3767987e905d5ab01f73b *R/newVersionAvailable.R 07cd779ab7e64f697604b8b4fa4c9d70 *R/oddeven.R 1d016a924dd59daa78ea62d986da2929 *R/permute.R a63125d868af498ebbd120afed52f11c *R/quantcut.R 1d41632397b9fb9f1feb03d04b565547 *R/roman2int.R 02390191f23321a34fcfc41719d66dc6 *R/running.R a5ea32bab219fd7c634f034dddada96b *R/scat.R 42fe35e31349c5006513f099a3c30f3e *R/setTCPNoDelay.R d7268856470f030b58fc6adf96e6ef72 *R/smartbind.R f78a2cee29bc7f2b15927305e5a2c56c *R/split_path.R ef22fb4007dec9fb62eb5ed947292fa3 *R/stars.pval.R bbc04a8581924855fb4107a90811fa52 *R/strmacro.R e302b31547caf90872346ee1f0867e1f *R/trimws.R 8e36d638d9b5c0c03d6f78235d07df96 *R/unByteCode.R d2d2d0444a049d74694203974624835c *data/ELISA.rda 273aa9cfc8e947fe6059a11a4813be57 *data/badDend.rda e45b4855b4a81e953876cbec7cd1b588 *man/ASCIIfy.Rd 904304f52b08ec847904ac2aa5be9aef *man/ELISA.Rd b2eac3f299f642616aa71dc03f1352f0 *man/asc.Rd 2ec67052614c77d9b02e42fcfad334e1 *man/ask.Rd a3e5592c04ef16417e469b29ebcefde5 *man/badDend.Rd f88dae7a266ec8dc3a617d7531a0c0ec *man/baseOf.Rd ecbe8481bdcff0d8abd1a47cc64ca7b2 *man/binsearch.Rd e81f12dea694580be239997fdebfa612 *man/capwords.Rd e1a3f01f01db3e883397eaa49037af6f *man/checkRVersion.Rd 047fdb296619325c7db296d6200f21d7 *man/combinations.Rd 4108f8247156300064312e1ec7527e41 *man/defmacro.Rd 3ac18878a63f7ca4913f66d5ecb72a4a *man/dirichlet.Rd 74868a3948263db0fbc2519b792acba2 *man/foldchange.Rd c208ca0a5e9c38fcb903cfd7656d5375 *man/getDependencies.Rd aa98190531ff93721b715e61000f76a4 *man/gtools-defunct.Rd 72d1da64e38796cc37347aa1be02bdd2 *man/gtools-deprecated.Rd 01c743eee2dbb9dc14d02035fa05063c *man/invalid.Rd 8d8b5429047edd4ed52f8f8f6b11f807 *man/keywords.Rd 67b9c146bd8470b1dd5ddcac782c2071 *man/lastAdd.Rd 3312a1cede040df6869bf9586b5fb18e *man/loadedPackages.Rd 3c207d731ad8ead62af138afe2e20c5f *man/logit.Rd 74e953706b708ad96dfde10268feaafa *man/mixedsort.Rd 817953cba4880c3c38eb2788ec626bc5 *man/na.replace.Rd f4d6f8222b9448ef039d9cbf582ee29e *man/oddeven.Rd f911c6c34412df66c1ff0d6376f46c3f *man/permute.Rd f417491b0b09a309c23f27f97af4dd5f *man/quantcut.Rd 90873b9cb32a59aaaf62cbc5b302e82b *man/roman2int.Rd 20033253beddc01faf5829cdf43f01fb *man/running.Rd f781e22f646cf803a7f24129525521fc *man/scat.Rd 020ed252505af5fb60e20474f3c81e88 *man/setTCPNoDelay.Rd 1fcbb12022021b9ad74634a00d980054 *man/smartbind.Rd df1285c2d8ac320dd13d96081b6cec6a *man/split_path.Rd 7ba286fa2b1bc994de1c6ec78883cdc8 *man/stars.pval.Rd edfa464a085bbf5a0a050d75f12b9953 *man/unByteCode.Rd 8d4158b8eb92153e2d3f581682b2a3c1 *src/Makevars.win 187197ae0cee7a150bc810064ad98d1f *src/gtools.h e1558bce47993f113f94416c1f113a0f *src/gtools_load.c ca5f00b573fc8591602b6378746e2eee *src/roman2int.c ab7d1db52f083e5c7bcb26065472e3ba *src/setTCPNoDelay.c 6c36d5eac8884ab13c200c1113cf9236 *tests/smartbind_Dates.R b7717fb8c16decc970c02e213cf50767 *tests/smartbind_emptynames.R b859dff6a12425f4ba692dc7706e99ed *tests/test_binsearch.R b4b7e4ed52ac89a56e2125620e524c4a *tests/test_ddirichlet.R 33c5986481c62f046106b02abc4d0c74 *tests/test_mixedorder.R cc5125fc132f9dc618d34bd26de17508 *tests/test_setTCPNoDelay.R gtools/DESCRIPTION0000644000176200001440000000355513314447705013307 0ustar liggesusersPackage: gtools Title: Various R Programming Tools Description: Functions to assist in R programming, including: - assist in developing, updating, and maintaining R and R packages ('ask', 'checkRVersion', 'getDependencies', 'keywords', 'scat'), - calculate the logit and inverse logit transformations ('logit', 'inv.logit'), - test if a value is missing, empty or contains only NA and NULL values ('invalid'), - manipulate R's .Last function ('addLast'), - define macros ('defmacro'), - detect odd and even integers ('odd', 'even'), - convert strings containing non-ASCII characters (like single quotes) to plain ASCII ('ASCIIfy'), - perform a binary search ('binsearch'), - sort strings containing both numeric and character components ('mixedsort'), - create a factor variable from the quantiles of a continuous variable ('quantcut'), - enumerate permutations and combinations ('combinations', 'permutation'), - calculate and convert between fold-change and log-ratio ('foldchange', 'logratio2foldchange', 'foldchange2logratio'), - calculate probabilities and generate random numbers from Dirichlet distributions ('rdirichlet', 'ddirichlet'), - apply a function over adjacent subsets of a vector ('running'), - modify the TCP\_NODELAY ('de-Nagle') flag for socket objects, - efficient 'rbind' of data frames, even if the column names don't match ('smartbind'), - generate significance stars from p-values ('stars.pval'), - convert characters to/from ASCII codes ('asc', 'chr'), - convert character vector to ASCII representation ('ASCIIfy'). Version: 3.8.1 Date: 2018-06-19 Author: Gregory R. Warnes, Ben Bolker, and Thomas Lumley Maintainer: Gregory R. Warnes License: GPL-2 Depends: methods, stats, utils NeedsCompilation: yes Packaged: 2018-06-25 14:51:36 UTC; gwarnes Repository: CRAN Date/Publication: 2018-06-26 14:37:57 UTC gtools/ChangeLog0000644000176200001440000007261213312756217013352 0ustar liggesusers2018-06-19 16:48 warnes * DESCRIPTION, NAMESPACE: Update DESCRIPTION and NAMESPACE for gtools 3.8.0. 2018-06-19 16:43 warnes * R/split_path.R, man/split_path.Rd: Add spit_path() function. 2018-06-19 16:43 warnes * R/baseOf.R, man/baseOf.Rd: Improvements to baseOf() function. 2017-08-23 23:03 warnes * R/baseOf.R, man/baseOf.Rd: Add `baseOf` function and documentation to support updated `gplots::venn` function. (Provided by Steffen Möller.) 2017-08-23 22:59 warnes * R/roman2int.R, R/setTCPNoDelay.R: Use correct 'PACKAGE=' parameter to '.C' calls. 2017-06-14 19:44 warnes * inst/ChangeLog, inst/NEWS: Update NEWS and ChangeLog 2017-06-14 19:42 warnes * DESCRIPTION, NAMESPACE, R/checkRVersion.R, R/newVersionAvailable.R, R/roman2int.R, R/setTCPNoDelay.R, man/combinations.Rd, man/defmacro.Rd, src/gtools.h, src/gtools_load.c, src/setTCPNoDelay.c, tests/test_setTCPNoDelay.R: Explicitly register C routines used by gtools 2017-06-13 00:16 warnes * man/combinations.Rd, man/defmacro.Rd: Update R News URLS 2017-06-12 23:30 warnes * man/capwords.Rd: Update link for taxise::taxize_capwords in gtools::capwords man page 2017-06-12 23:28 warnes * inst/ChangeLog: Fix typos 2017-06-12 23:28 warnes * man/capwords.Rd: Update link for taxise::taxize_capwords in gtools::capwords man page 2017-06-12 23:21 warnes * DESCRIPTION, NAMESPACE, inst/ChangeLog, inst/NEWS: Update meta files for gtools 3.7.0 2017-06-12 22:53 warnes * tests/smartbind_emptynames.R: Fix test for smartbind with empty column names 2017-06-12 22:52 warnes * man/setTCPNoDelay.Rd, tests/test_setTCPNoDelay.R: Add improved example to man page for setTCPnoDelat() and fix test function. 2017-06-12 22:51 warnes * man/ask.Rd: Add 'con' argument to ask() to allow specification of the connection to query for input. 2017-06-12 22:49 warnes * R/capwords.R, man/capwords.Rd: Add capwords() function to apply standard capitalization rules to a scharacter string. 2017-05-23 15:55 warnes * R/ask.R, R/quantcut.R, R/smartbind.R: - Integrate changes made by Mango Solutions at https://github.com/MangoTheCat/SASxport. - Remove functions duplicated from the Hmisc package. - Minor code cleanup. 2016-08-24 19:48 warnes * tests/test_setTCPNoDelay.R: Add more testing code. 2016-08-15 19:17 warnes * inst/ChangeLog: Update ChangeLog 2016-08-15 19:16 warnes * DESCRIPTION: Update version number and date 2016-08-15 19:14 warnes * tests/test_setTCPNoDelay.R: Add test code for setTCPNoDelay 2016-08-15 19:14 warnes * R/setTCPNoDelay.R: Modify setTCPNoDelay to work with current socket objects 2016-08-15 19:13 warnes * src/setTCPNoDelay.c: checkStatus() was not correctly getting the error message. 2016-04-22 16:10 warnes * NAMESPACE, R/capwords.R, man/capwords.Rd: Add capwords() function to properly capatilize strings for use in titles 2016-04-22 16:08 warnes * R/na.replace.R, man/na.replace.Rd: na.replace() now accepts a function providing the replcement value. 2015-11-24 17:58 warnes * R/smartbind.R: Correct error when column types don't match (reported by 2015-10-15 21:15 warnes * R/smartbind.R: smartbind() was not properly handling columsn that were numeric on one df and character in the other and other similar ctype conflicts. Fixed. 2015-08-08 05:01 warnes * tests/smartbind_emptynames.R: Add half-hearted test file 2015-08-08 03:14 warnes * R/smartbind.R: - Improve assignment of default names in smartbind. - Disambiguate 'list' into an object named 'list' and the function base::list() in smartbind(). 2015-08-08 01:47 warnes * DESCRIPTION, man/smartbind.Rd: Add example of using 'list' argument to smartbind() man page. 2015-08-08 01:44 warnes * R/smartbind.R, man/smartbind.Rd: - smartbind() gets a new argument 'list' to pass a list of data frames, instead of/in addition to data frames as arguments. - Fix bug in smartbind's handling of factor levels. 2015-07-14 21:19 warnes * R/loadedPackages.R, man/loadedPackages.Rd: Modify loadedPackages() to return data silently so that the results don't get printed twice. 2015-05-27 17:01 warnes * data/badDend.rda, man/badDend.Rd, man/unByteCode.Rd: Create local dataset to use in the example code for unByteCode instead of relying on web access. 2015-05-27 16:38 warnes * R/trimws.R: Fix missing closing paren. 2015-05-27 16:36 warnes * R/keywords.R, R/roman2int.R, R/trim.R, R/trimws.R: Two functions in gtools need to use either gdata::trim() or base::trimws() (added in R 3.2.0). The previous solution was to include gdata/R/gdata/R/trim.R in gtools using a symbolic link. Unfortunately, Rforge doesn't seem to like the symbolic link when building packages, and generates an error. So, instead, create the file trimws.R, which creates trimws() if it isn't already available (e.g. via base::trimws), and modify keywords() and roman2int() to use trimws() instead of gdata::trim(). 2015-05-27 02:48 warnes * man/roman2int.Rd: Add man page for roman2int(). 2015-05-27 02:29 warnes * man/mixedsort.Rd: Remove extraneous closing paren. 2015-05-27 02:26 warnes * NAMESPACE: Add roman2int() to exported function list. 2015-05-27 02:26 warnes * R/asc.R: Looks like we also lost the change of argument name to chr(). Fixed. 2015-05-27 02:23 warnes * R/asc.R: Somehow lost 'simplify=TRUE' argument to asc. Fixed. 2015-05-27 02:19 warnes * DESCRIPTION: Update gtools version number to 3.5.0 2015-05-27 02:17 warnes * DESCRIPTION, inst/ChangeLog, inst/NEWS: Update DESCRIPTION, ChangeLog, NEWS 2015-05-27 01:37 warnes * R/mixedsort.R, man/mixedsort.Rd: Add roman numeral support to mixedorder() and mixedsort(). 2015-05-27 00:21 warnes * man/asc.Rd: Add asc() and chr() functions for converting between characters and ASCII codes 2015-05-27 00:20 warnes * R/roman2int.R: roman2int() now returns NA for invalid roman numeral strings instead of generating an error. 2015-05-27 00:19 warnes * NAMESPACE: Add asc(), chr(), assignEdgewise(), unByteCode(), and unByteCodeAssign() to package NAMESPACE. 2015-05-27 00:17 warnes * R/asc.R: Add asc() and chr() functions for converting between characters and ASCII codes 2015-05-26 16:22 warnes * inst/ChangeLog: Add changelog to svn repository 2015-05-25 14:30 warnes * tests/test_ddirichlet.R: Add library call. 2015-05-25 14:29 warnes * man/unByteCode.Rd: Fix typo and add documentation for argument 'name'. 2015-05-25 14:29 warnes * man/mixedsort.Rd: Fix typo. 2015-05-25 14:16 warnes * man/mixedsort.Rd: Add description of blanklast argument, fix typo. 2015-05-25 14:13 warnes * man/quantcut.Rd: Change usage to match actual definition. 2015-05-25 14:10 warnes * man/mixedsort.Rd: Note characters sorting ignores case. 2015-05-25 14:08 warnes * man/mixedsort.Rd: Remove '...' from arglist to match source code. 2015-05-25 14:05 warnes * man/mixedsort.Rd: Replace unicode quotes with \code{..}. 2015-05-23 22:21 warnes * tests/test_ddirichlet.R: Add regression test ddirichlet() bug for x[i]=0, alpha[i]=1: ddirichlet(x, alpha) was returning NA rather than 0. 2015-05-23 22:12 warnes * R/dirichlet.R: ddirichlet() was incorrectly returning NA when x[i]=0 and alpha[i]=1. In this case, the one calculation became (-Inf * 0), which R evaluates to NaN. The correction is to detect this case and substitute -Inf instead of NaN. 2015-05-08 22:49 warnes * R/mixedsort.R: Summary: Speed up mixedorder by moving suppressWarnings outside of lapply loops. (Suggestion by Henrik Bengtsson.) 2015-05-02 17:38 warnes * Rename 'trunk' to 'pkg' for compatibility with R-forge 2015-05-02 13:50 warnes * Minor layout change. 2015-05-02 13:48 warnes * Remove stray 'svn' that was inserted into the code. 2015-05-02 13:47 warnes * Add man page for unByteCode(), assignEdgeWise(), and unByteCodeAssign() 2015-04-28 04:27 warnes * Changes to mixedsort(): - Hands off objects that are not character vectors to the default sort. - Add 'decreasing', 'na.last', and 'blank.last' arguments. 2015-04-28 04:16 warnes * Add private function 'checkReverseDependencies'. 2015-04-23 21:53 warnes * Update NEWS and ChangeLog 2015-04-23 21:47 warnes * - The 'q' argument to quantcut()'s 'q' now accept an integer indicating the number of equally spaced quantile groups to create. (Suggestion and patch submitted by Ryan C. Thompson.) 2015-04-23 21:10 warnes * Revers accidental text deletion: 2015-04-23 21:09 warnes * Update for gtools 3.4.3 2015-04-23 21:06 warnes * Remove debugging code and stray browser() call 2015-04-14 19:39 warnes * Fix typo 2015-04-09 19:46 warnes * Update gtools ChangeLog 2015-04-09 19:45 warnes * Move first()/last()/left()/right() to gdata. Add new functions na.replace() and loadedPackages(). Add more text to package description. 2015-04-08 19:55 warnes * Move first/last/left/right to from gtools to gdata 2015-04-06 22:09 warnes * Correct URL 2015-04-06 22:04 warnes * Update NEWS and ChangeLog for gtools 3.5.0 2015-04-06 21:52 warnes * Add ChangeLog files to repository 2015-04-06 21:44 warnes * Implement fix to keywords() needed for R-3.4.1, as suggested by Kurt Hornik. 2015-04-06 21:40 warnes * - Export S3 methods for first(), last(), left() and right(). - Ensure code matches man page for first(), last(), left(), and right(). 2014-10-09 18:56 warnes * Update for 3.5.0 release of gtools 2014-10-09 18:52 warnes * Make right() and left() S3 methods for classes data.frame and matrix 2014-08-27 00:44 warnes * Fix man page 2014-08-27 00:36 warnes * Finish adding first(), last(), left(), and right(). 2014-08-27 00:12 warnes * Add functions first(), last(), left(), and right(). 2014-05-28 00:24 warnes * Update for gtools 3.4.1 2014-05-28 00:18 warnes * Add test to ensure smartbind() properly handles Date columns. 2014-05-28 00:14 warnes * smartbind: Convert non-native type columns (except factor) to character. 2014-04-18 18:11 arnima * Main arg is 'x' like showNonASCII(x), preformatted notes instead of verb 2014-04-17 17:33 warnes * Update ASCIIfy man page to match source code and add keywords 2014-04-17 17:25 warnes * Update NEWS for gtools 3.4.0 2014-04-17 16:56 warnes * Add ASCIIfy function posted to RDevel by Arni Magnusson 2014-03-01 20:15 warnes * Fix cut-and-paste error. 2014-03-01 20:12 warnes * Update files for gtools 3.3.1 release 2014-03-01 20:02 warnes * Fix bug in gtools::mixedorder regular expression for regognizing numbers. (Periods weren't escaped). 2014-02-11 17:44 warnes * Create and use locate copy of tools:::.split_op_version. 2014-02-11 17:25 warnes * Update for gtools 3.3.0. 2014-02-11 17:19 warnes * Fix arguments 2014-02-11 17:17 warnes * Update arguments to match code. 2014-02-11 17:14 warnes * Add getDependencies() function to return a list of package dependencies. 2014-01-14 19:43 warnes * Update for bug-fix release 2014-01-14 19:37 warnes * Add test file for binsearch() function. 2014-01-14 15:56 warnes * Fixed bug where binsearch() returned the wrong endpoint & value when the found value was at the upper endpoint. 2014-01-13 18:16 warnes * Fix typo 2014-01-11 23:39 warnes * Update for gtools release 3.2.0 2014-01-11 23:38 warnes * fixes for R CMD check 2014-01-11 23:24 warnes * Fixes for gtools release 3.2.0 2013-12-23 18:48 warnes * Extend the keywords() function to return keywords associated with a specified topic via 'keywords(topic)'. 2013-12-23 16:08 warnes * Add keyword. 2013-12-23 16:04 warnes * Add stars.pval() function to convert p-values into significance symbols. 2013-11-26 14:38 warnes * mixedorder() was failing to correctly handle numbers including decimals due to a faulty regular expression. Prior to the fix: > drr [1] "Dose 0.3 mg" "Dose 0.04 mg" "Dose 0.5 mg" > gtools::mixedsort(drr) [1] "Dose 0.3 mg" "Dose 0.04 mg" "Dose 0.5 mg" After the fix: > drr [1] "Dose 0.3 mg" "Dose 0.04 mg" "Dose 0.5 mg" > mixedsort(drr) [1] "Dose 0.04 mg" "Dose 0.3 mg" "Dose 0.5 mg" In addition, an optimization was added that checked if the input vector was numeric. If so, simply use the existing base::order function. 2013-11-18 16:06 warnes * Use ".Deprecated" instead of warning. 2013-11-06 14:53 warnes * Update files for gtools 3.1.1 2013-11-06 14:51 warnes * Fix problem with mixedorder/mixedsort when there is only zero or one elements in the vector. 2013-09-23 15:46 warnes * Comment out empty sections in gtools-deprecated.Rd 2013-09-23 15:41 warnes * Update files for gtools 3.1.0 release 2013-09-23 15:37 warnes * Make 'addLast()' defunct. 2013-09-23 15:29 warnes * Mark 'addLast()' as defunct and move 'lastAdd()' function to a separate file. 2013-09-23 15:23 warnes * Update for gtools 3.0.1 release 2013-09-23 15:19 warnes * Use 'suppressWarnings() instead of 'options(warn=-1)' in 'mixedorder()'. 2013-07-07 00:11 warnes * Fix typo. 2013-07-06 23:55 warnes * Fix Rd warning. 2013-07-06 23:49 warnes * Include lastAdd in NAMESPACE 2013-07-06 23:46 warnes * Change assert from deprecated to defunct. 2013-07-06 23:45 warnes * Improve deprecation message 2013-07-06 23:43 warnes * Update for gtools 3.0.0 2013-07-06 23:26 warnes * Create new function lastAdd to replace addLast and mark addLast as deprecated. 2013-07-05 23:48 warnes * Point out that addLast() modifies the value of .Last in the global environment. 2013-07-05 23:47 warnes * Point out that addLast() modifies the value of .Last in the global environment. 2013-07-05 23:34 warnes * Update for gtools 2.7.2 mark 2 2013-07-05 23:33 warnes * Remove cross-reference to (obsolete?) moc package 2013-07-05 17:31 warnes * Update for gtools 2.7.2 2013-07-05 17:29 warnes * Update for R version 3.0.0 and later 2013-03-17 02:21 warnes * Fix error in smartbind: factor levels were not being handled if the factor column was not present in the first data frame. 2012-06-19 19:00 warnes * Update for gtools 2.7.0. 2012-06-19 14:00 warnes * Document new 'verbose' argument to smartbind(). 2012-06-19 13:56 warnes * Clean up R CMD check warnings. 2012-05-04 16:06 warnes * smartbind(): Improve handling of factors and ordered factors. 2011-10-05 17:05 warnes * Update version number for release 2011-10-05 16:53 warnes * Add 'sep' argument to smartbind() to allow specification of character used to separate components of constructed names 2011-09-28 22:56 warnes * smartbind(): Prevent coersion to data frame from mangling column names. 2011-09-28 22:53 warnes * Add 'fill' argument to smartbind() to specify a value to use for missing entries. 2011-09-28 22:53 warnes * Add 'fill' argument to smartbind() to specify a value to use for missing entries. 2010-08-14 19:28 warnes * Modify mixedorder()/mixedsort() to better handle strings containing multiple periods, like version numbers (e.g 1.1.2, 1.2.1. 1.1.1.1). 2010-05-01 22:14 warnes * Update version number for new release 2010-05-01 22:03 warnes * Change Greg's email address to greg@warnes.net 2010-05-01 21:59 warnes * Fix error in checkRVersion() 2010-04-28 17:23 ggrothendieck2 * fixed problems with R CMD CHECK 2009-05-09 03:35 warnes * Escape $ in .Rd file to avoid latex issues 2009-05-09 03:26 warnes * Update NEWS and create softlinks for NEWS and ChangeLog in top level directory 2009-05-09 03:15 warnes * Move actual NEWS file into inst. 2009-05-09 03:13 warnes * Update Greg's email address and fix Rd syntax errors 2009-02-16 15:34 warnes * Correct windows make flags as suggested by Brian Ripley. 2008-08-15 13:15 warnes * Add keywords() function to show /doc/KEYWORDS file 2008-05-29 23:19 warnes * Add newVersionAvailable() function to compare running and latest available R versions 2008-05-26 19:15 warnes * Update license specification 2008-05-26 15:04 warnes * Remove 'assert' man page 2008-05-22 16:40 warnes * Finish rename of assert.R to assert-depricated.Rd 2008-05-22 16:35 warnes * Add checkRVersion.R file 2008-05-22 16:34 warnes * Rename again to get correct extension! 2008-05-22 16:30 warnes * Update NEWS for 2.5.0 2008-05-22 16:17 warnes * Add man page for checkRVersion 2008-05-22 16:16 warnes * Rename assert-deprecated.R to assert.R to meet R file name requirements. 2008-05-22 16:15 warnes * Add checkRVersion to NAMESPACE, and increment version in DESCRIPTION. 2008-05-22 16:14 warnes * Remove broken SEE LSO reference 2008-04-12 19:42 warnes * Improve text explanation of how defmacro() and strmacro() differ from function(). 2008-04-12 19:19 warnes * assert() is now deprecated in favor of base::stopifnot() 2008-04-12 19:19 warnes * Rename 'assert.R' to 'deprecated.R'. 2008-04-12 19:14 warnes * Assert is now deprecated in favor of base::stopifnot(), so add call to .Deprecated() to inform the user. 2007-11-30 18:05 warnes * Update defnitions of odd() and even() to use modulus operator instead of division. Prettier, I think, :-D 2007-08-08 13:52 warnes * Fix bug identified by R-2.6's check routings in binsearch() 2007-08-08 13:48 warnes * Add the binsearch(), previously in the genetics package. 2007-07-18 11:48 ggorjan * typo fixed 2007-04-12 21:16 warnes * Add ask() function to prompt the user and collect a single response. 2007-04-07 13:41 warnes * Fix improper escapes in regexp detected by R 2.5.0 package check. 2007-03-23 22:53 warnes * Allow permutations for r>n provided repeats.allowed=TRUE 2006-11-28 00:53 warnes * Replace F with FALSE in smartbind example. 2006-11-27 22:42 warnes * Replace T with TRUE in smartbind example 2006-11-27 21:40 warnes * Temprary remove to reset binary flag 2006-11-27 21:40 warnes * Temprary remove to reset binary flag 2006-11-27 21:34 warnes * Add smartbind() to list of exported functions, and add corresponding documentation file. 2006-11-27 20:52 warnes * Update my email address 2006-11-14 22:25 ggorjan * Removed executable property 2006-08-02 22:21 warnes * Update my email address 2006-05-05 18:13 nj7w * Fixed minor typo - in {value} - n was replaced by r 2006-05-05 16:55 nj7w * Fixed minor typos 2006-03-01 19:12 warnes * Add smartbind function 2006-01-18 16:28 warnes * Add concept tags to make mixedsort easier to locate. 2005-12-21 15:23 warnes * Update version number and date 2005-12-21 06:11 warnes * Note changes for 2.2.3 2005-12-21 06:08 warnes * Should now work on Windows 2005-12-20 20:25 warnes * Temporary fix to allow setTCPNoDelay.c to compile on Windows. If compiled on windows calling setTCPNoDelay will just raise an error. 2005-12-14 15:48 warnes * Change C++ comment to standard comment 2005-12-13 16:19 nj7w * *** empty log message *** 2005-12-13 16:18 nj7w * Updated NEWS and removed ChangeLog 2005-12-12 22:10 nj7w * Updated version for CRAN release 2005-12-08 20:21 warnes * Add C source code for setTCPNoDelay. 2005-12-01 16:54 nj7w * Updated Greg's email address 2005-11-29 22:30 warnes * Add UseDynLib to NAMESPACE so the shared library gets properly loaded. 2005-11-29 22:25 warnes * - Remove debugging comments - Change return value on success to "Success". 2005-11-22 22:54 warnes * NAMESPACE 2005-11-22 22:54 warnes * Update news for 2.2.1 release. 2005-11-22 22:51 warnes * Fixes for R CMD check 2005-11-22 22:31 warnes * Add setTCPNoDelay() function and documentation 2005-11-22 15:46 warnes * New function 'addLast' that adds functions to R's .Last() so that they will be executed when R is terminating. 2005-09-22 18:12 warnes * More changes for strmacro(), also changes for 2.1.1 release 2005-09-22 17:26 warnes * Add strmaco() which defines functions that use strings for macro definition 2005-09-21 18:51 warnes * Add support for DOTS/... arguments to defmacro 2005-09-12 15:44 nj7w * Updated Greg's email 2005-09-02 22:53 nj7w * Exported assert 2005-09-02 22:53 nj7w * Updated the version number 2005-09-02 22:52 nj7w * Added NEWS 2005-09-02 22:52 nj7w * Added ChangeLog 2005-09-02 22:51 nj7w * Fixed syntax errors 2005-09-02 16:43 warnes * Add assert() and documentation 2005-09-02 16:28 warnes * Fix problem in defmacro.Rd file: don't use \code{} in the example section. 2005-08-31 20:00 warnes * Adding the defmacro() function, extracted from Lumley T. "Programmer's Niche: Macros in {R}", R News, 2001, Vol 1, No. 3, pp 11--13, \url{http://CRAN.R-project.org/doc/Rnews/} 2005-08-31 16:18 warnes * Add stand-alone DESCRIPTION file and remove old DESCRIPTION.in file. 2005-06-13 17:08 nj7w * Fixed a bug in mixedsort - check if "which.na" and "which.blank" is numeric(0) before subsetting the datasets. 2005-06-09 14:20 nj7w * Updating the version number, and various help files to synchronize splitting of gregmisc bundle in 4 individual components. 2005-05-10 22:05 warnes * Fix handling of NA's in mixedorder. We were using a high UTF character to try to put NA's at the end of the sort order, but R 2.1.0 checks if characters are in the correct range. Instead, we explicitly force NA's to the end. 2005-04-07 00:28 warnes * - Add scat() function which writes its arguments to stderr and flushes so that output is immediately displayed, but only if 'getOption("DEBUG")' is true. 2005-04-02 04:19 warnes * Move drop.levels() from gtools to gdata. 2005-04-02 04:17 warnes * Minor reordering of functions in file 2005-04-02 04:14 warnes * Move frameApply() to gdata package. 2005-04-02 03:28 warnes * Fix error if only one value passed to mixedorder. 2005-04-02 02:37 warnes * Add proper handling where more than one quantile obtains the same value 2005-04-01 23:00 warnes * Add CVS ID tag to file headers. 2005-04-01 23:00 warnes * Fixes from Jim Rogers for R CMD check problems in frameApply 2005-03-31 19:03 warnes * Updates to drop.levels() and frameApply() from Jim Rogers 2005-03-31 19:01 warnes * Add ELISA data set used by frameApply and drop.levels examples 2005-02-25 23:02 warnes * Replace 'T' with TRUE. 2005-02-25 22:54 warnes * Remove dependency on ELISA data set for the example. 2005-02-25 21:00 warnes * Add drop.levels, frameApply to namespace export. 2005-02-15 00:41 warnes * Add frameApply and drop.levels contributed by Jim Rogers. 2005-01-12 20:50 warnes * Add dependency on R 1.9.0+ to prevent poeple from installing on old versions of R which don't support namespaces. 2004-09-27 21:01 warneg * Updated to pass R CMD check. 2004-09-03 17:27 warneg * initial bundle checkin 2004-09-02 17:14 warneg * Initial revision 2004-08-27 21:57 warnes * Fixed bug in mixedsort, and modified reorder.factor to use mixedsort. 2004-08-26 20:08 warnes * - Fix bug pointed out by Jim Rogers. - Use a more distictive internal separator: $@$ instead of just $ - Capitalization is now irrelevent for search order (unlike ASCII). 2004-06-08 15:49 warnes * Nitin Jain added by= parameter to allow specifying separation between groups. 2004-05-26 13:40 warnes * Escape underscores in email addresses so Latex is happy. 2004-05-26 13:18 warnes * Replace 'T' with 'TRUE' to pass R CMD check. 2004-05-25 17:11 warnes * Remove extraneous comments. 2004-05-25 17:08 warnes * Fix an error in the code when using repeats.allow=T and r>2. Bug report and fix both due to Elizabeth Purdom . 2004-05-24 17:36 warnes * Check if argument is a vector before doing is.na to avoid generating a warning. 2004-05-24 17:17 warnes * Add invalid() function for testing if a parameter value is non-missing, non-NA, non-NULL. 2004-04-27 14:33 warnes * Replaced argument `as.list' with `simplify'. Updated documentation, and updated examples appropriately. 2004-04-26 16:37 warnes * Added as.list argument to return one list element per evaluation. 2004-03-26 22:21 warnes * Uncomment and fix large 'n' example. 2004-03-26 22:19 warnes * - Update to match changes in running() - Add examples to illustrate new arguments. - Modify running correlation plot example to be more clear. 2004-03-26 22:12 warnes * More of the same. 2004-03-26 15:34 warnes * Fix bug discovered by Sean Davis . The running function took an improper shortcut. When allow.fewer=FALSE it was still passing shorter lists of elements to the called function, and then overwriting the results for the shorter lists with NAs. The code now skips evaluation of the function on lists shorter than the specified length when allow.fewer=FALSE. 2004-01-21 04:31 warnes * - Mark sprint() as depreciated. - Replace references to sprint with capture.output() - Use match.arg for halign and valign arguments to textplot.default. - Fix textplot.character so that a vector of characters is properly displayed. Previouslt, character vectors were plotted on top of each other. 2003-12-03 02:46 warnes * - match function argument defaults with 'usage' 2003-11-21 23:00 warnes * Removed 'deqn' call that was confusing things. 2003-11-21 20:54 warnes * Add email address to author field 2003-11-21 20:35 warnes * - new files 2003-11-21 19:54 warnes * - Change 'T' to 'TRUE' in mixedsort.R - Add missing brace in mixedsort.Rd 2003-11-20 15:56 warnes * - Move 'odd' and 'even' functions to a separate file & provide documentation 2003-11-18 22:47 warnes * - Renamed smartsort to mixedsort and added documentation. 2003-11-10 22:11 warnes * - Add files contributed by Arni Magnusson . As well as some of my own. 2003-05-23 18:14 warnes * - library() backported from 1.7-devel. This version of the function adds the "pos=" argument to specify where in the search path the library should be placed. - updated .First.lib to use library(...pos=3) for MASS to avoid the 'genotype' data set in MASS from masking the genotype funciton in genetics when it loads gregmisc - Added logit() inv.logit() matchcols() function and corresponding docs 2003-04-22 16:00 warnes * - Fixed tpyo in example that allowed combinations(500,2) to run when it should have been ignred for testing.. 2003-04-10 16:22 warnes * - Added note about the need to increase options("expressions") to use large values for 'n'. Prompted by bug report from Huan Huang n provided repeat.allowed=TRUE - Bumped up version number 2002-08-01 19:37 warnes * - Corrected documentation mismatch for ci, ci.default. - Replaced all occurences of '_' for assignment with '<-'. - Replaced all occurences of 'T' or 'F' for 'TRUE' and 'FALSE' with the spelled out version. - Updaded version number and date. 2002-04-09 00:51 warneg * Checkin for version 0.5.3 2002-03-26 14:49 warneg * Initial Checkin 2002-03-26 14:29 warneg * Initial checkin. 2002-03-20 03:44 warneg * - Added definition of is.R function. - Added boxplot.formula 2002-03-07 23:39 warneg * - Added documentation and example for running2 2002-03-07 23:38 warneg * - Added "running2", which handles both univariate and bivariate cases - Modified "running" to call "running2" 2002-02-05 02:20 warneg * - Fix typo that caused code meant to run only under S-Plus to run under R, causing problems. 2001-12-19 22:45 warneg * - Added code for %in%. 2001-09-18 14:15 warneg * Release 0.3.2 2001-09-01 19:19 warneg * Initial checkin. 2001-09-01 00:01 warneg * Release 0.3.0 2001-08-25 05:53 warneg * Initial CVS checkin. 2001-08-25 05:50 warneg * Fixed a typo and a syntax error. 2001-08-25 03:59 warneg * Initial Checkin 2001-06-29 13:24 warneg * Initial revision. gtools/man/0000755000176200001440000000000013003720437012333 5ustar liggesusersgtools/man/roman2int.Rd0000644000176200001440000000200113003720437014524 0ustar liggesusers\name{roman2int} \alias{roman2int} \title{Convert Roman Numerals to Integers} \description{ Convert roman numerals to integers } \usage{ roman2int(roman) } \arguments{ \item{roman}{character vector containing roman numerals} } \details{ This functon will convert roman numerals to integers without the upper bound imposed by R (3899), ignoring case. } \value{ A integer vector with the same length as \code{roman}. Character strings which are not valid roman numerals will be converted to \code{NA}. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[utils]{as.roman}} } \examples{ roman2int( c('I', 'V', 'X', 'C', 'L', 'D', 'M' ) ) # works regardless of case roman2int( 'MMXVI' ) roman2int( 'mmxvi' ) # works beyond R's limit of 3899 val.3899 <- 'MMMDCCCXCIX' val.3900 <- 'MMMCM' val.4000 <- 'MMMM' as.numeric(as.roman( val.3899 )) as.numeric(as.roman( val.3900 )) as.numeric(as.roman( val.4000 )) roman2int(val.3899) roman2int(val.3900) roman2int(val.4000) } \keyword{arith} gtools/man/running.Rd0000644000176200001440000001071513003720437014306 0ustar liggesusers% $Id: running.Rd 1433 2010-05-01 22:03:03Z warnes $ % \name{running} \alias{running} \title{Apply a Function Over Adjacent Subsets of a Vector} \description{Applies a function over subsets of the vector(s) formed by taking a fixed number of previous points.} \usage{ running(X, Y=NULL, fun=mean, width=min(length(X), 20), allow.fewer=FALSE, pad=FALSE, align=c("right", "center","left"), simplify=TRUE, by, ...) } \arguments{ \item{X}{ data vector } \item{Y}{ data vector (optional) } \item{fun}{ Function to apply. Default is \code{mean}} \item{width}{Integer giving the number of vector elements to include in the subsets. Defaults to the lesser of the length of the data and 20 elements.} \item{allow.fewer}{Boolean indicating whether the function should be computed for subsets with fewer than \code{width} points} \item{pad}{Boolean indicating whether the returned results should be 'padded' with NAs corresponding to sets with less than \code{width} elements. This only applies when when \code{allow.fewer} is FALSE.} \item{align}{One of "right", "center", or "left". This controls the relative location of `short' subsets with less then \code{width} elements: "right" allows short subsets only at the beginning of the sequence so that all of the complete subsets are at the end of the sequence (i.e. `right aligned'), "left" allows short subsets only at the end of the data so that the complete subsets are `left aligned', and "center" allows short subsets at both ends of the data so that complete subsets are `centered'. } \item{simplify}{Boolean. If FALSE the returned object will be a list containing one element per evaluation. If TRUE, the returned object will be coerced into a vector (if the computation returns a scalar) or a matrix (if the computation returns multiple values). Defaults to FALSE.} \item{by}{Integer separation between groups. If \code{by=width} will give non-overlapping windows. Default is missing, in which case groups will start at each value in the X/Y range.} \item{\dots}{ parameters to be passed to \code{fun} } } \details{ \code{running} applies the specified function to a sequential windows on \code{X} and (optionally) \code{Y}. If \code{Y} is specified the function must be bivariate. } \value{ List (if \code{simplify==TRUE}), vector, or matrix containg the results of applying the function \code{fun} to the subsets of \code{X} (\code{running}) or \code{X} and \code{Y}. Note that this function will create a vector or matrix even for objects which are not simplified by \code{sapply}. } \author{ Gregory R. Warnes \email{greg@warnes.net}, with contributions by Nitin Jain \email{nitin.jain@pfizer.com}.} \seealso{ \code{\link[gplots]{wapply}} to apply a function over an x-y window centered at each x point, \code{\link[base]{sapply}}, \code{\link[base]{lapply}} } \examples{ # show effect of pad running(1:20, width=5) running(1:20, width=5, pad=TRUE) # show effect of align running(1:20, width=5, align="left", pad=TRUE) running(1:20, width=5, align="center", pad=TRUE) running(1:20, width=5, align="right", pad=TRUE) # show effect of simplify running(1:20, width=5, fun=function(x) x ) # matrix running(1:20, width=5, fun=function(x) x, simplify=FALSE) # list # show effect of by running(1:20, width=5) # normal running(1:20, width=5, by=5) # non-overlapping running(1:20, width=5, by=2) # starting every 2nd # Use 'pad' to ensure correct length of vector, also show the effect # of allow.fewer. par(mfrow=c(2,1)) plot(1:20, running(1:20, width=5, allow.fewer=FALSE, pad=TRUE), type="b") plot(1:20, running(1:20, width=5, allow.fewer=TRUE, pad=TRUE), type="b") par(mfrow=c(1,1)) # plot running mean and central 2 standard deviation range # estimated by *last* 40 observations dat <- rnorm(500, sd=1 + (1:500)/500 ) plot(dat) sdfun <- function(x,sign=1) mean(x) + sign * sqrt(var(x)) lines(running(dat, width=51, pad=TRUE, fun=mean), col="blue") lines(running(dat, width=51, pad=TRUE, fun=sdfun, sign=-1), col="red") lines(running(dat, width=51, pad=TRUE, fun=sdfun, sign= 1), col="red") # plot running correlation estimated by last 40 observations (red) # against the true local correlation (blue) sd.Y <- seq(0,1,length=500) X <- rnorm(500, sd=1) Y <- rnorm(500, sd=sd.Y) plot(running(X,X+Y,width=20,fun=cor,pad=TRUE),col="red",type="s") r <- 1 / sqrt(1 + sd.Y^2) # true cor of (X,X+Y) lines(r,type="l",col="blue") } \keyword{misc} gtools/man/gtools-deprecated.Rd0000644000176200001440000000106213003720437016226 0ustar liggesusers\name{gtools-deprecated} \alias{gtools-deprecated} \title{Deprecated Functions in the gtools package} \description{ These functions are provided for compatibility with older versions of gtools, and may be defunct as soon as the next release. } %\usage{ %} %\arguments{ %} \details{ gtools currently contains no deprecated functions. % The original help page for these functions is often % available at \code{help("oldName-deprecated")} (note the quotes). % % \itemize{ % \item{} % } } \seealso{ \code{\link{Deprecated}} } \keyword{misc} gtools/man/ASCIIfy.Rd0000644000176200001440000000262313003720437014014 0ustar liggesusers\name{ASCIIfy} \alias{ASCIIfy} \title{Convert Characters to ASCII} \description{ Convert character vector to ASCII, replacing non-ASCII characters with single-byte (\samp{\x00}) or two-byte (\samp{\u0000}) codes. } \usage{ ASCIIfy(x, bytes = 2, fallback = "?") } \arguments{ \item{x}{a character vector, possibly containing non-ASCII characters.} \item{bytes}{either \code{1} or \code{2}, for single-byte (\samp{\x00}) or two-byte (\samp{\u0000}) codes.} \item{fallback}{an output character to use, when input characters cannot be converted.} } \value{ A character vector like \code{x}, except non-ASCII characters have been replaced with \samp{\x00} or \samp{\u0000} codes. } \author{Arni Magnusson \email{arnima@hafro.is}} \note{ To render single backslashes, use these or similar techniques:\preformatted{ write(ASCIIfy(x), "file.txt") cat(paste(ASCIIfy(x), collapse="\n"), "\n", sep="")} The resulting strings are plain ASCII and can be used in R functions and datasets to improve package portability. } \seealso{ \code{\link[tools]{showNonASCII}} identifies non-ASCII characters in a character vector. } \examples{ cities <- c("S\u00e3o Paulo", "Reykjav\u00edk") print(cities) ASCIIfy(cities, 1) ASCIIfy(cities, 2) athens <- "\u0391\u03b8\u03ae\u03bd\u03b1" print(athens) ASCIIfy(athens) } \keyword{utilites} \keyword{character} gtools/man/baseOf.Rd0000644000176200001440000000641013312471347014030 0ustar liggesusers\name{baseOf} \alias{baseOf} \title{Transform an integer to an array of base-n digits} \description{ Transform an integer to an array of base-n digits } \usage{ baseOf(v, base=10, len=1) } \arguments{ \item{v}{ A single integer value to be transformed. } \item{base}{ The base to which to transform to. } \item{len}{ The minimal length of the returned array. } } \details{ This function converts the elements of an integer vector as an array of its digits. The base of the numbering scheme may be changed away from 10, which defines our decimal system, to any other integer value. For base=2, the number is returned in the dual system. The least significant digit has the highest index in the array, i.e. it appears on the right. The highest exponent is at position 1, i.e. left. To write decimal values in another base is very common in computer science. In particular at the basis 2 the then possible values 0 and 1 are often interpreted as logical false or true. And at the very interface to electrical engineering, it is indicacted as an absence or presence of voltage. When several bit values are transported synchronously, then it is common to give every lane of such a data bus a unique 2^x value and interpret it as a number in the dual system. To distinguish 256 characters one once needed 8 bit ("byte"). It is the common unit in which larger non-printable data is presented. Because of the many non-printable characters and the difficulty for most humans to memorize an even longer alphabet, it is presented as two half bytes ("nibble") of 4 bit in a hexadecimal presentation. Example code is shown below. For statisticians, it is more likely to use bit representations for hashing. A bit set to 1 (TRUE) at e.g. position 2, 9 or 17 is interpreted as the presence of a particular feature combination of a sample. With baseOf, you can refer to the bit combination as a number, which is more easily and more efficiently dealt with than with an array of binary values. The example code presents a counter of combinations of features which may be interpreted as a Venn diagram. } \author{Steffen Moeller \email{moeller@debian.org} } \examples{ # decimal representation baseOf(123) # dual representation baseOf(123,base=2) # octal representation baseOf(123,base=8) # hexadecimal representation baseOf(123,base=16) # hexadecimal with more typical letter-notation c(0:9,LETTERS)[baseOf(123,16)] # hexadecimal again, now showing a single string paste(c(0:9,LETTERS)[baseOf(123,16)],collapse="") # decimal representation but filling leading zeroes baseOf(123,len=5) # and converting that back sum(2^(4:0)*baseOf(123,len=5)) # hashing and a tabular venn diagram derived from it m<-matrix(sample(c(FALSE,TRUE),replace=TRUE,size=300),ncol=4) colnames(m)<-c("strong","colorful","nice","humorous") names(dimnames(m)) <- c("samples","features") head(m) m.val <- apply(m,1,function(X){return(sum(2^((ncol(m)-1):0)*X))}) m.val.rle <- rle(sort(m.val)) m.counts <- cbind(baseOf(m.val.rle$value,base=2,len=ncol(m)), m.val.rle$lengths) colnames(m.counts)<- c(colnames(m),"num") rownames(m.counts)<- apply(m.counts[,1:ncol(m)],1,paste,collapse="") m.counts[1==m.counts[,"nice"]&1==m.counts[,"humorous"],,drop=FALSE] m.counts[,"num",drop=TRUE] } \keyword{base} gtools/man/setTCPNoDelay.Rd0000644000176200001440000000365013117611546015252 0ustar liggesusers\name{setTCPNoDelay} \alias{setTCPNoDelay} \title{Modify the TCP\_NODELAY (`de-Nagle') flag for socket objects} \description{ Modify the TCP\_NODELAY (`de-Nagele') flag for socket objects } \usage{ setTCPNoDelay(socket, value=TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{socket}{A socket connection object} \item{value}{Logical indicating whether to set (\code{TRUE}) or unset (\code{FALSE}) the flag} } \details{ By default, TCP connections wait a small fixed interval before actually sending data, in order to permit small packets to be combined. This algorithm is named after its inventor, John Nagle, and is often referred to as 'Nagling'. While this reduces network resource utilization in these situations, it imposes a delay on all outgoing message data, which can cause problems in client/server situations. This function allows this feature to be disabled (de-Nagling, \code{value=TRUE}) or enabled (Nagling, \code{value=FALSE}) for the specified socket. } \value{ The character string "SUCCESS" will be returned invisible if the operation was succesful. On failure, an error will be generated. } \references{ "Nagle's algorithm" at WhatIS.com \url{ http://searchnetworking.techtarget.com/sDefinition/0,,sid7_gci754347,00.html} Nagle, John. "Congestion Control in IP/TCP Internetworks", IETF Request for Comments 896, January 1984. \url{http://www.ietf.org/rfc/rfc0896.txt?number=896} } \author{Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link{make.socket}}, \code{\link{socketConnection}} } \examples{ \dontrun{ host <- "www.r-project.org" socket <- make.socket(host, 80) print(socket) setTCPNoDelay(socket, TRUE) write.socket(socket, "GET /\n\n") write.socket(socket, "A") write.socket(socket, "B\n") while( (str <- read.socket(socket)) > "") cat(str) close.socket(socket) } } \keyword{programming} \keyword{misc} \keyword{utilities} gtools/man/ask.Rd0000644000176200001440000000210213117607176013405 0ustar liggesusers\name{ask} \alias{ask} \title{Display a prompt and collect the user's response} \description{ Display a prompt and collect the user's response } \usage{ ask(msg = "Press to continue: ", con=stdin()) } \arguments{ \item{msg}{Character vetor providing the message to be displayed} \item{con}{Character connection to query, defaults to \code{stdin()}.} } \details{ The prompt message will be displayed, and then \code{readLines} is used to collect a single input value (possibly empty), which is then returned. In most situations using the default \code{con=stdin()} should work properly. Under RStudio, it is necessary to specify \code{con=file("stdin")} for proper operaation. } \value{ A character scalar containing the input providede by the user. } \author{Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link{readLines}}, \code{\link{scan}} } \examples{ # use default prompt ask() silly <- function() { age <- ask("How old aroe you? ") age <- as.numeric(age) cat("In 10 years you will be", age+10, "years old!\n") } } \keyword{IO} gtools/man/defmacro.Rd0000644000176200001440000001044013120260017014372 0ustar liggesusers\name{defmacro} \alias{defmacro} \alias{strmacro} \title{Define a macro} \description{ \code{defmacro} define a macro that uses R expression replacement \code{strmacro} define a macro that uses string replacement } \usage{ defmacro(..., expr) strmacro(..., expr, strexpr) } \arguments{ \item{\dots}{ macro argument list } \item{expr}{ R expression defining the macro body } \item{strexpr}{ character string defining the macro body } } \details{ \code{defmacro} and \code{strmacro} create a macro from the expression given in \code{expr}, with formal arguments given by the other elements of the argument list. A macro is similar to a function definition except for handling of formal arguments. In a function, formal arguments are simply variables that contains the result of evaluating the expressions provided to the function call. In contrast, macros actually modify the macro body by \emph{replacing} each formal argument by the expression (\code{defmacro}) or string (\code{strmacro}) provided to the macro call. For \code{defmacro}, the special argument name \code{DOTS} will be replaced by \code{...} in the formal argument list of the macro so that \code{...} in the body of the expression can be used to obtain any additional arguments passed to the macro. For \code{strmacro} you can mimic this behavior providing a \code{DOTS=""} argument. This is illustrated by the last example below. Macros are often useful for creating new functions during code execution. } \note{ Note that because [the defmacro code] works on the parsed expression, not on a text string, defmacro avoids some of the problems of traditional string substitution macros such as \code{strmacro} and the C preprocessor macros. For example, in \preformatted{ mul <- defmacro(a, b, expr={a*b}) } a C programmer might expect \code{mul(i, j + k)} to expand (incorrectly) to \code{i*j + k}. In fact it expands correctly, to the equivalent of \code{i*(j + k)}. For a discussion of the differences between functions and macros, please Thomas Lumley's R-News article (reference below). } \value{ A macro function. } \references{ The original \code{defmacro} code was directly taken from: Lumley T. "Programmer's Niche: Macros in R", R News, 2001, Vol 1, No. 3, pp 11--13, \url{https://cran.r-project.org/doc/Rnews/} } \author{ Thomas Lumley wrote \code{defmacro}. Gregory R. Warnes \email{greg@warnes.net} enhanced it and created \code{strmacro}. } \seealso{ \code{\link[base]{function}} \code{\link[base]{substitute}}, \code{\link[base]{eval}}, \code{\link[base]{parse}}, \code{\link[base]{source}}, \code{\link[base]{parse}}, } \examples{ #### # macro for replacing a specified missing value indicator with NA # within a dataframe ### setNA <- defmacro(df, var, values, expr={ df$var[df$var \%in\% values] <- NA }) # create example data using 999 as a missing value indicator d <- data.frame( Grp=c("Trt", "Ctl", "Ctl", "Trt", "Ctl", "Ctl", "Trt", "Ctl", "Trt", "Ctl"), V1=c(1, 2, 3, 4, 5, 6, 999, 8, 9, 10), V2=c(1, 1, 1, 1, 1, 2, 999, 2, 999, 999) ) d # Try it out setNA(d, V1, 999) setNA(d, V2, 999) d ### # Expression macro ### plot.d <- defmacro( df, var, DOTS, col="red", title="", expr= plot( df$var ~ df$Grp, type="b", col=col, main=title, ... ) ) plot.d( d, V1) plot.d( d, V1, col="blue" ) plot.d( d, V1, lwd=4) # use optional 'DOTS' argument ### # String macro (note the quoted text in the calls below) # # This style of macro can be useful when you are reading # function arguments from a text file ### plot.s <- strmacro( DF, VAR, COL="'red'", TITLE="''", DOTS="", expr= plot( DF$VAR ~ DF$Grp, type="b", col=COL, main=TITLE, DOTS) ) plot.s( "d", "V1") plot.s( DF="d", VAR="V1", COL='"blue"' ) plot.s( "d", "V1", DOTS='lwd=4') # use optional 'DOTS' argument ####### # Create a macro that defines new functions ###### plot.sf <- defmacro(type='b', col='black', title=deparse(substitute(x)), DOTS, expr= function(x,y) plot( x,y, type=type, col=col, main=title, ...) ) plot.red <- plot.sf(col='red',title='Red is more Fun!') plot.blue <- plot.sf(col='blue',title="Blue is Best!", lty=2) plot.red(1:100,rnorm(100)) plot.blue(1:100,rnorm(100)) } \keyword{programming} gtools/man/getDependencies.Rd0000644000176200001440000000474713003720437015724 0ustar liggesusers\name{getDependencies} \alias{getDependencies} \title{ Get package dependencies } \description{ Get package dependencies } \usage{ getDependencies(pkgs, dependencies = c("Depends", "Imports", "LinkingTo"), installed=TRUE, available=TRUE, base=FALSE, recommended=FALSE) } \arguments{ \item{pkgs}{character vector of package names} \item{dependencies}{character vector of dependency types to include. Choices are "Depends", "Imports", "LinkingTo", "Suggests", and "Enhances". Defaults to \code{c("Depends", "Imports", "LinkingTo")}. } \item{installed}{Logical indicating whether to pull dependency information from installed packages. Defaults to TRUE. } \item{available}{Logical indicating whether to pull dependency information from available packages. Defaults to TRUE. } \item{base}{Logical indicating whether to include dependencies on base packages that are included in the R installation. Defaults to FALSE. } \item{recommended}{Logical indicating whether to include dependencies on recommended packages that are included in the R installation. Defaults to FALSE. } } \details{ This function recursively constructs the list of dependencies for the packages given by \code{pkgs}. By default, the dependency information is extracted from both installed and available packages. As a consequence, it works both for local and CRAN packages. } \value{ A character vector of package names. } \note{ If \code{available=TRUE} R will attempt to access the currently selected CRAN repository, prompting for one if necessary. } \author{ Gregory R. Warnes email{greg@warnes.net} based on the non exported \code{utils:::getDependencies} and \code{utils:::.clean_up_dependencies2}. } \seealso{ \code{\link{installed.packages}}, \code{\link{available.packages}} } \examples{ ## A locally installed package getDependencies("MASS", installed=TRUE, available=FALSE) \dontrun{ ## A package on CRAN getDependencies("gregmisc", installed=FALSE, available=TRUE) } ## Show base and recommended dependencies getDependencies("MASS", available=FALSE, base=TRUE, recommended=TRUE) \dontrun{ ## Download the set of packages necessary to support a local package deps <- getDependencies("MyLocalPackage", available=FALSE) download.packages(deps, destdir="./R_Packages") } } \keyword{utilities} gtools/man/combinations.Rd0000644000176200001440000000406313120310704015302 0ustar liggesusers% $Id: combinations.Rd 2169 2017-06-14 19:42:59Z warnes $ % \name{combinations} \alias{combinations} \alias{permutations} \title{Enumerate the Combinations or Permutations of the Elements of a Vector} \description{ \code{combinations} enumerates the possible combinations of a specified size from the elements of a vector. \code{permutations} enumerates the possible permutations. } \usage{ combinations(n, r, v=1:n, set=TRUE, repeats.allowed=FALSE) permutations(n, r, v=1:n, set=TRUE, repeats.allowed=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{n}{ Size of the source vector } \item{r}{ Size of the target vectors } \item{v}{ Source vector. Defaults to \code{1:n}} \item{set}{ Logical flag indicating whether duplicates should be removed from the source vector \code{v}. Defaults to \code{TRUE}.} \item{repeats.allowed}{ Logical flag indicating whether the constructed vectors may include duplicated values. Defaults to \code{FALSE}. } } \details{ Caution: The number of combinations and permutations increases rapidly with \code{n} and \code{r}!. To use values of \code{n} above about 45, you will need to increase R's recursion limit. See the \code{expression} argument to the \code{options} command for details on how to do this. } \value{ Returns a matrix where each row contains a vector of length \code{r}. } \references{Venables, Bill. "Programmers Note", R-News, Vol 1/1, Jan. 2001. \url{https://cran.r-project.org/doc/Rnews/} } \author{ Original versions by Bill Venables \email{Bill.Venables@cmis.csiro.au}. Extended to handle \code{repeats.allowed} by Gregory R. Warnes \email{greg@warnes.net}. } \seealso{ \code{\link[base]{choose}}, \code{\link[base]{options}} } \examples{ combinations(3,2,letters[1:3]) combinations(3,2,letters[1:3],repeats=TRUE) permutations(3,2,letters[1:3]) permutations(3,2,letters[1:3],repeats=TRUE) # To use large 'n', you need to change the default recusion limit options(expressions=1e5) cmat <- combinations(300,2) dim(cmat) # 44850 by 2 } \keyword{ manip } gtools/man/unByteCode.Rd0000644000176200001440000000447613003720437014676 0ustar liggesusers\name{unByteCode} \alias{unByteCode} \alias{unByteCodeAssign} \alias{assignEdgewise} \title{ Convert a Byte-Code Function to an Interpreted-Code Function } \description{ Convert a byte-code function to an interpreted-code function } \usage{ unByteCode(fun) assignEdgewise(name, env, value) unByteCodeAssign(fun) } \arguments{ \item{fun}{function to be modified} \item{name}{object name} \item{env}{namespace} \item{value}{new function body} } \details{ The purpose of these functions is to allow a byte coded function to be converted back into a fully interpreted function as a \emph{temporary} work around for issues in byte-code interpretation. \code{unByteCode} returns a copy of the function that is directly interpreted from text rather than from byte-code. \code{assignEdgewise} makes an assignment into a locked environemnt. \code{unByteCodeAssign} changes the specified function \emph{in its source environment} to be directly interpreted from text rather than from byte-code. } \value{ All three functions return a copy of the modified function or assigned value. } \references{ These functions were inspired as a work-around to R bug \url{https://bugs.r-project.org/bugzilla/show_bug.cgi?id=15215}. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \note{ These functions are not intended as a permanent solution to issues with byte-code compilation or interpretation. Any such issues should be promtply reported to the R maintainers via the R Bug Tracking System at \url{https://bugs.r-project.org} and via the R-devel mailing list \url{https://stat.ethz.ch/mailman/listinfo/r-devel}. } \seealso{ \code{\link[compiler]{disassemble}}, \code{\link{assign}} } \examples{ data(badDend) dist2 <- function(x) as.dist(1-cor(t(x), method="pearson")) hclust1 <- function(x) hclust(x, method = "single") distance <- dist2(badDend) cluster <- hclust1(distance) dend <- as.dendrogram(cluster) \dontrun{ ## In R 2.3.0 and earlier crashes with a node stack overflow error plot(dend) ## Error in xy.coords(x, y, recycle = TRUE) : node stack overflow } ## convert stats:::plotNode from byte-code to interpreted-code unByteCodeAssign(stats:::plotNode) # increase recursion limit options("expressions"=5e4) # now the function does not crash plot(dend) } \keyword{programming} \keyword{utilites} gtools/man/smartbind.Rd0000644000176200001440000000512313003720437014606 0ustar liggesusers\name{smartbind} \alias{smartbind} \title{Efficient rbind of data frames, even if the column names don't match} \description{ Efficient rbind of data frames, even if the column names don't match } \usage{ smartbind(..., list, fill=NA, sep=':', verbose=FALSE) } \arguments{ \item{\dots}{Data frames to combine} \item{list}{List containing data frames to combine} \item{fill}{Value to use when 'filling' missing columns. Defaults to \code{NA}. } \item{sep}{Character string used to separate column names when pasting them together.} \item{verbose}{Logical flag indicating whether to display processing messages. Defaults to \code{FALSE}.} } \value{ The returned data frame will contain: \item{columns}{all columns present in any provided data frame} \item{rows}{a set of rows from each provided data frame, with values in columns not present in the given data frame filled with missing (\code{NA}) values.} The data type of columns will be preserved, as long as all data frames with a given column name agree on the data type of that column. If the data frames disagree, the column will be converted into a character strings. The user will need to coerce such character columns into an appropriate type. } \author{Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link{rbind}}, \code{\link{cbind}} } \examples{ df1 <- data.frame(A=1:10, B=LETTERS[1:10], C=rnorm(10) ) df2 <- data.frame(A=11:20, D=rnorm(10), E=letters[1:10] ) # rbind would fail \dontrun{ rbind(df1, df2) # Error in match.names(clabs, names(xi)) : names do not match previous # names: # D, E } # but smartbind combines them, appropriately creating NA entries smartbind(df1, df2) # specify fill=0 to put 0 into the missing row entries smartbind(df1, df2, fill=0) \dontshow{ n=10 # number of data frames to create s=10 # number of rows in each data frame # create a bunch of column names names <- LETTERS[2:5] # create a list 'Z' containing 'n' data frames, each with 3 columns # and 's' rows. The first column is always named 'A', but the other # two have a names randomly selected from 'names' Z <- list() for(i in 1:n) { X <- data.frame(A=sample(letters,s,replace=TRUE), B=letters[1:s], C=rnorm(s) ) colnames(X) <- c("A",sample(names,2,replace=FALSE)) Z[[i]] <- X } # Error in match.names(clabs, names(xi)) : names do not match # previous names: E # But smartbind will 'do the right thing' df <- do.call("smartbind",Z) df # Equivalent call: df <- smartbind(list=Z) } } \keyword{manip} gtools/man/asc.Rd0000644000176200001440000000372113003720437013373 0ustar liggesusers\name{asc} \alias{asc} \alias{chr} \title{Convert between characters and ASCII codes} \description{ \code{asc} returns the ASCII codes for the specified characters. \code{chr} returns the characters corresponding to the specified ASCII codes. } \usage{ asc(char, simplify=TRUE) chr(ascii) } \arguments{ \item{char}{vector of character strings} \item{simplify}{logical indicating whether to attempt to convert the result into a vector or matrix object. See \code{\link[base]{sapply}} for details. } \item{ascii}{vector or list of vectors containing integer ASCII codes} } \value{ \code{asc} returns the integer ASCII values for each character in the elements of \code{char}. If \code{simplify=FALSE} the result will be a list contining one vector per element of \code{char}. If \code{simplify=TRUE}, the code will attempt to convert the result into a vector or matrix. \code{asc} returns the characters corresponding to the provided ASCII values. } \author{ Adapted by Gregory R. Warnes \email{greg@warnes.net} from code posted on the 'Data Debrief' blog on 2011-03-09 at \url{http://datadebrief.blogspot.com/2011/03/ascii-code-table-in-r.html}. } \seealso{ \code{\link[base]{strtoi}}, \code{\link[base]{charToRaw}}, \code{\link[base]{rawToChar}}, \code{\link[base]{as.raw}} } \examples{ ## ascii codes for lowercase letters asc(letters) ## uppercase letters from ascii codes chr(65:90) ## works on muti-character strings ( tmp <- asc('hello!') ) chr(tmp) ## Use 'simplify=FALSE' to return the result as a list ( tmp <- asc('hello!', simplify=FALSE) ) chr(tmp) ## When simplify=FALSE the results can be... asc( c('a', 'e', 'i', 'o', 'u', 'y' ) ) # a vector asc( c('ae', 'io', 'uy' ) ) # or a matrix ## When simplify=TRUE the results are always a list... asc( c('a', 'e', 'i', 'o', 'u', 'y' ), simplify=FALSE ) asc( c('ae', 'io', 'uy' ), simplify=FALSE) } \keyword{character} \keyword{programming} gtools/man/gtools-defunct.Rd0000644000176200001440000000150213003720437015555 0ustar liggesusers\name{gtools-defunct} \alias{gtools-defunct} \alias{assert} \alias{addLast} \alias{capture} \alias{sprint} \title{Defunct Functions in package \code{gtools}} \description{ The functions or variables listed here are no longer part of package \code{gtools}. } \details{ \itemize{ \item{ \code{assert} is a defunct synonym for \code{\link[base]{stopifnot}}. } \item{ \code{addLast} has been replaced by \code{lastAdd}, which has the same purpose but appled using different syntax. } \item{ \code{capture} and \code{capture.output} have been removed in favor of \code{capture.output} from the \code{utils} package.} } } \seealso{ \code{\link[base]{Defunct}}, \code{\link[base]{stopifnot}}, \code{\link[gtools]{lastAdd}}, \code{\link[utils]{capture.output}} } \keyword{misc} gtools/man/dirichlet.Rd0000644000176200001440000000273113003720437014574 0ustar liggesusers% $Id: dirichlet.Rd 1918 2015-04-06 22:09:54Z warnes $ % \name{rdirichlet} \alias{rdirichlet} \alias{ddirichlet} \title{Functions for the Dirichlet Distribution} \description{ Functions to compute the density of or generate random deviates from the Dirichlet distribution. } \usage{ rdirichlet(n, alpha) ddirichlet(x, alpha) } \arguments{ \item{x}{A vector containing a single random deviate or matrix containg one random deviate per row.} \item{n}{Number of random vectors to generate. } \item{alpha}{Vector or (for \code{ddirichlet}) matrix containing shape parameters. } } \details{ The Dirichlet distribution is the multidimensional generalization of the beta distribution. It is the canonical Bayesian distribution for the parameter estimates of a multinomial distribution. } \value{ \code{ddirichlet} returns a vector containing the Dirichlet density for the corresponding rows of \code{x}. \code{rdirichlet} returns a matrix with \code{n} rows, each containing a single Dirichlet random deviate. } \author{ Code original posted by Ben Bolker to R-News on Fri Dec 15 2000. See \url{https://stat.ethz.ch/pipermail/r-help/2000-December/009561.html}. Ben attributed the code to Ian Wilson \email{i.wilson@maths.abdn.ac.uk}. Subsequent modifications by Gregory R. Warnes \email{greg@warnes.net}. } \seealso{ \code{\link{dbeta}}, \code{\link{rbeta}} } \examples{ x <- rdirichlet(20, c(1,1,1) ) ddirichlet(x, c(1,1,1) ) } \keyword{distribution} gtools/man/stars.pval.Rd0000644000176200001440000000162613003720437014724 0ustar liggesusers\name{stars.pval} \alias{stars.pval} \title{ Generate significance stars from p-values } \description{ Generate significance stars (e.g. '***', '**', '*', '+') from p-values using R's standard definitions. } \usage{ stars.pval(p.value) } \arguments{ \item{p.value}{numeric vector of p-values} } \details{ Mapping from p-value ranges to symbols: \describe{ \item{0 - 0.001}{'***'} \item{0.001 - 0.01}{'**'} \item{0.01 - 0.05}{'*'} \item{0.05 - 0.1}{'+'} \item{0.1 - 1.0}{'' (No symbol)} } } \value{ A character vector containing the same number of elements as \code{p-value}, with an attribute "legend" providing the conversion pattern. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[stats]{symnum}} } \examples{ p.val <- c(0.0004, 0.0015, 0.013, 0.044, 0.067, 0.24) stars.pval(p.val) } \keyword{misc} gtools/man/logit.Rd0000644000176200001440000000234613003720437013745 0ustar liggesusers% $Id: logit.Rd 1695 2013-07-05 23:33:15Z warnes $ % \name{logit} \alias{logit} \alias{inv.logit} \title{Generalized logit and inverse logit function} \description{ Compute generalized logit and generalized inverse logit functions. } \usage{ logit(x, min = 0, max = 1) inv.logit(x, min = 0, max = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{value(s) to be transformed} \item{min}{Lower end of logit interval} \item{max}{Upper end of logit interval} } \details{ The generalized logit function takes values on [min, max] and transforms them to span [-Inf,Inf] it is defined as: \deqn{y = log(\frac{p}{(1-p)})}{y = log(p/(1-p))} where \deqn{p=\frac{(x-min)}{(max-min)}}{p=(x-min)/(max-min)} The generized inverse logit function provides the inverse transformation: \deqn{x = p' (max-min) + min}{x = p * (max-min) + min} where \deqn{p'=\frac{exp(y)}{(1+exp(y))}}{exp(y)/(1+exp(y))} } \value{ Transformed value(s). } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[car]{logit}} } \examples{ x <- seq(0,10, by=0.25) xt <- logit(x, min=0, max=10) cbind(x,xt) y <- inv.logit(xt, min=0, max=10) cbind(x,xt,y) } \keyword{math} gtools/man/permute.Rd0000644000176200001440000000105013003720437014277 0ustar liggesusers% $Id: permute.Rd 1433 2010-05-01 22:03:03Z warnes $ % \name{permute} \alias{permute} \title{Randomly Permute the Elements of a Vector} \description{ Randomly Permute the elements of a vector } \usage{ permute(x) } \arguments{ \item{x}{ Vector of items to be permuted } } \details{ This is simply a wrapper function for \code{\link{sample}}. } \value{ Vector with the original items reordered. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link{sample}} } \examples{ x <- 1:10 permute(x) } \keyword{distribution} gtools/man/scat.Rd0000644000176200001440000000137013003720437013555 0ustar liggesusers% $Id: scat.Rd 1433 2010-05-01 22:03:03Z warnes $ \name{scat} \alias{scat} %- Also NEED an '\alias' for EACH other topic documented here. \title{Display debugging text} \description{ If \code{getOption('DEBUG')==TRUE}, write text to STDOUT and flush so that the text is immediatly displayed. Otherwise, do nothing. } \usage{ scat(...) } \arguments{ \item{\dots}{Arguments passed to \code{cat}} } \value{ NULL (invisibly) } \author{Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link[base]{cat}}} \examples{ options(DEBUG=NULL) # makee sure DEBUG isn't set scat("Not displayed") options(DEBUG=TRUE) scat("This will be displayed immediately (even in R BATCH output \n") scat("files), provided options()$DEBUG is TRUE.") } \keyword{print} gtools/man/mixedsort.Rd0000644000176200001440000001104413003720437014640 0ustar liggesusers\name{mixedsort} \alias{mixedsort} \alias{mixedorder} \title{Order or Sort strings with embedded numbers so that the numbers are in the correct order} \description{ These functions sort or order character strings containing embedded numbers so that the numbers are numerically sorted rather than sorted by character value. I.e. "Asprin 50mg" will come before "Asprin 100mg". In addition, case of character strings is ignored so that "a", will come before "B" and "C". } \usage{ mixedsort(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE, numeric.type=c("decimal", "roman"), roman.case=c("upper","lower","both") ) mixedorder(x, decreasing=FALSE, na.last=TRUE, blank.last=FALSE, numeric.type=c("decimal", "roman"), roman.case=c("upper","lower","both") ) } \arguments{ \item{x}{Vector to be sorted.} \item{decreasing}{logical. Should the sort be increasing or decreasing? Note that \code{descending=TRUE} reverses the meanings of \code{na.last} and \code{blanks.last}.} \item{na.last}{for controlling the treatment of \code{NA} values. If \code{TRUE}, missing values in the data are put last; if \code{FALSE}, they are put first; if \code{NA}, they are removed.} \item{blank.last}{for controlling the treatment of blank values. If \code{TRUE}, blank values in the data are put last; if \code{FALSE}, they are put first; if \code{NA}, they are removed.} \item{numeric.type}{either "decimal" (default) or "roman". Are numeric values represented as decimal numbers (\code{numeric.type="decimal"}) or as Roman numerals (\code{numeric.type="roman"})? } \item{roman.case}{one of "upper", "lower", or "both". Are roman numerals represented using only capital letters ('IX') or lower-case letters ('ix') or both?} } \details{ I often have character vectors (e.g. factor labels), such as compound and dose, that contain both text and numeric data. This function is useful for sorting these character vectors into a logical order. It does so by splitting each character vector into a sequence of character and numeric sections, and then sorting along these sections, with numbers being sorted by numeric value (e.g. "50" comes before "100"), followed by characters strings sorted by character value (e.g. "A" comes before "B") \emph{ignoring case} (e.g. 'A' has the same sort order as 'a'). By default, sort order is ascending, empty strings are sorted to the front, and \code{NA} values to the end. Setting \code{descending=TRUE} changes the sort order to descending and reverses the meanings of \code{na.last} and \code{blank.last}. Parsing looks for decimal numbers unless \code{numeric.type="roman"}, in which parsing looks for roman numerals, with character case specified by \code{roman.case}. } \value{ \code{mixedorder} returns a vector giving the sort order of the input elements. \code{mixedsort} returns the sorted vector. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[base]{sort}}, \code{\link[base]{order}} } \examples{ ## compound & dose labels Treatment <- c("Control", "Asprin 10mg/day", "Asprin 50mg/day", "Asprin 100mg/day", "Acetomycin 100mg/day", "Acetomycin 1000mg/day") ## ordinary sort puts the dosages in the wrong order sort(Treatment) ## but mixedsort does the 'right' thing mixedsort(Treatment) ## Here is a more complex example x <- rev(c("AA 0.50 ml", "AA 1.5 ml", "AA 500 ml", "AA 1500 ml", "EXP 1", "AA 1e3 ml", "A A A", "1 2 3 A", "NA", NA, "1e2", "", "-", "1A", "1 A", "100", "100A", "Inf")) mixedorder(x) mixedsort(x) # Notice that plain numbers, including 'Inf' show up # before strings, NAs at the end, and blanks at the # beginning . mixedsort(x, na.last=TRUE) # default mixedsort(x, na.last=FALSE) # push NAs to the front mixedsort(x, blank.last=FALSE) # default mixedsort(x, blank.last=TRUE) # push blanks to the end mixedsort(x, decreasing=FALSE) # default mixedsort(x, decreasing=TRUE) # reverse sort order ## Roman numerals chapters <- c("V. Non Sequiturs", "II. More Nonsense", "I. Nonsense", "IV. Nonesensical Citations", "III. Utter Nonsense") mixedsort(chapters, numeric.type="roman" ) ## Lower-case Roman numerals vals <- c("xix", "xii", "mcv", "iii", "iv", "dcclxxii", "cdxcii", "dcxcviii", "dcvi", "cci") (ordered <- mixedsort(vals, numeric.type="roman", roman.case="lower")) roman2int(ordered) } \keyword{univar} \keyword{manip} \concept{natural sort} \concept{dictionary sort} gtools/man/badDend.Rd0000644000176200001440000000122413003720437014142 0ustar liggesusers\name{badDend} \alias{badDend} \docType{data} \title{Dataset That Crashes Base:::Plot.Dendogram with 'Node Stack Overflow'} \description{ Base:::Plot.Dendogram() will generate a 'Node Stack Overflow' when run on a dendrogram appropriately constructed from this data set. } \usage{data("badDend")} \format{ The format is: num [1:2047, 1:12] 1 2 3 4 5 6 7 8 9 10 ... - attr(*, "dimnames")=List of 2 ..$ : NULL ..$ : chr [1:12] "X" "V1" "V2" "V3" ... } \note{ See help page for \code{\link{unByteCode}} to see how to construct the 'bad' dentrogram from this data and how to work around the issue. } \examples{ data(badDend) } \keyword{datasets} gtools/man/loadedPackages.Rd0000644000176200001440000000203013003720437015504 0ustar liggesusers\name{loadedPackages} \alias{loadedPackages} \title{ Provide Name, Version, and Path of Loaded Package Namespaces } \description{ Provide name, version, and path of loaded package namespaces } \usage{ loadedPackages(silent = FALSE) } \arguments{ \item{silent}{Logical indicating whether the results should be printed} } \value{ Invisibly returns a data frame containing one row per loaded package namespace, with columns: \item{Package}{Package name} \item{Version}{Version string} \item{Path}{Path to package files} \item{SearchPath}{Either the index of the package namespace in the current search path, or '-' if the package namespace is not in the search path. '1' corresponds to the top of the search path (the first namespace searched for values). } } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[base]{loadedNamespaces}}, \code{\link[utils]{packageVersion}}, \code{\link[base]{search}}, \code{\link[base]{find.package}} } \examples{ loadedPackages() } \keyword{package} gtools/man/split_path.Rd0000644000176200001440000000112013312232620014756 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/split_path.R \name{split_path} \alias{split_path} \title{Split a File Path into Components} \usage{ split_path(x, depth_first = TRUE) } \arguments{ \item{x}{character scalar. Path to be processed.} \item{depth_first}{logical. Should path be returned depth first? Defaults to \code{TRUE}.} } \value{ Character vector of path components, depth first. } \description{ This function converts a character scalar containing a \emph{valid} file path into a character vector of path components (e.g. directories). } gtools/man/binsearch.Rd0000644000176200001440000001001713003720437014557 0ustar liggesusers% $Id: binsearch.Rd 1087 2006-11-11 04:09:59Z warnes $ \name{binsearch} \alias{binsearch} \title{Binary Search} \description{ Search within a specified range to locate an integer parameter which results in the the specified monotonic function obtaining a given value. } \usage{ binsearch(fun, range, ..., target = 0, lower = ceiling(min(range)), upper = floor(max(range)), maxiter = 100, showiter = FALSE) } \arguments{ \item{fun}{Monotonic function over which the search will be performed.} \item{range}{2-element vector giving the range for the search.} \item{\dots}{Additional parameters to the function \code{fun}.} \item{target}{Target value for \code{fun}. Defaults to 0.} \item{lower}{Lower limit of search range. Defaults to \code{min(range)}.} \item{upper}{Upper limit of search range. Defaults to \code{max(range)}.} \item{maxiter}{ Maximum number of search iterations. Defaults to 100.} \item{showiter}{ Boolean flag indicating whether the algorithm state should be printed at each iteration. Defaults to FALSE.} } \details{ This function implements an extension to the standard binary search algorithm for searching a sorted list. The algorithm has been extended to cope with cases where an exact match is not possible, to detect whether that the function may be monotonic increasing or decreasing and act appropriately, and to detect when the target value is outside the specified range. The algorithm initializes two variable \code{lo} and \code{high} to the extremes values of \code{range}. It then generates a new value \code{center} halfway between \code{lo} and \code{hi}. If the value of \code{fun} at \code{center} exceeds \code{target}, it becomes the new value for \code{lo}, otherwise it becomes the new value for \code{hi}. This process is iterated until \code{lo} and \code{hi} are adjacent. If the function at one or the other equals the target, this value is returned, otherwise \code{lo}, \code{hi}, and the function value at both are returned. Note that when the specified target value falls between integers, the \emph{two} closest values are returned. If the specified target falls outside of the specified \code{range}, the closest endpoint of the range will be returned, and an warning message will be generated. If the maximum number if iterations was reached, the endpoints of the current subset of the range under consideration will be returned. } \value{ A list containing: \item{call}{How the function was called.} \item{numiter}{The number of iterations performed} \item{flag }{One of the strings, "Found", "Between Elements", "Maximum number of iterations reached", "Reached lower boundary", or "Reached upper boundary."} \item{where}{One or two values indicating where the search terminated.} \item{value}{Value of the function \code{fun} at the values of \code{where}.} } %\references{ ~put references to the literature/web site here ~ } \author{Gregory R. Warnes \email{greg@warnes.net} } \note{This function often returns two values for \code{where} and \code{value}. Be sure to check the \code{flag} parameter to see what these values mean.} \seealso{ \code{\link{optim}}, \code{\link{optimize}}, \code{\link{uniroot}} } \examples{ ### Toy examples # search for x=10 binsearch( function(x) x-10, range=c(0,20) ) # search for x=10.1 binsearch( function(x) x-10.1, range=c(0,20) ) ### Classical toy example # binary search for the index of 'M' among the sorted letters fun <- function(X) ifelse(LETTERS[X] > 'M', 1, ifelse(LETTERS[X] < 'M', -1, 0 ) ) binsearch( fun, range=1:26 ) # returns $where=13 LETTERS[13] ### Substantive example, from genetics \dontrun{ library(genetics) # Determine the necessary sample size to detect all alleles with # frequency 0.07 or greater with probability 0.95. power.fun <- function(N) 1 - gregorius(N=N, freq=0.07)$missprob binsearch( power.fun, range=c(0,100), target=0.95 ) # equivalent to gregorius( freq=0.07, missprob=0.05) } } \keyword{optimize} \keyword{programming} gtools/man/capwords.Rd0000644000176200001440000000474013117621755014462 0ustar liggesusers\name{capwords} \alias{capwords} \title{ Capitalize Words for Titles } \description{ This function capitalizes words for use in titles } \usage{ capwords(s, strict=FALSE, AP=TRUE, onlyfirst=FALSE, preserveMixed=FALSE, sep=" ") } \arguments{ \item{s}{character string to be processed} \item{strict}{Logical, remove all additional capitalization.} \item{AP}{Logical, apply the Associated Press (AP) rules for prepositions and conjunctions that should not be capitalized in titles.} \item{onlyfirst}{Logical, only capitalize the first word.} \item{preserveMixed}{Logical, preserve the capitalization mixed-case words containing an upper-case letter after a lower-case letter.} \item{sep}{Character string, word separator} } \details{ This function separates the provided character string into separate words using \code{sep} as the word separator. If \code{firstonly==TRUE}, it then capitalizes the first letter the first word, otherwise (the default), it capitalizes the first letter of every word. If \code{AP==TRUE}, it then un-capitalizes words in the Associated Press's (AP) list of prepositions and conjunctions should not be capitalized in titles. Next, it capitalizes the first word. It then re-joins the words using the specified separator. If \code{preserveMixed==TRUE}, words with an upper-case letter appearing after a lower-case letter will not be changed (e.g. "iDevice"). } \value{ A character scalar containing the capitalized words. } \references{ Fogarty, Mignon. Capitalizing Titles: "Which words should you capitalize? Grammar Girl's Quick and Dirty Tips for Better Writing. 9 Jun. 2011. Quick and Dirty Tips Website." Accessed 22 April 2016 \url{http://www.quickanddirtytips.com/education/grammar/capitalizing-titles} } \author{ Gregory R. Warnes \email{greg@warnes.net} based on code from the \code{\link[base]{chartr}} manual page, and \code{\link[taxize]{taxize_capwords}} in the taxize package. } \seealso{ \code{\link[base]{chartr}}, \code{\link[taxize]{taxize_capwords}}, \code{\link[SGP]{capwords}} } \examples{ capwords("a function to capitalize words in a title") capwords("a function to capitalize words in a title", AP=FALSE) capwords("testing the iProduct for defects") capwords("testing the iProduct for defects", strict=TRUE) capwords("testing the iProduct for defects", onlyfirst=TRUE) capwords("testing the iProduct for defects", preserveMixed=TRUE) capwords("title_using_underscores_as_separators", sep="_") } \keyword{utilites} \keyword{character} gtools/man/oddeven.Rd0000644000176200001440000000066613003720437014256 0ustar liggesusers% $Id: oddeven.Rd 1433 2010-05-01 22:03:03Z warnes $ % \name{odd} \alias{odd} \alias{even} \title{Detect odd/even integers } \description{ detect odd/even integers } \usage{ odd(x) even(x) } \arguments{ \item{x}{ vector of integers } } \value{ Vector of TRUE/FALSE values. } \author{ Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link[base]{round}} } \examples{ odd(4) even(4) odd(1:10) even(1:10) } \keyword{arith} gtools/man/quantcut.Rd0000644000176200001440000000413113003720437014465 0ustar liggesusers% $Id: quantcut.Rd 2025 2015-05-25 14:13:12Z warnes $ % \name{quantcut} \alias{quantcut} \title{ Create a Factor Variable Using the Quantiles of a Continuous Variable} \description{ Create a factor variable using the quantiles of a continous variable. } \usage{ quantcut(x, q=4, na.rm=TRUE, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ Continous variable. } \item{q}{ Either a integer number of equally spaced quantile groups to create, or a vector of quantiles used for creating groups. Defaults to \code{q=4} which is equivalent to \code{q=seq(0, 1, by=0.25)}. See \code{\link{quantile}} for details. } \item{na.rm}{ Boolean indicating whether missing values should be removed when computing quantiles. Defaults to TRUE.} \item{\dots}{ Optional arguments passed to \code{\link{cut}}. } } \details{ This function uses \code{\link{quantile}} to obtain the specified quantiles of \code{x}, then calls \code{\link{cut}} to create a factor variable using the intervals specified by these quantiles. It properly handles cases where more than one quantile obtains the same value, as in the second example below. Note that in this case, there will be fewer generated factor levels than the specified number of quantile intervals. } \value{ Factor variable with one level for each quantile interval. } \author{Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link{cut}}, \code{\link{quantile}} } \examples{ ## create example data \testonly{ set.seed(1234) } x <- rnorm(1000) ## cut into quartiles quartiles <- quantcut( x ) table(quartiles) ## cut into deciles deciles.1 <- quantcut( x, 10 ) table(deciles.1) # or equivalently deciles.2 <- quantcut( x, seq(0,1,by=0.1) ) \testonly{ stopifnot(identical(deciles.1, deciles.2)) } ## show handling of 'tied' quantiles. x <- round(x) # discretize to create ties stem(x) # display the ties deciles <- quantcut( x, 10 ) table(deciles) # note that there are only 5 groups (not 10) # due to duplicates } \keyword{ manip } gtools/man/lastAdd.Rd0000644000176200001440000000364213003720437014203 0ustar liggesusers\name{lastAdd} \alias{lastAdd} \title{Non-destructively construct a .Last function to be executed when R exits.} \description{ Non-destructively construct a \code{.Last} function to be executed when R exits. } \usage{ lastAdd(fun) } \arguments{ \item{fun}{Function to be called.} } \details{ \code{lastAdd} constructs a new function which can be used to replace the exising definition of \code{.Last}, which will be executed when R terminates normally. If a \code{.Last} function already exists in the global environment, the original definition is stored in a private environment, and the new function is defined to call the function \code{fun} and then to call the previous (stored) definition of \code{.Last}. If no \code{.Last} function exists in the global environment, \code{lastAdd} simply returns the function \code{fun}. } \note{ This function replaces the (now defunct) \code{addLast} function. } \value{ A new function to be used for \code{.Last}. } \author{Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link[base]{.Last}} } \examples{ ## Print a couple of cute messages when R exits. helloWorld <- function() cat("\nHello World!\n") byeWorld <- function() cat("\nGoodbye World!\n") .Last <- lastAdd(byeWorld) .Last <- lastAdd(helloWorld) \dontshow{ .Last() } \dontrun{ q("no") ## Should yield: ## ## Save workspace image? [y/n/c]: n ## ## Hello World! ## ## Goodbye World! ## ## Process R finished at Tue Nov 22 10:28:55 2005 } ## Unix-flavour example: send Rplots.ps to printer on exit. myLast <- function() { cat("Now sending PostScript graphics to the printer:\n") system("lpr Rplots.ps") cat("bye bye...\n") } .Last <- lastAdd(myLast) \dontshow{ .Last() } \dontrun{ quit("yes") ## Should yield: ## ## Now sending PostScript graphics to the printer: ## lpr: job 1341 queued ## bye bye... ## ## Process R finished at Tue Nov 22 10:28:55 2005 } } \keyword{programming} gtools/man/foldchange.Rd0000644000176200001440000000305113003720437014713 0ustar liggesusers% $Id: foldchange.Rd 1433 2010-05-01 22:03:03Z warnes $ % \name{foldchange} \alias{foldchange} \alias{logratio2foldchange} \alias{foldchange2logratio} \title{Compute fold-change or convert between log-ratio and fold-change.} \description{ \code{foldchange} computes the fold change for two sets of values. \code{logratio2foldchange} converts values from log-ratios to fold changes. \code{foldchange2logratio} does the reverse. } \usage{ foldchange(num,denom) logratio2foldchange(logratio, base=2) foldchange2logratio(foldchange, base=2) } \arguments{ \item{num,denom}{vector/matrix of numeric values} \item{logratio}{vector/matrix of log-ratio values} \item{foldchange}{vector/matrix of fold-change values} \item{base}{Exponential base for the log-ratio.} } \details{ Fold changes are commonly used in the biological sciences as a mechanism for comparing the relative size of two measurements. They are computed as: \eqn{\frac{num}{denom}}{num/denom} if \eqn{num>denom}, and as \eqn{\frac{-denom}{num}}{-denom/num} otherwise. Fold-changes have the advantage of ease of interpretation and symmetry about \eqn{num=denom}, but suffer from a discontinuty between -1 and 1, which can cause significant problems when performing data analysis. Consequently statisticians prefer to use log-ratios. } \value{ A vector or matrix of the same dimensions as the input containing the converted values. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \examples{ a <- 1:21 b <- 21:1 f <- foldchange(a,b) cbind(a,b,f) } \keyword{math} gtools/man/invalid.Rd0000644000176200001440000000154113003720437014251 0ustar liggesusers% $Id: invalid.Rd 1433 2010-05-01 22:03:03Z warnes $ % \name{invalid} \alias{invalid} \title{Test if a value is missing, empty, or contains only NA or NULL values} \description{ Test if a value is missing, empty, or contains only NA or NULL values. } \usage{ invalid(x) } \arguments{ \item{x}{value to be tested} } %\details{ %} \value{ Logical value. } \author{Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[base]{missing}}, \code{\link[base]{is.na}}, \code{\link[base]{is.null}} } \examples{ invalid(NA) invalid() invalid(c(NA,NA,NULL,NA)) invalid(list(a=1,b=NULL)) # example use in a function myplot <- function(x,y) { if(invalid(y)) { y <- x x <- 1:length(y) } plot(x,y) } myplot(1:10) myplot(1:10,NA) } \keyword{programming} gtools/man/na.replace.Rd0000644000176200001440000000162613003720437014637 0ustar liggesusers\name{na.replace} \alias{na.replace} \title{ Replace Missing Values } \description{ Replace missing values } \usage{ na.replace(x, replace, ...) } \arguments{ \item{x}{vector possibly contining missing (\code{NA}) values} \item{replace}{either a scalar replacement value, or a function returning a scalar value} \item{...}{Optional arguments to be passed to \code{replace}} } \details{ This is a convenience function that is the same as x[is.na(x)] <- replace } \value{ Vector with missing values (\code{NA}) replaced by the value of \code{replace}. } \author{ Gregory R. Warnes \email{greg@warnes.net} } \seealso{ \code{\link[base]{is.na}}, \code{\link[stats]{na.omit}} } \examples{ x <- c(1,2,3,NA,6,7,8,NA,NA) # Replace with a specified value na.replace(x, '999') # Replace with the calculated median na.replace(x, median, na.rm=TRUE) } \keyword{ manip } gtools/man/checkRVersion.Rd0000644000176200001440000000251313003720437015370 0ustar liggesusers\name{checkRVersion} \alias{checkRVersion} \title{Check if a newer version of R is available} \description{ Check if a newer version of R is available } \usage{ checkRVersion(quiet = FALSE) } \arguments{ \item{quiet}{Logical indicating whether printed output should be supressed.} } \details{ This function accesses the R web site to discover the latest released version of R. It then compares this version to the running version. If the running version is the same as the latest version, it prints the message, "The latest version of R is installed:" followed by the version number, and returns NULL. If the running version is older than the current version, it displays the message, "A newer version of R is now available:" followed by the corresponding version number, and returns the version number. If \code{quiet=TRUE}, no printing is performed. } \value{ Either the version number of the latest version of R, if the running version is less than the latest version, or NULL. } \author{Gregory R. Warnes \email{gregory.warnes@rochester.edu>}} \note{ This function utilizes the internet to access the R project web site. If internet access is unavailable, the function will fail. } \seealso{ \code{\link[base]{R.Version}} } \examples{ checkRVersion() ver <- checkRVersion() print(ver) } \keyword{utilities} gtools/man/ELISA.Rd0000644000176200001440000000160013003720437013454 0ustar liggesusers% $Id: ELISA.Rd 1012 2006-11-14 22:25:06Z ggorjan $ % \name{ELISA} \docType{data} \alias{ELISA} \title{Data from an ELISA assay} \description{Observed signals and (for some observations) nominal concentrations for samples that were aliquoted to multiple assay plates, which were read multiple times on multiple days. } \usage{ data(ELISA) } \format{a data frame with the following columns: \itemize{ \item{PlateDay}{factor. Specifies one of four physically disctinct 96 well plates} \item{Read}{factor. The signal was read 3 times for each plate.} \item{Description}{character. Indicates contents of sample.} \item{Concentration}{numeric. Nominal concentration of standards (NA for all other samples).} \item{Signal}{numeric. Assay signal. Specifically, optical density (a colorimetric assay).} } } \source{Anonymized data. } \keyword{datasets} gtools/man/keywords.Rd0000644000176200001440000000121513003720437014470 0ustar liggesusers\name{keywords} \alias{keywords} \title{List valid keywords for R man pages} \description{ List valid keywords for R man pages } \usage{ keywords(topic) } \arguments{ \item{topic}{object or man page topic} } \details{ If \code{topic} is provided, return a list of the keywords associated with \code{topic}. Otherwise, display the list of valid R keywords from the R doc/KEYWORDS file. } \author{Gregory R. Warnes \email{greg@warnes.net}} \seealso{ \code{\link[utils]{help}} } \examples{ ## Show all valid R keywords keywords() ## Show keywords associated with the 'merge' function keywords(merge) keywords("merge") } \keyword{documentation}