hash/0000755000175100001440000000000013437200711011211 5ustar hornikusershash/TODO0000644000175100001440000001670712111276670011721 0ustar hornikusers TODO: - copy functions - automatic coercion for hash[ x , ... ] where x is a 'name' - invert not working correctly - ha2 <- ha[] : should produce copy and not a reference? - Is there a happly function that is like lapply that either passes keys and values to the functions happly( h, function(k,v,...) ), will it return a hash object? - Increase perfomance of `[` and `hash` methods - Be able to create a loop that assigns both key and value, e.g.: for( k,v in ha ) ... - (LOW PRIORITY) default MISSING behavior should be customizable at the hash instance level. Requires a slot: @na.action that can be a function or value. This default should exist between the global default and the call level. This is low priority since missing customization only applies to hash slices now. - Default of missing key should be NULL. - option to fail on missing key? - customizable missing - Should the default value of non-existant keys be NA or NULL. - The default of the environemnet is NULL - NA is the norm when data is missing, i.e. from a frame. l:: THUSFAR, we are using NA when there are missing keys. - N.B. When access these objects the missing values are returned: - vectors : NA - list : NULL - data.frames : NULL - since getOption( 'na.action.hash' ) returns NULL if undefined, we can use this as getOption( 'na.action.hash' ) as the na.action only . . . but this sets the value of the Hash to NULL. Setting the value to NULL is equal to deleting the key. h$key <- NULL deletes the key. So we should have no. - NA is retu - Handle any type for a key, especially integers. - Keep track of the type of the key: hash@key.class - Show method should sort on key or use: hash@indexed x make.key already uses as.character - Would require that there be a way to turn that value into a scalar perhaps even through the make.key or make.name functions. ? Do we allow mixing of types ? :: NO - See also IxHash TODO below. - x <- h ; produce x as a reference to h and not a copied object. - IxHash : Indexed Hash. Allow access by integer position? There becomes a problem of keeping track of replacements. - Implement Judy Hash? - Is there a abstract version of the hash where keys can contain muliple values? how would this be implemented as an md5hash of the args? h[[ vector ]] <- values ? h[[ paste( as.character( vector ) ) ]] <- value How can we make each of the keys searchable? i.e. get all where the second key field = 7. Each of the key fields would have to be hashed? - Coersion functions - as.vector, - pairlist, - as.data.frame, x as.environment, x as.list - other coercions : as.environment, not possible without clobbering base h@env anyhow as.data.frame, yes as.vector , yes - Implement clear as initializing of hash rather than rm - R/clear.R bug? :: SHOULD THIS COPY THE HASH? h <- hash( letters, 1:26 ) hh <- h clear(hh) h # EMPTY. Does not work the same with 'rm'. Will this require overloading the assignment operators? - test functions x is.hash : object is a hash is.vector : test values to see if they are expressible as a vector is.list : " - assign <==> set : it is to bad that assign is used instead of get get/set seems better aligned than get/assign. ============================ COMPLETED ================================ x copy method: copy( hash ) x is.empty method? h <- hash() is.empty(h) # TRUE x Move functions to their own file . . . hash.actions x implement max.print. x DEPRECATE $ x DEPRECATE: .get use get and mget instead to create [ and [[ and use these instead X implement length as env.profile(ha)$nchains? No. Not the same result. x mget.hash - is it faster than sapply(x, function(x,hash) hash[[x]], hash )? x test for missing keys for accessor ($, [[, [) x emits NA x $, [[ x [ : what is the behaviour of trying to access a missing key among many missing keys. x GET x consider eliminating .get :: NO x mget : return ... override base::mget :: decided values works better x values : x There is an ambiguity of whether to simplify or not x move @env to @.Data NO- move @.Data to plain object: this should be explicit. x inverted.hash constructor function to directly create an inverted hash x Constructor method should handle hash and environment objects. what does hash( hash() ) give? A ref to the hash. x Get rm working correctly so that a call to clear is not needed before the call: I do not think this is necessary any longer. to rm. See the bookmarked link of how this is managed. Detach? x 'delete' as an alias for del to match Perl dictionary lingo. x Modify arguments to 'hash' to be named ( x, key, value ) ? ( x , value )? (...) and pass the lot to set()? And let set sort it out? - Generics: x set : can this be replaced by [ or [[ x get : " we can probably get rid of get, set but will need to create them as hidden functions in the hash package: hash::get and hash::set x Should x h[[key]] <- NULL x h[, key] <- NULL x h$key <- NULL x erase the items as it does for data.frames? Yes. x items : as.list this is a base function. The methods should closely mirror the base function. x length : needed (keep) x keys : same as names? x values : [] [[]] x del : same as rm -- see items 1 and 2 above x clear : same as new x show : has-key: same as exists summary: create x methods: [[ [ $ keys values( no different from accessors ) x del clear show has.key show x remove : items, set, get x - if we remove set and get as methods ... then we should have them x as functions in the class. x how many accessors do we need? get, values, $, [, [[ . get and values are essensially the same. What about values(h) <- x? or keys(h) <- x should these be viable replacement functions as well? x How do we use set to accomodate setting from data.frame? list? environment? and hashes? append( hash, list or data.frame or env or hash ) to add Then we have to be more explicit ... h[[keys]] <- values etc. x what about x names(h) ? x ls(h) ? Cannot be done. there is a potential problems as both names and ls might imply that there is an order to the hash which there might not be. x Rename slot x to .env. Although a class cannot inherit from 'environment' If we name the environment slot .Data, we cannot set it with the constructor 'new'. Calling new( "hash", .Data = new.env( ... ) result in the following warning ... Error in initialize(value, ...) : initialize method returned an object of class "environment" instead of the required class "foo" The object is then class environment. Other option call the slot 'env' or 'Data' or 'hash' '.Data' cannot be set. So we have: h@hash, x@hash, hash@hash h@env, x@env, hash@env h@data, x@data, hash@data Personally I like env. hash is too generic and confusing. data is too generic hash/tests/0000755000175100001440000000000012102427366012360 5ustar hornikusershash/tests/clear.R0000644000175100001440000000026212111300031013544 0ustar hornikusers library(hash) library( testthat ) h <- hash( letters, 1 ) expect_is( h, "hash" ) expect_that( length(h), equals(26) ) clear(h) expect_that( length(h), equals(0) ) hash/tests/accessors.R0000644000175100001440000000255712111277603014476 0ustar hornikuserslibrary(hash) library(testthat) h0 <- hash() h <- hash( letters, 1:26 ) # OBJECT CREATION / TYPE for( h in list( h0, h) ) expect_is( h, "hash" ) # EMPTY HASH expect_that( length(h0), equals(0) ) expect_that( length(h0), equals(0) ) # POPULATED HASH expect_that( length(h), equals(26) ) expect_that( keys(h), is_identical_to(letters) ) # ALL HASHES for( h in list( h0, h) ) { expect_that( h[['missing']], is_identical_to(NULL) , label="Attempt to retrieve missing key" ) } # TEST [[ for( h in list( h0, h ) ) { expect_error( h[[NULL]] ) expect_error( h[[NA] ]) expect_error( h[[]] ) expect_error( h[[letters]] ) } for( n in 1:26 ) expect_that( h[[ letters[n] ]], equals(n) ) # TEST $ expect_that( h$a, equals(1) ) expect_that( h$z, equals(26) ) # TEST [ for( h in list( h0, h ) ) { expect_error( h[[NULL]] ) expect_error( h[[NA] ]) expect_error( h[[]] ) expect_error( h[[letters]] ) } expect_that( h[ letters ], equals(h) ) # TEST [[ <- h[['a']] <- -1 expect_that( h[['a']], equals(-1) ) # TEST $<- h$b <- -2 expect_that( h$b, equals(-2) ) # TEST [ <- hash/tests/has.key.R0000644000175100001440000000015412102427366014045 0ustar hornikusers library( hash ) #' Ensure that there are no keys on hash h <- hash() all( has.key( 'c' , h ) == FALSE ) hash/tests/set.R0000644000175100001440000000076512102304353013274 0ustar hornikusers # TEST FILE FOR hash METHODS set library(hash) h <- hash() # SET: key-value pairs .set( h, "a", 1:2 ) .set( h, letters, 1:26 ) .set( h, 1:5, 1:5 ) .set( h, letters, 12 ) # SET: key-hash pair added in version 1.0.4 .set( h, "ha", hash( a=1, b=2 ) ) class( h[["ha"]] ) == "hash" # SET: data.frame .set( h, "df", data.frame( a=1:10, b=11:20) ) class( h[["df"]] ) == "data.frame" # SET: list .set( h, "li", list( a=1, b=1:5, c=letters[1:3] ) ) class( h[["li"]] ) == "list" # SET: environment hash/NAMESPACE0000755000175100001440000000023713437176766012463 0ustar hornikusersexportPattern("^[[:alpha:]]+") export( .set ) exportClasses( hash ) importFrom("methods", "is", "new") S3method(as.list, hash) S3method(names, hash) hash/demo/0000755000175100001440000000000012102304353012130 5ustar hornikusershash/demo/00Index0000644000175100001440000000013412102304353013260 0ustar hornikusershash-benchmarks Benchmark for vector, list, env and hash accessors for HPC applications hash/demo/hash-benchmarks.R0000644000175100001440000001714312102304353015317 0ustar hornikusers# BENCHMARK FILE. # - Demo file for comparing hash benchmarks. # cat( "The hash-benchmark compares named access and update speed of R's native " , "vectors, lists, envrionments and hashes from the hash package . . . \n\n" ) library(hash) library(rbenchmark) # STEP 0. CREATE A SAMPLE SET OF KEYS AND VALUES. # size: the sample size # keys: hash's keys # values: hash's values size <- 2^18 # The size of the refernece objects. keys <- as.character( sample(1:size) ) # A vector of values <- as.character( rnorm( size ) ) # Which is faster setting by mapply or doing a for-loop # Intialize parameters and prepare things. # --------------------------------------------------------------------- # BENCHMARK 1: # Speed for assigning values to an environment # The following benchmark compares the speeds of setting key,values # on an environment by using mapply, a for-loop and lapply. # # CONCLUSION: # Use for-loop for setting it is at least 5% faster than the other # methods. # # R-2.9.2: # Using the for-loop is about 15-20% faster than apply and 2-3x faster # than mapply # # R-2.11.0: size 5e4 # results from benchmark() # test replications elapsed relative user.self sys.self user.child sys.child # 2 for_loop 5 7.026 1.000000 7.025 0 0 0 # 3 lapply 5 7.383 1.050811 7.384 0 0 0 # 1 mapply 5 7.750 1.103046 7.753 0 0 0 # # # --------------------------------------------------------------------- cat( "BENCHMARK 1:\n Testing the best method to assign many keys to a new environment\n" ) env.mapply <- new.env( hash = T , parent = emptyenv() ) env.lapply <- new.env( hash = T , parent = emptyenv() ) env.for <- new.env( hash = T , parent = emptyenv() ) h <- hash() benchmark( for_loop = for( i in 1:length(keys) ) assign( keys[[i]], values[[i]], envir = env.for ) , mapply = mapply( assign, keys, values, MoreArgs = list( envir = env.mapply ) ) , lapply = lapply( ( 1:length(keys) ) , FUN = function(i) assign( keys[[i]], values[[i]], envir = env.lapply ) ) , replications = 5 , order = "relative" ) cat( "\n\n" ) # --------------------------------------------------------------------- # BENCHMARK 2: ACCESSING SINGLE VALUES # Compare times for accessing single elements of a list vs vector vs hash # # CONCLUSIONS: # - For number of items, looking up in a list is faster than looking # up in an environment. # # --------------------------------------------------------------------- # Create a list using mapply, n.b much faster than for-loop cat( "BENCHMARK 2: Accessing a sinle value in a large hash structure\n" ) number.of.lookups <- 1e3 bm2 <- data.frame() # LOOP OVER SIX ORDERS OF MAGNITUDES. for( size in 2^(0:13) ) { cat( "\nComparing access time for object of size", size, "\n" ) # CREATE NAMED-LIST: li<-mapply( function(k,v) { li<-list() li[[k]]<-v li } , keys[1:size] , values[1:size] , USE.NAMES=F ) # CREATE NAMED-HASH: ha <- hash( keys[1:size], values[1:size] ) # CREATE A VECTOR ve <- values[1:size] names(ve) <- keys[1:size] # CREATE KEYS TO LOOK UP: ke <- keys[ round(runif(max=size,min=1,n=number.of.lookups )) ] print( res <- benchmark( # `get/env` = for( k in ke ) get( k, ha@.xData ) , # `get/hash` = for( k in ke ) get(k, ha) , #`hash` = for( k in ke ) ha[[k]] , `list` = for( k in ke ) li[[k]] , `vector`= for( k in ke ) ve[[k]] , replications = 10 , order = "relative" ) ) res$size <- size bm2 <- rbind( bm2, res ) } xyplot( elapsed ~ size, groups=test, data=bm2, type="b", pch=16:20, col=rainbow(5), lwd=2, main="Reading from data structures", cex=1.2, cex.title=4, auto.key=list(space = "right", points = FALSE, lines = FALSE, lwd=4, cex=1, col=rainbow(5)) , scales=list( cex=2 ), ylab = "Elapsed Time ( per 1K Reads)" , xlab = "Object Size ( n elements )" ) p <- ggplot(bm2 , aes(x=size, y=elapsed, group=test )) p + geom_line() cat("\n\n") # --------------------------------------------------------------------- # BENCHMARK 3: Slices [ # Take slices of an object. This is equivalent to [[. # We compare # # Notes: # - There is no native slice operation for env # - # # --------------------------------------------------------------------- cat( "BENCHMARK 3: Slices\n" ) slice.pct <- 0.01 n.lookups <- 100 bm3 <- data.frame() for( size in 2^(17:18) ) { slice.size <- floor( size * slice.pct ) + 1 cat( "\nComparing slice time for object of size", size, "with slice pct", slice.pct, "\n" ) # CREATE NAMED-LIST: li<-mapply( function(k,v) { li<-list() li[[k]]<-v li } , keys[1:size] , values[1:size] , USE.NAMES=F ) # CREATE NAMED-HASH: ha <- hash( keys[1:size], values[1:size] ) # CREATE A VECTOR ve <- values[1:size] names(ve) <- keys[1:size] # CREATE KEYS TO LOOK UP: kes <- lapply( 1:n.lookups, function(x) keys[ round(runif(max=size,min=1,n=slice.size )) ] ) # ke <- keys[ round(runif(max=size,min=1,n=slice.size )) ] print( res <- benchmark( `hash` = for( ke in kes ) ha[ ke ] , `list` = for( ke in kes ) li[ ke ] , `vector` = for( ke in kes ) ve[ ke ] , `mget` = for( ke in kes ) mget( ke, ha@.xData ) , replications = 5 , order = "relative" ) ) res$size <- size bm3 <- if( nrow(bm3)==0) res else rbind( bm3, res ) } xyplot( elapsed ~ size, groups=test, data=bm3, type="b", pch=16:20, col=rainbow(5), lwd=2, main="Reading from data structures", cex=1.2, cex.title=4, auto.key=list(space = "right", points = FALSE, lines = FALSE, lwd=4, cex=1, col=rainbow(5)) , scales=list( cex=2 ), ylab = "Elapsed Time ( per 1K Reads)" , xlab = "Object Size ( n elements )" ) cat( "BENCHMARK 3: [[ Single Element ]] <- Writes \n" ) n.writes <- 100 bm4 <- data.frame() for( size in 2^(0:12) ) { # CREATE NAMED-LIST: li<-mapply( function(k,v) { li<-list() li[[k]]<-v li } , keys[1:size] , values[1:size] , USE.NAMES=F ) # CREATE NAMED-HASH: ha <- hash( keys[1:size], values[1:size] ) # CREATE ENV en <- new.env( hash=TRUE ) for( i in 1:size ) assign( keys[[i]], values[[i]], en ) # CREATE A VECTOR ve <- values[1:size] names(ve) <- keys[1:size] # CREATE KEYS TO LOOK UP: kes <- keys[ round(runif(n=n.writes,min=1,max=length(keys) )) ] # ke <- keys[ round(runif(max=size,min=1,n=slice.size )) ] print( res <- benchmark( # `hash` = for( ke in kes ) ha[[ ke ]] <- "a" , # `list` = for( ke in kes ) li[[ ke ]] <- "a" , `vector` = for( ke in kes ) ve[[ ke ]] <- "a" , # `env/assign` = for( ke in kes ) assign( ke, "a" , en ) , replications = 5 , order = "relative" ) ) res$size <- size bm4 <- if( nrow(bm4)==0) res else rbind( bm4, res ) } xyplot( elapsed ~ size, groups=test, data=bm4, type="b", pch=16:20, col=rainbow(5), lwd=2, main="Writing 100 Values to data structure", cex=1.2, cex.title=4, auto.key=list(space = "right", points = FALSE, lines = FALSE, lwd=4, cex=1, col=rainbow(5)) , scales=list( cex=2 ), ylab = "Elapsed Time ( per 100 Writes" , xlab = "Object Size ( n elements )" ) hash/NEWS0000644000175100001440000002237012111300372011704 0ustar hornikusers2013-02-20 Version 2.2.6 Fixes bug with '[' assessor which was broken. Adds some tests. 2013-01-31 Version 2.2.5 Fixes bug with has.key. Because of the default settingg of inherits=TRUE in the exists function, the has.key function was revealing keys for objects found on inherited environments, this included functions such as 'c' and 'q'. Thanks to Michael Pratt for spotting the bug. 2012-04-25 Version 2.2.0 Recaptured orphaned package - R/zzz.R: uses utlis::packageVersion(pkgname, libname) - R/DESCRIPTION: Dependency to R-2.12.0+ 2011-03-17 Version 2.1.0 Changed contact information. 2010-09-26 Version 2.0.2 (cbrown) Just releasing as version 2.0.2. Mostly, documentation and benchmarks added. Unreleased to CRAN. 2010-07-25 - demo/hash-benchmarks.R has been expanded. 2010-06-14 - man/hash-package.Rd - man/hash-class.Rd: Ammended notes section specifically being more clear about the PASS-BY-REFERENCE BEHAVIOR of HASHES 2010-05-26 Version 2.0.1 (cbrown) - At the request of Michael Hahsler, removed the ODG ASCII ART logo in the .OnLoad method. It will comeback as soon as I can figure out how to disable it through the appropriate option. Hi Christopher, thank you for providing the package hash. I am thinking of using it in my rEMM package. Is there a way to make the load message a little less flashy. I include hash in my DESCRIPTION file and the ASCII art comes always up when my package loads. Thanks, Michael -- Dr. Michael Hahsler, Visiting Assistant Professor Department of Computer Science and Engineering Lyle School of Engineering Southern Methodist University, Dallas, Texas 2010-04-24 Version 2.0.0 (cbrown) - The coercion of keys make.keys has largely been deprecated. This might change in future version, but what we really want is to have any object stand for the keys that will get automatically converted. This might be make.key in the future. Also, we removed .get. All the accessor coding now exists in the definition of the native accessors. - R/format : implement max.print to display only getOption('max.print') keys. - R/na.actions : na.*.hash function's have been renamed to hash.na.function. This is so as not to conflict with the base::na.* S3 functions. It is unfortunate, because it would have been nice to retain a name. It was impossible because of the generic form of the functions, na.fail which requires an object as the first argument. Meanwhile, the 'ifnotfound' argument of mget takes one argument. mget is extensively used in this package and the one argument that needs to be passed is the name of the key. The choice was to either re-write the standardGeneric which will cause downstream problems -OR- abandone the na.* names. The latter was chosen with the added benefit that other hash controlled options would be grouped by hash.* in the option vector. - R/Class-hash: - [[, [[<-: DEPRECATED + methods deprecated because new objects can inherit from environments. - $ : DEPRECATED + methods deprecated because new objects can inherit from environments + NB. $<- is still retained so that ha$a <- NULL will remove 'a' from ha. - [: + No longer relise on .set, creates new hash directly - R/hash-benchmark.R + Uses rbenchmark to check various perfomance metrics - DESCRIPTION: + Suggests: rbenchmark (>= 0.3) - R/get-R: .get DEPRECATED for perfomance reasons. - R/values.R: + values() - redefined as function(x, keys=NULL, ... ) - no longer uses .get - R/hash-action.R : DEPRECATED After renaming these, it was decided that these would be DEPRECATED. Sometimes consitency is better than customizabilty. replaces R/na.action with the following funcitons renamed: + hash.na.fail => hash.fail + hash.na.warn => hash.warn + hash.na.default => hash.default 2010-03-15 - Passes Checks on R 2.9.2, 2.10.1. 2.11.0 (devel) - Warning on CHECK: Defining type "environment" as a superclass via class ".environment" Some R data types do not behave normally, in the sense that they are non-local references or other objects that are not duplicated. Examples include those corresponding to classes "environment", "externalptr", and "name". These can not be the types for objects with user-defined classes (either S4 or S3) because setting an attribute overwrites the object in all contexts. It is possible to define a class that inherits from such types, through an indirect mechanism that stores the inherited object in a reserved slot. The implementation tries to make such classes behave as if the object had a data part of the corresponding object type. Methods defined with the object type in the signature should work as should core code that coerces an object to the type in an internal or primitive calculation. There is no guarantee, however, because C-level code may switch directly on the object type, which in this case will be "S4". The cautious mechanism is to use as(x, "environment") or something similar before doing the low-level computation. See the example for class "stampedEnv" below. - R/Class-hash.R: Added if( getRversion ) to accomodate older and newer versions of R. - man/hash-accessors.Rd: added alias for $-hash,NULL-method. 2010-02-16 Version 1.99.3 (cbrown) - Fixed several typos - R/Class-hash.R + [[ now allows for na.action and works correctly + $ now calls [[ rather than get 2010-02-16 Version 1.99.1 (cbrown) - Fixed S4 Documentation Bugs throughtout - R/Class-hash.R : sped up $ and [[ with 'try' was previously using keys which is very slow by comparison. - R/values.R : fixed definition to values<- 2010-02-16 Version 1.99.0 (cbrown) RELEASE CANDIDATE FOR VERSION 2.00 THIS VERSION BREAKS BACKWARD COMPATABILITY WHEN TRYING TO ACCESS A NON-EXISTANT KEY. PACKAGE NOW RETURNS NA BY DEFAULT, BUT BAHAVIOUR IS CONTROLABLE BY Options('na.default.hash') - R/Class-hash.R: fixed $ accessor to remove 'name' - R/get: - Added ability to control the default action when non-existant keys are requested. Thanks Matthias Buch-Kromann. - Deault for non-existant keys is NA. - Added customizable behavior for accessing non-existing keys - man/hash-pacakge.Rd: Added note comparing hash implementation to native environments 2010-02-15 Version 1.10.3 (cbrown) - R/keys.R: added all.names = T to show even hidden names. - R/values.R: + Added keys argument to 'values' and 'values<'- methods. + 'values' Passes ... argument to .get method Thanks Matthias Buch-Kromann. 2010-01-01 Version 1.10.2 (cbrown) - R/Class-hash.R + Added methods signature [-hash,missing,... to return the case when no indexes are provided to the hash slice method. - R/get.R + get.R will not return a simplified version from sapply call. When the hash had values with all the same elements, a matrix was returned and this interferred with the hash slices, [. I am not sure the behavior was even useful. - R/values.R + Added replacement method for values - R/zzz.R + Make it so that the odg.logo is displayed only once per session. 2009-12-09 Version 1.10.1 (cbrown) - R/Class-hash.R + Removed 'name' from signature for methods: $, $<- 2009-11-29 Version 1.10.0 (cbrown) - R/set.R + Fixed problem pointed out by Denise Maudlin from blog.opendatagroup.com key <- 'one' ikey <- 'two' val <- 'three' info <- hash() info[key] <- hash( keys=c(ikey), values=c(val) ) Error in get(make.keys(i), x@.Data) : object ‘1′ not found Solution is to check if only one key is provided than the values are are the value vector. - tests/set.r + Added test for adding hashes as values. - Class-hash.R + [[-method: verifies if argument is a previously assigned key. If not, method returns NULL with a warning. NULL with a warning. + $-method: verifies if argument is a previously assigned key. If not, method returns NULL with a warning. 2009-11-11 (cbrown) - R/zzz.R + Fixed logo - R/invert.R + Made better generic for use with formula tools 2009-11-04 Version 1.0.3 (cbrown) + Fixed dependency of R-2.9.0 2009-10-14 (cbrown) + show.R - Handled cases where values are not supported by "format". These are collapsed as character 2009-10-11 (cbrown) Version 1.0.2 + revert previous change allowing [[(hash) to accept multiple keys 2009-10-09 (cbrown) Version 1.0.1 ( not released on CRAN ) + [[(hash) support for multiple supplied keys also passes ... to simplify + now properly inherits from environment + requires R>=2.9.0 2009-09-30 (cbrown) + validate.key rename make.keys - This is more R-ish and more like the make.names function. 2009-09-28 (cbrown) + R/hash.R: - Fixed format of hash accessors. Now hashes can contain hashes. - Deprecated use of [[ with multipe keys. + R/show.R: Now aliases format + R/format.R: added + R/zzz.R: added graphical Open Data Logo + R/print.R: added 2009-09-04 (cbrown) - R/zzz.R: added Open Data message 2009-09-04 Version 0.40 (cbrown) - R/get.R: Added drop to reduce to lowest dimension by default. + R/invert.R: + invert method added. + inverted.hash function added. hash/R/0000755000175100001440000000000012102305225011404 5ustar hornikusershash/R/invert.R0000644000175100001440000000131712102304353013041 0ustar hornikusers# ---------------------------------------------------------------------------------- # METHOD: invert( hash ) # produces a hash with the values as keys and the keys as values # ---------------------------------------------------------------------------------- setGeneric( "invert", function(x) standardGeneric( "invert" ) ) setMethod( 'invert', 'hash', function(x) { h <- hash() for( k in keys(x) ) { for( v in make.keys(x[[k]]) ) { if ( ! has.key(v,h) ) h[[v]] <- k else h[[v]] <- append( h[[v]], k ) } } return(h) } ) # h <- hash( a=1, b=1:2, c=1:3 ) # invert(h) inverted.hash <- function(...) invert( hash(...) ) # inverted.hash( a=1, b=1:2, c=1:3 ) hash/R/clear.R0000755000175100001440000000101312102304353012614 0ustar hornikusers# --------------------------------------------------------------------- # clear.R # METHOD: clear # clears, rm all key-value pairs from a hash without destroying the # hash # # TODO: # - for large hashes it might be more efficient to re-initialize the # slot than rm the keys on the hash. # # --------------------------------------------------------------------- setGeneric( "clear", function(x) standardGeneric("clear") ) setMethod( "clear" , "hash" , function(x) rm( list=keys(x), envir=x@.Data ) ) hash/R/keys.R0000755000175100001440000000053512102304353012511 0ustar hornikusers# ----------------------------------------------------------------------------- # keys.R # METHOD: keys # ----------------------------------------------------------------------------- setGeneric( "keys", function(x) standardGeneric("keys") ) setMethod( "keys" , "hash" , function(x) ls(x@.Data, all.names=T ) ) names.hash <- function(x) keys(x) hash/R/has-key.R0000644000175100001440000000141712102305225013073 0ustar hornikusers# --------------------------------------------------------------------- # has-key.R # # METHOD: has.key( k ) logical # # Returns logical indicating if the hash contains the key # # NOTES: # - We could implement as a plain old function, but the function then # would have to check based on the signature arguments. It is just # simpler to use the S4 dispatch mechanism # # - See documentation for has-key-methods.Rd and has-key.Rd # # --------------------------------------------------------------------- setGeneric( "has.key", function( key, hash, ... ) standardGeneric( "has.key" ) ) setMethod( "has.key" , signature( "ANY", "hash" ) , function( key, hash, ... ) { sapply( key, exists, hash@.Data, inherits=FALSE ) } ) hash/R/copy.R0000644000175100001440000000052512102304353012504 0ustar hornikusers# ----------------------------------------------------------------------------- # copy.R # # ----------------------------------------------------------------------------- setGeneric( 'copy', function(x,...) standardGeneric( 'copy' ) ) setMethod( 'copy', 'hash', function(x, ... ) { hash( mget( keys(x), x@.xData ) ) } ) hash/R/values.R0000644000175100001440000000204212102304353013025 0ustar hornikusers# --------------------------------------------------------------------- # values.R # values(hash) : returns the values for a hash # # TODO: # - Change get to .get in values # - na.action # --------------------------------------------------------------------- setGeneric( 'values', function(x, ...) standardGeneric( 'values' ) ) setMethod( 'values', 'hash', function(x, keys=NULL, ... ) { if( is.null(keys) ) keys <- keys(x) if( ! is.character(keys) ) keys <- make.keys(keys) return(sapply( keys, get, x, ... )) } ) setGeneric( 'values<-', function(x, ..., value) standardGeneric( 'values<-' ) ) setReplaceMethod( 'values', c('hash', 'ANY' ), function(x, ..., value ) { keys <- list(...)$keys if ( is.null(keys) ) keys <- keys(x) if ( ! is.character(keys) ) keys <- make.keys(keys) x[ keys ] <- value return(x) } ) # TEST: # h <- hash( 1:26, letters ) # values(h) # values(h, keys=1:5 ) # values(h, keys=c(1,1,1:5) ) # values(h, 1:5 ) # values(h, keys=1:5) <- 6:10 # values(h) <- rev( letters ) hash/R/show.R0000755000175100001440000000056612102304353012522 0ustar hornikusers# ----------------------------------------------------------------------------- # show.r # # METHODS: show # The default method on the class. Perhaps this should return the # length. # # See Also: print # ----------------------------------------------------------------------------- setMethod( "show" , "hash" , function(object) cat(format(object)) ) hash/R/format.R0000644000175100001440000000256312102304353013026 0ustar hornikusers# ----------------------------------------------------------------------------- # METHOD: format # ----------------------------------------------------------------------------- setMethod( "format", "hash", function( x, max.print = getOption('max.print'), ... ) { indent <- list(...)$indent if( is.null(indent) ) { indent <- "" } else { indent <- paste( indent, " ", sep="" ) } indent2 <- paste( indent, " ", sep="" ) ret <- paste( " containing ", length(x), " key-value pair(s).\n", sep="" ) i <- 0 for ( k in keys(x)[1:min(length(x),max.print)] ) { # vals <- paste( format( x[[k]], indent=indent ), collapse = " " ) # THERE ARE SOME CASES WHERE FORMAT DOESN'T WORK, WE TRAP THESE. vals <- try( paste( format( x[[k]], indent=indent ), collapse = " " ), silent=T ) if( inherits( vals, "try-error" ) ) vals <- paste( as.character( x[[k]] ), collapse=", " ) ret <- paste( ret, indent2, k, " : ", vals, "\n", sep="" ) i <- i + 1 if( i >= max.print ) { ret <- paste( ret, "Reached getOption(max.print)=", max.print, " -- omitted ", length(x) - max.print, " entries.\n", sep="" ) break } } ret <- gsub( "\n\n", "\n", ret ) ret } ) hash/R/Class-hash.R0000755000175100001440000001073612111272224013531 0ustar hornikusers# --------------------------------------------------------------------- # CLASS: hash # # n.b.: The name of this class from the Open Data R Style Guide which # would have the CLASS named 'Hash'. We use hash since the goal is to # emulate a native class that is missing from the R Specification. # # TODO: # # CONTAINS: hash class and hash accessors ($ [ [[) # # --------------------------------------------------------------------- setClass( 'hash', contains = 'environment' , ) # ----------------------- ACCESSOR METHODS ------------------------------ # --------------------------------------------------------------------- # METHOD: [ (hash slice) # The [ method provides for the subseting of the object and # extracting a copy of the slice. # # Notes: # - Uses 'mget' internally for speed. Provides access to the hash. # - We do not use the .set method for speed. # --------------------------------------------------------------------- setMethod( '[' , signature( x="hash", i="ANY", j="missing", drop = "missing") , function( x,i,j, ... , # na.action = # if( is.null( getOption('hash.na.action') ) ) NULL else # getOption('hash.na.action') , drop ) { .h <- hash() # Will be the new hash for( k in i ) assign( k, get(k,x), .h@.Data ) return(.h) } ) # system.time( for( i in 1:10 ) for( ke in kes ) ha[ ke ] ) # NB. A slice without any arguments, by definition returns the hash itself setMethod( '[', signature( 'hash', 'missing', 'missing', 'missing' ), function(x,i,j, ..., drop ) { return( x ) } ) # --------------------------------------------------------------------- # METHOD: [<-, Hash Slice Replacement Method # WHAT DO WE DO IF WE HAVE A DIFFERENT NUMBER OF KEYS AND VALUES? # This should implement a hash slice. # NB. Although we would like to use assign directly, we use set # because it deals with the ambiguity of the lengths of the # key and value vectors. # --------------------------------------------------------------------- setReplaceMethod( '[', c(x ="hash", i="ANY" ,j="missing", value="ANY") , function( x, i, ..., value ) { .set( x, i, value, ... ) return( x ) } ) # hash[ key ] <- NULL : Removes key-value pair from hash setReplaceMethod( '[', c(x="hash", i="ANY", j="missing", value="NULL") , function( x, i, ..., value ) { del( i, x ) return( x ) } ) # TEST: # h[ "foo" ] <- letters # Assigns letters, a vector to "foo" # h[ letters ] <- 1:26 # h[ keys ] <- value # h[ 'a' ] <- NULL # --------------------------------------------------------------------- # $ -- DEPRECATED # This is deprecated since '$' is defined on environments and # environments can be inherited in objects # # --------------------------------------------------------------------- # SPECIAL CASE: NULL value # When assign a null values to a hash the key is deleted. It is # idiomatic when setting a value to NULL in R that that value is # removed from a list or environment. # # If R's behavior changes this will go away. # It is interesting to note that [[ behaves this way # setReplaceMethod( '$', c( x="hash", value="NULL"), function(x, name, value) { remove( list=name, envir=x@.xData ) x } ) # --------------------------------------------------------------------- # [[ -- DEPRECATED: # This is deprecated since this is handled by R natively. # Return single value, key,i, is a name/gets interpretted. # # NB: We no longer use .get. # --------------------------------------------------------------------- setReplaceMethod( '[[', c(x="hash", i="ANY", j="missing", value="ANY") , function(x,i,value) { assign( i, value, x@.xData ) return( x ) } ) # CASE: hash$value <- NULL # Deletes the value setReplaceMethod( '[[', c(x="hash", i="ANY", j="missing", value="NULL") , function(x,i,value) { rm( list=i, envir=x@.xData ) return( x ) } ) # --------------------------------------------------------------------- # MISC. FUNCTIONS # --------------------------------------------------------------------- is.hash <- function(x) is( x, "hash" ) as.list.hash <- function(x, all.names=FALSE, ...) as.list( x@.Data, all.names, ... ) is.empty <- function(x) { if( class(x) != 'hash' ) stop( "is.empty only works on hash objects" ) if( length(x) == 0 ) TRUE else FALSE } hash/R/length.R0000644000175100001440000000052612102304353013014 0ustar hornikusers# --------------------------------------------------------------------- # length.R # return the number of keys in a hash # NB: # - This doesn't work: env.profile(x@.xData)$nchains # --------------------------------------------------------------------- setMethod( "length" , "hash" , function(x) length( x@.xData ) ) hash/R/make-keys.R0000755000175100001440000000116512102304353013424 0ustar hornikusers# ----------------------------------------------------------------------------- # make.keys.R # # FUNCTION: make.keys # # Coerces arguments to a valid value that can be be passed to various hash # utilitites. # # ----------------------------------------------------------------------------- make.keys <- function(key) { key <- as.character( key ) if ( length(key) == 0 ) stop( "You must provide at least one key to the hash" ) if ( any(key=="") ) stop( "\nThe empty character string, '', cannot be used for a key at key(s): ", paste( which( key == "" ), collapse=", " ) ) return( key ) } hash/R/hash.R0000755000175100001440000000076312102304353012464 0ustar hornikusers# ----------------------------------------------------------------------------- # CONSTRUCTOR: hash # Takes an optional 1 or two parameter # DEPENDS on method set # ----------------------------------------------------------------------------- hash <- function( ... ) { li <- list(...) # INITIALIZE A NEW HASH h <- new( "hash" , new.env( hash = TRUE , parent=emptyenv() ) ) if ( length(li) > 0 ) { if( length(li) > 0 ) .set( h, ... ) } return(h) } hash/R/del.R0000644000175100001440000000107512102304353012277 0ustar hornikusers# --------------------------------------------------------------------- # del.R # # METHOD: del # Remove a list of keys. # --------------------------------------------------------------------- setGeneric( "del", function( x, hash ) { standardGeneric("del") } ) setMethod( "del" , signature( "ANY", "hash" ) , function ( x, hash ) { rm( list=make.keys(x), envir=hash@.Data ) } ) # ALIAS delete setGeneric( "delete", function( x, hash ) { standardGeneric("delete") } ) setMethod( "delete", signature( "ANY", "hash" ) , function(x,hash) { del(x,hash) } ) hash/R/set.R0000755000175100001440000000542612102304353012335 0ustar hornikusers# --------------------------------------------------------------------- # METHOD: set.R # Sets a key-value pair for the hash object # # The .set method is an internal method for assigning key-value pairs # if handles both constructor and settor cases. It handles a variety # of forms and performs a number of checks. When a certain type of # input is known to exist. It is faster to use assign. See assign. # # For hash construction it accepts the following formal methods. # # EXPLICIT key AND value ARGUMENTS # NAMED kv PAIRS # NAMED VECTORS # IMPLICIT KEY-VALUES # # --------------------------------------------------------------------- .set <- function( hash, ... ) { li <- list(...) # EXPLICIT 'keys' AND 'values' ARGUMENTS # .set( keys=letters, values=1:26 ) # if( identical( names(li) , c('keys', 'values') ) ) { if( 'keys' %in% names(li) && 'values' %in% names(li) ) { keys <- li[['keys']] values <- li[['values']] } else # NAMED KV PAIRS # .set( a=1, b=2, c=3 ) if( ! is.null( names( li ) ) ) { keys <- names(li) values <- li } else # NAMED VECTOR: # .set( c(a=1, b=2, c=3) ) if( length(li) == 1 ) { v <- li[[1]] if( length(names(v) == length(v) ) ) { keys <- names(v) values <- v } } else # IMPLICIT keys AND values VECTORS if( length(li) == 2 ) { keys <- li[[1]] values <- li[[2]] } keys <- make.keys(keys) # cat( length(keys), ", ", keys, "\n" ) # cat( length(values), ", ", values, "\n" ) # UNEQUAL keys and values both greater than one if ( length(keys) > 1 & length(values) > 1 & length(keys) != length(values) ) { stop( "Keys of length ", length( keys ), " do not match values of length ", length( values ) , "\n" ) } # ASSIGNMENT: if( length(keys) == 1 ) { assign( keys, values, envir = hash@.Data ) } else if( length( keys ) == length( values ) ) { for( i in 1:length(keys) ) assign( keys[[i]], values[[i]], envir = hash@.Data ) # assign( keys[[i]], hash( b=12 ), envir = hash@.Data ) } else { if( length( keys ) == 1 ) assign( keys, values, envir = hash@.Data ) if( length( values ) == 1 ) for( i in 1:length(keys) ) assign( keys[[i]], values, envir = hash@.Data ) } return( invisible(NULL) ) } hash/R/zzz.R0000644000175100001440000000037512102304353012372 0ustar hornikusers # .First.lib <- function( libname, pkgname ) { .onAttach <- function( libname, pkgname ) { packageStartupMessage( pkgname , "-" , utils::packageVersion(pkgname, libname), " provided by Decision Patterns\n" , domain = NA ) } hash/dev/0000755000175100001440000000000012102304353011762 5ustar hornikusershash/dev/hash.actions.Rd.off0000644000175100001440000000315312102304353015406 0ustar hornikusers\name{hash.action} \Rdversion{1.1} \alias{hash.default} \alias{hash.fail} \alias{hash.warn} \title{Actions for when hash keys are not found.} \description{ These functions control the behavior of the hash package when trying to access non-existant hash keys. The default behavior is to return \code{NA}. This is controllable through the \code{hash.action} option. See Details for further explanation. } \usage{ hash.default( key ) hash.warn( key, call. = FALSE, immediate. = TRUE ) hash.fail( key, call. = FALSE ) } \arguments{ \item{key}{ The name of the non-existant key } \item{call.}{ Passed to \code{\link{stop}} or \code{\link{warning}} } \item{immediate.}{ hash.warn only. Whether to immediately issue the warning. See \code{\link{warning}} for details } } \details{ \code{hash.default} always returns \code{NA}. This is the default behavior for hashes. Looking up values for non-existant keys returns \code{NA}. \code{hash.warn} issues an immediate warning, but returns \code{hash.default} value, by default \code{NA}. \code{hash.fail} stops iexecution with an error. The default behavior can be customized by setting the \code{hash.action} option. A value or callback function may be provided. \code{ options( hash.action=0 ) } \code{ options( hash.action=hash.warn ) } } \value{ \code{hash.default} returns \code{NA}. \code{hash.warn} returns \code{hash.default()} with a warning. \code{hash.fail} fails immediately } \author{ Christopher Brown } \examples{ hash.default() } \keyword{ methods } \keyword{ manip } hash/dev/hash.actions.R.off0000644000175100001440000000154712102304353015247 0ustar hornikusers # --------------------------------------------------------------------- # hash.na.action. functions # set options( hash.na.action=X ) # # X can be a function that expects minimally the name of a key or # a constant. # # These can be used in .get or the various accessor functions. Can # be globally set options( 'hash.na.action' ) # # --------------------------------------------------------------------- # FAIL on missing key hash.fail <- function(key, call.=FALSE ) { stop( "key, ", key, ", not found in hash.", call.=call. ) } # WARN on missing key hash.warn <- function(key, call.=FALSE, immediate.=TRUE ) { warning( "key, ", key, ", not found in hash.", call.=call., immediate.=immediate. ) return( hash.default() ) } # DEFAULT: NA on missing key hash.default <- function(key) return(NULL) hash/MD50000644000175100001440000000407613437200711011530 0ustar hornikusers329dcb9e9642523b5f032245f645a56a *DESCRIPTION 46b11aa21faa2ea81ba47eda491b5b6f *LICENSE d59836df521b00e6d284d5b082558fb2 *NAMESPACE 562bb285d647c21fe754aea42315cd3c *NEWS a01969015233782f5b60c38a763040dc *R/Class-hash.R 165be1287e9139b77a7ba4d3ccef4a79 *R/clear.R 265891818de64ca2d0a1ab18c585708e *R/copy.R acb792c8a624e7f9cf632a6943288477 *R/del.R 95fcbd641f7d6a4243f27192def1be22 *R/format.R 0f09ce8977eda4c6cdd01e4489ed052c *R/has-key.R defc6d41621ff825de2bc366fbf15e3f *R/hash.R 0eb83908be1c913faed350b2f81156ec *R/invert.R 5b4dc00281b8b6f19e2775f5c7532446 *R/keys.R 781ca9815ada11c3f0f3a79834ac5b06 *R/length.R 4289881a1664ddebed8df4fa24eedc60 *R/make-keys.R 12c70f33cbe9ff71c4e454d232602130 *R/set.R 654639e76a46e51a4a197f310205fbe4 *R/show.R b619daa830168639dcacb959212b0953 *R/values.R fc0fa5da8204f1abd22871da73fbf0c7 *R/zzz.R 3aed66c915dbba587bfc6c14388fd487 *README 0297e0f0d0caa7267d23352a42a64814 *TODO 6e3556a4300cb7f333239fa50e855b74 *demo/00Index f5c3e0f23cd6c0c2de53b6d11cf057f3 *demo/hash-benchmarks.R e08891cb0f95cf4eccd9631d35ca70d3 *dev/hash.actions.R.off 44e914c288a7f808d6002824b4623333 *dev/hash.actions.Rd.off 5b2b975f5a26de68744a473a791b85d6 *man/clear.Rd 93bdbc164605eabc859bc28f8331146d *man/copy.Rd 86ac3775d8df0abe89e0fcc478df1047 *man/del.Rd 3bf8fbafddbda91062fbc6581e56c588 *man/format.Rd 642aa132467c9d1458ad2241012b2129 *man/has-key.Rd 4e6362ef595a408c7126e91e170d3f79 *man/hash-accessors.Rd fdafd0b432840f1b19c4cd609dcb9373 *man/hash-class.Rd 11f2695e64e404f77871106352addc59 *man/hash-package.Rd cda9a4b013f055b0584aec1326139747 *man/hash.Rd e216d087208b36205893278d3f59c044 *man/invert.Rd 580802887913d59537b0d7585c9b13a5 *man/is.empty.Rd 0a07bdf0fc8ebe0f696528644961406c *man/keys.Rd 8d881855968f2a2aea91b8c7a0932a2e *man/length.Rd aeb76829a67b2c5d1cc546cada85e2bf *man/make.keys.Rd 8c8e33f452eb6d6d7ee5204efe253740 *man/set.Rd ce972e8aadc577f0efb0138d2f88cc8a *man/values.Rd 8fcb898b6dee828dae025f2993d97dfd *tests/accessors.R da3a8ed7139396542ab3a09eb6eeb655 *tests/clear.R 837f7ff16695e147b735c02ffdd81078 *tests/has.key.R 1dc934927ed7f3db01c9aecae867354a *tests/set.R hash/README0000644000175100001440000000213512102304353012065 0ustar hornikusersThis code is based on: #-- Define functions on Hash Tuples (Python alike) --------------------- # functions: new/def, len, set/get, has_key, keys, items, values, del, clear def.h <- function() new.env( hash=TRUE, parent=emptyenv() ) len.h <- function(dict) length(ls(envir=dict)) set.h <- function(key, val, dict) assign(key, val, envir=dict) get.h <- function(key, dict, default=NULL) { if (exists(key, envir=dict)) { get(key, dict) } else { default } } has_key <- function(key, dict) exists(key, envir=dict) keys.h <- function(dict) ls(envir=dict) items.h <- function(dict) as.list(dict) values.h <- function(dict, mode='character') { l <- as.list(dict) n <- length(l) if (n==0) invisible(NULL) v <- vector('character', n) for (i in 1:n) v[i] <- l[[i]] if (mode=='numeric') v <- as.numeric(v) return(v) } del.h <- function(key, dict) { if (exists(key, envir=dict)) { val <- get.h(key, dict) rm(list=c(key), envir=dict) } else { val <- NULL } invisible(val) } clear.h <- function(dict) { rm(list=keys.h(dict), envir=dict) } hash/DESCRIPTION0000755000175100001440000000127313437200711012725 0ustar hornikusersPackage: hash Type: Package Title: Full Feature Implementation of Hash/Associated Arrays/Dictionaries Version: 2.2.6.1 Date: 2013-02-20 Author: Christopher Brown Maintainer: Christopher Brown Depends: R (>= 2.12.0), methods, utils Suggests: testthat Description: Implements a data structure similar to hashes in Perl and dictionaries in Python but with a purposefully R flavor. For objects of appreciable size, access using hashes outperforms native named lists and vectors. License: GPL (>= 2) LazyLoad: yes Packaged: 2019-03-04 10:29:43 UTC; hornik NeedsCompilation: no Repository: CRAN Date/Publication: 2019-03-04 10:45:29 UTC hash/man/0000755000175100001440000000000012102427544011767 5ustar hornikusershash/man/hash.Rd0000755000175100001440000000377012102304353013203 0ustar hornikusers\name{hash} \alias{hash} \alias{is.hash} \alias{as.list.hash} \title{ hash/associative array/dictionary data structure for the R language } \description{ Preferred constructor for the \code{\link{hash-class}}. } \usage{ hash(...) is.hash(x) \method{as.list}{hash}(x, all.names = FALSE, \dots ) } \arguments{ \item{x}{ A hash object. } \item{all.names}{ a logical indicating whether to copy all values or (default) only those whose names do not begin with a dot } \item{...}{ Additional arguments passed to the function } } \details{ \code{hash} returns a hash object. Key-value pairs may be specified via the \code{...} argument as explicity arguments \code{keys} and \code{values}, as named key-value pairs, as a named vector or as implicit key, value vectors. See examples below for each type. Keys must be a valid R name, must be a character vector and must not be the empty string, \code{""}. Values are restricted to any valid R objects. See \code{\link{.set}} for further details and how key-value vectors of unequal length are interpretted. Hashes may be accessed via the standard R accessors \code{[}, \code{[[} and \code{\$}. See \code{\link{hash-accessors}} for details. \code{is.hash} returns a boolean value indicating if the argument is a hash object. \code{as.list.hash} coerces the hash to a list. } \value{ For \code{hash}, an object of class hash. } \author{ Christopher Brown } \seealso{ \code{\link{.set}}, \code{\link{hash-accessors}} } \examples{ hash() hash( key=letters, values=1:26 ) hash( 1:3, lapply(1:3, seq, 1 )) hash( a=1, b=2, c=3 ) hash( c(a=1, b=2, c=3) ) hash( list(a=1,b=2,c=3) ) hash( c("foo","bar","baz"), 1:3 ) hash( c("foo","bar","baz"), lapply(1:3, seq, 1 ) ) hash( letters, 1:26 ) h <- hash( letters, 1:26 ) h$a h$b h[[ "a" ]] h[ letters[1:3] ] h$a<-100 # h[['a']]<-letters is.hash(h) as.list(h) clear(h) rm(h) } \keyword{ data } \keyword{ manip } hash/man/set.Rd0000755000175100001440000000504112102304353013044 0ustar hornikusers\name{.set} \alias{.set} \title{assign key-value pair(s) to a hash } \description{ \code{.set} is an internal method for assigning key-value pairs to a \code{\link{hash}}. Normally, there is no need to use this function. Convenient access is provided by: \code{ hash, \$, [ and [[ } and their corresponding replacement methods. \code{.set} takes 4 types of arguments: explicitly named key and value vectors named key-value pairs named vectors implicit key-value pairs The keys are automatically coerced to valid keys and are restricted to character classes. Values are free to be any valid R object. } \usage{ .set( hash, ... ) } \arguments{ \item{hash}{ An hash object on which to set the key-value pair(s) } \item{...}{ Any of several ways to specify keys and values. See Details. } } \details{ \code{.set} sets zero or more key-value pairs. If the key(s) already exist, existing values are silently clobbered. Otherwise, a new value is saved for each key. Keys and values are by the \code{...} argument. If \code{...} is: made only of explicitly named \code{keys} and \code{values} arguments then these are taken as the keys and values respectively. a named list, then the names are taken as keys and list elements are taken as values. a named vector, then the names are taken as keys. Vector elements are taken as values. of length two, keys are taken from the first element, values from the second. Keys are coerced to type \code{character}. Keys and values are assigned to the hash as follows: IF \code{keys} and \code{values} are the same length, key-value pairs are added to the hash pairwise. IF \code{keys} is a vector of length 1, then this key is assigned the entire \code{values} vector. IF \code{values} is a vector of length 1, each key of \code{keys} is assigned the value given by \code{values} IF \code{keys} and \code{values} are of different lengths, both greater than one, then the assignment is considered ambiguous and an error is thrown. } \value{ \code{.set} exists solely for its side-effects. An invisible NULL is returned. } \author{ Christopher Brown } \seealso{ See also \code{\link{hash}}, \code{\link{environment}} } \examples{ h <- hash() .set( h, keys=letters, values=1:26 ) .set( h, a="foo", b="bar", c="baz" ) .set( h, c( aa="foo", ab="bar", ac="baz" ) ) clear(h) .set( h, letters, values ) } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/hash-accessors.Rd0000755000175100001440000000344412102304353015164 0ustar hornikusers\name{hash-accessors} \alias{hash-accessors} \alias{$,hash-method} \alias{$<-,hash-method} \alias{$<-,hash,ANY-method} \alias{$<-,hash,ANY,NULL-method} \alias{$<-,hash,ANY,ANY-method} \alias{$<-,hash,missing,NULL-method} \alias{$<-,hash,NULL-method} \alias{[,hash,missing,missing,missing-method} \alias{[,hash,ANY,missing,missing-method} \alias{[<-,hash,ANY,missing-method} \alias{[<-,hash,ANY,missing,ANY-method} \alias{[<-,hash,ANY,missing,NULL-method} \alias{[[,hash,ANY,missing-method} \alias{[[<-,hash,ANY,missing-method} \alias{[[<-,hash,ANY,missing,ANY-method} \alias{[[<-,hash,ANY,missing,NULL-method} \title{Accessor methods for the hash class.} \description{ R style accesors for the \code{\link{hash-class}}. } \details{ These are the hash accessor methods. They closely follow an R style. \code{$} is a look-up operator for a single key. The native \code{$} method is used. The key is taken as a string literal and is not interpreted. \code{[[} is the look-up, extraction operator. It returns the values of a single key. \code{[} is a subseting operator. It returns a (sub) hash with the specified keys. All other keys are removed. } \value{ \$ and [[ return the value for the supplied argument. If a key does not match an existing key, then \code{NULL} is returned with a warning. [ returns a hash slice, a sub hash with only the defined keys. } \author{ Christopher Brown } \seealso{ \code{\link{hash}}, \code{\link{values}}, \code{\link{.set}}, \code{\link{as.list}} } \examples{ h <- hash() h <- hash( letters, 1:26 ) h$a h$a <- "2" h$z <- NULL # Removes 'z' from h[['a']] h[['a']] <- 23 h[ letters[1:4] ] # hash with a,b,c,d h[ letters[1:4] ] <- 4:1 } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/has-key.Rd0000755000175100001440000000172312102304353013615 0ustar hornikusers\name{has.key} \alias{has.key} \alias{has.key-methods} \alias{has.key,ANY,hash-method} \title{ Test for existence of key(s) on a hash } \description{ \code{has.key} returns a logical vector as long as \code{keys}, indicating which keys are defined on the hash. } \usage{ has.key(key, hash, ...) } \arguments{ \item{key}{ A vector whose entries will be coerced to valid keys. } \item{hash}{ A \code{\link{hash}} object. } \item{...}{ arguments passed to further functions } } \details{ None. } \value{ \item{logical}{ A logical vector of length \code{key} indicating whether the key is defined in the hash. \code{has.key} also accepts \code{...} to be passed to underlying \code{sapply} } } \author{ Christopher Brown } \seealso{ See also \code{\link{hash}} } \examples{ h <- hash( letters, 1:26 ) all( has.key( letters, h ) ) # TRUE } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/keys.Rd0000755000175100001440000000121412102304353013222 0ustar hornikusers\name{keys} \alias{keys} \alias{names} \alias{names.hash} \alias{keys-methods} \alias{keys,hash-method} \title{ Returns key(s) from a hash } \description{ Returns the key(s) from a hash } \usage{ keys(x) \method{names}{hash}(x) } \arguments{ \item{x}{ A \code{\link{hash}} object. } } \details{ Returns the character vector containing the keys of a hash object. } \value{ \item{keys}{A vector of type character} } \author{ Christopher Brown } \seealso{ See Also \code{\link{hash}}. } \examples{ h <- hash( letters, 1:26 ) keys(h) # letters names(h) # same } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/values.Rd0000755000175100001440000000532212102304353013552 0ustar hornikusers\name{values} \alias{values} \alias{values-methods} \alias{values,hash-method} \alias{values<-} \alias{values<--methods} \alias{values<-,hash-method} \alias{values<-,hash,ANY-method} \title{ Extract values of a hash object. } \description{ Extract \code{values} from a \code{hash} object. This is a pseudo- accessor method that returns hash values (without keys) as a vector if possible, a list otherwise. simplifies them to the lowest order (c.f. simplify). It is very similar to \code{ h[[ keys(h) ]] }, An optional key. It is identical to \code{ h[[ keys(h) ]] }. For details about hash accessors, please see \code{\link{hash-class}} } \usage{ \S4method{values}{hash}(x, keys=NULL, ...) \S4method{values}{hash}(keys=NULL) <- value } \arguments{ \item{x}{ The \code{\link{hash}} from where the values retrieved } \item{keys}{ A vector of keys to be returned. } \item{...}{ Arguments passed to \code{\link{sapply}} } \item{value}{ For the replacement method, the value(s) to be set. } } \details{ The \code{values} method returns the values from a hash. It is similar to \code{ h[[ keys(h) ]] } except that a named vector or list is returned instead of a hash. : By default, the returned values are simplified by coercing to a vector or matrix if possible; elements are named after the corresponding key. If the values are of different types or of a complex class than a named list is returned. Argument \code{simplify} can be used to control this behavior. If a character vector of \code{keys} is provided, only these keys are returned. This also allows for returning values mulitple times as in: \code{ values(h, keys=c('a','a','b' ) ) } This is now the preferred method for returning multiple values for the same key. The replacement method, \code{values<-} can replace all the values or simply those associated with the supplied \code{keys}. Use of the accessor '[' is almost always preferred. } \value{ Please see details for which value will be returned: \item{vector}{Vector with the type as the values of the hash} \item{list}{list containing the values of the hash} } \references{ http://blog.opendatagroup.com/2009/10/21/r-accessors-explained/ } \author{ Christopher Brown } \seealso{ See also \code{\link{hash}}, \code{\link{sapply}}. } \examples{ h <- hash( letters, 1:26 ) values(h) # 1:26 values(h, simplify = FALSE ) values(h, USE.NAMES = FALSE ) h <- hash( 1:26, letters ) values(h) values(h, keys=1:5 ) values(h, keys=c(1,1,1:5) ) values(h, keys=1:5) <- 6:10 values(h) <- rev( letters ) } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/copy.Rd0000644000175100001440000000166412102304353013227 0ustar hornikusers\name{copy-methods} \docType{methods} \alias{copy} \alias{copy-methods} \alias{copy,hash-method} \title{ Create a seperate copy of a hash object. } \description{ The copy hash method creates a independent copy of a hash object. Creating a copy using the assingment operator, \code{<-}, does not work as expected, since hashes are based on environments and environments are reference objects in R. The assignment operator consequently creates a linked copy to the original hash and not an independent copy. The \code{copy} method provides an identical unlinked copy of the hash. } \section{Methods}{ \describe{ \item{\code{signature(x = "hash")}}{ Creates and returns an identical, independent, unreferenced copy of the the hash. } }} \value{ A hash object. } \author{ Christopher Brown } \seealso{ \code{\link{environment}} } \examples{ h <- hash( a=1, b=2 ) h.new <- copy( h ) } \keyword{methods} hash/man/hash-class.Rd0000755000175100001440000000674112102304353014307 0ustar hornikusers\name{hash-class} \docType{class} \alias{hash-class} \title{Class "hash" } \description{ Implements a S4 hash class in R similar to hashes / associatesd arrays / dictionaries in other programming languages. Where possible, the hash class uses the standard R accessors: \code{\$}, \code{[} and \code{[[}. Hash construction is flexible and takes several syntaxes and all hash operations are supported. For shorter key-value pairs, lists might yield higher performance, but for lists of appreciable length hash objects handly outperform native lists. } \section{Slots}{ \describe{ \item{\code{.xData}:}{ Object of class \code{"environment"}. This is the hashed environment used for key-value storage. } } } \section{Extends}{ environment } \section{Methods}{ \describe{ HASH ACCESSORS: \item{[<-}{\code{signature(x = "hash", i = "ANY", j = "missing")}: Slice Replacement } \item{[}{\code{signature(x = "hash", i = "ANY", j = "missing", drop = "missing")} : Slice } \item{[[<-}{\code{signature(x = "hash", i = "ANY", j = "missing")}: Single key replacement with interpolation. } \item{[[}{\code{signature(x = "hash", i = "ANY", j = "missing")}: i Single key look-up with interpolation } \item{\$<-}{\code{signature(x = "hash")}: Single key replacement no interpolation } \item{\$}{\code{signature(x = "hash")}: Single key lookup no interpolation } Manipulation: \item{clear}{\code{signature(x = "hash")}: Remove all key-value pairs from hash } \item{del}{\code{signature(x = "ANY", hash = "hash")}: Remove specified key-value pairs from hash } \item{has.key}{\code{signature(key = "ANY", hash = "hash")}: Test for existence of key } \item{is.empty}{\code{signature(x = "hash")}: Test if no key-values are assigned } \item{length}{\code{signature(x = "hash")}: Return number of key-value pairs from the hash } \item{keys}{\code{signature(hash = "hash")}: Retrieve keys from hash } \item{values}{\code{signature(x = "hash")}: Retrieve values from hash } \item{copy}{\code{signature(x = "hash")}: Make a copy of a hash using a new environment. } \item{format}{\code{signature(x = "hash")}: Internal function for displaying hash } } } \references{ http://en.wikipedia.org/wiki/Hash_table http://en.wikipedia.org/wiki/Associative_array } \author{ Christopher Brown } \note{ HASH KEYS must be a valid character value and may not be the empty string \code{""}. HASH VALUES can be any R value, vector or object. PASS-BY REFERENCE. Environments and hashes are special objects in R because only one copy exists globally. When provide as an argument to a function, no local copy is made and any changes to the hash in the functions are reflected globally. PERFORMANCE. Hashes are based on environments and are designed to be exceedingly fast using the environments internal hash table. For small data structures, a list will out-perform a hash in nearly every case. For larger data structure, i.e. >100-1000 key value pair the performance of the hash becomes faster. Much beyond that the performance of the hash far outperforms native lists. MEMORY. Objects of class \code{hash} do not release memory with a call to \code{rm}. \code{clear} must be called before \code{rm} to properly release the memory. } \seealso{ \code{\link{hash-accessors}}, \code{\link{environment}}. } \examples{ showClass("hash") } \keyword{classes} hash/man/length.Rd0000755000175100001440000000103212102304353013526 0ustar hornikusers\name{length} \alias{length} \alias{length-methods} \alias{length,hash-method} \title{ Returns the number of items in a hash } \description{ Returns the number of items in a hash } \details{ Return the number of items in the hash by calling \code{\link{length}} on the internal environment. } \value{ \item{integer}{ Number of items in the hash. } } \author{ Christpher Brown } \seealso{ See Also \code{\link{hash}}, \code{\link{length}} } \examples{ h <- hash( letters, 1:26 ) length(h) # 26 } \keyword{ methods } hash/man/format.Rd0000644000175100001440000000056012102304353013537 0ustar hornikusers\name{Format hash object for pretty printing} \docType{methods} \alias{format,hash-method} \alias{format} \title{ Methods for Function format in Package 'hash' } \description{ Format a hash for printing. } \section{Methods}{ \describe{ \item{x = "hash"}{ Format a hash for pretty printing. } } } \seealso{ See also \code{\link{format}} } \keyword{methods} hash/man/del.Rd0000755000175100001440000000160212102304353013014 0ustar hornikusers\name{del} \alias{del} \alias{del-methods} \alias{del,ANY,hash-method} \alias{delete} \alias{delete-methods} \alias{delete,ANY,hash-method} \title{ Remove key-value pair(s) from a hash } \description{ Removes key-value pair(s) from a hash. } \usage{ del(x,hash) delete(x,hash) } \arguments{ \item{x}{ An object that will be coerced to valid key(s) to be removed from the hash. \code{x} will be coerced to a valid hash keys using \code{\link{make.keys}} } \item{hash}{ A \code{\link{hash}} object } } \value{ None. This method exists solely for the side-effects of removing items from the hash. } \author{ Christopher Brown } \seealso{ See Also as \code{\link{hash}}, \code{\link{make.keys}}. } \examples{ h <- hash( letters, 1:26 ) h # 26 elements del( "a", h ) h # 25 elements } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/clear.Rd0000755000175100001440000000201412102304353013334 0ustar hornikusers\name{clear} \alias{clear} \alias{clear-methods} \alias{clear,hash-method} \title{ Removes all key-value pairs from a hash } \description{ \code{clear} removes all key-values from a hash. } \usage{ clear(x) } \arguments{ \item{x}{ A \code{hash} object. } } \details{ Currently \code{clear} removes (\code{rm}) the key-value pairs on the hash. For large hashes it might be faster to reinitialize the hash, though this might cause memory leaks. } \value{ None. Method clear exists entirely for its side effects. } \note{ \code{clear} should be called prior to removing a hash. This ensures that the memory from the environment is freed. } \author{ Christopher Brown } \seealso{ \code{\link{del}} to remove specific key-values from the hash. \code{\link{hash}}. } \examples{ h <- hash( letters, 1:26 ) h # An object of type 'hash' containing 26 key-value pairs. clear(h) h # An object of type 'hash' containing 0 key-value pairs. } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/invert.Rd0000644000175100001440000000235612102304353013563 0ustar hornikusers\name{invert} \Rdversion{1.1} \alias{invert} \alias{inverted.hash} \alias{invert-methods} \alias{invert,hash-method} \title{ Create an inverted hash.} \description{ THIS IS AN EXPERIMENTAL FUNCTION. THE IMPLEMENTATION OR INTERFACE MAY CHANGE WITHOUT WARNING. Invert creates an inverted hash from an existing hash. An inverted hash is one in which the keys and values are exchanged. } \usage{ invert(x) inverted.hash(...) } \arguments{ \item{x}{ A \code{\link{hash}} object } \item{...}{ Arguments passed to the \code{\link{hash}} function. } } \details{ For \code{invert}, keys and value elements switch. Each element of the \code{values(x)} is coerced to a key. The value becomes the associated key. For \code{inverted.hash}, a hash is created than inverted. It is defined as: \code{ function(...) invert(hash(...)) } } \value{ A hash object with: keys as the unique elements of \code{values(x)} and values as the associated \code{keys{x}} } \author{ Christopher Brown } \seealso{ See also \code{link{hash}} and \code{\link{make.keys}} } \examples{ h <- hash( a=1, b=1:2, c=1:3 ) invert(h) inverted.hash( a=1, b=1:2, c=1:3 ) } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/make.keys.Rd0000755000175100001440000000167012102304353014144 0ustar hornikusers\name{make.keys} \alias{make.keys} \title{ creates/coerces objects to proper hash keys } \description{ Given an vector of any type, \code{make.keys} tries to coerce it into a character vector that can be used as a hash key. This is used internally by the hash package and should not be normally needed. } \usage{ make.keys(key) } \arguments{ \item{key}{ An object that represents the key(s) to be coerced to a valid hash keys. } } \details{ This function is used internally by the \code{\link{hash}} class to ensure that the keys are valid. There should be no need to use this externally and is only documented for completeness. } \value{ A character vector of valid keys } \author{ Christopher Brown } \seealso{ See also as \code{\link{hash}} } \examples{ make.keys( letters ) make.keys( 1:26 ) } \keyword{ methods } \keyword{ data } \keyword{ manip } hash/man/is.empty.Rd0000644000175100001440000000117612102304353014023 0ustar hornikusers\name{is.empty} \alias{is.empty} \title{ Test if a hash has no key-value pairs. } \description{ \code{is.empty} tests to see if any key value pairs are assigned on a \code{hash} object. } \usage{ is.empty(x) } \arguments{ \item{x}{ hash object. } } \details{ Returns \code{TRUE} if no key-value pairs are defined for the hash, \code{FALSE} otherwise. } \value{ logical. } \author{ Christopher Brown. } \seealso{ \code{\link{exists}}. } \examples{ h <- hash( a=1, b=2, c=3 ) is.empty(h) # FALSE clear(h) is.empty(h) # TRUE h <- hash() is.empty(h) # TRUE } \keyword{ methods } hash/man/hash-package.Rd0000755000175100001440000000536312111300253014567 0ustar hornikusers\name{hash-package} \alias{hash-package} \docType{package} \title{ Hash/associative array/dictionary data structure for the R language. } \description{ This S4 class is designed to provide a hash-like data structure in a native R style and provides the necessary methods for all general methods for hash operations. } \details{ \tabular{ll}{ Package: \tab hash\cr Type: \tab Package\cr Version: \tab 2.2.6\cr Date: \tab 2013-02-20\cr License: \tab GPL (>= 2)\cr LazyLoad: \tab yes\cr Depends: \tab R (>= 2.12.0), utils, methods\cr } } \author{ Christopher Brown Maintainer: Christopher Brown } \references{ http://www.mail-archive.com/r-help@r-project.org/msg37637.html http://www.mail-archive.com/r-help@r-project.org/msg37650.html http://tolstoy.newcastle.edu.au/R/help/05/12/index.html\#18192 } \note{ R is slowly moving toward a native implementation of hashes using enviroments, (cf. \code{\link{Extract}}. Access to environments using $ and [[ has been available for some time and recently objects can inherit from environments, etc. But many features that make hashes/dictionaries great are still lacking, such as the slice operation, [. The hash package is the only full featured hash implementation for the R language. It provides more features and finer control of the hash behavior than the native feature set and has similar and sometimes better performance. HASH KEYS must be a valid character value and may not be the empty string \code{""}. HASH VALUES can be any R value, vector or object. PASS-BY REFERENCE. Environments and hashes are special objects in R because only one copy exists globally. When provide as an argument to a function, no local copy is made and any changes to the hash in the functions are reflected globally. PERFORMANCE. Hashes are based on R's native environments and are designed to be exceedingly fast using the environments internal hash table. For small data structures, a list will out-perform a hash in nearly every case. For larger data structure, i.e. > 500 key value pair the performance of the hash becomes faster. Much beyond that the performance of the hash far outperforms native lists. MEMORY. Objects of class \code{hash} do not release memory with a call to \code{rm}. \code{clear} must be called before \code{rm} to properly release the memory. } \seealso{ See also \code{\link{hash} }, \code{\link{hash-accessors}} and \code{\link{environment} } } \examples{ h <- hash( keys=letters, values=1:26 ) h <- hash( letters, 1:26 ) h$a # 1 h$foo <- "bar" h[ "foo" ] h[[ "foo" ]] clear(h) rm(h) } \keyword{ package } hash/LICENSE0000644000175100001440000000041612102304353012212 0ustar hornikusersThis package is licenses under GPLv2. For a copy of this license, refer to http://www.r-project.org/Licenses/GPL-2. If you are interested in other licensing arrangements, please contact the copyright holder. Copyright (c) 2011 Decision Patterns. Oakland, CA, USA.