bitops/0000755000176000001440000000000012203745252011604 5ustar ripleyusersbitops/tests/0000755000176000001440000000000012203674151012745 5ustar ripleyusersbitops/tests/consistency.R0000644000176000001440000001566012203674151015441 0ustar ripleyuserslibrary(bitops) i7 <- 0:127 ri7 <- bitFlip(i7) stopifnot(identical(bitAnd(i7,ri7),rep(0,length(i7))), ri7+i7 == 2^32-1, ## flipping the bits twice should be the identity (modulo overflow): identical(i7, as.integer(bitFlip(ri7))), bitAnd(i7, ri7) == 0, bitAnd(15,17) == 1, bitOr (15,17) == 31, bitXor(15,17) == 30 ) for(N in 1:200) { j7 <- sample(i7) ## Commutative Law: stopifnot(identical(bitOr (i7, j7), bitOr (j7, i7)), identical(bitAnd(i7, j7), bitAnd(j7, i7)), identical(bitXor(i7, j7), bitXor(j7, i7))) ## Xor "+" And == Or : stopifnot(identical(bitOr(i7, j7), bitOr(bitXor(i7,j7), bitAnd(i7,j7)))) ## Logic: !(A & B) <-> (!A) | (!B) stopifnot(identical(bitFlip(bitAnd(i7, j7)), bitOr(bitFlip(i7), bitFlip(j7)))) ## !(A | B) <-> (!A) & (!B) stopifnot(identical(bitFlip(bitOr(i7, j7)), bitAnd(bitFlip(i7), bitFlip(j7)))) ## Associative Law: k7 <- sample(j7) stopifnot(identical(bitOr(bitOr(i7, j7), k7), bitOr(i7, bitOr(j7, k7))), identical(bitAnd(bitAnd(i7, j7), k7), bitAnd(i7, bitAnd(j7, k7))), identical(bitXor(bitXor(i7, j7), k7), bitXor(i7, bitXor(j7, k7)))) } # # verify cksum # b<-sapply(1:92, FUN=function(a,b=" !#$%&()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[]^_`abcdefghijklmnopqrstuvwxyz{|}~") { paste(substring(b,a),substring(b,1,a-1),collapse="",sep="") }) d<-c(2442416856, 1669542993, 313999433, 178729808, 3394733963, 2164389741, 3871734349, 3789449038, 40636212, 1452746146, 541480198, 2979936832, 2923782422, 792265197, 3640409291, 1202696403, 4011398543, 2699207183, 2985612474, 1439186030, 1508213684, 1865388774, 2380454843, 454855490, 1019166481, 924244674, 1406204380, 2429078660, 1046223291, 1230078089, 1548993556, 280855472, 421066716, 2967223269, 1100914587, 886676022, 1657109189, 843923270, 620178494, 1609552402, 1787171819, 4006198310, 1023859819, 1411671880, 513493423, 2495633464, 1866449535, 4291277827, 3301230818, 381214501, 2497598429, 675736398, 3735311659, 2170409126, 3731386467, 1015853879, 4060922207, 1023658490, 2980477601, 350747207, 2650042644, 600967562, 4254175774, 1970787970, 4065204194, 1521286262, 3589949651, 879070207, 1152896007, 2418807455, 2666637124, 2577590065, 4208759298, 3274144307, 1957580223, 3095930811, 3625810032, 126832280, 1912362968, 515865842, 3876027886, 304043927, 785523686, 3840974701, 2587165204, 1710947718, 2356035548, 430213333, 3484582166, 885948210, 1348073033, 2652440189) stopifnot( all.equal(cksum(b),d)) # verify bit shifts: stopifnot( identical(2^(0:31), bitShiftL(1,0:31)) ) stopifnot( identical(2^(31:0),bitShiftR(2^31,0:31)) ) # test boundary value behavior: +/- Inf, NA, NaN, 2^32: a<-round(runif(500)*2^33) b<-which(a<4294967296) stopifnot(identical(bitAnd(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitAnd(a,a)[b],a[b])) stopifnot(identical(bitOr(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitOr(a,a)[b],a[b])) stopifnot(identical(bitXor(a,0)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(a,0)[b],a[b])) stopifnot(identical(bitXor(0,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(0,a)[b],a[b])) stopifnot(identical(bitFlip(bitFlip(a))[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitFlip(bitFlip(a))[b],bitAnd(a,2^32-1)[b])) stopifnot(identical(bitShiftR(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitShiftL(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[-b]))) a[-b]<-1/0 stopifnot(identical(bitAnd(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitAnd(a,a)[b],a[b])) stopifnot(identical(bitOr(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitOr(a,a)[b],a[b])) stopifnot(identical(bitXor(a,0)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(a,0)[b],a[b])) stopifnot(identical(bitXor(0,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(0,a)[b],a[b])) stopifnot(identical(bitFlip(bitFlip(a))[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitFlip(bitFlip(a))[b],bitAnd(a,2^32-1)[b])) stopifnot(identical(bitShiftR(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[- b]))) stopifnot(identical(bitShiftL(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[- b]))) a[-b]<--1/0 stopifnot(identical(bitAnd(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitAnd(a,a)[b],a[b])) stopifnot(identical(bitOr(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitOr(a,a)[b],a[b])) stopifnot(identical(bitXor(a,0)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(a,0)[b],a[b])) stopifnot(identical(bitXor(0,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(0,a)[b],a[b])) stopifnot(identical(bitFlip(bitFlip(a))[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitFlip(bitFlip(a))[b],bitAnd(a,2^32-1)[b])) stopifnot(identical(bitShiftR(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[- b]))) stopifnot(identical(bitShiftL(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[- b]))) a[-b]<-suppressWarnings(sqrt(-1)) stopifnot(identical(bitAnd(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitAnd(a,a)[b],a[b])) stopifnot(identical(bitOr(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitOr(a,a)[b],a[b])) stopifnot(identical(bitXor(a,0)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(a,0)[b],a[b])) stopifnot(identical(bitXor(0,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(0,a)[b],a[b])) stopifnot(identical(bitFlip(bitFlip(a))[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitFlip(bitFlip(a))[b],bitAnd(a,2^32-1)[b])) stopifnot(identical(bitShiftR(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[- b]))) stopifnot(identical(bitShiftL(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[- b]))) a[-b]<-NA stopifnot(identical(bitAnd(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitAnd(a,a)[b],a[b])) stopifnot(identical(bitOr(a,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitOr(a,a)[b],a[b])) stopifnot(identical(bitXor(a,0)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(a,0)[b],a[b])) stopifnot(identical(bitXor(0,a)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitXor(0,a)[b],a[b])) stopifnot(identical(bitFlip(bitFlip(a))[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitFlip(bitFlip(a))[b],bitAnd(a,2^32-1)[b])) stopifnot(identical(bitShiftR(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[-b]))) stopifnot(identical(bitShiftL(a,runif(10)*32)[-b],as.numeric(rep(NA,length(a))[-b]))) bitops/src/0000755000176000001440000000000012203674151012372 5ustar ripleyusersbitops/src/bit-ops.c0000644000176000001440000001320412203716701014111 0ustar ripleyusers#include #include "bit-ops.h" #include /* bitwise complement for use with .Call to bitFlip masked to bitWidth */ SEXP bitFlip(SEXP a, SEXP bitWidth ) { PROTECT (a = AS_NUMERIC(a) ) ; PROTECT (bitWidth = AS_INTEGER(bitWidth) ) ; int n = LENGTH(a); int *xbitWidth = INTEGER_POINTER(bitWidth); double *xa = NUMERIC_POINTER(a); unsigned int mask = ( unsigned int ) -1 >> (32 - *xbitWidth); SEXP aflip = PROTECT(NEW_NUMERIC(n)); double *xaflip = NUMERIC_POINTER(aflip); for (int i=0; i31 ) xaflip[i]=NA_REAL ; else { // in case of a negative, cast twice; unsigned int tmp = xa[i] < 0 ? (int) xa[i] : (unsigned) xa[i]; xaflip[i]=(double) ( ~tmp & mask ) ; } } UNPROTECT(3) ; return (aflip) ; } /* Improved version of bitwise __OP__ operator for S vectors for use with .C call where result is pre-allocated to length of a+b, operands are coerced to integer, but left at their original lengths. __OP__ is in { & , | , ^ } AND OR XOR */ #define bit2op_BODY(__OP__) \ int i, j, nshorter, nlonger ; \ double *shorter, *longer, *t ; \ SEXP aAb ; \ \ PROTECT (a = AS_NUMERIC(a) ) ; \ PROTECT (b = AS_NUMERIC(b) ) ; \ \ nlonger=LENGTH(a) ; \ longer=NUMERIC_POINTER(a) ; \ nshorter=LENGTH(b) ; \ shorter=NUMERIC_POINTER(b) ; \ \ if ( nshorter > nlonger ) { \ i=nshorter ; nshorter=nlonger; nlonger=i ;\ t=shorter ; shorter=longer ; longer= t ; \ } \ \ if ( !nshorter || !nlonger ) nlonger=0 ; \ else if ( nlonger % nshorter ) warning("longer object length is not a multiple of shorter object length\n") ; \ \ PROTECT (aAb = NEW_NUMERIC(nlonger) ) ; \ t=NUMERIC_POINTER(aAb) ; \ \ \ for (i=0; i31 || logb(longer[i])>31 ) { *(t++)=NA_REAL ; i++ ;} \ \ else *(t++) =(double) ( (unsigned int) shorter[j] __OP__ (unsigned int ) longer[i++] ) ; \ if (! (inb ? na : nb ; \ \ if (!na || !nb ) n=na=nb=0 ; \ else if (n%na || n%nb ) warning("longer object length is not a multiple of shorter object length\n") ; \ \ PROTECT (aAb= NEW_NUMERIC(n) ) ; \ xaAb=NUMERIC_POINTER(aAb) ; \ \ \ if (na > nb ) { \ for (i=0; i< na; ) { \ for (j=0; j< nb; j++ ) { \ \ if ( !R_FINITE(xa[i]) || xb[j]==NA_INTEGER || logb(xa[i]) > 31 ) { *(xaAb++) = NA_REAL ; i++ ; } \ else *(xaAb++)=(double) ( (unsigned int) xa[i++] __OP__ (xb[j] & 31 ) ) ; \ if (! (i 31 ) { *(xaAb++) = NA_REAL ; i++ ; } \ else *(xaAb++)=(double) ( (unsigned int) xa[j] __OP__ (xb[i++] & 31 ) ) ; \ if (! (i> ) } bitops/src/bit-ops.h0000644000176000001440000000041112203716701014112 0ustar ripleyusers#include #include #include SEXP bitFlip( SEXP a, SEXP bitWidth ); SEXP bitAnd( SEXP a, SEXP b ); SEXP bitOr ( SEXP a, SEXP b ); SEXP bitXor( SEXP a, SEXP b ); SEXP bitShiftL( SEXP a, SEXP b); SEXP bitShiftR( SEXP a, SEXP b); bitops/src/cksum.c0000644000176000001440000000730112203716701013657 0ustar ripleyusers#include #include #include static const unsigned int crctab[] = { 0x0, 0x04c11db7, 0x09823b6e, 0x0d4326d9, 0x130476dc, 0x17c56b6b, 0x1a864db2, 0x1e475005, 0x2608edb8, 0x22c9f00f, 0x2f8ad6d6, 0x2b4bcb61, 0x350c9b64, 0x31cd86d3, 0x3c8ea00a, 0x384fbdbd, 0x4c11db70, 0x48d0c6c7, 0x4593e01e, 0x4152fda9, 0x5f15adac, 0x5bd4b01b, 0x569796c2, 0x52568b75, 0x6a1936c8, 0x6ed82b7f, 0x639b0da6, 0x675a1011, 0x791d4014, 0x7ddc5da3, 0x709f7b7a, 0x745e66cd, 0x9823b6e0, 0x9ce2ab57, 0x91a18d8e, 0x95609039, 0x8b27c03c, 0x8fe6dd8b, 0x82a5fb52, 0x8664e6e5, 0xbe2b5b58, 0xbaea46ef, 0xb7a96036, 0xb3687d81, 0xad2f2d84, 0xa9ee3033, 0xa4ad16ea, 0xa06c0b5d, 0xd4326d90, 0xd0f37027, 0xddb056fe, 0xd9714b49, 0xc7361b4c, 0xc3f706fb, 0xceb42022, 0xca753d95, 0xf23a8028, 0xf6fb9d9f, 0xfbb8bb46, 0xff79a6f1, 0xe13ef6f4, 0xe5ffeb43, 0xe8bccd9a, 0xec7dd02d, 0x34867077, 0x30476dc0, 0x3d044b19, 0x39c556ae, 0x278206ab, 0x23431b1c, 0x2e003dc5, 0x2ac12072, 0x128e9dcf, 0x164f8078, 0x1b0ca6a1, 0x1fcdbb16, 0x018aeb13, 0x054bf6a4, 0x0808d07d, 0x0cc9cdca, 0x7897ab07, 0x7c56b6b0, 0x71159069, 0x75d48dde, 0x6b93dddb, 0x6f52c06c, 0x6211e6b5, 0x66d0fb02, 0x5e9f46bf, 0x5a5e5b08, 0x571d7dd1, 0x53dc6066, 0x4d9b3063, 0x495a2dd4, 0x44190b0d, 0x40d816ba, 0xaca5c697, 0xa864db20, 0xa527fdf9, 0xa1e6e04e, 0xbfa1b04b, 0xbb60adfc, 0xb6238b25, 0xb2e29692, 0x8aad2b2f, 0x8e6c3698, 0x832f1041, 0x87ee0df6, 0x99a95df3, 0x9d684044, 0x902b669d, 0x94ea7b2a, 0xe0b41de7, 0xe4750050, 0xe9362689, 0xedf73b3e, 0xf3b06b3b, 0xf771768c, 0xfa325055, 0xfef34de2, 0xc6bcf05f, 0xc27dede8, 0xcf3ecb31, 0xcbffd686, 0xd5b88683, 0xd1799b34, 0xdc3abded, 0xd8fba05a, 0x690ce0ee, 0x6dcdfd59, 0x608edb80, 0x644fc637, 0x7a089632, 0x7ec98b85, 0x738aad5c, 0x774bb0eb, 0x4f040d56, 0x4bc510e1, 0x46863638, 0x42472b8f, 0x5c007b8a, 0x58c1663d, 0x558240e4, 0x51435d53, 0x251d3b9e, 0x21dc2629, 0x2c9f00f0, 0x285e1d47, 0x36194d42, 0x32d850f5, 0x3f9b762c, 0x3b5a6b9b, 0x0315d626, 0x07d4cb91, 0x0a97ed48, 0x0e56f0ff, 0x1011a0fa, 0x14d0bd4d, 0x19939b94, 0x1d528623, 0xf12f560e, 0xf5ee4bb9, 0xf8ad6d60, 0xfc6c70d7, 0xe22b20d2, 0xe6ea3d65, 0xeba91bbc, 0xef68060b, 0xd727bbb6, 0xd3e6a601, 0xdea580d8, 0xda649d6f, 0xc423cd6a, 0xc0e2d0dd, 0xcda1f604, 0xc960ebb3, 0xbd3e8d7e, 0xb9ff90c9, 0xb4bcb610, 0xb07daba7, 0xae3afba2, 0xaafbe615, 0xa7b8c0cc, 0xa379dd7b, 0x9b3660c6, 0x9ff77d71, 0x92b45ba8, 0x9675461f, 0x8832161a, 0x8cf30bad, 0x81b02d74, 0x857130c3, 0x5d8a9099, 0x594b8d2e, 0x5408abf7, 0x50c9b640, 0x4e8ee645, 0x4a4ffbf2, 0x470cdd2b, 0x43cdc09c, 0x7b827d21, 0x7f436096, 0x7200464f, 0x76c15bf8, 0x68860bfd, 0x6c47164a, 0x61043093, 0x65c52d24, 0x119b4be9, 0x155a565e, 0x18197087, 0x1cd86d30, 0x029f3d35, 0x065e2082, 0x0b1d065b, 0x0fdc1bec, 0x3793a651, 0x3352bbe6, 0x3e119d3f, 0x3ad08088, 0x2497d08d, 0x2056cd3a, 0x2d15ebe3, 0x29d4f654, 0xc5a92679, 0xc1683bce, 0xcc2b1d17, 0xc8ea00a0, 0xd6ad50a5, 0xd26c4d12, 0xdf2f6bcb, 0xdbee767c, 0xe3a1cbc1, 0xe760d676, 0xea23f0af, 0xeee2ed18, 0xf0a5bd1d, 0xf464a0aa, 0xf9278673, 0xfde69bc4, 0x89b8fd09, 0x8d79e0be, 0x803ac667, 0x84fbdbd0, 0x9abc8bd5, 0x9e7d9662, 0x933eb0bb, 0x97ffad0c, 0xafb010b1, 0xab710d06, 0xa6322bdf, 0xa2f33668, 0xbcb4666d, 0xb8757bda, 0xb5365d03, 0xb1f740b4 }; /* * Compute and return a POSIX 1003.2 checksum. */ #define COMPUTE(var, ch) (var) = (var) << 8 ^ crctab[(var) >> 24 ^ (ch)] void cksum(int *nstrings, char **strings, double *crcs) { int i ; register unsigned char *p; register unsigned int crc, len; for (i=0 ; i < *nstrings ; i++ ) { crc = len = 0; for ( p = (unsigned char *)strings[i] ; *p ; ++p, len++ ) { COMPUTE(crc, *p); } /* Include the length of the file. */ for (; len != 0; len >>= 8) { COMPUTE(crc, len & 0xff); } crcs[i] = (double) ~crc; } } bitops/NAMESPACE0000644000176000001440000000017712203674151013027 0ustar ripleyusers## Re-written 2012-11-03 B. D. Ripley useDynLib(bitops) export(bitFlip, bitAnd, bitOr, bitXor, bitShiftL, bitShiftR, cksum) bitops/R/0000755000176000001440000000000012203674151012004 5ustar ripleyusersbitops/R/bitops.R0000644000176000001440000000224012203674151013425 0ustar ripleyusers## MM: the "x <- a - a" (== integer(n)) and then ## --- "x <- x + .C(...)" ## is probably for safety, normalization of unsigned int ## -- and for NA/NaN handling -- but that is done too complicated here. ##--- and: If I really want pack bits into integers, ##--- I cannot really deal with NA-bits in such a way! ##---> I'd need extra structure to store NA locations... ## ## OTOH: instead of CLASSES & COPY, we should use .Call() !! bitFlip <- function(a,bitWidth=32) { .Call("bitFlip", a, bitWidth, PACKAGE = "bitops") } bitAnd <- function(a, b) { .Call("bitAnd", a, b, PACKAGE = "bitops") } bitOr <- function(a, b) { .Call("bitOr", a, b, PACKAGE = "bitops") } bitXor <- function(a, b) { .Call("bitXor", a, b, PACKAGE = "bitops") } bitShiftL <- function(a, b) { .Call("bitShiftL", a, b, PACKAGE = "bitops") } bitShiftR <- function(a, b) { .Call("bitShiftR", a, b, PACKAGE = "bitops") } cksum <- function(a) { x <- nchar(as.character(a))*0 x <- x + .C("cksum", length(a), as.character(a), val = as.numeric(x), NAOK=TRUE, DUP=TRUE, PACKAGE= "bitops")$val x[is.na(a)] <- NA x } bitops/README.md0000644000176000001440000000000012203674151013050 0ustar ripleyusersbitops/MD50000644000176000001440000000121612203745252012114 0ustar ripleyusers3136ef1c07a6e494c151ad0ff73fc47f *ChangeLog 262f3111f66f1c8b363a8a5d3f17e8bb *DESCRIPTION 17a0ec2e92452496167bc97715b4e70d *INDEX 7a49848cd6d0d82f0d7d665185891eea *NAMESPACE f1556b4833aa34668d26844d761d5464 *R/bitops.R d41d8cd98f00b204e9800998ecf8427e *README.md e3e9f7ba02483fa14ddf6fdb7c307b81 *man/bitAnd.Rd 6eedc37753c40f7ac37a73143a69310b *man/bitFlip.Rd a46e3326ae4ee0d4e067edc8ff7d9011 *man/bitShiftL.Rd e5518fc477d17b13e4492d6a8db401b6 *man/cksum.Rd 653ce0c3e2a1d4e0731b7b65b594c356 *src/bit-ops.c 107e7b3886382d8c5c2e620c2af5d850 *src/bit-ops.h 7fcce4120e44544f7c1ae64092dc4e73 *src/cksum.c 7a70ea3f5f8b5a8991b8cffbe7345c8d *tests/consistency.R bitops/DESCRIPTION0000644000176000001440000000076412203745252013321 0ustar ripleyusersPackage: bitops Version: 1.0-6 Date: 2013-08-17 Author: S original by Steve Dutky initial R port and extensions by Martin Maechler; revised and modified by Steve Dutky Maintainer: Martin Maechler Title: Bitwise Operations Description: Functions for bitwise operations on integer vectors. License: GPL (>= 2) Packaged: 2013-08-17 15:58:57 UTC; maechler NeedsCompilation: yes Repository: CRAN Date/Publication: 2013-08-17 21:10:34 bitops/ChangeLog0000644000176000001440000000243512203674151013361 0ustar ripleyusers2005-01-28 Steve Dutky * DESCRIPTION (Version): 1.0-4 * src/cksum.c: replaced all 'u_int' with 'unsigned character' to hopefully allow successful check & install for Windows 2005-01-26 Steve Dutky * DESCRIPTION (Version): 1.0-3 * src/bit-ops.c: converted from long long to unsigned long to ensure ANSI C compliance, redid limit checks to 32 bits * tests/consistency.R: adjusted limit checks * man/{ bitAnd.Rd bitFlip.Rd bitShiftL.Rd cksum.Rd}: adjusted to reflect use of unsigned long in place of long long * man/cksum.Rd: corrected reference to ACM article. 2005-01-10 Steve Dutky * DESCRIPTION (Version): 1.0-2 * src/bit-ops.c: (double *) i++ wherever NA_REAL set for binary ops tests & warnings compliant to recycling rules * src/init.c: not referenced, removed * tests/consistency.R: fixed, extended tests for NA, NaN, etc. 2004-11-22 Martin Maechler * DESCRIPTION (Version): 1.0-1 * src/cksum.c: use 'int', not 'long' (to work on 64-bit!) * man/cksum.Rd: fix \references{}, \email 2004-11-04 Steve Dutky * DESCRIPTION (Version): 1.0-0 * R/bitops.R: use .Call() everywhere * ..... bitops/man/0000755000176000001440000000000012203674151012356 5ustar ripleyusersbitops/man/cksum.Rd0000644000176000001440000000205612203674151013772 0ustar ripleyusers\name{cksum} \alias{cksum} \title{Compute Check Sum} \description{ Return a cyclic redundancy checksum for each element in the argument. } \usage{ cksum(a) } \arguments{ \item{a}{coerced to character vector} } \details{ \code{\link{NA}}'s appearing in the argument are returned as \code{NA}'s. The default calculation is identical to that given in pseudo-code in the ACM article (in the References). } \value{ numeric vector of the same length as \code{a}. } \references{ Fashioned from \code{cksum(1)} UNIX command line utility, i.e., \code{man cksum}. Dilip V. Sarwate (1988) Computation of Cyclic Redundancy Checks Via Table Lookup, \emph{Communications of the ACM} \bold{31}, 8, 1008--1013. } \author{Steve Dutky \email{sdutky@terpalum.umd.edu} } \seealso{\code{\link{bitShiftL}}, \code{\link{bitAnd}}, etc. } \examples{ b <- "I would rather have a bottle in front of me than frontal lobotomy\n" stopifnot(cksum(b) == 1342168430) (bv <- strsplit(b, " ")[[1]]) cksum(bv) # now a vector of length 13 } \keyword{arith} \keyword{utilities} bitops/man/bitAnd.Rd0000644000176000001440000000173012203674151014047 0ustar ripleyusers\name{bitAnd} \alias{bitAnd} \alias{bitOr} \alias{bitXor} \title{Bitwise And, Or and Xor Operations} \description{ Bitwise operations, \sQuote{and} (\code{\link{&}}), \sQuote{or} (\code{\link{|}}), and \sQuote{Xor} (\code{\link{xor}}). } \usage{ bitAnd(a, b) bitOr (a, b) bitXor(a, b) } \arguments{ \item{a,b}{numeric vectors of compatible length.} } \details{ The bitwise operations are applied to the arguments cast as 32 bit (unsigned long) integers. NA is returned wherever the magnitude of the arguments is not less than \eqn{2^31}, or, where either of the arguments is not finite. } \value{ numeric vector of maximum length of \code{a} or \code{b}. } %\references{ ~put references to the literature/web site here ~ } \author{Steve Dutky} \seealso{\code{\link{bitFlip}}, \code{\link{bitShiftL}}; further, \code{\link{cksum}}.} \examples{ bitAnd(15,7) == 7 bitOr(15,7) == 15 bitXor(15,7) == 8 bitOr(-1,0) == 4294967295 } \keyword{arith} \keyword{utilities} bitops/man/bitFlip.Rd0000644000176000001440000000143512203674151014241 0ustar ripleyusers\name{bitFlip} \alias{bitFlip} \title{Binary Flip (Not) Operator} \description{ The binary flip (not) operator, \code{bitFlip(a, w)}, \dQuote{flips every bit} of \code{a} up to the \code{w}-th bit. } \usage{ bitFlip(a, bitWidth=32) } \arguments{ \item{a}{numeric vector.} \item{bitWidth}{scalar integer between 0 and 32.} } \value{ binary numeric vector of the same length as \code{a} masked with (2^\code{bitWidth})-1. \code{\link{NA}} is returned for any value of \code{a} that is not finite or whose magnitude is greater or equal to \eqn{2^{32}}. } \author{Steve Dutky} \seealso{\code{\link{bitShiftL}}, \code{\link{bitXor}}, etc.} \examples{ stopifnot( bitFlip(-1) == 0, bitFlip(0 ) == 2^32 - 1, bitFlip(0, bitWidth=8) == 255 ) } \keyword{arith} \keyword{utilities} bitops/man/bitShiftL.Rd0000644000176000001440000000160612203674151014540 0ustar ripleyusers\name{bitShiftL} \alias{bitShiftL} \alias{bitShiftR} \title{Bitwise Shift Operator (to the Left or Right)} \description{ Shifting integers bitwise to the left or to the right. } \usage{ bitShiftL(a, b) bitShiftR(a, b) } \arguments{ \item{a}{numeric vector (integer valued), to be shifted.} \item{b}{integer vector } } \value{ numeric vector of the maximum length as \code{a} or \code{b} containing the value of \code{a} shifted to the left or right by \code{b} bits. NA is returned wherever the value of \code{a} or \code{b} is not finite, or, wherever the magnitude of \code{a} is greater than or equal to \eqn{2^{32}}. } %\author{ Steve Dutky } \seealso{\code{\link{bitFlip}}, \code{\link{bitXor}}, etc.} \examples{ bitShiftR(-1,1) == 2147483647 bitShiftL(2147483647,1) == 4294967294 bitShiftL(-1,1) == 4294967294 } \keyword{arith} \keyword{utilities} bitops/INDEX0000644000176000001440000000033612203674151012377 0ustar ripleyusersbitAnd Bitwise And, Or and Xor operations bitFlip Binary Flip (Not) Operator bitShiftL Bitwise Shift Operator (to the Left or Right) cksum Compute Check Sum