IRanges/DESCRIPTION0000644000126300012640000000530712234075662015207 0ustar00biocbuildphs_compbioPackage: IRanges Title: Infrastructure for manipulating intervals on sequences Description: The package provides efficient low-level and highly reusable S4 classes for storing ranges of integers, RLE vectors (Run-Length Encoding), and, more generally, data that can be organized sequentially (formally defined as Vector objects), as well as views on these Vector objects. Efficient list-like classes are also provided for storing big collections of instances of the basic classes. All classes in the package use consistent naming and share the same rich and consistent "Vector API" as much as possible. Version: 1.20.4 Author: H. Pages, P. Aboyoun and M. Lawrence Maintainer: Bioconductor Package Maintainer biocViews: Infrastructure, DataRepresentation Depends: R (>= 2.8.0), methods, utils, stats, BiocGenerics (>= 0.7.7) Imports: methods, utils, stats, BiocGenerics, stats4 Suggests: XVector, GenomicRanges, BSgenome.Celegans.UCSC.ce2, RUnit License: Artistic-2.0 ExtraLicenses: The following files in the 'src' directory are licensed for all use by Jim Kent, in a manner compatible with the Artistic 2.0 license: common.c/h, memalloc.c/h, localmem.c/h, hash.c/h, errabort.c/h, rbTree.c/h, dlist.c/h, errCatch.h Collate: S4-utils.R utils.R isConstant.R normarg-utils.R subsetting-utils.R int-utils.R str-utils.R compact_bitvector.R endoapply.R runstat.R Annotated-class.R Vector-class.R Vector-comparison.R List-class.R AtomicList-class.R Ranges-class.R Ranges-comparison.R IRanges-class.R IRanges-constructor.R IRanges-utils.R DataTable-API.R DataTable-stats.R Views-class.R Grouping-class.R SimpleList-class.R CompressedList-class.R Rle-class.R RleViews-class.R RleViews-utils.R AtomicList-impl.R DataFrame-class.R DataFrame-utils.R DataFrameList-class.R DataFrameList-utils.R RangesList-class.R GappedRanges-class.R ViewsList-class.R RleViewsList-class.R RleViewsList-utils.R MaskCollection-class.R RangedData-class.R FilterRules-class.R RDApplyParams-class.R RangedData-utils.R Hits-class.R HitsList-class.R RangesMapping-class.R IntervalTree-class.R IntervalTree-utils.R IntervalForest-class.R OverlapEncodings-class.R RangedSelection-class.R read.Mask.R funprog-methods.R intra-range-methods.R inter-range-methods.R setops-methods.R findOverlaps-methods.R nearest-methods.R encodeOverlaps-methods.R reverse-methods.R coverage-methods.R slice-methods.R expand-methods.R updateObject-methods.R classNameForDisplay-methods.R test_IRanges_package.R debug.R zzz.R Packaged: 2013-10-30 03:23:30 UTC; biocbuild IRanges/NAMESPACE0000644000126300012640000003146212227064501014711 0ustar00biocbuildphs_compbiouseDynLib(IRanges) import(methods) importFrom(utils, head, read.table, tail, stack, relist) importFrom(stats, start, end, var, cov, cor, sd, median, quantile, mad, IQR, smoothEnds, runmed, window, "window<-", aggregate, na.omit, na.exclude, complete.cases, setNames) import(BiocGenerics) importFrom(stats4, summary, update) importFrom(parallel, mclapply, mcmapply) exportClasses( characterORNULL, functionORNULL, Annotated, DataTable, DataTableORNULL, Vector, List, SimpleList, CompressedList, Ranges, RangesORmissing, IRanges, NormalIRanges, IntervalTree, IntervalForest, Grouping, H2LGrouping, Dups, Partitioning, PartitioningByEnd, PartitioningByWidth, Views, Rle, RleViews, MaskCollection, AtomicList, CompressedAtomicList, SimpleAtomicList, LogicalList, CompressedLogicalList, SimpleLogicalList, IntegerList, CompressedIntegerList, SimpleIntegerList, NumericList, CompressedNumericList, SimpleNumericList, ComplexList, CompressedComplexList, SimpleComplexList, CharacterList, CompressedCharacterList, SimpleCharacterList, RawList, CompressedRawList, SimpleRawList, RleList, CompressedRleList, SimpleRleList, RangesList, SimpleRangesList, IRangesList, CompressedIRangesList, SimpleIRangesList, NormalIRangesList, CompressedNormalIRangesList, SimpleNormalIRangesList, GappedRanges, ViewsList, SimpleViewsList, RleViewsList, SimpleRleViewsList, DataFrame, DataFrameList, SimpleDataFrameList, SplitDataFrameList, CompressedSplitDataFrameList, SimpleSplitDataFrameList, RangedData, RangedDataList, FilterRules, FilterMatrix, RDApplyParams, Hits, HitsList, CompressedHitsList, OverlapEncodings, RangedSelection, RangesMapping ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export S3 methods ### S3method(aggregate, Rle) S3method(as.data.frame, DataFrame) S3method(as.data.frame, DataFrameList) S3method(as.data.frame, GappedRanges) S3method(as.data.frame, Hits) S3method(as.data.frame, OverlapEncodings) S3method(as.data.frame, RangedData) S3method(as.data.frame, Ranges) S3method(as.data.frame, RangesList) S3method(as.data.frame, Rle) S3method(as.data.frame, Vector) S3method(as.list, List) S3method(as.list, SimpleList) S3method(as.list, CompressedList) S3method(as.list, Rle) S3method(as.list, CompressedNormalIRangesList) S3method(as.list, Hits) S3method(diff, Rle) S3method(duplicated, Vector) S3method(duplicated, Ranges) S3method(duplicated, Dups) S3method(duplicated, DataTable) S3method(duplicated, Rle) S3method(duplicated, AtomicList) S3method(duplicated, CompressedAtomicList) S3method(head, Vector) S3method(levels, Rle) S3method(levels, OverlapEncodings) S3method(mean, Rle) S3method(median, Rle) S3method(quantile, Rle) S3method(rev, Rle) S3method(sort, Vector) S3method(sort, Rle) S3method(sort, RleList) S3method(summary, Rle) S3method(tail, Vector) S3method(unique, Vector) S3method(unique, DataTable) S3method(unique, Rle) S3method(unique, CompressedAtomicList) S3method(unique, CompressedRleList) S3method(unique, SimpleRleList) S3method(window, Vector) S3method(window, vector) S3method(window, factor) S3method(window, NULL) S3method(window, Rle) S3method(`window<-`, Vector) S3method(`window<-`, vector) S3method(`window<-`, factor) ### We also export them thru the export() directive so that (a) they can be ### called directly, (b) tab-completion on the name of the generic shows them, ### (but ?generic. shows all documented methods) and (c) methods() ### doesn't asterisk them. export( aggregate.Rle, as.data.frame.DataFrame, as.data.frame.DataFrameList, as.data.frame.GappedRanges, as.data.frame.Hits, as.data.frame.OverlapEncodings, as.data.frame.RangedData, as.data.frame.Ranges, as.data.frame.RangesList, as.data.frame.Rle, as.data.frame.Vector, as.list.List, as.list.SimpleList, as.list.CompressedList, as.list.Rle, as.list.CompressedNormalIRangesList, as.list.Hits, diff.Rle, duplicated.Vector, duplicated.Ranges, duplicated.Dups, duplicated.DataTable, duplicated.Rle, duplicated.AtomicList, duplicated.CompressedAtomicList, head.Vector, levels.Rle, levels.OverlapEncodings, mean.Rle, median.Rle, quantile.Rle, rev.Rle, sort.Vector, sort.Rle, sort.RleList, summary.Rle, tail.Vector, unique.Vector, unique.DataTable, unique.Rle, unique.CompressedAtomicList, unique.CompressedRleList, unique.SimpleRleList, window.Vector, window.vector, window.factor, window.NULL, window.Rle, "window<-.Vector", "window<-.vector", "window<-.factor" ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export S4 methods for generics not defined in IRanges ### exportMethods( length, "length<-", names, "names<-", nrow, NROW, ncol, NCOL, dim, rownames, "rownames<-", colnames, "colnames<-", dimnames, "dimnames<-", "[", "[<-", "[[", "[[<-", "$", "$<-", as.vector, as.logical, as.integer, as.numeric, as.complex, as.character, as.raw, as.factor, as.matrix, as.data.frame, as.list, as.table, coerce, c, show, "==", "!=", "<=", ">=", "<", ">", duplicated, match, "%in%", order, sort, rank, is.unsorted, Ops, Math, Math2, Summary, Complex, summary, rev, rep, head, tail, drop, start, end, min, max, range, which.max, which.min, diff, mean, var, cov, cor, sd, median, quantile, mad, IQR, smoothEnds, runmed, subset, window, "window<-", aggregate, nchar, substr, substring, chartr, tolower, toupper, sub, gsub, levels, "levels<-", unlist, stack, "split<-", unsplit, relist, update, append, "!", which, ifelse, merge, split, with, within, t, is.na, na.omit, na.exclude, complete.cases, by, cbind, rbind, eval, lapply, sapply, mapply, pmax, pmin, pmax.int, pmin.int, paste, Reduce, Filter, Find, Map, Position, rep.int, table, tapply, union, intersect, setdiff, unique, xtabs, updateObject ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export non-generic functions ### export( setValidity2, new2, setMethods, .Call2, isTRUEorFALSE, isSingleInteger, isSingleNumber, isSingleString, isSingleNumberOrNA, isSingleStringOrNA, recycleIntegerArg, recycleNumericArg, fold, safeExplode, strsplitAsListOfIntegerVectors, svn.time, subsetByRanges, multisplit, seqapply, mseqapply, tseqapply, seqsplit, seqby, splitAsList, solveUserSEW0, IRanges, solveUserSEW, successiveIRanges, breakInChunks, whichAsIRanges, asNormalIRanges, rangeComparisonCodeToLetter, IntervalTree, IntervalForest, H2LGrouping, Dups, PartitioningByEnd, PartitioningByWidth, RangedData, RangedDataList, RangedSelection, FilterRules, FilterMatrix, RDApplyParams, RangesList, IRangesList, RleViewsList, remapHits, CompressedHitsList, hits, "%over%", "%within%", "%outside%", encodeOverlaps1, RangesList_encodeOverlaps, MaskCollection.show_frame, Mask, read.gapMask, read.agpMask, read.liftMask, read.rmMask, read.trfMask, ##read.chain, newViews, successiveViews, SimpleList, DataFrame, LogicalList, IntegerList, NumericList, ComplexList, CharacterList, RawList, RleList, DataFrameList, SplitDataFrameList, get_showHeadLines, get_showTailLines ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Export S4 generics defined in IRanges + export corresponding methods ### export( ## isConstant.R: isConstant, ## endoapply.R: endoapply, mendoapply, ## runstat.R: runsum, runmean, runwtsum, runq, ## Annotated-class.R: metadata, "metadata<-", ## Vector-class.R: showAsCell, elementMetadata, "elementMetadata<-", mcols, "mcols<-", values, "values<-", rename, seqselect, "seqselect<-", splitAsListReturnedClass, mstack, shiftApply, ## List-class.R: elementType, elementLengths, isEmpty, revElements, as.env, ## Ranges-class.R: width, mid, "start<-", "width<-", "end<-", isNormal, whichFirstNotNormal, ## Ranges-comparison.R compare, selfmatch, findMatches, countMatches, ## Views-class.R: subject, ranges, "ranges<-", Views, trim, subviews, viewApply, viewMins, viewMaxs, viewSums, viewMeans, viewWhichMins, viewWhichMaxs, viewRangeMins, viewRangeMaxs, ## Grouping-class.R: nobj, grouplength, members, vmembers, togroup, togrouplength, high2low, low2high, grouprank, togrouprank, ## Rle-class.R: runLength, runValue, nrun, "runLength<-", "runValue<-", Rle, findRange, findRun, splitRanges, ## DataFrameList-class.R: columnMetadata, "columnMetadata<-", ## RangesList-class.R: universe, "universe<-", space, ## GappedRanges-class.R: ngap, ## MaskCollection-class.R: nir_list, active, "active<-", desc, "desc<-", maskedwidth, maskedratio, collapse, ## RangedData-class.R: score, "score<-", ## RangedData-utils.R: rdapply, ## FilterRules-class.R: evalSeparately, subsetByFilter, params, ## RDApplyParams-class.R: rangedData, "rangedData<-", applyFun, "applyFun<-", applyParams, "applyParams<-", ##excludePattern, "excludePattern<-", filterRules, "filterRules<-", simplify, "simplify<-", reducerFun, "reducerFun<-", reducerParams, "reducerParams<-", iteratorFun, "iteratorFun<-", ## Hits-class.R: queryHits, subjectHits, queryLength, subjectLength, countQueryHits, countSubjectHits, ## RangesMapping-class.R: map, pmap, ## OverlapEncodings-class.R: Loffset, Roffset, encoding, flippedQuery, Lencoding, Rencoding, Lngap, Rngap, ## intra-range-methods.R: shift, narrow, flank, reflect, resize, promoters, restrict, threebands, ## inter-range-methods.R: reduce, gaps, disjoin, isDisjoint, disjointBins, ## setops-methods.R: punion, pintersect, psetdiff, pgap, ## findOverlaps-methods.R: findOverlaps, countOverlaps, overlapsAny, subsetByOverlaps, ## nearest-methods.R: precede, follow, nearest, distance, distanceToNearest, ## encodeOverlaps-methods.R: encodeOverlaps, ## reverse-methods.R: reverse, ## coverage-methods.R: coverage, ## slice-methods.R: slice, ## expand-methods.R: expand, ## classNameForDisplay-methods.R: classNameForDisplay ) ### Exactly the same list as above. exportMethods( isConstant, endoapply, mendoapply, runsum, runmean, runwtsum, runq, metadata, "metadata<-", showAsCell, elementMetadata, "elementMetadata<-", mcols, "mcols<-", values, "values<-", rename, seqselect, "seqselect<-", splitAsListReturnedClass, mstack, shiftApply, elementType, elementLengths, isEmpty, revElements, as.env, width, mid, "start<-", "width<-", "end<-", isNormal, whichFirstNotNormal, compare, selfmatch, findMatches, countMatches, subject, ranges, "ranges<-", Views, trim, subviews, viewApply, viewMins, viewMaxs, viewSums, viewMeans, viewWhichMins, viewWhichMaxs, viewRangeMins, viewRangeMaxs, nobj, grouplength, members, vmembers, togroup, togrouplength, high2low, low2high, grouprank, togrouprank, runLength, runValue, nrun, "runLength<-", "runValue<-", Rle, findRange, findRun, splitRanges, columnMetadata, "columnMetadata<-", universe, "universe<-", space, ngap, nir_list, active, "active<-", desc, "desc<-", maskedwidth, maskedratio, collapse, score, "score<-", rdapply, evalSeparately, subsetByFilter, params, rangedData, "rangedData<-", applyFun, "applyFun<-", applyParams, "applyParams<-", ##excludePattern, "excludePattern<-", filterRules, "filterRules<-", simplify, "simplify<-", reducerFun, "reducerFun<-", reducerParams, "reducerParams<-", iteratorFun, "iteratorFun<-", queryHits, subjectHits, queryLength, subjectLength, countQueryHits, countSubjectHits, map, pmap, Loffset, Roffset, encoding, flippedQuery, Lencoding, Rencoding, Lngap, Rngap, shift, narrow, flank, reflect, resize, promoters, restrict, threebands, reduce, gaps, disjoin, isDisjoint, disjointBins, punion, pintersect, psetdiff, pgap, findOverlaps, countOverlaps, overlapsAny, subsetByOverlaps, precede, follow, nearest, distance, distanceToNearest, encodeOverlaps, reverse, coverage, slice, expand, classNameForDisplay ) IRanges/NEWS0000644000126300012640000005642012227346737014210 0ustar00biocbuildphs_compbioCHANGES IN VERSION 1.20.0 ------------------------- NEW FEATURES o Add IntervalForest class from Hector Corrada Bravo. o Add a FilterMatrix class, for holding the results of multiple filters. o Add selfmatch() as a faster equivalent of 'match(x, x)'. o Add "c" method for Views objects (only combine objects with same subject). o Add coercion from SimpleRangesList to SimpleIRangesList. o Add an `%outside%` that is the opposite of `%over%`. o Add validation of length() and names() of Vector objects. o Add "duplicated" and "table" methods for Vector objects. o Add some split methods that dispatch to splitAsList() even when only 'f' is a Vector. SIGNIFICANT USER-VISIBLE CHANGES o All functionalities related to XVector objects have been moved to the new XVector package. o Refine how isDisjoint() handles empty ranges. o Remove 'keepLength' argument from "window<-" methods. o unlist( , use.names=FALSE) on a CompressedSplitDataFrameList object now preserves the rownames of the list elements, which is more consistent with what unlist() does on other CompressedList objects. o Splitting a list by a Vector just yields a list, not a List. o The rbind,DataFrame method now handles the case where Rle and vector columns need to be combined (assuming an equivalence between Rle and vector). Also the way the result DataFrame is constructed was changed (avoids undesirable coercions and should be faster). o as.data.frame.DataFrame now passes 'stringsAsFactors=FALSE' and 'check.names=!optional' to the underlying data.frame() call. as(x,"DataFrame") sets 'optional=TRUE' when delegating. Most places where we called as.data.frame(), we now call 'as(x,"data.frame")'. o The [<-,DataFrame method now coerces column sub-replacement value to class of column when the column already exists. o DataFrame() now automatically derives rownames (from the first argument that has some). This is a fairly significant change in behavior, but it probably does better match user behavior. o Make sure that SimpleList objects are coerced to a DataFrame with a single column. The automatic coecion methods created by the methods package were trying to create a DataFrame with one column per element, because DataFrame extends SimpleList. o Change default to 'compress=TRUE' for RleList() constructor. o tapply() now handles the case where only INDEX is a Vector (e.g. an Rle object). o Speedup coverage() in the "tiling case" (i.e. when 'x' is a tiling of the [1, width] interval). This makes it much faster to turn into an Rle a coverage loaded from a BigWig, WIG or BED as a GRanges object. o Allow logical Rle return values from filter rules. o FilterRules no longer requires its elements to be named. o The select,Vector method now returns a DataFrame even when a single column is selected. o Move is.unsorted() generic to BiocGenerics. DEPRECATED AND DEFUNCT o Deprecate seqselect() and subsetByRanges(). o Deprecate 'match.if.overlap' arg of "match" method for Ranges objects. o "match" and "%in%" methods that operate on Views, ViewsList, RangesList, or RangedData objects (20 methods in total) are now defunct. o Remove previously defunct tofactor(). BUG FIXES o The subsetting code for Vector derivatives was substancially refactored. As a consequence, it's now cleaner, simpler, and [ and [[ behave more consistently across Vector derivatives. Some obscure long-standing bugs have been eliminated and the code can be slightly faster in some circumstances. o Fix bug in findOverlaps(); zero-width ranges in the query no longer produce hits ever (regardless of 'maxgap' and 'minoverlap' values). o Correctly free memory allocated for linked list of results compiled for findOverlap(select="all"). o Various fixes for AsIs and DataFrames. o Allow zero-row replacement values in [<-,DataFrame. o Fix long standing segfault in "[" method for Rle objects (when doing Rle()[0]). o "show" methods now display its most specific class when a column or slot is an S3 object for which class() returns more than one class. o "show" methods now display properly cells that are arrays. o Fix the [<-,DataFrame method for when a value DataFrame has matrix columns. o Fix ifelse() for when one or more of the arguments are Rle objects. o Fix coercion from SimpleList to CompressedList via AtomicList constructors. o Make "show" methods robust to "showHeadLines" and "showTailLines" global options set to NA, Inf or non-integer values. o Fix error condition in eval,FilterRules method. o Corrected an error formatting in eval,FilterRules,ANY method. CHANGES IN VERSION 1.18.0 ------------------------- NEW FEATURES o Add global options 'showHeadLines' and 'showTailLines' to control the number of head/tails lines displayed by "show" methods for Ranges, DataTable, and Hits objects. o "subset" method for Vector objects now considers metadata columns. o Add classNameForDisplay() generic and use it in all "show" methods defined in IRanges and GenomicRanges. o as(x, "DataFrame") now works on *any* R object. o Add findMatches(), an enhanced version of match() that returns all the matches between 'x' and 'table'. The hits are returned in a Hits object. Also add countMatches() for counting the number of matches in 'table' for each element in 'x'. o Add overlapsAny() as a replacement for %in% (now deprecated on range-based objects), and %over% and %within% as convenience wrappers for overlapsAny(). %over% is the replacement for %in%. o Add 'with.mapping' arg to "reduce" methods for IRanges, Ranges, Views, RangesList, and CompressedIRangesList objects. o Add "order" method for Rle objects. o Add subsetByRanges() generic with methods for ANY, NULL, vector, and IRanges for now. This is work-in-progress and more methods will be added soon. The long term plan is to make this a replacement for seqselect(), but with a faster and cleaner implementation. o Add promoters() generic with methods for Ranges, RangesList, Views, and CompressedIRangesList objects. o elementLengths() now works on XVectorList objects (and thus works on DNAStringSet objects and family defined in the Biostrings package). Note that this is the first step towards having relist() work on XVector objects (e.g. DNAString objects) eventhough this is not ready yet. o Add "mstack" method for DataFrame objects. o Add 'name.var' argument to "stack" method for List objects for naming the optional column formed when the elements themselves have named elements. SIGNIFICANT USER-VISIBLE CHANGES o "distanceToNearest" methods now return a Hits instead of a DataFrame object. o The behavior of distance() has changed. Adjacent and overlapping ranges now return a distance of 0L. See ?distance man page for details. A temporary warning will be emitted by distance() until the release of Bioconductor 2.13. o Change arg list of expand() generic: function(x, ...) instead of function(x, colnames, keepEmptyRows). o Dramatic duplicated() and unique() speedups on CompressedAtomicList objects. o Significant endoapply() speedup on XVectorList objects (this benefits DNAStringSet objects and family defined in the Biostrings package). o 2x speedup to "c" method for CompressedList objects. o classNameForDisplay() strips 'Simple' or 'Compressed', which affects all the "show" methods based on it. So now: > IntegerList(1:4, 2:-3) IntegerList of length 2 [[1]] 1 2 3 4 [[2]] 2 1 0 -1 -2 -3 instead of: > IntegerList(1:4, 2:-3) CompressedIntegerList of length 2 [[1]] 1 2 3 4 [[2]] 2 1 0 -1 -2 -3 o Optimization of "[<-" method for Rle objects when no indices are selected (just return self). o "stack" method for List objects now creates a factor for the optional name variable. o Evaluating FilterRules now subsets by each filter individually, rather than subsetting by all at the end. o Optimized which() on CompressedLogicalList objects. o All the binary comparison operations (==, <=, etc...) on Ranges objects are now using compare() behind the scene. This makes them slightly faster and also slightly more memory efficient. DEPRECATED AND DEFUNCT o %in% is now deprecated on range-based objects. Please use %over% instead. More precisely: - "match" and "%in%" methods that operate on Views, ViewsList, RangesList, or RangedData objects (20 methods in total) are now deprecated. - Behavior of match() and %in% on Ranges objects was changed (and will issue a warning) to use equality instead of overlap for comparing elements between Ranges objects 'x' and 'table'. The old behavior is still available for match() via new 'match.if.overlap' arg that is FALSE by default (the arg will be deprecated in BioC 2.13 and removed in BioC 2.14). o tofactor() is now defunct. o '.ignoreElementMetadata' argument of "c" method for IRanges objects is now defunct. BUG FIXES o Small fix to "unlist" method for CompressedList objects when 'use.names' is TRUE and 'x' is a zero-length named List (the zero-length vector returned in that case was not named, now it is). o "resize" method for Ranges objects now allows zero-length 'fix' when 'x' is zero-length. o Subsetting a Views object now subsets its metadata columns. o Names on the vector-like columns of a DataFrame object are now preserved when calling DataFrame(), or when coercing to DataFrame, or when combining DataFrame objects with rbind(). o relist() now propagates the names on 'skeleton' when returning a SimpleList. o Better argument checking in breakInChunks(). o Fix broken "showAsCell" method for ANY. Now tries to coerce uni-dimensional objects to vector instead of data.frame (which never worked anyway, due to a bug). o Fix long standing bug in "flank" method for Ranges objects: it no longer returns an invalid object when NAs are passed thru the 'width' arg. Now it's an error to try to do so. o Fix issue with some of the "as.env" methods not being able to find the environment of the caller. o Fix bug in "showAsCell" method for AtomicList objects: now returns character(0) instead of NULL on an object of length 0. o sort() now drops NA's when 'na.last=NA' on an Rle object (consistent with base::sort). o table() now handles NA's appropriately on an Rle object. o table() now returns all the levels on a factor-Rle object. o Fix sub-replacement of Rles when using Ranges as the index. o Fix bug in [<- method for DataFrame objects. The fix corrects the way a new column created by a subset assignment is filled. Previously, if the first row was set, say, to '1', all values in the column were set to '1' when they needed to be set to NA (for consistency with data.frame). o Fix bug in compare() (was not returning 0 when comparing a 0-width range to itself). o Fix naming of column when passing an AsIs matrix to DataFrame() -- no more .X suffix. o Fix "rbind" method for DataFrame objects when some columns are matrix objects. CHANGES IN VERSION 1.16.0 ------------------------- NEW FEATURES o as( , "SimpleList"), as( , "CompressedList"), and as( , "List") now work on atomic vectors, and each element of the vector corresponds to an element of the returned List (this is consistent with as.list). o Add as.list,Rle method. o Add as.matrix,Views method. Each view corresponds to a row in the returned matrix. Rows corresponding to views shorter than the longest view are right-padded with NAs. o Add FilterClosure closure class for functions placed into a FilterRules. Has methods for getting parameters and showing. o Support 'na.rm' argument in "runsum", "runwtsum", "runq", and "runmean" methods for Rle and RleList objects. o Add splitAsList() and splitAsListReturnedClass(). o Improve summary,FilterRules to support serial evaluation, discarded counts (instead of passed) and percentages. o Make rename work on ordinary vector (in addition to Vector). o Add coercion from RangedData to CompressedIRangesList, IRangesList, or RangesList. It propagates the data columns (aka values) of the RangedData object to the inner metadata columns of the RangesList object. o Add 'NG' arg to PartitioningByEnd() and PartitioningByWidth() constructors. o Make PartitioningByEnd() work on list-like objects (like PartitioningByWidth()). o Fast disjoin() for moderate-sized CompressedIRangesList. o Add countQueryHits() and countSubjectHits(). o coverage() now supports method="auto" and this is the new default. o Add the flippedQuery(), levels(), ngap(), Lngap(), Rngap(), Lencoding(), and Rencoding() getters for OverlapEncodings objects. o Add "encodeOverlaps" method for GRangesList objects. o Enhance "[" methods for IRanges, XVector, XVectorList, and MaskCollection objects, as well as "[<-" method for IRanges objects, by supporting the following subscript types: NULL, Rle, numeric, logical, character, and factor. (All the methods listed above already supported some of those types but no method supported them all). o Add remapHits() for remapping the query and subject hits of a Hits object. o Add match,Hits method. o Add %in%,Vector method. o Add "compare", "==", "!=", "<=", ">=", "<", ">", "is.unsorted", "order", "rank", "match", and "duplicated" methods for XRawList objects. unique() and sort() also work on these objects via the "unique" and "sort" methods for Vector objects. o Add expand() for expanding a DataFrame based on the contents of one or more designated columms. o After being deprecated (in BioC 2.9) and defunct (in BioC 2.10), the "as.vector" method for AtomicList objects is back, but now it mimics what as.vector() does on an ordinary list i.e. it's equivalent to 'as.vector(as.list(x), mode=mode)'. Also coercions from AtomicList to logical/integer/numeric/double/complex/character/raw are back and based on the "as.vector" method for AtomicList objects i.e. they work only on objects with top-level elements of length <= 1. o DataFrame constructor now supports 'check.names' argument. o Add revElements() generic with methods for List and CompressedList objects. SIGNIFICANT USER-VISIBLE CHANGES o Splitting / relisting a Hits object now returns a HitsList instead of an ordinary list. o Operations in the Ops group between a List and an atomic vector operand now coerce the atomic vector to List (SimpleList or CompressedList) before performing the operation. Also, operands are recycled and a better job is done returning zero length results of the correct type. o Change the warning for 'Integer overflow ...' thrown by sum() on integer-Rle's o DataFrame now coerces List/list value to DataFrame in [<-. o Fix as.matrix,DataFrame for zero column DataFrames. Returns an nrow()x0 logical matrix. o union,Hits method now sorts the returned hits first by query hit, then by subject hit. o Add mcols() accessor as the preferred way (over elementMetadata() and values()) to access the metadata columns of a Vector object. o By default, mcols(x) and elementMetadata(x) do NOT propagate the names of x as the row names of the returned DataTable anymore. However the user can still get the old behavior by doing mcols(x, use.names=TRUE). o [<-,XVectorList now preserves the original names instead of propagating the names of the replacement value, which is consistent with how [<- operates on an ordinary vector/list. o coverage() now returns a numeric-Rle when passed numeric weights. o When called on a List object with use.names=TRUE, unlist() no longer tries to mimic the kind of non-sense name mangling that base::unlist() does (e.g. on list(a=1:3)) in a pointless effort to return a vector with unique names. o Remove 'hits' argument from signature of encodeOverlaps() generic function. o unique,Vector now drops the names for consistency with base::unique(). o Remove make.names() coercion in colnames<-,DataFrame for consistency with data.frame. DEPRECATED AND DEFUNCT o Deprecated tofactor(). o Remove RangesMatching, RangesMatchingList, and Binning classes. o Change from deprecated to defunct: matchMatrix(), "dim" method for Hits objects, and RangesMatchingList(). BUG FIXES o Fix bug in pintersect,IRanges,IRanges when input had empty ranges (broken since 2010-03-04). o Avoid integer overflow in mean,Rle method by coercing integer-Rle to numeric-Rle internally. o Change evaluation frame of with,List to parent.frame(), and get the enclosure correct in eval,List. o Many fixes and improvements to coercion from RangesList to RangedData (see commit 68195 for the details). o Fix "runValue" and "ranges" methods for CompressedRleList objects (broken for a very long time). o shift,Ranges method now fails in case of integer overflow instead of returning an invalid Ranges object. o mstack() now works on Vector objects with NULL metadata columns. o In case of integer overflow, coverage() now puts NAs in the returned Rle and issues a warning. o Fix bug in xvcopy,XRawList objects that prevented sequences from being removed from the cache of a BSgenome object. See commit 67171 for the details. o Fix issues related to duplicate column names in DataFrame (see commit 67163 for the details). o Fix a bunch of subsetting methods that were not subsetting the metadata columns: "[", "subseq", and "seqselect" methods for XVector objects, "seqselect" and "window" methods for XVectorList objects, and "[" method for MaskCollection objects. o Fix empty replacement with [<-,Vector o Make %in% robust on an empty 'table' argument when operating on Hits objects. CHANGES IN VERSION 1.14.0 ------------------------- NEW FEATURES o The map generic and RangesMapping class for mapping ranges between sequences according to some alignment. Some useful methods are implemented in GenomicRanges. o The Hits class has experimental support for basic set operations, including setdiff, union and intersect. o Added a number of data manipulation functions and methods, including mstack, multisplit, rename, unsplit for Vector. o Added compare() generic for generalized range-wise comparison of 2 range-based objects. o Added OverlapEncodings class and encodeOverlaps() generic for dealing with "overlap encodings". o subsetByOverlaps() should now work again on an RleViews object. o DataFrame now supports storing an array (like a matrix) in a column. o Added as.matrix,DataFrame method. o Added merge,DataTable,DataTable method. o Added disjointBins,RangesList method. o Added ranges,Rle and ranges,RleList methods. o Added which.max,Rle method. o Added drop,AtomicList method. o Added tofactor() wrapper around togroup(). o Added coercions from vector to any AtomicList subtype (compressed and uncompressed). o Added AtomicList to Character/Numeric/Logical/Integer/Raw/ComplexList coercions. o Added revElements() for reversing individual elements of a List object. SIGNIFICANT USER-VISIBLE CHANGES o RangesMatching has been renamed to Hits and extends Vector, so that it supports metadata columns and other features. o RangesMatchingList has been renamed to HitsList. o The 2 columns of the matrix returned by the "as.matrix" method for Hits objects are now named queryHits/subjectHits instead of query/subject, for consistency with the queryHits() and subjectHits() getters. o queryLength()/subjectLength() are recommended alternatives to dim,Hits. o breakInChunks() returns a PartitioningByWidth object. o The 'weight' arg in "coverage" methods for IRanges, Views and MaskCollection objects now can also be a single string naming a column in elementMetadata(x). o "countOverlaps" methods now propagate the names of the query. DEPRECATED AND DEFUNCT o matchMatrix,Hits is deprecated. o Moved the following deprecated features to defunct status: - use of as.data.frame() or as( , "data.frame") on an AtomicList object; - all coercion methods from AtomicList to atomic vectors; - subsetting an IRanges by Ranges; - subsetting a RangesList or RangedData by RangesList. BUG FIXES o within,RangedData/List now support replacing columns o aggregate() override no longer breaks on . ~ x formulas o "[", "c", "rep.int" and "seqselect" methods for Rle objects are now safer and will raise an error if the object to be returned has a length > .Machine$integer.max o Avoid blowing up memory by not expanding 'logical' Rle's into logical vectors internally in "slice" method for RleList objects. CHANGES IN VERSION 1.12.0 ------------------------- NEW FEATURES o Add "relist" method that works on a List skeleton. o Add XDoubleViews class with support of most of the functionalities available for XIntegerViews. o c() now works on XInteger and XDouble objects (in addition to XRaw objects). o Add min, max, mean, sum, which.min, which.max methods as synonyms for the view* functions. SIGNIFICANT USER-VISIBLE CHANGES o Views and RleViewsList classes don't derive from IRanges and IRangesList classes anymore. o When used on a List or a list, togroup() now returns an integer vector (instead of a factor) for consistency with what it does on other objects (e.g. on a Partitioning object). o Move compact() generic from Biostrings to IRanges. o Drop deprecated 'multiple' argument from "findOverlaps" methods. o Drop deprecated 'start' and 'symmetric' arguments from "resize" method for Ranges objects. DEPRECATED AND DEFUNCT o Using as.data.frame() and or as( , "data.frame") on an AtomicList object is deprecated. o Deprecate all coercion methods from AtomicList to atomic vectors. Those methods were unlisting the object, which can still be done with unlist(). o Deprecate the Binning class. o Remove defunct overlap() and countOverlap(). BUG FIXES o togroup() on a List or a list does not look at the names anymore to infer the grouping, only at the shape of the list-like object. o Fix 'relist(IRanges(), IRangesList())'. o Fix 'rep.int(Rle(), integer(0))'. o Fix some long-standing issues with the XIntegerViews code (better handling of "out of limits" or empty views, overflows, NAs). IRanges/R/0000755000126300012640000000000012234041342013661 5ustar00biocbuildphs_compbioIRanges/R/Annotated-class.R0000644000126300012640000000201512227064470017033 0ustar00biocbuildphs_compbio### ========================================================================= ### Annotated objects ### ------------------------------------------------------------------------- setClass("Annotated", representation("VIRTUAL", metadata = "list")) setGeneric("metadata", function(x, ...) standardGeneric("metadata")) setMethod("metadata", "Annotated", function(x) { if (is.null(x@metadata) || is.character(x@metadata)) list(metadata = x@metadata) else x@metadata }) setGeneric("metadata<-", function(x, ..., value) standardGeneric("metadata<-")) setReplaceMethod("metadata", "Annotated", function(x, value) { if (!is.list(value)) stop("replacement 'metadata' value must be a list") if (!length(value)) names(value) <- NULL # instead of character() x@metadata <- value x }) IRanges/R/AtomicList-class.R0000644000126300012640000000247312227064470017176 0ustar00biocbuildphs_compbio### ========================================================================= ### AtomicList objects ### ------------------------------------------------------------------------- ## A list that holds atomic objects setClass("AtomicList", representation("VIRTUAL"), prototype = prototype(elementType = "logical"), contains = "List") setClass("LogicalList", representation("VIRTUAL"), prototype = prototype(elementType = "logical"), contains = "AtomicList") setClass("IntegerList", representation("VIRTUAL"), prototype = prototype(elementType = "integer"), contains = "AtomicList") setClass("NumericList", representation("VIRTUAL"), prototype = prototype(elementType = "numeric"), contains = "AtomicList") setClass("ComplexList", representation("VIRTUAL"), prototype = prototype(elementType = "complex"), contains = "AtomicList") setClass("CharacterList", representation("VIRTUAL"), prototype = prototype(elementType = "character"), contains = "AtomicList") setClass("RawList", representation("VIRTUAL"), prototype = prototype(elementType = "raw"), contains = "AtomicList") setClass("RleList", representation("VIRTUAL"), prototype = prototype(elementType = "Rle"), contains = "AtomicList") IRanges/R/AtomicList-impl.R0000644000126300012640000012356012234041342017022 0ustar00biocbuildphs_compbio### ========================================================================= ### AtomicList object implementations ### ------------------------------------------------------------------------- ## Possible optimizations for compressed lists: ## - order/sort: unlist, order by split factor first ## - sum/mean: unlist, rowsum() with split factor ## - cumsum: unlist, cumsum and subtract offsets .ATOMIC_TYPES <- c("logical", "integer", "numeric", "complex", "character", "raw") setClassUnion("atomic", .ATOMIC_TYPES) ## A list that holds atomic objects setClass("CompressedAtomicList", contains = c("AtomicList", "CompressedList"), representation("VIRTUAL")) setClass("SimpleAtomicList", contains = c("AtomicList", "SimpleList"), representation("VIRTUAL")) setClass("CompressedLogicalList", prototype = prototype(elementType = "logical", unlistData = logical()), contains = c("LogicalList", "CompressedAtomicList")) setClass("SimpleLogicalList", prototype = prototype(elementType = "logical"), contains = c("LogicalList", "SimpleAtomicList")) setClass("CompressedIntegerList", prototype = prototype(elementType = "integer", unlistData = integer()), contains = c("IntegerList", "CompressedAtomicList")) setClass("SimpleIntegerList", prototype = prototype(elementType = "integer"), contains = c("IntegerList", "SimpleAtomicList")) setClass("CompressedNumericList", prototype = prototype(elementType = "numeric", unlistData = numeric()), contains = c("NumericList", "CompressedAtomicList")) setClass("SimpleNumericList", prototype = prototype(elementType = "numeric"), contains = c("NumericList", "SimpleAtomicList")) setClass("CompressedComplexList", prototype = prototype(elementType = "complex", unlistData = complex()), contains = c("ComplexList", "CompressedAtomicList")) setClass("SimpleComplexList", prototype = prototype(elementType = "complex"), contains = c("ComplexList", "SimpleAtomicList")) setClass("CompressedCharacterList", prototype = prototype(elementType = "character", unlistData = character()), contains = c("CharacterList", "CompressedAtomicList")) setClass("SimpleCharacterList", prototype = prototype(elementType = "character"), contains = c("CharacterList", "SimpleAtomicList")) setClass("CompressedRawList", prototype = prototype(elementType = "raw", unlistData = raw()), contains = c("RawList", "CompressedAtomicList")) setClass("SimpleRawList", prototype = prototype(elementType = "raw"), contains = c("RawList", "SimpleAtomicList")) setClass("CompressedRleList", prototype = prototype(elementType = "Rle", unlistData = new("Rle")), contains = c("RleList", "CompressedAtomicList")) setClass("SimpleRleList", prototype = prototype(elementType = "Rle"), contains = c("RleList", "SimpleAtomicList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructors ### .dotargsAsList <- function(type, ...) { listData <- list(...) if (length(listData) == 1) { arg1 <- listData[[1]] if (is.list(arg1) || is(arg1, "List")) listData <- arg1 else if (type == "integer" && class(arg1) == "character") listData <- strsplitAsListOfIntegerVectors(arg1) # weird special case } listData } AtomicListConstructor <- function(type, compress.default = TRUE) { constructor <- eval(substitute(function(..., compress = compress.default) { if (!isTRUEorFALSE(compress)) stop("'compress' must be TRUE or FALSE") listData <- .dotargsAsList(type, ...) CompressedOrSimple <- if (compress) "Compressed" else "Simple" if (is(listData, listClassName(CompressedOrSimple, type))) listData else CoercerToAtomicList(type, compress)(listData) }, list(type = type))) formals(constructor)$compress <- compress.default constructor } LogicalList <- AtomicListConstructor("logical") IntegerList <- AtomicListConstructor("integer") NumericList <- AtomicListConstructor("numeric") ComplexList <- AtomicListConstructor("complex") CharacterList <- AtomicListConstructor("character") RawList <- AtomicListConstructor("raw") RleList <- AtomicListConstructor("Rle") atomicElementListClass <- function(x) { if (is(x, "Rle")) ans <- "RleList" else if (is.raw(x)) ans <- "RawList" else if (is.logical(x)) ans <- "LogicalList" else if (is.integer(x)) ans <- "IntegerList" else if (is.numeric(x)) ans <- "NumericList" else if (is.complex(x)) ans <- "ComplexList" else if (is.character(x)) ans <- "CharacterList" else ans <- NA_character_ ans } ### FIXME: these seem very similar to asList(). SimpleAtomicList <- function(listData) { classOrder <- c("RleList", "CharacterList", "ComplexList", "NumericList", "IntegerList", "LogicalList", "RawList") uniqueClasses <- unique(unlist(lapply(listData, atomicElementListClass), use.names=FALSE)) if (anyMissing(uniqueClasses)) stop("cannot create a SimpleAtomicList with non-atomic elements") baseClass <- classOrder[min(match(uniqueClasses, classOrder))] do.call(baseClass, c(listData, compress = FALSE)) } CompressedAtomicList <- function(unlistData, partitioning) { classOrder <- c("RleList", "CharacterList", "ComplexList", "NumericList", "IntegerList", "LogicalList", "RawList") baseClass <- atomicElementListClass(unlistData) if (is.na(baseClass)) stop("cannot create a CompressedAtomicList with non-atomic elements") new2(paste("Compressed", baseClass, sep = ""), unlistData = unlistData, partitioning = partitioning, check = FALSE) } CompressedAtomicListFromList <- function(listData) { classOrder <- c("RleList", "CharacterList", "ComplexList", "NumericList", "IntegerList", "LogicalList", "RawList") uniqueClasses <- unique(unlist(lapply(listData, atomicElementListClass), use.names=FALSE)) if (anyMissing(uniqueClasses)) stop("cannot create a SimpleAtomicList with non-atomic elements") baseClass <- classOrder[min(match(uniqueClasses, classOrder))] do.call(baseClass, c(listData, compress = TRUE)) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Iteration ### setMethod("lapply", "CompressedAtomicList", function(X, FUN, ...) { if (is(X, "CompressedRleList")) { callNextMethod(X, FUN, ...) } else { lapply(as.list(X), FUN, ...) } }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### setMethod("as.list", "CompressedAtomicList", function(x, use.names = TRUE) { if (is(x, "CompressedRleList")) { callNextMethod(x, use.names = use.names) } else { codes <- seq_len(length(x)) ans <- split(x@unlistData, structure(rep.int(codes, elementLengths(x)), levels = as.character(codes), class = "factor")) if (use.names) { names(ans) <- names(x) } else { names(ans) <- NULL } ans } }) setAs("CompressedAtomicList", "list", function(from) as.list(from)) ### Equivalent to 'as.vector(as.list(x), mode=mode)' but faster on ### CompressedAtomicList objects (10x, 75x, or more, depending on 'length(x)'). setMethod("as.vector", "AtomicList", function(x, mode="any") { valid_modes <- c("any", .ATOMIC_TYPES, "double", "list") mode <- match.arg(mode, valid_modes) if (mode %in% c("any", "list")) return(as.list(x)) elt_lens <- elementLengths(x) if (any(elt_lens > 1L)) stop("coercing an AtomicList object to an atomic vector ", "is supported only for\n", " objects with top-level elements of length <= 1") ans <- base::rep.int(as.vector(NA, mode=mode), length(x)) ans[elt_lens == 1L] <- as.vector(unlist(x, use.names=FALSE), mode=mode) ans } ) setMethod("drop", "AtomicList", function(x) { lens <- elementLengths(x) if (any(lens > 1)) stop("All element lengths must be <= 1") x_dropped <- rep.int(NA, sum(lens)) x_dropped[lens > 0] <- unlist(x, use.names = FALSE) names(x_dropped) <- names(x) x_dropped }) CoercerToAtomicList <- function(type, compress) { .coerceToList <- if (compress) coerceToCompressedList else coerceToSimpleList function(from) { .coerceToList(from, type) } } setAtomicListCoercions <- function(type) { CompressedClass <- listClassName("Compressed", type) SimpleClass <- listClassName("Simple", type) Class <- listClassName("", type) setAs("ANY", CompressedClass, CoercerToAtomicList(type, compress = TRUE)) setAs("ANY", SimpleClass, CoercerToAtomicList(type, compress = FALSE)) setAs("ANY", Class, CoercerToAtomicList(type, compress = TRUE)) } setAtomicListCoercions("logical") setAtomicListCoercions("integer") setAtomicListCoercions("numeric") setAtomicListCoercions("complex") setAtomicListCoercions("character") setAtomicListCoercions("raw") setAtomicListCoercions("Rle") ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Group generic methods ### emptyOpsReturnValue <- function(.Generic, e1, e2, compress) { dummy.vector <- do.call(.Generic, list(vector(e1@elementType), vector(e2@elementType))) CoercerToAtomicList(NULL, compress)(dummy.vector) } recycleList <- function(x, length.out) { if (length.out %% length(x) > 0L) warning("shorter object is not a multiple of longer object length") rep(x, length.out = length.out) } setMethod("Ops", signature(e1 = "SimpleAtomicList", e2 = "SimpleAtomicList"), function(e1, e2) { if (length(e1) == 0L || length(e2) == 0L) { return(emptyOpsReturnValue(.Generic, e1, e2, compress = FALSE)) } n <- max(length(e1), length(e2)) e1 <- recycleList(e1, n) e2 <- recycleList(e2, n) SimpleAtomicList(Map(.Generic, e1, e2)) }) repLengthOneElements <- function(x, times) { x@unlistData <- rep(x@unlistData, times) x@partitioning@end <- cumsum(times) x } setMethod("Ops", signature(e1 = "CompressedAtomicList", e2 = "CompressedAtomicList"), function(e1, e2) { if (length(e1) == 0L || length(e2) == 0L) { return(emptyOpsReturnValue(.Generic, e1, e2, compress = TRUE)) } n <- max(length(e1), length(e2)) e1 <- recycleList(e1, n) e2 <- recycleList(e2, n) nms <- names(e1) if (is.null(nms)) nms <- names(e2) n1 <- elementLengths(e1) n2 <- elementLengths(e2) if (any(n1 != n2)) { if (all(n1 == 1L)) { e1 <- repLengthOneElements(e1, n2) } else if (all(n2 == 1L)) { e2 <- repLengthOneElements(e2, n1) } else { u1 <- as.list(e1) u2 <- as.list(e2) zeroLength <- which((n1 == 0L) | (n2 == 0L)) empty1 <- e1[[1L]][integer(0)] empty2 <- e2[[1L]][integer(0)] for (i in zeroLength) { u1[[i]] <- empty1 u2[[i]] <- empty2 } n1[zeroLength] <- 0L n2[zeroLength] <- 0L for (i in which(n1 < n2)) u1[[i]] <- rep(u1[[i]], length.out = n2[i]) for (i in which(n2 < n1)) u2[[i]] <- rep(u2[[i]], length.out = n1[i]) partitioningEnd <- cumsum(pmax.int(n1, n2)) e1@unlistData <- unlist(u1) e1@partitioning@end <- partitioningEnd e2@unlistData <- unlist(u2) e2@partitioning@end <- partitioningEnd } } partitioning <- e1@partitioning names(partitioning) <- nms CompressedAtomicList(callGeneric(e1@unlistData, e2@unlistData), partitioning = partitioning) }) setMethod("Ops", signature(e1 = "SimpleAtomicList", e2 = "CompressedAtomicList"), function(e1, e2) { classMap <- c("character" = "CharacterList", "complex" = "ComplexList", "numeric" = "NumericList", "integer" = "IntegerList", "logical" = "LogicalList", "raw" = "RawList", "Rle" = "RleList") if (sum(as.numeric(elementLengths(e1))) < .Machine$integer.max) e1 <- do.call(classMap[e1@elementType], c(e1@listData, compress = TRUE)) else e2 <- do.call(classMap[e2@elementType], c(as.list(e2), compress = FALSE)) callGeneric(e1, e2) }) setMethod("Ops", signature(e1 = "CompressedAtomicList", e2 = "SimpleAtomicList"), function(e1, e2) { classMap <- c("character" = "CharacterList", "complex" = "ComplexList", "numeric" = "NumericList", "integer" = "IntegerList", "logical" = "LogicalList", "raw" = "RawList", "Rle" = "RleList") if (sum(as.numeric(elementLengths(e2))) < .Machine$integer.max) e2 <- do.call(classMap[e2@elementType], c(e2@listData, compress = TRUE)) else e1 <- do.call(classMap[e1@elementType], c(as.list(e1), compress = FALSE)) callGeneric(e1, e2) }) setMethod("Ops", signature(e1 = "AtomicList", e2 = "atomic"), function(e1, e2) { e2 <- as(e2, "List") callGeneric(e1, e2) }) setMethod("Ops", signature(e1 = "atomic", e2 = "AtomicList"), function(e1, e2) { e1 <- as(e1, "List") callGeneric(e1, e2) }) setMethod("Ops", signature(e1 = "SimpleAtomicList", e2 = "atomic"), function(e1, e2) { e2 <- as(e2, "SimpleList") callGeneric(e1, e2) }) setMethod("Ops", signature(e1 = "atomic", e2 = "SimpleAtomicList"), function(e1, e2) { e1 <- as(e1, "SimpleList") callGeneric(e1, e2) }) setMethod("Ops", signature(e1 = "CompressedAtomicList", e2 = "atomic"), function(e1, e2) { if (length(e2) > 1) { e2 <- recycleVector(e2, length(e1)) e2 <- rep(e2, elementLengths(e1)) } CompressedAtomicList(callGeneric(e1@unlistData, e2), partitioning = e1@partitioning) }) setMethod("Ops", signature(e1 = "atomic", e2 = "CompressedAtomicList"), function(e1, e2) { if (length(e1) > 1) { e1 <- recycleVector(e1, length(e2)) e1 <- rep(e1, elementLengths(e2)) } CompressedAtomicList(callGeneric(e1, e2@unlistData), partitioning = e2@partitioning) }) setMethod("Math", "CompressedAtomicList", function(x) { CompressedAtomicList(callGeneric(x@unlistData), partitioning = x@partitioning) }) setMethod("cumsum", "CompressedAtomicList", function(x) { xunlist <- unlist(x, use.names=FALSE) xcumsum <- cumsum(as.numeric(xunlist)) partition <- PartitioningByEnd(x) ans <- xcumsum - rep(xcumsum[start(partition)] - xunlist[start(partition)], width(partition)) CompressedAtomicList(ans, partitioning=x@partitioning) }) setMethod("cumprod", "CompressedAtomicList", function(x) { lst <- as(x, "list") CompressedAtomicListFromList(lapply(lst, .Generic)) }) setMethod("cummin", "CompressedAtomicList", function(x) { lst <- as(x, "list") CompressedAtomicListFromList(lapply(lst, .Generic)) }) setMethod("cummax", "CompressedAtomicList", function(x) { lst <- as(x, "list") CompressedAtomicListFromList(lapply(lst, .Generic)) }) setMethod("Math", "SimpleAtomicList", function(x) SimpleAtomicList(lapply(x@listData, .Generic))) setMethod("Math2", "CompressedAtomicList", function(x, digits) { if (missing(digits)) digits <- ifelse(.Generic == "round", 0, 6) CompressedAtomicList(callGeneric(x@unlistData, digits = digits), partitioning = x@partitioning) }) setMethod("Math2", "SimpleAtomicList", function(x, digits) { if (missing(digits)) digits <- ifelse(.Generic == "round", 0, 6) SimpleAtomicList(lapply(x@listData, .Generic, digits = digits)) }) setMethod("Summary", "AtomicList", function(x, ..., na.rm = FALSE) { sapply(x, .Generic, na.rm = na.rm) }) rowsumCompressedList <- function(x, ..., na.rm = FALSE) { x_flat <- unlist(x, use.names = FALSE) ans <- vector(class(x_flat), length(x)) non_empty <- elementLengths(x) > 0 if (is.logical(x_flat)) x_flat <- as.integer(x_flat) ans[non_empty] <- rowsum(x_flat, togroup(x), reorder = FALSE, na.rm = na.rm)[,1] setNames(ans, names(x)) } setMethod("sum", "CompressedNumericList", rowsumCompressedList) setMethod("sum", "CompressedIntegerList", rowsumCompressedList) setMethod("sum", "CompressedLogicalList", rowsumCompressedList) setMethod("Summary", "CompressedRleList", function(x, ..., na.rm = FALSE) { toViewFun <- list(max = viewMaxs, min = viewMins, sum = viewSums) if (!is.null(viewFun <- toViewFun[[.Generic]])) { ans <- viewFun(as(x, "RleViews"), na.rm = na.rm) names(ans) <- names(x) ans } else sapply(x, .Generic, na.rm = na.rm) }) setMethod("all", "CompressedRleList", function(x, ..., na.rm = FALSE) { args <- list(...) if (length(args) > 0L) stop("Only a single argument in '...' is supported for now") if (!isTRUEorFALSE(na.rm)) stop("'na.rm' must be TRUE or FALSE") rv <- runValue(x) if (na.rm) rv <- rv[!is.na(rv)] elen <- elementLengths(rv) ans <- elen == 0L singletons <- elen == 1L ans[singletons] <- unlist(rv, use.names = FALSE)[singletons[togroup(rv)]] ans }) setMethod("Complex", "CompressedAtomicList", function(z) CompressedAtomicList(callGeneric(z@unlistData), partitioning = z@partitioning)) setMethod("Complex", "SimpleAtomicList", function(z) SimpleAtomicList(lapply(z@listData, .Generic))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### More list-ized methods ### setListMethod <- function(f, inputClass, outputBaseClass, whichArg = 1L, remainingSignature = character(), mapply = FALSE, endoapply = FALSE, applyToUnlist = FALSE, where = topenv(parent.frame())) { fargs <- formals(args(get(f))) args <- sapply(names(fargs), as.name) names(args) <- sub("...", "", names(args), fixed = TRUE) if (applyToUnlist) { call2 <- as.call(c(as.name("@"), args[[whichArg]], "partitioning")) args[[whichArg]] <- as.call(c(as.name("@"), args[[whichArg]], "unlistData")) call1 <- as.call(c(as.name(f), args)) call <- as.call(c(as.name("new2"), paste("Compressed", outputBaseClass, sep=""), unlistData = call1, partitioning = call2, check = FALSE)) } else { args <- c(args[[whichArg]], as.name(f), args[-whichArg]) if (endoapply) { call <- as.call(c(as.name("endoapply"), args)) } else if (missing(outputBaseClass)) { call <- as.call(c(as.name("sapply"), args, list(simplify = TRUE))) } else { if (mapply) { if (length(args) <= 3) { call <- as.call(c(as.name("mapply"), args[c(2:1,3L)], SIMPLIFY = FALSE)) } else { call <- as.call(c(as.name("mapply"), args[c(2:1,3L)], MoreArgs = as.call(c(as.name("list"), tail(args, -3))), SIMPLIFY = FALSE)) } } else { call <- as.call(c(as.name("lapply"), args)) } if (extends(inputClass, "SimpleList")) { call <- as.call(c(as.name("new2"), paste("Simple", outputBaseClass, sep=""), listData = call, check = FALSE)) } else { call <- as.call(c(as.name(outputBaseClass), call, compress = TRUE)) } } } def <- as.function(c(fargs, call)) environment(def) <- parent.frame() setMethod(f, c(rep("ANY", whichArg - 1L), inputClass, remainingSignature), def, where) } setAtomicListMethod <- function(f, inputBaseClass = "AtomicList", outputBaseClass, whichArg = 1L, remainingSignature = character(), mapply = FALSE, endoapply = FALSE, applyToUnlist = FALSE, addRleList = TRUE, rleListOutputBaseClass = "RleList", where = topenv(parent.frame())) { if (missing(outputBaseClass)) { for (i in inputBaseClass) setListMethod(f, i, whichArg = whichArg, remainingSignature = remainingSignature, endoapply = endoapply, where = where) } else if (endoapply) { setListMethod(f, "AtomicList", whichArg = whichArg, remainingSignature = remainingSignature, endoapply = TRUE, where = where) } else { setListMethod(f, paste("Simple", inputBaseClass, sep = ""), outputBaseClass = outputBaseClass, whichArg = whichArg, remainingSignature = remainingSignature, mapply = mapply, where = where) setListMethod(f, paste("Compressed", inputBaseClass, sep = ""), outputBaseClass = outputBaseClass, whichArg = whichArg, remainingSignature, mapply = mapply, applyToUnlist = applyToUnlist, where = where) if (addRleList) { setListMethod(f, "SimpleRleList", outputBaseClass = rleListOutputBaseClass, whichArg = whichArg, remainingSignature = remainingSignature, mapply = mapply, where = where) setListMethod(f, "CompressedRleList", outputBaseClass = rleListOutputBaseClass, whichArg = whichArg, remainingSignature = remainingSignature, mapply = mapply, applyToUnlist = applyToUnlist, where = where) } } } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### General methods ### setAtomicListMethod("is.na", outputBaseClass = "LogicalList", applyToUnlist = TRUE) ### S3/S4 combo for duplicated.AtomicList duplicated.AtomicList <- function(x, incomparables=FALSE, fromLast=FALSE, ...) { if (is(x, "CompressedList")) ans_class <- "CompressedLogicalList" else ans_class <- "SimpleLogicalList" ans_listData <- lapply(x, duplicated, incomparables=incomparables, fromLast=fromLast, ...) newList(ans_class, ans_listData) } setMethod("duplicated", "AtomicList", duplicated.AtomicList) ### S3/S4 combo for duplicated.CompressedAtomicList .duplicated.CompressedAtomicList <- function(x, incomparables=FALSE, fromLast=FALSE) { if (!identical(incomparables, FALSE)) stop("\"duplicated\" method for CompressedAtomicList objects ", "does not support the 'incomparables' argument") x_unlistData <- x@unlistData sm <- match(x_unlistData, x_unlistData) # doesn't work on an Rle x_group <- rep.int(seq_along(x), elementLengths(x)) ans_unlistData <- duplicatedIntegerPairs(x_group, sm, fromLast=fromLast) relist(ans_unlistData, x) } duplicated.CompressedAtomicList <- function(x, incomparables=FALSE, fromLast=FALSE, ...) .duplicated.CompressedAtomicList(x, incomparables=incomparables, fromLast=fromLast, ...) setMethod("duplicated", "CompressedAtomicList", duplicated.CompressedAtomicList) ### S3/S4 combo for unique.CompressedAtomicList .unique.CompressedAtomicList <- function(x, incomparables=FALSE, fromLast=FALSE) { if (!identical(incomparables, FALSE)) stop("\"unique\" method for CompressedAtomicList objects ", "does not support the 'incomparables' argument") is_dup <- duplicated(x, incomparables=incomparables, fromLast=fromLast) x_unlistData <- x@unlistData keep_idx <- which(!is_dup@unlistData) ans_unlistData <- x_unlistData[keep_idx] x_group <- rep.int(seq_along(x), elementLengths(x)) ans_group <- x_group[keep_idx] ans_eltlens <- tabulate(ans_group, nbins=length(x)) ans_partitioning <- PartitioningByEnd(cumsum(ans_eltlens), names=names(x)) relist(ans_unlistData, ans_partitioning) } unique.CompressedAtomicList <- function(x, incomparables=FALSE, ...) .unique.CompressedAtomicList(x, incomparables=incomparables, ...) setMethod("unique", "CompressedAtomicList", unique.CompressedAtomicList) ### S3/S4 combo for unique.CompressedRleList unique.CompressedRleList <- function(x, incomparables=FALSE, ...) { if (is.factor(runValue(x@unlistData))) runValue(x@unlistData) <- as.character(runValue(x@unlistData)) CompressedAtomicListFromList(lapply(x, unique, incomparables = incomparables, ...)) } setMethod("unique", "CompressedRleList", unique.CompressedRleList) ### S3/S4 combo for unique.SimpleRleList unique.SimpleRleList <- function(x, incomparables=FALSE, ...) { SimpleAtomicList(lapply(x, function(y) { if (is.factor(runValue(y))) runValue(y) <- as.character(runValue(y)) unique(y, incomparables = incomparables, ...) })) } setMethod("unique", "SimpleRleList", unique.SimpleRleList) setAtomicListMethod("match", outputBaseClass = "IntegerList", remainingSignature = "atomic") setAtomicListMethod("match", outputBaseClass = "IntegerList", remainingSignature = "AtomicList", mapply = TRUE) setAtomicListMethod("%in%", outputBaseClass = "LogicalList", remainingSignature = "atomic") setAtomicListMethod("%in%", outputBaseClass = "LogicalList", remainingSignature = "AtomicList", mapply = TRUE) setMethod("table", "SimpleAtomicList", function(...) { args <- list(...) if (length(args) > 1) stop("Only one argument in '...' supported") x <- args[[1L]] values <- as.character(sort(unique(unlist(lapply(x, unique), use.names=FALSE)))) zeros <- structure(rep.int(0L, length(values)), names = values) if (is.null(names(x))) names(x) <- as.character(seq_len(length(x))) structure(do.call(rbind, lapply(x, function(elt) { eltTable <- table(elt) out <- zeros out[names(eltTable)] <- eltTable out })), class = "table") }) setMethod("table", "CompressedAtomicList", function(...) { args <- list(...) if (length(args) > 1) stop("Only one argument in '...' supported") x <- args[[1L]] nms <- names(x) if (is.null(nms)) { nms <- as.character(seq_len(length(x))) } nms <- factor(rep.int(nms, elementLengths(x)), levels = nms) ans <- table(nms, as.vector(unlist(x, use.names = FALSE))) names(dimnames(ans)) <- NULL ans }) setAtomicListMethod("order", outputBaseClass = "IntegerList") ### S3/S4 combo for sort.RleList sort.RleList <- function(x, decreasing=FALSE, ...) endoapply(x, sort, decreasing=decreasing, ...) setMethod("sort", "RleList", sort.RleList) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Logical methods ### setAtomicListMethod("!", inputBaseClass = "LogicalList", outputBaseClass = "LogicalList", applyToUnlist = TRUE) setAtomicListMethod("which", inputBaseClass = "LogicalList", outputBaseClass = "IntegerList", rleListOutputBaseClass = "IntegerList") setMethod("which", "CompressedLogicalList", function(x) { x.flat <- unlist(x, use.names = FALSE) part <- PartitioningByEnd(x) which.global <- which(x.flat) group <- findInterval(which.global, start(part)) which.local <- which.global - start(part)[group] + 1L ans <- seqsplit(which.local, factor(group, seq_len(length(x)))) names(ans) <- names(x) ans }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Numerical methods ### for (i in c("IntegerList", "NumericList", "RleList")) { setAtomicListMethod("diff", inputBaseClass = i, endoapply = TRUE) setAtomicListMethod("which.max", inputBaseClass = i) setAtomicListMethod("which.min", inputBaseClass = i) setMethod("pmax", i, function(..., na.rm = FALSE) mendoapply(pmax, ..., MoreArgs = list(na.rm = na.rm))) setMethod("pmin", i, function(..., na.rm = FALSE) mendoapply(pmin, ..., MoreArgs = list(na.rm = na.rm))) setMethod("pmax.int", i, function(..., na.rm = FALSE) mendoapply(pmax.int, ..., MoreArgs = list(na.rm = na.rm))) setMethod("pmin.int", i, function(..., na.rm = FALSE) mendoapply(pmin.int, ..., MoreArgs = list(na.rm = na.rm))) } setMethod("mean", "AtomicList", function(x, ...) sapply(x, mean, ...) ) setMethod("var", c("AtomicList", "missing"), function(x, y=NULL, na.rm=FALSE, use) { if (missing(use)) use <- ifelse(na.rm, "na.or.complete", "everything") sapply(x, var, na.rm=na.rm, use=use) } ) setMethod("var", c("AtomicList", "AtomicList"), function(x, y=NULL, na.rm=FALSE, use) { if (missing(use)) use <- ifelse(na.rm, "na.or.complete", "everything") mapply(var, x, y, MoreArgs=list(na.rm=na.rm, use=use)) } ) setMethod("cov", c("AtomicList", "AtomicList"), function(x, y=NULL, use="everything", method=c("pearson", "kendall", "spearman")) mapply(cov, x, y, MoreArgs=list(use=use, method=match.arg(method))) ) setMethod("cor", c("AtomicList", "AtomicList"), function(x, y=NULL, use="everything", method=c("pearson", "kendall", "spearman")) mapply(cor, x, y, MoreArgs=list(use=use, method=match.arg(method))) ) setMethod("sd", "AtomicList", function(x, na.rm=FALSE) sapply(x, sd, na.rm=na.rm) ) setMethod("median", "AtomicList", function(x, na.rm=FALSE) sapply(x, median, na.rm=na.rm) ) setMethod("quantile", "AtomicList", function(x, ...) sapply(x, quantile, ...) ) setMethod("mad", "AtomicList", function(x, center=median(x), constant=1.4826, na.rm=FALSE, low=FALSE, high=FALSE) { if (!missing(center)) stop("'center' argument is not supported") sapply(x, mad, constant=constant, na.rm=na.rm, low=low, high=high) } ) setMethod("IQR", "AtomicList", function(x, na.rm=FALSE, type=7) sapply(x, IQR, na.rm=na.rm, type=type) ) setMethod("which.max", "CompressedRleList", function(x) { viewWhichMaxs(as(x, "RleViews"), na.rm=TRUE) - c(0L, head(cumsum(elementLengths(x)), -1)) }) setMethod("which.min", "CompressedRleList", function(x) { viewWhichMins(as(x, "RleViews"), na.rm=TRUE) - c(0L, head(cumsum(elementLengths(x)), -1)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Running window statistic methods ### setAtomicListMethod("smoothEnds", inputBaseClass = "IntegerList", outputBaseClass = "NumericList", addRleList = FALSE) setAtomicListMethod("smoothEnds", inputBaseClass = "NumericList", endoapply = TRUE) setAtomicListMethod("smoothEnds", inputBaseClass = "RleList", endoapply = TRUE) setMethod("runmed", "CompressedIntegerList", function(x, k, endrule = c("median", "keep", "constant"), algorithm = NULL, print.level = 0) NumericList(lapply(x, runmed, k = k, endrule = match.arg(endrule), algorithm = algorithm, print.level = print.level))) setMethod("runmed", "SimpleIntegerList", function(x, k, endrule = c("median", "keep", "constant"), algorithm = NULL, print.level = 0) NumericList(lapply(x, runmed, k = k, endrule = match.arg(endrule), algorithm = algorithm, print.level = print.level), compress = FALSE)) setMethod("runmed", "NumericList", function(x, k, endrule = c("median", "keep", "constant"), algorithm = NULL, print.level = 0) endoapply(x, runmed, k = k, endrule = match.arg(endrule), algorithm = algorithm, print.level = print.level)) setMethod("runmed", "RleList", function(x, k, endrule = c("median", "keep", "constant"), algorithm = NULL, print.level = 0) endoapply(x, runmed, k = k, endrule = match.arg(endrule))) setMethod("runmean", "RleList", function(x, k, endrule = c("drop", "constant"), na.rm = FALSE) endoapply(x, runmean, k = k, endrule = match.arg(endrule), na.rm = na.rm)) setMethod("runsum", "RleList", function(x, k, endrule = c("drop", "constant"), na.rm = FALSE) endoapply(x, runsum, k = k, endrule = match.arg(endrule), na.rm = na.rm)) setMethod("runwtsum", "RleList", function(x, k, wt, endrule = c("drop", "constant"), na.rm = FALSE) endoapply(x, runwtsum, k = k, wt = wt, endrule = match.arg(endrule), na.rm = na.rm)) setMethod("runq", "RleList", function(x, k, i, endrule = c("drop", "constant"), na.rm = FALSE) endoapply(x, runq, k = k, i = i, endrule = match.arg(endrule), na.rm = na.rm)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Character ### setAtomicListMethod("nchar", inputBaseClass = "CharacterList", outputBaseClass = "IntegerList", applyToUnlist = TRUE) ## need vectorized start, end ##setAtomicListMethod("substr") ##setAtomicListMethod("substring") setAtomicListMethod("chartr", inputBaseClass = "CharacterList", outputBaseClass = "CharacterList", whichArg = 3L, applyToUnlist = TRUE) setAtomicListMethod("tolower", inputBaseClass = "CharacterList", outputBaseClass = "CharacterList", applyToUnlist = TRUE) setAtomicListMethod("toupper", inputBaseClass = "CharacterList", outputBaseClass = "CharacterList", applyToUnlist = TRUE) setAtomicListMethod("sub", inputBaseClass = "CharacterList", outputBaseClass = "CharacterList", whichArg = 3L, applyToUnlist = TRUE) setAtomicListMethod("gsub", inputBaseClass = "CharacterList", outputBaseClass = "CharacterList", whichArg = 3L, applyToUnlist = TRUE) ### TODO: grep, grepl ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Rle methods ### setMethod("runValue", "RleList", function(x) { seqapply(x, runValue) }) setMethod("runValue", "CompressedRleList", function(x) { rle <- unlist(x, use.names=FALSE) rlePart <- PartitioningByWidth(runLength(rle)) listPart <- PartitioningByEnd(x) ## 'rlePart' cannot contain empty ranges so using ## Using 'hit.empty.query.ranges=TRUE' won't affect the result ## (because 'rlePart' cannot contain empty ranges) but it makes ## findOverlaps_Ranges_Partitioning() just a little bit faster. hits <- findOverlaps_Ranges_Partitioning(rlePart, listPart, hit.empty.query.ranges=TRUE) ans_partitioning <- PartitioningByEnd(subjectHits(hits), NG=length(x)) ans_unlistData <- runValue(rle)[queryHits(hits)] ans <- relist(ans_unlistData, ans_partitioning) names(ans) <- names(x) ans } ) setMethod("runLength", "RleList", function(x) { seqapply(x, runLength) }) setMethod("runLength", "CompressedRleList", function(x) { width(ranges(x)) }) setMethod("ranges", "RleList", function(x) { seqapply(x, ranges) }) diceRangesByList <- function(x, list) { listPart <- PartitioningByEnd(list) ## 'x' cannot contain empty ranges so using ## 'hit.empty.query.ranges=TRUE' won't affect the result but ## it makes findOverlaps_Ranges_Partitioning() just a little ## bit faster. hits <- findOverlaps_Ranges_Partitioning(x, listPart, hit.empty.query.ranges=TRUE) ans_partitioning <- PartitioningByEnd(subjectHits(hits), NG=length(list)) ans_unlistData <- shift(ranges(hits, x, listPart), 1L - start(listPart)[subjectHits(hits)]) ans <- relist(ans_unlistData, ans_partitioning) names(ans) <- names(list) ans } setMethod("ranges", "CompressedRleList", function(x) { rle <- unlist(x, use.names=FALSE) rlePart <- PartitioningByWidth(runLength(rle)) diceRangesByList(rlePart, x) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### .showAtomicList <- function(object, minLines, ...) { len <- length(object) k <- min(minLines, len) d <- len - minLines for (i in seq_len(k)) { nm <- names(object)[i] if (length(nm) > 0 && nchar(nm) > 0) label <- paste("[[\"", nm, "\"]]", sep = "") else label <- paste("[[", i, "]]", sep = "") if (length(object[[i]]) == 0) { cat(label, " ", sep = "") print(object[[i]]) } else { cat(BiocGenerics:::labeledLine(label, object[[i]], labelSep = "", count = FALSE)) } } if (d > 0) cat("...\n<", d, ifelse(d == 1, " more element>\n", " more elements>\n"), sep="") } setMethod("show", "AtomicList", function(object) { cat(classNameForDisplay(object), " of length ", length(object), "\n", sep = "") .showAtomicList(object, 10) } ) setMethod("show", "RleList", function(object) { lo <- length(object) k <- min(5, length(object)) diffK <- lo - 5 cat(classNameForDisplay(object), " of length ", lo, "\n", sep = "") show(as.list(head(object, k))) if (diffK > 0) cat("...\n<", diffK, ifelse(diffK == 1, " more element>\n", " more elements>\n"), sep="") }) setMethod("showAsCell", "AtomicList", function(object) { if (length(object) == 0L) return(character(0)) unlist(lapply(object, function(x) { str <- paste(as.vector(head(x, 3)), collapse = ",") if (length(x) > 3) str <- paste(str, "...", sep = ",") str }), use.names = FALSE) }) IRanges/R/CompressedList-class.R0000644000126300012640000004034612227064470020067 0ustar00biocbuildphs_compbio### ========================================================================= ### CompressedList objects ### ------------------------------------------------------------------------- setClass("CompressedList", contains="List", representation( "VIRTUAL", partitioning="PartitioningByEnd", unlistData="ANY" ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("elementLengths", "CompressedList", function(x) { ans <- elementLengths(x@partitioning) names(ans) <- names(x) ans } ) setMethod("length", "CompressedList", function(x) length(x@partitioning)) setMethod("names", "CompressedList", function(x) names(x@partitioning)) setReplaceMethod("names", "CompressedList", function(x, value) { names(x@partitioning) <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### ### Use ### IRanges:::newCompressedList0(getClass("MyClass"), ### unlistData, partitioning) ### when calling this from another package. ### newCompressedList0 <- function(Class, unlistData, partitioning) { ans <- new2(Class, unlistData=unlistData, partitioning=partitioning, check=FALSE) reconcileMetadatacols(ans) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.CompressedList.partitioning <- function(x) { dataLength <- NROW(x@unlistData) if (nobj(x@partitioning) != dataLength) "improper partitioning" else NULL } .valid.CompressedList.unlistData <- function(x) { ## FIXME: workaround to support CompressedNormalIRangesList ## elementTypeX <- elementType(x) elementTypeX <- elementType(new(class(x))) if (!extends(class(x@unlistData), elementTypeX)) paste("the 'unlistData' slot must be of class", elementTypeX) else NULL } .valid.CompressedList <- function(x) { c(.valid.CompressedList.unlistData(x), .valid.CompressedList.partitioning(x)) } setValidity2("CompressedList", .valid.CompressedList) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("extractROWS", "CompressedList", function(x, i) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) ir <- IRanges(end=extractROWS(end(x@partitioning), i), width=extractROWS(width(x@partitioning), i)) ans_unlistData <- extractROWS(x@unlistData, ir) ans_partitioning <- new2("PartitioningByEnd", end=cumsum(width(ir)), NAMES=extractROWS(names(x), i), check=FALSE) ans_elementMetadata <- extractROWS(x@elementMetadata, i) initialize(x, unlistData=ans_unlistData, partitioning=ans_partitioning, elementMetadata=ans_elementMetadata) } ) .CompressedList.list.subscript <- function(X, INDEX, USE.NAMES = TRUE, COMPRESS = missing(FUN), FUN = identity, ...) { k <- length(INDEX) nonZeroLength <- elementLengths(X)[INDEX] > 0L whichNonZeroLength <- which(nonZeroLength) kOK <- length(whichNonZeroLength) if ((k > 0) && all(nonZeroLength)) { zeroLengthElt <- NULL } else { zeroLengthElt <- FUN(extractROWS(X@unlistData, integer(0)), ...) } useFastSubset <- (is.vector(X@unlistData) || is(X@unlistData, "Vector")) if (!COMPRESS && (k == 0)) { elts <- list() } else if (COMPRESS && (kOK == 0)) { elts <- zeroLengthElt } else if(COMPRESS && missing(FUN) && useFastSubset) { nzINDEX <- INDEX[whichNonZeroLength] elts <- extractROWS(X@unlistData, IRanges(start=start(X@partitioning), width=width(X@partitioning))[nzINDEX]) } else { elts <- rep(list(zeroLengthElt), k) if (kOK > 0) { nzINDEX <- INDEX[whichNonZeroLength] eltStarts <- start(X@partitioning)[nzINDEX] eltEnds <- end(X@partitioning)[nzINDEX] oldValidityStatus <- disableValidity() disableValidity(TRUE) on.exit(disableValidity(oldValidityStatus)) if (useFastSubset) { elts[whichNonZeroLength] <- lapply(seq_len(kOK), function(j) FUN(extractROWS(X@unlistData, IRanges(eltStarts[j], eltEnds[j])), ...)) } else { elts[whichNonZeroLength] <- lapply(seq_len(kOK), function(j) FUN(extractROWS(X@unlistData, eltStarts[j]:eltEnds[j]), ...)) } disableValidity(oldValidityStatus) } if (COMPRESS) { elts <- compress_listData(elts) } else { for (i in seq_len(length(elts))) { obj <- elts[[i]] if (isS4(obj) && !isTRUE(validObject(obj, test = TRUE))) stop("invalid output element of class \"", class(obj), "\"") } if (USE.NAMES) names(elts) <- names(X)[INDEX] } } elts } setMethod("getListElement", "CompressedList", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=FALSE) if (is.na(i)) return(NULL) .CompressedList.list.subscript(X=x, INDEX=i, USE.NAMES=FALSE) } ) setReplaceMethod("[[", "CompressedList", function(x, i, j,..., value) { nameValue <- if (is.character(i)) i else "" i <- normargSubset2_iOnly(x, i, j, ..., .conditionPrefix="[[<-,CompressedList-method: ") if (is.null(value)) { if (i <= length(x)) # if name did not exist, could be +1 x <- x[-i] } else { value <- try(as(value, elementType(x)), silent = TRUE) if (inherits(value, "try-error")) stop("cannot coerce 'value' to a ", elementType(x), " instance") listData <- as.list(x, use.names = FALSE) listData[[i]] <- value widths <- elementLengths(x) names(widths) <- NULL widths[i] <- NROW(value) if ((i == length(x) + 1L) && (!is.null(names(x)) || nchar(nameValue) > 0)) { NAMES <- names(x) if (is.null(NAMES)) NAMES <- rep.int("", length(x)) NAMES[i] <- nameValue } else { NAMES <- names(x) } slot(x, "unlistData", check=FALSE) <- compress_listData(listData) slot(x, "partitioning", check=FALSE) <- new2("PartitioningByEnd", end = cumsum(widths), NAMES = NAMES, check=FALSE) if (i > length(x)) x <- rbindRowOfNAsToMetadatacols(x) x } }) setReplaceMethod("$", "CompressedList", function(x, name, value) { x[[name]] <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining and splitting. ### .bindROWS <- function(...) { args <- list(...) if (length(dim(args[[1L]])) < 2L) return(c(...)) rbind(...) } ### Not exported. 'x' *must* be an unnamed list of length >= 1 (not checked). unlist_list_of_CompressedList <- function(x) { ans_unlistData <- do.call(.bindROWS, lapply(x, slot, "unlistData")) ans_eltlens <- unlist(lapply(x, elementLengths)) ans <- relist(ans_unlistData, PartitioningByEnd(cumsum(ans_eltlens))) ans_mcols <- do.call(rbind.mcols, x) rownames(ans_mcols) <- NULL mcols(ans) <- ans_mcols ans } ## NOTE: while the 'c' function does not have an 'x', the generic does. ## c() is a primitive, so 'x' can be missing; dispatch is by position, ## although sometimes this does not work so well, so it's best to keep ## names off the parameters whenever feasible. setMethod("c", "CompressedList", function(x, ..., recursive = FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for CompressedList objects ", "does not support the 'recursive' argument") if (missing(x)) tls <- unname(list(...)) else tls <- unname(list(x, ...)) if (!all(sapply(tls, is, "CompressedList"))) stop("all arguments in '...' must be CompressedList objects") ecs <- sapply(tls, elementType) if (!all(sapply(ecs, extends, ecs[[1L]]))) stop("all arguments in '...' must have an element class ", "that extends that of the first argument") unlist_list_of_CompressedList(tls) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Looping. ### setMethod("lapply", "CompressedList", function(X, FUN, ...) { if (length(X) == 0) list() else .CompressedList.list.subscript(X = X, INDEX = seq_len(length(X)), USE.NAMES = TRUE, COMPRESS = FALSE, FUN = match.fun(FUN), ...) }) setMethod("aggregate", "CompressedList", function(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE) { if (!missing(by) && is(by, "RangesList")) { if (length(x) != length(by)) stop("for Ranges 'by', 'length(x) != length(by)'") y <- as.list(x) result <- lapply(structure(seq_len(length(x)), names = names(x)), function(i) aggregate(y[[i]], by = by[[i]], FUN = FUN, frequency = frequency, delta = delta, ..., simplify = simplify)) ans <- try(SimpleAtomicList(result), silent = TRUE) if (inherits(ans, "try-error")) ans <- newList("SimpleList", result) } else { ans <- callNextMethod() } ans }) .updateCompressedList <- function(X, listData) { elementTypeX <- elementType(X) if (!all(sapply(listData, function(Xi) extends(class(Xi), elementTypeX)))) stop("'FUN' must return elements of class ", elementTypeX) if (length(listData) == 0) { end <- integer(0) } else { end <- cumsum(unlist(lapply(listData, NROW), use.names = FALSE)) } initialize(X, unlistData = compress_listData(listData), partitioning = new2("PartitioningByEnd", end = end, NAMES = names(X), check=FALSE)) } setMethod("endoapply", "CompressedList", function(X, FUN, ...) { .updateCompressedList(X, .CompressedList.list.subscript(X = X, INDEX = seq_len(length(X)), USE.NAMES = FALSE, COMPRESS = FALSE, FUN = match.fun(FUN), ...)) }) setMethod("mendoapply", "CompressedList", function(FUN, ..., MoreArgs = NULL) { .updateCompressedList(list(...)[[1L]], mapply(FUN = FUN, ..., MoreArgs = MoreArgs, SIMPLIFY = FALSE)) }) setMethod("revElements", "CompressedList", function(x, i) { i <- normalizeSingleBracketSubscript(i, x) if (length(x) == 0L) return(x) elt_lens <- elementLengths(x) offset <- cumsum(c(0L, elt_lens[-length(elt_lens)])) rev <- logical(length(x)) rev[i] <- TRUE ii <- fancy_mseq(elt_lens, offset=offset, rev=rev) x@unlistData <- x@unlistData[ii] x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### .as.list.CompressedList <- function(x, use.names = TRUE) { .CompressedList.list.subscript(X = x, INDEX = seq_len(length(x)), USE.NAMES = use.names, COMPRESS = FALSE) } ### S3/S4 combo for as.list.CompressedList as.list.CompressedList <- function(x, ...) .as.list.CompressedList(x, ...) setMethod("as.list", "CompressedList", as.list.CompressedList) setMethod("unlist", "CompressedList", function(x, recursive=TRUE, use.names=TRUE) { if (!identical(recursive, TRUE)) stop("\"unlist\" method for CompressedList objects ", "does not support the 'recursive' argument") if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") ans <- x@unlistData ## If 'use.names' is FALSE or 'x' has no *outer* names, then we don't ## do anything to 'ans' i.e. we just keep whatever names/rownames are ## on it (which are the *inner* names/rownames of 'x'). Note that this ## behavior is NOT consistent with unlist,List or base::unlist as ## both of them will return a vector with no names/rownames when ## 'use.names' is FALSE. ## FIXME: Make unlist,CompressedList and unlist,List behave ## consistently in *any* situation. ## Otherwise (i.e. if 'use.names' is TRUE and 'x' has *outer* names), ## we make up new names/rownames for 'ans' by prepending the *outer* ## names of 'x' to its *inner* names/rownames. Note that this differs ## from what base::unlist does but THIS IS A FEATURE and is consistent ## with what unlist,List does. if (use.names && !is.null(x_names <- names(x))) { if (length(dim(ans)) < 2L) { ans_ROWNAMES <- names(ans) } else { ans_ROWNAMES <- rownames(ans) } nms <- rep.int(x_names, elementLengths(x)) ans_ROWNAMES <- make.unlist.result.names(nms, ans_ROWNAMES) if (length(dim(ans)) < 2L) { res <- try(names(ans) <- ans_ROWNAMES, silent=TRUE) what <- "names" } else { res <- try(rownames(ans) <- ans_ROWNAMES, silent=TRUE) what <- "rownames" } if (is(res, "try-error")) warning("failed to set ", what, " on the result ", "of unlisting a ", class(x), " object") } ans } ) coerceToCompressedList <- function(from, element.type = NULL, ...) { if (is(from, listClassName("Compressed", element.type))) return(from) if (is.list(from) || is(from, "List")) { if (is.list(from)) { v <- compress_listData(from) } else { v <- unlist(from, use.names = FALSE) } part <- PartitioningByEnd(from) } else { v <- from part <- PartitioningByEnd(seq_len(length(from))) } if (!is.null(element.type)) { v <- coercerToClass(element.type)(v, ...) } to <- relist(v, part) names(to) <- names(from) to } IRanges/R/DataFrame-class.R0000644000126300012640000005256112227064470016755 0ustar00biocbuildphs_compbio### ========================================================================= ### DataFrame objects ### ------------------------------------------------------------------------- ## A data.frame-like interface for S4 objects that implement length() and `[` ## NOTE: Normal data.frames always have rownames (sometimes as integers), ## but we allow the rownames to be NULL for efficiency. This means that we ## need to store the number of rows (nrows). setClass("DataFrame", representation( rownames = "characterORNULL", nrows = "integer" ), prototype(rownames = NULL, nrows = 0L, listData = structure(list(), names = character())), contains = c("DataTable", "SimpleList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("nrow", "DataFrame", function(x) x@nrows) setMethod("ncol", "DataFrame", function(x) length(x)) setMethod("rownames", "DataFrame", function(x, do.NULL = TRUE, prefix = "row") { rn <- x@rownames if (is.null(rn) && !do.NULL) { nr <- NROW(x) if (nr > 0L) rn <- paste(prefix, seq_len(nr), sep = "") else rn <- character(0L) } rn }) setMethod("colnames", "DataFrame", function(x, do.NULL = TRUE, prefix = "col") { if (!identical(do.NULL, TRUE)) warning("do.NULL arg is ignored ", "in this method") cn <- names(x@listData) if (!is.null(cn)) return(cn) if (length(x@listData) != 0L) stop("DataFrame object with NULL colnames, please fix it ", "with colnames(x) <- value") return(character(0)) }) setReplaceMethod("rownames", "DataFrame", function(x, value) { if (!is.null(value)) { if (anyMissing(value)) stop("missing values not allowed in rownames") if (length(value) != nrow(x)) stop("invalid rownames length") if (anyDuplicated(value)) stop("duplicate rownames not allowed") if (!is(value, "XStringSet")) value <- as.character(value) } x@rownames <- value x }) setReplaceMethod("colnames", "DataFrame", function(x, value) { if (!is.character(value)) stop("'value' must be a character vector ", "in colnames(x) <- value") if (length(value) > length(x)) stop("more column names than columns") names(x) <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.DataFrame.dim <- function(x) { nr <- dim(x)[1L] if (!length(nr) == 1) return("length of 'nrows' slot must be 1") if (nr < 0) return("number of rows must be non-negative") NULL } .valid.DataFrame.rownames <- function(x) { if (is.null(rownames(x))) return(NULL) if (length(rownames(x)) != nrow(x)) return("number of row names and number of rows differ") NULL } .valid.DataFrame.names <- function(x) { ## DataFrames with no columns can have NULL column name if (is.null(names(x)) && ncol(x) != 0) return("column names should not be NULL") if (length(names(x)) != ncol(x)) return("number of columns and number of column names differ") NULL } .valid.DataFrame <- function(x) { c(.valid.DataFrame.dim(x), .valid.DataFrame.rownames(x), .valid.DataFrame.names(x)) } setValidity2("DataFrame", .valid.DataFrame) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### DataFrame <- function(..., row.names = NULL, check.names = TRUE) { ## build up listData, with names from arguments if (!isTRUEorFALSE(check.names)) stop("'check.names' must be TRUE or FALSE") nr <- 0 listData <- list(...) varlist <- vector("list", length(listData)) if (length(listData) > 0) { dotnames <- names(listData) if (is.null(dotnames)) { emptynames <- rep.int(TRUE, length(listData)) } else { emptynames <- !nzchar(dotnames) } if (any(emptynames)) { qargs <- as.list(substitute(list(...)))[-1L] dotvalues <- sapply(qargs[emptynames], function(arg) deparse(arg)[1L]) names(listData)[emptynames] <- dotvalues } varnames <- as.list(names(listData)) nrows <- ncols <- integer(length(varnames)) for (i in seq_along(listData)) { element <- try(as(listData[[i]], "DataFrame"), silent = TRUE) if (inherits(element, "try-error")) stop("cannot coerce class \"", class(listData[[i]]), "\" to a DataFrame") nrows[i] <- nrow(element) ncols[i] <- ncol(element) varlist[[i]] <- as.list(element, use.names = FALSE) if (!is(listData[[i]], "AsIs")) { if (((length(dim(listData[[i]])) > 1) || (ncol(element) > 1))) { if (emptynames[i]) varnames[[i]] <- colnames(element) else varnames[[i]] <- paste(varnames[[i]], colnames(element), sep = ".") } else if (is.list(listData[[i]]) && length(names(listData[[i]]))) varnames[[i]] <- names(element) } if (is.null(row.names)) row.names <- rownames(element) } nr <- max(nrows) for (i in which((nrows > 0L) & (nrows < nr) & (nr %% nrows == 0L))) { recycle <- rep(seq_len(nrows[i]), length.out = nr) varlist[[i]] <- lapply(varlist[[i]], `[`, recycle, drop=FALSE) nrows[i] <- nr } if (!all(nrows == nr)) stop("different row counts implied by arguments") varlist <- unlist(varlist, recursive = FALSE, use.names = FALSE) nms <- unlist(varnames[ncols > 0L]) if (check.names) nms <- make.names(nms, unique = TRUE) names(varlist) <- nms } else names(varlist) <- character(0) if (!is.null(row.names)) { if (anyMissing(row.names)) stop("missing values in 'row.names'") if (length(varlist) && length(row.names) != nr) stop("invalid length of row names") if (anyDuplicated(row.names)) stop("duplicate row names") row.names <- as.character(row.names) } new2("DataFrame", listData=varlist, rownames=row.names, nrows=as.integer(max(nr, length(row.names))), check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setReplaceMethod("[[", "DataFrame", function(x, i, j,..., value) { nrx <- nrow(x) lv <- NROW(value) if (!missing(j) || length(list(...)) > 0) warning("arguments beyond 'i' ignored") if (missing(i)) stop("subscript is missing") if (!is.character(i) && !is.numeric(i)) stop("invalid subscript type") if (length(i) < 1L) stop("attempt to select less than one element") if (length(i) > 1L) stop("attempt to select more than one element") if (is.numeric(i) && (i < 1L || i > ncol(x) + 1L)) stop("subscript out of bounds") if (!is.null(value) && (nrx != lv)) { if ((nrx == 0) || (lv == 0) || (nrx %% lv != 0)) stop(paste(lv, "elements in value to replace", nrx, "elements")) else value <- rep(value, length.out = nrx) } x <- callNextMethod(x, i, value=value) ## ensure unique, valid names names(x) <- make.names(names(x), unique=TRUE) x }) setMethod("extractROWS", "DataFrame", function(x, i) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x, byrow=TRUE, exact=FALSE) slot(x, "listData", check=FALSE) <- lapply(structure(seq_len(ncol(x)), names=names(x)), function(j) extractROWS(x[[j]], i)) if (is(i, "Ranges")) li <- sum(width(i)) else li <- length(i) slot(x, "nrows", check=FALSE) <- li if (!is.null(rownames(x))) { slot(x, "rownames", check=FALSE) <- make.unique(extractROWS(rownames(x), i)) } x } ) setMethod("[", "DataFrame", function(x, i, j, ..., drop=TRUE) { if (!isTRUEorFALSE(drop)) stop("'drop' must be TRUE or FALSE") if (length(list(...)) > 0L) warning("parameters in '...' not supported") ## We do list-style subsetting when [ was called with no ','. ## NOTE: matrix-style subsetting by logical matrix not supported. list_style_subsetting <- (nargs() - !missing(drop)) < 3L if (list_style_subsetting || !missing(j)) { if (list_style_subsetting) { if (!missing(drop)) warning("'drop' argument ignored by list-style subsetting") if (missing(i)) return(x) j <- i } if (!is(j, "Ranges")) j <- normalizeSingleBracketSubscript(j, x) new_listData <- extractROWS(x@listData, j) new_mcols <- extractROWS(mcols(x), j) x <- initialize(x, listData=new_listData, elementMetadata=new_mcols) if (anyDuplicated(names(x))) names(x) <- make.names(names(x)) if (list_style_subsetting) return(x) } if (!missing(i)) x <- extractROWS(x, i) if (missing(drop)) # drop by default if only one column left drop <- ncol(x) == 1L if (drop) { ## one column left if (ncol(x) == 1L) return(x[[1L]]) ## one row left if (nrow(x) == 1L) return(as(x, "list")) } x } ) setMethod("replaceROWS", "DataFrame", function(x, i, value) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x, byrow=TRUE) x_ncol <- ncol(x) value_ncol <- ncol(value) if (value_ncol > x_ncol) stop("provided ", value_ncol, " variables ", "to replace ", x_ncol, " variables") slot(x, "listData", check=FALSE) <- lapply(structure(seq_len(ncol(x)), names=names(x)), function(j) replaceROWS(x[[j]], i, value[[((j - 1L) %% value_ncol) + 1L]])) x } ) setReplaceMethod("[", "DataFrame", function(x, i, j, ..., value) { if (length(list(...)) > 0) warning("parameters in '...' not supported") useI <- FALSE newrn <- newcn <- NULL if (nargs() < 4) { i2 <- seq_len(nrow(x)) if (missing(i)) { j2 <- seq_len(ncol(x)) } else { if (length(i) == 1) { if (is.logical(i) == 1 && i) i <- rep(i, ncol(x)) } j2 <- normalizeSingleBracketSubscript(i, x, allow.append=TRUE) if (is.character(i)) newcn <- i[j2 > ncol(x)] } } else { if (missing(i)) { i2 <- seq_len(nrow(x)) } else { useI <- TRUE i2 <- normalizeSingleBracketSubscript(i, x, byrow=TRUE, allow.append=TRUE) if (is.character(i)) newrn <- i[i2 > nrow(x)] } if (missing(j)) { j2 <- seq_len(ncol(x)) } else { j2 <- normalizeSingleBracketSubscript(j, x, allow.append=TRUE) if (is.character(j)) newcn <- j[j2 > ncol(x)] } } i <- i2 j <- j2 if (!length(j)) # nothing to replace return(x) if (is(value, "list") || is(value, "List")) value <- as(value, "DataFrame") if (!is(value, "DataFrame")) { if (useI) li <- length(i) else li <- nrow(x) lv <- length(value) if (li != lv) { if (li %% lv != 0) stop(paste(lv, "rows in value to replace", li, " rows")) else value <- rep(value, length.out = li) } ## come up with some default row and col names if (!length(newcn) && max(j) > length(x)) { newcn <- paste("V", seq.int(length(x) + 1L, max(j)), sep = "") if (length(newcn) != sum(j > length(x))) stop("new columns would leave holes after ", "existing columns") } if (useI) { if (length(newrn) == 0L && li > 0L && max(i) > nrow(x)) newrn <- as.character(seq.int(nrow(x) + 1L, max(i))) if (length(x@listData[j][[1]]) == 0L) x@listData[j] <- list(rep(NA, nrow(x))) x@listData[j] <- lapply(x@listData[j], function(y) {y[i] <- value; y}) } else { x@listData[j] <- list(value) } } else { vc <- seq_len(ncol(value)) if (ncol(value) > length(j)) stop("ncol(x[j]) < ncol(value)") if (ncol(value) < length(j)) vc <- rep(vc, length.out = length(j)) if (useI) li <- length(i) else li <- nrow(x) nrv <- nrow(value) if (li != nrv) { if ((li == 0) || (li %% nrv != 0)) stop(paste(nrv, "rows in value to replace", li, " rows")) else value <- value[rep(seq_len(nrv), length.out = li), , drop=FALSE] } ## attempt to derive new row and col names from value if (!length(newcn) && max(j) > length(x)) { newcn <- rep(names(value), length.out = length(j)) newcn <- newcn[j > length(x)] } if (useI) { if (length(newrn) == 0L && li > 0L && max(i) > nrow(x)) { if (!is.null(rownames(value))) { newrn <- rep(rownames(value), length.out = length(i)) newrn <- newrn[i > nrow(x)] } else newrn <- as.character(seq.int(nrow(x) + 1L, max(i))) } for (k in seq_len(length(j))) { if (j[k] > length(x)) v <- NULL else v <- x@listData[[j[k]]] rv <- value[[vc[k]]] if (length(dim(rv)) == 2) v[i,] <- rv else v[i] <- if (is.null(v)) rv else as(rv, class(v)) x@listData[[j[k]]] <- v } } else { if (is.logical(j)) { for (k in seq_len(length(j))) x@listData[[k]] <- value[[vc[k]]] } else { for (k in seq_len(length(j))) x@listData[[j[k]]] <- value[[vc[k]]] } } } ## update row and col names, making them unique if (length(newcn)) { oldcn <- head(colnames(x), length(x) - length(newcn)) colnames(x) <- make.unique(c(oldcn, newcn)) if (!is.null(mcols(x))) mcols(x)[tail(names(x),length(newcn)),] <- DataFrame(NA) } if (length(newrn)) { notj <- setdiff(seq_len(ncol(x)), j) x@listData[notj] <- lapply(x@listData[notj], function(y) c(y, rep(NA, length(newrn)))) x@rownames <- make.unique(c(rownames(x), newrn)) } x@nrows <- length(x[[1]]) # we should always have a column x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ## Break DataFrame into a normal R data.frame setAs("DataFrame", "data.frame", function(from) { as.data.frame(from, optional=TRUE) }) injectIntoScope <- function(x, ...) { nms <- sapply(tail(substitute(list(...)), -1), deparse) environment(x) <- list2env(setNames(list(...), nms), parent = environment(x)) x } ### S3/S4 combo for as.data.frame.DataFrame as.data.frame.DataFrame <- function(x, row.names=NULL, optional=FALSE, ...) { if (length(list(...))) warning("Arguments in '...' ignored") l <- as(x, "list") if (is.null(row.names)) row.names <- rownames(x) if (!length(l) && is.null(row.names)) row.names <- seq_len(nrow(x)) l <- lapply(l, function(y) { if (is(y, "SimpleList") || is(y, "CompressedList")) y <- as.list(y) if (is.list(y)) y <- I(y) y }) IRanges.data.frame <- injectIntoScope(data.frame, as.data.frame) do.call(IRanges.data.frame, c(l, list(row.names=row.names), check.names=!optional, stringsAsFactors=FALSE)) } setMethod("as.data.frame", "DataFrame", as.data.frame.DataFrame) setMethod("as.matrix", "DataFrame", function(x) { if (length(x) == 0L) m <- matrix(logical(), nrow = nrow(x), ncol = 0L) else m <- do.call(cbind, as.list(x)) rownames(m) <- rownames(x) m }) ## take data.frames to DataFrames setAs("data.frame", "DataFrame", function(from) { rn <- attributes(from)[["row.names"]] if (is.integer(rn)) rn <- NULL rownames(from) <- NULL new2("DataFrame", listData = as.list(from), nrows = nrow(from), rownames = rn, check=FALSE) }) # matrices and tables just go through data.frame setAs("matrix", "DataFrame", function(from) { df <- as.data.frame(from) if (0L == ncol(from)) ## colnames on matrix with 0 columns are 'NULL' names(df) <- character() as(df, "DataFrame") }) setAs("table", "DataFrame", function(from) { df <- as.data.frame(from) factors <- sapply(df, is.factor) factors[1] <- FALSE do.call(DataFrame, c(df[1], lapply(df[factors], Rle), df["Freq"])) }) setAs("xtabs", "DataFrame", function(from) { class(from) <- "table" as(from, "DataFrame") }) .defaultAsDataFrame <- function(from) { row.names <- if (!anyDuplicated(names(from))) names(from) else NULL new2("DataFrame", listData = setNames(list(from), "X"), nrows = length(from), rownames = row.names, check=FALSE) } setAs("ANY", "DataFrame", .defaultAsDataFrame) ## overriding the default inheritance-based coercion from methods package setAs("SimpleList", "DataFrame", .defaultAsDataFrame) ## note that any element named 'row.names' will be interpreted differently ## is this a bug or a feature? setAs("list", "DataFrame", function(from) { do.call(DataFrame, c(from, check.names = FALSE)) }) setAs("NULL", "DataFrame", function(from) as(list(), "DataFrame")) ### FIXME: only exists due to annoying S4 warning due to its caching of ### coerce methods. setAs("integer", "DataFrame", function(from) { selectMethod("coerce", c("vector", "DataFrame"))(from) }) setAs("AsIs", "DataFrame", function(from) { df <- new2("DataFrame", nrows = NROW(from), check=FALSE) df[[1]] <- from df }) setAs("ANY", "AsIs", function(from) I(from)) IRanges/R/DataFrame-utils.R0000644000126300012640000000762512227064470017011 0ustar00biocbuildphs_compbio### ========================================================================= ### DataFrame utilities ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Splitting and combining. ### setMethod("splitAsListReturnedClass", "data.frame", function(x) "CompressedSplitDataFrameList" ) setMethod("splitAsListReturnedClass", "DataFrame", function(x) "CompressedSplitDataFrameList" ) setMethod("cbind", "DataFrame", function(..., deparse.level=1) { ans <- DataFrame(...) mcols(ans) <- rbind.mcols(...) ans }) setMethod("rbind", "DataFrame", function(..., deparse.level=1) { args <- list(...) hasrows <- unlist(lapply(args, nrow), use.names=FALSE) > 0L hascols <- unlist(lapply(args, ncol), use.names=FALSE) > 0L if (!any(hasrows | hascols)) { return(DataFrame()) } else if (!any(hasrows)) { return(args[[which(hascols)[1L]]]) } else if (sum(hasrows) == 1) { return(args[[which(hasrows)]]) } else { args <- args[hasrows] } df <- args[[1L]] for (i in 2:length(args)) { if (ncol(df) != ncol(args[[i]])) stop("number of columns for arg ", i, " do not match those of first arg") if (!identical(colnames(df), colnames(args[[i]]))) stop("column names for arg ", i, " do not match those of first arg") } if (ncol(df) == 0) { ans <- DataFrame() ans@nrows <- sum(unlist(lapply(args, nrow), use.names=FALSE)) } else { cn <- colnames(df) cl <- unlist(lapply(as.list(df, use.names = FALSE), class)) factors <- unlist(lapply(as.list(df, use.names = FALSE), is.factor)) cols <- lapply(seq_len(length(df)), function(i) { cols <- lapply(args, `[[`, cn[i]) isRle <- sapply(cols, is, "Rle") if (any(isRle) && !all(isRle)) # would fail dispatch to c,Rle cols <- lapply(cols, as.vector) if (factors[i]) { # combine factor levels, coerce to character levs <- unique(unlist(lapply(cols, levels), use.names=FALSE)) cols <- lapply(cols, as.character) } rectangular <- length(dim(cols[[1]])) == 2L if (rectangular) { combined <- do.call(rbind, unname(cols)) } else { combined <- do.call(c, unname(cols)) } if (factors[i]) combined <- factor(combined, levs) ## this coercion needed only because we extracted ([[) above ## which brings external -> internal ## external objects should support external combination (c) combined <- as(combined, cl[i]) combined }) names(cols) <- colnames(df) ans <- new("DataFrame", listData = cols, nrows = length(cols[[1]])) } rn <- unlist(lapply(args, rownames), use.names=FALSE) if (!is.null(rn)) { if (length(rn) != nrow(ans)) { rn <- NULL } else if (anyDuplicated(rn)) rn <- make.unique(rn, sep = "") } rownames(ans) <- rn if (!is.null(mcols(df))) { df_mcols <- mcols(df) if (all(sapply(args, function(x) identical(mcols(x), df_mcols)))) mcols(ans) <- df_mcols } ans }) ## We are overriding all 'formula' calls to aggregate, and ## stats:::aggregate.formula depends on quoting a formula expression ## (x ~ y) in its first argument. Thus, we need some computing on the ## language, which may not be very robust. setMethod("aggregate", "formula", function(x, data, ...) { mc <- sys.call(-1) mc[[1]] <- quote(stats:::aggregate.formula) if (is(data, "DataFrame")) { data <- as(data, "data.frame") ## depending on the formula, this may or not be a valid subclass ## of DataFrame, so we just explicitly create a DataFrame here ##DataFrame(callGeneric()) mc[[3]] <- data DataFrame(eval(mc, parent.frame(2))) } else eval(mc, parent.frame(2)) ## for e.g. data.frame }) setMethod("mstack", "DataFrame", function(..., .index.var = "name") { stack(DataFrameList(...), index.var = .index.var) }) IRanges/R/DataFrameList-class.R0000644000126300012640000004051712227064470017607 0ustar00biocbuildphs_compbio### ========================================================================= ### DataFrameList objects ### ------------------------------------------------------------------------- setClass("DataFrameList", representation("VIRTUAL"), prototype = prototype(elementType = "DataFrame"), contains = "List") setClass("SimpleDataFrameList", prototype = prototype(elementType = "DataFrame"), contains = c("DataFrameList", "SimpleList")) setClass("SplitDataFrameList", representation("VIRTUAL"), prototype = prototype(elementType = "DataFrame"), contains = "DataFrameList") setClass("SimpleSplitDataFrameList", prototype = prototype(elementType = "DataFrame"), contains = c("SplitDataFrameList", "SimpleDataFrameList")) setClass("CompressedSplitDataFrameList", prototype = prototype(elementType = "DataFrame", unlistData = new("DataFrame")), contains = c("SplitDataFrameList", "CompressedList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("nrow", "DataFrameList", function(x) { if (length(x) == 0L) 0L else elementLengths(x) }) setMethod("ncol", "DataFrameList", function(x) { if (length(x) == 0L) 0L else unlist(lapply(x, ncol)) }) setMethod("ncol", "SimpleSplitDataFrameList", function(x) { if (length(x) == 0L) 0L else structure(rep.int(ncol(x[[1L]]), length(x)), names = names(x)) }) setMethod("ncol", "CompressedSplitDataFrameList", function(x) { if (length(x) == 0L) 0L else structure(rep.int(ncol(x@unlistData), length(x)), names = names(x)) }) setMethod("dim", "DataFrameList", function(x) { cbind(nrow(x), ncol(x)) }) setMethod("rownames", "DataFrameList", function(x, do.NULL = TRUE, prefix = "row") { CharacterList(lapply(x, rownames, do.NULL = do.NULL, prefix = prefix)) }) setMethod("colnames", "DataFrameList", function(x, do.NULL = TRUE, prefix = "col") { CharacterList(lapply(x, colnames, do.NULL = do.NULL, prefix = prefix)) }) setMethod("colnames", "SimpleSplitDataFrameList", function(x, do.NULL = TRUE, prefix = "col") { if (length(x)) { nms <- colnames(x[[1]], do.NULL = do.NULL, prefix = prefix) CharacterList(rep(list(nms), length(x))) } else NULL }) setMethod("colnames", "CompressedSplitDataFrameList", function(x, do.NULL = TRUE, prefix = "col") { if (length(x)) { nms <- colnames(x@unlistData, do.NULL = do.NULL, prefix = prefix) CharacterList(rep(list(nms), length(x))) } else NULL }) setMethod("dimnames", "DataFrameList", function(x) { list(rownames(x), colnames(x)) }) setReplaceMethod("rownames", "SimpleDataFrameList", function(x, value) { if (is.null(value)) { x@listData <- lapply(x@listData, function(y) {rownames(x) <- NULL; x}) } else if (is(value, "CharacterList")){ if (length(x) != length(value)) stop("replacement value must be the same length as x") for (i in seq_len(length(x))) rownames(x@listData[[i]]) <- value[[i]] } else { stop("replacement value must either be NULL or a CharacterList") } x }) setReplaceMethod("rownames", "CompressedSplitDataFrameList", function(x, value) { if (is.null(value)) { rownames(x@unlistData) <- NULL } else if (is(value, "CharacterList")){ if (length(x) != length(value)) stop("replacement value must be the same length as x") rownames(x@unlistData) <- unlist(value, use.names=FALSE) } else { stop("replacement value must either be NULL or a CharacterList") } x }) setReplaceMethod("colnames", "SimpleDataFrameList", function(x, value) { if (is.null(value)) { x@listData <- lapply(x@listData, function(y) {colnames(y) <- NULL; y}) } else if (is.character(value)) { for (i in seq_len(length(x))) colnames(x@listData[[i]]) <- value } else if (is(value, "CharacterList")){ if (length(x) != length(value)) stop("replacement value must be the same length as x") for (i in seq_len(length(x))) colnames(x@listData[[i]]) <- value[[i]] } else { stop("replacement value must either be NULL or a CharacterList") } x }) setReplaceMethod("colnames", "CompressedSplitDataFrameList", function(x, value) { if (is.null(value)) { colnames(x@unlistData) <- NULL } else if (is.character(value)) { colnames(x@unlistData) <- value } else if (is(value, "CharacterList")){ if (length(x) != length(value)) stop("replacement value must be the same length as x") if (length(x) > 0) colnames(x@unlistData) <- unlist(value[[1L]]) } else { stop("replacement value must either be NULL or a CharacterList") } x }) setReplaceMethod("dimnames", "DataFrameList", function(x, value) { if (!is.list(value)) stop("replacement value must be a list") rownames(x) <- value[[1L]] colnames(x) <- value[[2L]] x }) setGeneric("columnMetadata", function(x, ...) standardGeneric("columnMetadata")) setMethod("columnMetadata", "SimpleSplitDataFrameList", function(x) { if (length(x)) mcols(x[[1]]) else NULL }) setMethod("columnMetadata", "CompressedSplitDataFrameList", function(x) { mcols(x@unlistData) }) setGeneric("columnMetadata<-", function(x, ..., value) standardGeneric("columnMetadata<-")) setReplaceMethod("columnMetadata", "SimpleSplitDataFrameList", function(x, value) { x@listData <- lapply(x@listData, function(xi) { mcols(xi) <- value xi }) x }) setReplaceMethod("columnMetadata", "CompressedSplitDataFrameList", function(x, value) { mcols(x@unlistData) <- value }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.SplitDataFrameList <- function(x) { if (length(x) && !is(x, "CompressedList")) { firstNames <- colnames(x[[1L]]) l <- as.list(x, use.names = FALSE) if (!all(sapply(l, function(df) identical(firstNames, colnames(df))))) return("column counts or names differ across elements") firstMetaData <- mcols(x[[1L]]) # could be NULL if (!all(sapply(l, function(df) { identical(firstMetaData, mcols(df)) }))) return("metadata columns must be identical across elements") } NULL } setValidity2("SplitDataFrameList", .valid.SplitDataFrameList) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### DataFrameList <- function(...) { listData <- list(...) if (length(listData) == 1 && is.list(listData[[1L]]) && !is.data.frame(listData[[1L]])) listData <- listData[[1L]] if (length(listData) > 0 && !is(listData[[1L]], "DataFrame")) listData <- lapply(listData, as, "DataFrame") newList("SimpleDataFrameList", listData) } SplitDataFrameList <- function(..., compress = TRUE, cbindArgs = FALSE) { if (!isTRUEorFALSE(compress)) stop("'compress' must be TRUE or FALSE") listData <- list(...) if (length(listData) == 1 && is.list(listData[[1L]]) && !is.data.frame(listData[[1L]])) listData <- listData[[1L]] if (cbindArgs) { if (is.null(names(listData))) names(listData) <- paste("X", seq_len(length(listData)), sep = "") listData <- do.call(Map, c(list(DataFrame), listData)) } else if (any(!sapply(listData, is, "DataFrame"))) listData <- lapply(listData, as, "DataFrame") if (compress) newList("CompressedSplitDataFrameList", listData) else newList("SimpleSplitDataFrameList", listData) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("[", "SimpleSplitDataFrameList", function(x, i, j, ..., drop=TRUE) { if (!missing(j)) x@listData <- lapply(x@listData, function(y) y[,j,drop=FALSE]) if (!missing(i)) x <- callNextMethod(x, i) if (((nargs() - !missing(drop)) > 2) && (length(x@listData) > 0) && (ncol(x@listData[[1L]]) == 1) && (missing(drop) || drop)) { uniqueClasses <- unique(unlist(lapply(x@listData, function(y) class(y[[1L]])))) if (all(uniqueClasses %in% c("raw", "logical", "integer", "numeric", "character", "complex", "Rle"))) x <- SimpleAtomicList(lapply(x@listData, "[[", 1)) else if (identical(uniqueClasses, "IRanges")) x <- IRangesList(lapply(x@listData, "[[", 1), compress=FALSE) else if (unlist(lapply(uniqueClasses, function(y) extends(y, "Ranges")))) x <- RangesList(lapply(x@listData, "[[", 1)) } x }) setMethod("[", "CompressedSplitDataFrameList", function(x, i, j, ..., drop=TRUE) { if (!missing(j)) x@unlistData <- x@unlistData[, j, drop=FALSE] if (!missing(i)) x <- callNextMethod(x, i) if (((nargs() - !missing(drop)) > 2) && (ncol(x@unlistData) == 1) && (missing(drop) || drop)) { dataClass <- class(x@unlistData[[1L]]) if (dataClass %in% c("raw", "logical", "integer", "numeric", "character", "complex", "Rle")) x <- CompressedAtomicList(x@unlistData[[1L]], partitioning = x@partitioning) else if (dataClass == "IRanges") x <- new2("CompressedIRangesList", unlistData = x@unlistData[[1L]], partitioning = x@partitioning) } x }) setMethod("normalizeSingleBracketReplacementValue", "SplitDataFrameList", function(value, x) { value <- callNextMethod() # call default method if (length(x) != 0L && ncol(x)[[1L]] == ncol(value)[[1L]]) colnames(value)[[1L]] <- colnames(x)[[1L]] value } ) setReplaceMethod("[", "SplitDataFrameList", function(x, i, j,..., value) { if (length(list(...)) > 0L) stop("invalid replacement") value <- normalizeSingleBracketReplacementValue(value, x) if (missing(j)) { if (missing(i)) ans <- callNextMethod(x=x, value=value) else ans <- callNextMethod(x=x, i=i, value=value) return(ans) } j <- extractROWS(setNames(seq_len(ncol(x)[[1L]]), colnames(x)[[1L]]), j) y <- x[, j, drop=FALSE] if (missing(i)) { y[] <- value } else if (is.list(i) || (is(i, "List") && !is(i, "Ranges"))) { y <- subsetListByList_replace(y, i, value, byrow=TRUE) } else { y[i] <- value } if (is(x, "CompressedList")) { xels <- elementLengths(x) yels <- elementLengths(y) if (any(xels != yels)) { ends <- cumsum(elementLengths(y)) starts <- c(1L, head(ends, -1L) + 1L) indices <- unlist(lapply(seq_len(length(y)), function(k) { rep(starts[k]:ends[k], length.out=xels[k]) })) y@unlistData <- y@unlistData[indices, , drop=FALSE] } x@unlistData[, j] <- y@unlistData } else if (is(x, "SimpleList")) { indices <- structure(seq_len(length(x)), names = names(x)) x@listData <- lapply(indices, function(k) { z <- x@listData[[k]] z[j] <- y[[k]] z }) } else { stop(class(x), " objects not supported") } x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### ## Casting DataFrameList -> DataFrame implies cast to SplitDataFrameList setAs("DataFrameList", "DataFrame", function(from) { v <- .valid.SplitDataFrameList(from) if (!is.null(v)) stop(v) unlist(from) }) setAs("SplitDataFrameList", "DataFrame", function(from) unlist(from, use.names=FALSE) ) ### S3/S4 combo for as.data.frame.DataFrameList as.data.frame.DataFrameList <- function(x, row.names=NULL, optional=FALSE, ...) { if (!(is.null(row.names) || is.character(row.names))) stop("'row.names' must be NULL or a character vector") if (!missing(optional) || length(list(...))) warning("'optional' and arguments in '...' ignored") stacked <- stack(x) if (is.null(row.names)) row.names <- rownames(stacked) as.data.frame(stacked, row.names = row.names, optional = optional) } setMethod("as.data.frame", "DataFrameList", as.data.frame.DataFrameList) setAs("ANY", "SimpleSplitDataFrameList", function(from) SplitDataFrameList(from, compress=FALSE)) setAs("ANY", "CompressedSplitDataFrameList", function(from) SplitDataFrameList(from, compress=TRUE)) ## Behaves like as.list() on a vector, while SplitDataFrameList() is like list() setAs("List", "SimpleSplitDataFrameList", function(from) do.call(SplitDataFrameList, c(as.list(from), compress=FALSE))) setAs("List", "CompressedSplitDataFrameList", function(from) do.call(SplitDataFrameList, c(as.list(from), compress=TRUE))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Show ### setMethod("show", "SplitDataFrameList", function(object) { k <- length(object) cumsumN <- cumsum(elementLengths(object)) N <- tail(cumsumN, 1) cat(classNameForDisplay(object), " of length ", k, "\n", sep = "") if (k == 0L) { cat("<0 elements>\n") } else if ((k == 1L) || (N <= 20L)) { show(as.list(object)) } else { sketch <- function(x) c(head(x, 3), "...", tail(x, 3)) if (k >= 3 && cumsumN[3L] <= 20) showK <- 3 else if (k >= 2 && cumsumN[2L] <= 20) showK <- 2 else showK <- 1 diffK <- k - showK show(as.list(head(object, showK))) if (diffK > 0) cat("...\n<", k - showK, ifelse(diffK == 1, " more element>\n", " more elements>\n"), sep="") } }) IRanges/R/DataFrameList-utils.R0000644000126300012640000000130012227064470017625 0ustar00biocbuildphs_compbio### ========================================================================= ### DataFrameList utilities ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining. ### setMethod("cbind", "DataFrameList", function(..., deparse.level=1) mendoapply(cbind, ...)) setMethod("rbind", "DataFrameList", function(..., deparse.level=1) mendoapply(rbind, ...)) setMethod("stack", "DataFrameList", function(x, index.var = "name") { DataFrame(.stack.ind(x, index.var), x, row.names = unlist(lapply(x, rownames))) }) IRanges/R/DataTable-API.R0000644000126300012640000002374012227064470016253 0ustar00biocbuildphs_compbio### ========================================================================= ### The DataTable API ### ------------------------------------------------------------------------- ### ### DataTable is an API only (i.e. virtual class with no slots) for accessing ### objects with a rectangular shape like DataFrame or RangedData objects. ### It mimics the API for standard data.frame objects. ### ### See the Vector-class.R file for the definitions of the DataTable and ### DataTableORNULL virtual classes (they need to occur before the definition ### of the Vector class). ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Basic methods. ### setMethod("NROW", "DataTable", function(x) nrow(x)) setMethod("NCOL", "DataTable", function(x) ncol(x)) setMethod("dim", "DataTable", function(x) c(nrow(x), ncol(x))) setMethod("dimnames", "DataTable", function(x) { list(rownames(x), colnames(x)) }) setReplaceMethod("dimnames", "DataTable", function(x, value) { if (!is.list(value)) stop("replacement value must be a list") rownames(x) <- value[[1L]] colnames(x) <- value[[2L]] x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("subset", "DataTable", function(x, subset, select, drop = FALSE, ...) { if (missing(subset)) i <- TRUE else { i <- eval(substitute(subset), x, parent.frame(2)) i <- try(as.logical(i), silent=TRUE) if (inherits(i, "try-error")) stop("'subset' must be coercible to logical") i <- i & !is.na(i) } if (missing(select)) j <- TRUE else { nl <- as.list(seq_len(ncol(x))) names(nl) <- colnames(x) j <- eval(substitute(select), nl, parent.frame(2)) } x[i, j, drop = drop] }) setMethod("na.omit", "DataTable", function(object, ...) { attr(object, "row.names") <- rownames(object) object.omit <- stats:::na.omit.data.frame(object) attr(object.omit, "row.names") <- NULL object.omit }) setMethod("na.exclude", "DataTable", function(object, ...) { attr(object, "row.names") <- rownames(object) object.ex <- stats:::na.exclude.data.frame(object) attr(object.ex, "row.names") <- NULL object.ex }) setMethod("is.na", "DataTable", function(x) { na <- do.call(cbind, lapply(seq(ncol(x)), function(xi) is.na(x[[xi]]))) rownames(na) <- rownames(x) na }) setMethod("complete.cases", "DataTable", function(...) { args <- list(...) if (length(args) == 1) { x <- args[[1L]] rowSums(is.na(x)) == 0 } else complete.cases(args[[1L]]) & do.call(complete.cases, args[-1L]) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining. ### setMethod("cbind", "DataTable", function(..., deparse.level=1) stop("missing 'cbind' method for DataTable class ", class(list(...)[[1L]]))) setMethod("rbind", "DataTable", function(..., deparse.level=1) stop("missing 'rbind' method for DataTable class ", class(list(...)[[1L]]))) ## FIXME: do not cheat by going through data.frame setMethod("merge", c("DataTable", "DataTable"), function(x, y, ...) { DataFrame(merge(as(x, "data.frame"), as(y, "data.frame"), ...)) }) setMethod("merge", c("data.frame", "DataTable"), function(x, y, ...) { DataFrame(merge(x, as(y, "data.frame"), ...)) }) setMethod("merge", c("DataTable", "data.frame"), function(x, y, ...) { DataFrame(merge(as(x, "data.frame"), y, ...)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Looping methods. ### ### FIXME: this is not the same signature/contract as for data.frame setMethod("aggregate", "DataTable", function(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE) { FUN <- match.fun(FUN) if (!missing(by)) { start <- start(by) end <- end(by) } else { if (!is.null(width)) { if (is.null(start)) start <- end - width + 1L else if (is.null(end)) end <- start + width - 1L } start <- as(start, "integer") end <- as(end, "integer") } if (length(start) != length(end)) stop("'start', 'end', and 'width' arguments have unequal length") n <- length(start) if (!is.null(names(start))) indices <- structure(seq_len(n), names = names(start)) else indices <- structure(seq_len(n), names = names(end)) if (is.null(frequency) && is.null(delta)) { sapply(indices, function(i) FUN(window(x, start = start[i], end = end[i]), ...), simplify = simplify) } else { frequency <- rep(frequency, length.out = n) delta <- rep(delta, length.out = n) sapply(indices, function(i) FUN(window(x, start = start[i], end = end[i], frequency = frequency[i], delta = delta[i]), ...), simplify = simplify) } }) .by.data.frame <- by.data.frame # so it will find our generic environment(.by.data.frame) <- topenv() setMethod("by", "DataTable", function(data, INDICES, FUN, ..., simplify = TRUE) { .mc <- mc <- match.call() .mc[[1L]] <- .by.data.frame ans <- eval(.mc, parent.frame()) attr(ans, "call") <- mc ans }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Comparison ### ### S3/S4 combo for duplicated.DataTable duplicated.DataTable <- function(x, incomparables=FALSE, fromLast=FALSE, ...) { duplicated(as(x, "data.frame"), incomparables=incomparables, fromLast=fromLast, ...) } setMethod("duplicated", "DataTable", duplicated.DataTable) ### S3/S4 combo for unique.DataTable unique.DataTable <- unique.data.frame setMethod("unique", "DataTable", unique.DataTable) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### setMethod("as.env", "DataTable", function(x, enclos = parent.frame(2)) { env <- new.env(parent = enclos) lapply(colnames(x), function(col) { colFun <- function() { val <- x[[col]] rm(list=col, envir=env) assign(col, val, env) val } makeActiveBinding(col, colFun, env) }) env }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### setMethod("show", "DataTable", function(object) { nhead <- get_showHeadLines() ntail <- get_showTailLines() nr <- nrow(object) nc <- ncol(object) cat(class(object), " with ", nr, ifelse(nr == 1, " row and ", " rows and "), nc, ifelse(nc == 1, " column\n", " columns\n"), sep = "") if (nr > 0 && nc > 0) { nms <- rownames(object) if (nr < (nhead + ntail + 1L)) { out <- as.matrix(format(as.data.frame( lapply(object, showAsCell), optional = TRUE))) if (!is.null(nms)) rownames(out) <- nms } else { out <- rbind(as.matrix(format(as.data.frame( lapply(object, function(x) showAsCell(head(x, nhead))), optional = TRUE))), rbind(rep.int("...", nc)), as.matrix(format(as.data.frame( lapply(object, function(x) showAsCell(tail(x, ntail))), optional = TRUE)))) rownames(out) <- .rownames(nms, nr, nhead, ntail) } classinfo <- matrix(unlist(lapply(object, function(x) { paste0("<", classNameForDisplay(x)[1], ">") }), use.names = FALSE), nrow = 1, dimnames = list("", colnames(out))) out <- rbind(classinfo, out) print(out, quote = FALSE, right = TRUE) } }) .rownames <- function(nms, nrow, nhead, ntail) { p1 <- ifelse (nhead == 0, 0L, 1L) p2 <- ifelse (ntail == 0, 0L, ntail-1L) s1 <- s2 <- character(0) if (is.null(nms)) { if (nhead > 0) s1 <- paste0(as.character(p1:nhead)) if (ntail > 0) s2 <- paste0(as.character((nrow-p2):nrow)) } else { if (nhead > 0) s1 <- paste0(head(nms, nhead)) if (ntail > 0) s2 <- paste0(tail(nms, ntail)) } c(s1, "...", s2) } IRanges/R/DataTable-stats.R0000644000126300012640000000063212227064470016773 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Statistical routines ### ## TODO: lm, glm, loess, ... setMethod("xtabs", signature(data = "DataTable"), function(formula = ~., data, subset, na.action, exclude = c(NA, NaN), drop.unused.levels = FALSE) { data <- as(data, "data.frame") callGeneric() }) IRanges/R/FilterRules-class.R0000644000126300012640000003321512227064470017364 0ustar00biocbuildphs_compbio### ========================================================================= ### FilterRules objects ### ------------------------------------------------------------------------- setClassUnion("expressionORfunction", c("expression", "function")) setClass("FilterRules", representation(active = "logical"), prototype(elementType = "expressionORfunction"), contains = "SimpleList") ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessors. ### setMethod("active", "FilterRules", function(x) { a <- x@active names(a) <- names(x) a }) setReplaceMethod("active", "FilterRules", function(x, value) { if (is.numeric(value)) { value <- as.integer(value)[!is.na(value)] if (any(value < 1) || any(value > length(x))) stop("filter index out of range") value <- names(x)[value] } if (is.character(value)) { value <- value[!is.na(value)] ## NA's are dropped filterNames <- names(x) if (length(filterNames) == 0) stop("there are no filter names") if (any(!(value %in% filterNames))) stop("'value' contains invalid filter names") x@active <- filterNames %in% value x } else if (is.logical(value)) { nfilters <- length(x) if (length(value) > nfilters) stop("length of 'value' must not be greater than that of 'filters'") if (anyMissing(value)) stop("'value' cannot contain NA's") if (nfilters && (nfilters %% length(value) != 0)) stop("number of filters not a multiple of 'value' length") x@active <- rep(value, length.out = nfilters) x } else stop("unsupported type of 'value'") }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### FilterRules.parseRule <- function(expr) { if (is.character(expr)) { expr <- try(parse(text = expr, srcfile = NULL), silent = TRUE) if (is.character(expr)) stop("failed to parse filter expression: ", expr) expr } else if (is.language(expr) || is.logical(expr)) as.expression(expr) else if (is.function(expr)) new("FilterClosure", expr) else stop("would not evaluate to logical: ", expr) } ## takes logical expressions, character vectors, or functions to parse FilterRules <- function(exprs = list(), ..., active = TRUE) { exprs <- c(as.list(substitute(list(...)))[-1L], exprs) if (length(names(exprs)) == 0) { funs <- as.logical(sapply(exprs, is.function)) nonfuns <- exprs[!funs] names(nonfuns) <- unlist(lapply(nonfuns, deparse)) chars <- as.logical(sapply(nonfuns, is.character)) names(nonfuns)[chars] <- unlist(nonfuns[chars]) names(exprs)[!funs] <- names(nonfuns) } exprs <- lapply(exprs, FilterRules.parseRule) active <- rep(active, length.out = length(exprs)) if (!is.logical(active) || anyMissing(active)) stop("'active' must be logical without any missing values") if (length(active) > length(exprs)) stop("length of 'active' is greater than number of rules") if (length(exprs) && length(exprs) %% length(active) > 0) stop("number of rules must be a multiple of length of 'active'") ans <- newList("FilterRules", exprs, active = active) validObject(ans) ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setReplaceMethod("[[", "FilterRules", function(x, i, j, ..., value) { if (!missing(j) || length(list(...)) > 0) warning("arguments beyond 'i' ignored") if (missing(i)) stop("subscript is missing") rule <- FilterRules.parseRule(value) x <- callNextMethod(x, i, value = rule) if (is.numeric(i) && is.character(value)) names(x)[i] <- value active <- x@active ## in case we expanded names(active) <- names(x)[seq_along(active)] active[[i]] <- TRUE names(active) <- NULL x@active <- active names(x) <- make.names(names(x), unique = TRUE) x }) setMethod("[", "FilterRules", function(x, i, j, ..., drop) { if (!missing(j) || length(list(...)) > 0) stop("invalid subsetting") if (!missing(i)) { x@active <- setNames(setNames(x@active, names(x))[i], NULL) x <- callNextMethod(x, i) } x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.FilterRules.active <- function(x) { if (length(active(x)) != length(x)) "length of 'active' must match length of 'filters'" else if (!identical(names(active(x)), names(x))) "names of 'active' must match those of 'filters'" else if (anyMissing(active(x))) "'active' cannot contain NA's" else NULL } .valid.FilterRules.rules <- function(x) { unlist(lapply(x, function(rule) { if (is.function(rule) && length(formals(rule)) < 1) "function rule must take at least one parameter" else NULL })) } .valid.FilterRules <- function(x) c(.valid.FilterRules.active(x), .valid.FilterRules.rules(x)) setValidity2("FilterRules", .valid.FilterRules) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining ### setMethod("append", c("FilterRules", "FilterRules"), function(x, values, after=length(x)) { if (!isSingleNumber(after)) stop("'after' must be a single number") ans <- FilterRules(append(as.list(x, use.names = TRUE), as.list(values, use.names = TRUE), after = after)) active(ans) <- structure(append(active(x), active(values), after), names = names(ans)) mcols(ans) <- rbind(mcols(x), mcols(values)) ans }) setMethod("c", "FilterRules", function(x, ..., recursive = FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for FilterRules objects ", "does not support the 'recursive' argument") if (missing(x)) args <- unname(list(...)) else args <- unname(list(x, ...)) args <- lapply(args, as, "FilterRules") ans <- FilterRules(unlist(lapply(args, function(x) { elts <- as.list(x) names(elts) <- names(x) elts }), recursive = FALSE)) active(ans) <- structure(unlist(lapply(args, active), use.names = FALSE), names = names(ans)) mcols(ans) <- do.call(rbind, lapply(args, mcols)) ans }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Evaluating ### setMethod("eval", signature(expr="FilterRules", envir="ANY"), function(expr, envir = parent.frame(), enclos = if(is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv()) { result <- rep.int(TRUE, NROW(envir)) rules <- as.list(expr)[active(expr)] for (i in seq_along(rules)) { rule <- rules[[i]] if (is.expression(rule)) val <- eval(rule, envir, enclos) else val <- rule(envir) if (is(val, "Rle")) val <- as.vector(val) if (!is.logical(val)) stop("filter rule evaluated to non-logical: ", names(rules)[i]) if ((NROW(envir) == 0L && length(val) > 0L) || (NROW(envir) > 0L && length(val) == 0L) || (NROW(envir) > 0L && (max(NROW(envir), length(val)) %% min(NROW(envir), length(val)) != 0))) stop("filter rule evaluated to inconsistent length: ", names(rule)[i]) if (length(rules) > 1L) envir <- subset(envir, val) result[result] <- val } result }) setGeneric("evalSeparately", function(expr, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv(), ...) standardGeneric("evalSeparately")) setMethod("evalSeparately", "FilterRules", function(expr, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv(), serial = FALSE) { if (!isTRUEorFALSE(serial)) stop("'serial' must be TRUE or FALSE") inds <- seq_len(length(expr)) names(inds) <- names(expr) passed <- rep.int(TRUE, NROW(envir)) m <- do.call(cbind, lapply(inds, function(i) { result <- eval(expr[i], envir = envir, enclos = enclos) if (serial) { envir <<- subset(envir, result) passed[passed] <<- result passed } else result })) FilterMatrix(matrix = m, filterRules = expr) }) setGeneric("subsetByFilter", function(x, filter, ...) standardGeneric("subsetByFilter")) setMethod("subsetByFilter", c("ANY", "FilterRules"), function(x, filter) { subset(x, eval(filter, x)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Summary ### setMethod("summary", "FilterRules", function(object, subject, serial = FALSE, discarded = FALSE, percent = FALSE) { if (!isTRUEorFALSE(serial)) stop("'serial' must be TRUE or FALSE") mat <- evalSeparately(object, subject, serial = serial) summary(mat, discarded = discarded, percent = percent) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### FilterRule closures ### setClass("FilterClosure", contains = "function") setGeneric("params", function(x, ...) standardGeneric("params")) setMethod("params", "FilterClosure", function(x) { as.list(environment(x)) }) setMethod("show", "FilterClosure", function(object) { p <- params(object) cat("filter (", paste(names(p), "=", sapply(p, deparse, control = NULL), collapse = ", "), ")\n", sep = "") print(body(object)) }) ### ------------------------------------------------------------------------- ### FilterMatrix: coordinates results from multiple filters ### .valid.FilterMatrix <- function(object) { c(if (!is.logical(object)) "values must be logical", if (!is.null(names(filterRules))) "filterRules must not be named", if (length(object@filterRules) != ncol(object)) "length(filterRules) must equal ncol(object)") } setClass("FilterMatrix", representation(filterRules = "FilterRules"), contains = "matrix", validity = .valid.FilterMatrix) setGeneric("filterRules", function(x, ...) standardGeneric("filterRules")) setMethod("filterRules", "FilterMatrix", function(x) { setNames(x@filterRules, colnames(x)) }) setMethod("[", "FilterMatrix", function(x, i, j, ..., drop = TRUE) { if (!missing(i)) i <- as.vector(i) if (!missing(j)) j <- as.vector(j) ans <- callNextMethod() if (is.matrix(ans)) { filterRules <- filterRules(x) if (!missing(j)) filterRules <- filterRules[j] ans <- FilterMatrix(matrix = ans, filterRules = filterRules) } ans }) setMethod("rbind", "FilterMatrix", function(..., deparse.level = 1) { ans <- base::rbind(...) args <- list(...) rulesList <- lapply(args, filterRules) if (any(!sapply(rulesList, identical, rulesList[[1]]))) stop("cannot rbind filter matrices with non-identical rule sets") FilterMatrix(matrix = ans, filterRules = rulesList[[1]]) }) setMethod("cbind", "FilterMatrix", function(..., deparse.level = 1) { ans <- base::cbind(...) rules <- do.call(c, lapply(list(...), function(x) x@filterRules)) FilterMatrix(matrix = ans, filterRules = rules) }) FilterMatrix <- function(matrix, filterRules) { stopifnot(ncol(matrix) == length(filterRules)) if (is.null(colnames(matrix))) colnames(matrix) <- names(filterRules) else if (!is.null(names(filterRules)) && !identical(names(filterRules), colnames(matrix))) stop("if names(filterRules) and colnames(matrix) are both not NULL,", " the names must match") names(filterRules) <- NULL new("FilterMatrix", matrix, filterRules = filterRules) } setMethod("show", "FilterMatrix", function(object) { cat(class(object), " (", nrow(object), " x ", ncol(object), ")\n", sep = "") mat <- makePrettyMatrixForCompactPrinting(object, function(x) x@.Data) print(mat, quote = FALSE, right = TRUE) }) setMethod("summary", "FilterMatrix", function(object, discarded = FALSE, percent = FALSE) { if (!isTRUEorFALSE(discarded)) stop("'discarded' must be TRUE or FALSE") if (!isTRUEorFALSE(percent)) stop("'percent' must be TRUE or FALSE") counts <- c("" = nrow(object), colSums(object), "" = sum(rowSums(object) == ncol(object))) if (discarded) { counts <- nrow(object) - counts } if (percent) { round(counts / nrow(object), 3) } else counts }) IRanges/R/GappedRanges-class.R0000644000126300012640000001360212227064470017462 0ustar00biocbuildphs_compbio### ========================================================================= ### GappedRanges objects ### ------------------------------------------------------------------------- ### ### A GappedRanges object is a vector of gapped ranges. ### A gapped range is conceptually the union of 1 or more non-overlapping ### ranges ordered from left to right. ### More precisely, a gapped range can be represented by a normal IRanges ### object of length >= 1. In particular normality here ensures that the ### individual ranges are non-empty and are separated by non-empty gaps. ### The start of a gapped range is the start of its first range. ### The end of a gapped range is the end of its last range. ### If we ignore the gaps, then a GappedRanges object can be seen as a Ranges ### object. ### setClass("GappedRanges", contains="Ranges", representation(cnirl="CompressedNormalIRangesList"), prototype(elementType="NormalIRanges") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor-like methods. ### setMethod("length", "GappedRanges", function(x) length(x@cnirl)) setMethod("start", "GappedRanges", function(x, ...) CompressedNormalIRangesList.min(x@cnirl, FALSE) ) setMethod("end", "GappedRanges", function(x, ...) CompressedNormalIRangesList.max(x@cnirl, FALSE) ) setGeneric("ngap", function(x) standardGeneric("ngap")) setMethod("ngap", "GappedRanges", function(x) {elementLengths(x) - 1L}) setMethod("names", "GappedRanges", function(x) names(x@cnirl)) setReplaceMethod("names", "GappedRanges", function(x, value) { names(x@cnirl) <- value x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.GappedRanges <- function(x) .Call2("valid_GappedRanges", x, 0L, PACKAGE="IRanges") setValidity2("GappedRanges", .valid.GappedRanges) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setAs("CompressedNormalIRangesList", "GappedRanges", function(from) new("GappedRanges", cnirl=from) ) setAs("CompressedIRangesList", "GappedRanges", function(from) as(as(from, "CompressedNormalIRangesList"), "GappedRanges") ) setAs("GappedRanges", "CompressedNormalIRangesList", function(from) from@cnirl) setAs("GappedRanges", "NormalIRangesList", function(from) from@cnirl) setAs("GappedRanges", "CompressedIRangesList", function(from) from@cnirl) setAs("GappedRanges", "IRangesList", function(from) from@cnirl) setAs("GappedRanges", "RangesList", function(from) from@cnirl) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### ### S3/S4 combo for as.data.frame.GappedRanges as.data.frame.GappedRanges <- function(x, row.names=NULL, optional=FALSE, ...) { ans <- as.data.frame.Ranges(unname(x), row.names, optional, ...) ans$ngap <- ngap(x) ans$names <- names(x) ans } setMethod("as.data.frame", "GappedRanges", as.data.frame.GappedRanges) setMethod("show", "GappedRanges", function(object) { lo <- length(object) cat(class(object), " of length ", lo, "\n", sep="") if (lo == 0L) { return(NULL) } else if (lo < 20L) { showme <- as.data.frame(object, row.names=paste("[", seq_len(lo), "]", sep="")) } else { sketch <- function(x) c(head(x, n=9L), "...", tail(x, n=9L)) showme <- data.frame(start=sketch(start(object)), end=sketch(end(object)), width=sketch(width(object)), ngap=sketch(ngap(object)), row.names=c(paste("[", 1:9, "]", sep=""), "...", paste("[", (lo-8L):lo, "]", sep="")), check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) NAMES <- names(object) if (!is.null(NAMES)) showme$names <- sketch(NAMES) } show(showme) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### ### WARNING: We override the *semantic* of the "[[" method for Ranges objects. setMethod("getListElement", "GappedRanges", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=TRUE) newNormalIRangesFromIRanges(x@cnirl[[i]], check=FALSE) } ) ### WARNING: We override the *semantic* of the "elementLengths" method for ### Ranges objects. setMethod("elementLengths", "GappedRanges", function(x) elementLengths(x@cnirl) ) setMethod("extractROWS", "GappedRanges", function(x, i) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) x@cnirl <- extractROWS(x@cnirl, i) x@elementMetadata <- extractROWS(x@elementMetadata, i) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining. ### setMethod("c", "GappedRanges", function(x, ..., recursive=FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for GappedRanges objects ", "does not support the 'recursive' argument") if (missing(x)) { args <- unname(list(...)) x <- args[[1L]] } else { args <- unname(list(x, ...)) } if (length(args) == 1L) return(x) arg_is_null <- sapply(args, is.null) if (any(arg_is_null)) args[arg_is_null] <- NULL # remove NULL elements by setting them to NULL! if (!all(sapply(args, is, class(x)))) stop("all arguments in '...' must be ", class(x), " objects (or NULLs)") x@cnirl <- do.call(c, lapply(args, function(xx) xx@cnirl)) x } ) IRanges/R/Grouping-class.R0000644000126300012640000006603012227064470016717 0ustar00biocbuildphs_compbio### ========================================================================= ### Grouping objects ### ------------------------------------------------------------------------- ### ### We call "grouping" the action of dividing a collection of NO objects into ### NG groups (some of them eventually empty). The Grouping class and ### subclasses are containers for representing groupings. ### setClass("Grouping", contains="IntegerList", representation("VIRTUAL")) setGeneric("nobj", function(x) standardGeneric("nobj")) setGeneric("grouplength", signature="x", function(x, i=NULL) standardGeneric("grouplength") ) setMethod("grouplength", "Grouping", function(x, i=NULL) { if (is.null(i)) i <- seq_len(length(x)) sapply(i, function(ii) length(x[[i]])) } ) setGeneric("members", signature="x", function(x, i) standardGeneric("members") ) setMethod("members", "Grouping", function(x, i) { if (!is.numeric(i)) stop("subscript 'i' must be a vector of integers") if (!is.integer(i)) i <- as.integer(i) sort(unlist(sapply(i, function(ii) x[[ii]]))) } ) setGeneric("vmembers", signature="x", function(x, L) standardGeneric("vmembers") ) setMethod("vmembers", "Grouping", function(x, L) { if (!is.list(L)) stop("'L' must be a list of integer vectors") lapply(L, function(i) members(x, i)) } ) setGeneric("togroup", signature="x", function(x, j=NULL) standardGeneric("togroup") ) ### The default method works on any object 'x' for which 'elementLengths(x)' ### works (e.g. Partitioning, List, list). Not very efficient. setMethod("togroup", "ANY", function(x, j=NULL) { elt_len <- elementLengths(x) to_group <- rep.int(seq_len(length(elt_len)), elt_len) if (is.null(j)) return(to_group) if (!is.numeric(j)) stop("subscript 'j' must be a vector of integers or NULL") if (!is.integer(j)) j <- as.integer(j) bound <- length(to_group) if (anyMissingOrOutside(j, -bound, bound)) stop("subscript 'j' contains NAs or out of bounds indices") to_group[j] } ) setGeneric("togrouplength", signature="x", function(x, j=NULL) standardGeneric("togrouplength") ) setMethod("togrouplength", "Grouping", function(x, j=NULL) grouplength(x, togroup(x, j)) ) setMethod("show", "Grouping", function(object) { NG <- length(object) NO <- nobj(object) cat(class(object), " with ", NG, ifelse(NG == 1, " group ", " groups "), "and ", NO, ifelse(NO == 1, " object\n", " objects\n"), sep="") if (NG == 0L) return(invisible(NULL)) empty_groups <- which(grouplength(object) == 0L) cat("Nb of empty groups: ", length(empty_groups), " (", 100.00 * length(empty_groups) / NG, "%)\n", sep="") } ) ### ------------------------------------------------------------------------- ### BiIndexGrouping objects ### ----------------------- #setClass("BiIndexGrouping", # contains="Grouping", # representation( # group2object="list", # object2group="integer" # ) #) #setMethod("length", "BiIndexGrouping", function(x) length(x@group2object)) #setMethod("nobj", "BiIndexGrouping", function(x) length(x@object2group)) ### ------------------------------------------------------------------------- ### H2LGrouping and Dups objects ### ---------------------------- ### ### High-to-Low Index Grouping objects. ### setClass("H2LGrouping", contains="Grouping", representation( high2low="integer", low2high="list" ) ) ### For storing the grouping implicitly defined by the "duplicated" ### relationship between elements of an arbitrary vector. setClass("Dups", contains="H2LGrouping") ### Two additional accessors for H2LGrouping objects. setGeneric("high2low", function(x) standardGeneric("high2low")) setMethod("high2low", "H2LGrouping", function(x) x@high2low) setGeneric("low2high", function(x) standardGeneric("low2high")) setMethod("low2high", "H2LGrouping", function(x) x@low2high) ### 'length(x)' and 'nobj(x)' are the same. setMethod("length", "H2LGrouping", function(x) length(x@low2high)) setMethod("nobj", "H2LGrouping", function(x) length(x@high2low)) setMethod("getListElement", "H2LGrouping", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=TRUE) if (is.na(x@high2low[i])) c(i, x@low2high[[i]]) else integer() } ) ### Should be more efficient than the default method for Grouping objects. setMethod("grouplength", "H2LGrouping", function(x, i=NULL) { group_length <- elementLengths(x@low2high) + 1L group_length[!is.na(x@high2low)] <- 0L if (is.null(i)) return(group_length) if (!is.numeric(i)) stop("subscript 'i' must be a vector of integers or NULL") if (!is.integer(i)) i <- as.integer(i) bound <- length(group_length) if (anyMissingOrOutside(i, -bound, bound)) stop("subscript 'i' contains NAs or out of bounds indices") group_length[i] } ) setMethod("members", "H2LGrouping", function(x, i) { if (!is.numeric(i)) stop("subscript 'i' must be a vector of integers") if (!is.integer(i)) i <- as.integer(i) ## NAs and "subscript out of bounds" are checked at the C level .Call2("H2LGrouping_members", x, i, PACKAGE="IRanges") } ) setMethod("vmembers", "H2LGrouping", function(x, L) { if (!is.list(L)) stop("'L' must be a list of integer vectors") .Call2("H2LGrouping_vmembers", x, L, PACKAGE="IRanges") } ) setMethod("togroup", "H2LGrouping", function(x, j=NULL) { to_group <- x@high2low to_group[is.na(to_group)] <- which(is.na(to_group)) if (is.null(j)) return(to_group) if (!is.numeric(j)) stop("subscript 'j' must be a vector of integers or NULL") if (!is.integer(j)) j <- as.integer(j) bound <- length(to_group) if (anyMissingOrOutside(j, -bound, bound)) stop("subscript 'j' contains NAs or out of bounds indices") to_group[j] } ) ### The default method should be as good (if not better) as this. #setMethod("togrouplength", "H2LGrouping", # function(x) # { # ans <- rep.int(1L, length(x)) # mapped_lows <- setdiff(unique(x@high2low), NA) # for (low in mapped_lows) { # ii <- as.integer(c(low, x@low2high[[low]])) # ans[ii] <- length(ii) # } # ans # } #) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### More operations on H2LGrouping objects. These operations are NOT part of ### the Grouping core API. ### ### The rank of group G_i is the number of non-empty groups that are before ### G_i plus one. Or, equivalently, it's the number of non-empty groups with ### an index <= i. setGeneric("grouprank", signature="x", function(x, i=NULL) standardGeneric("grouprank") ) setMethod("grouprank", "H2LGrouping", function(x, i=NULL) { ans <- cumsum(is.na(high2low(x))) if (!is.null(i)) ans <- ans[i] return(ans) } ) ### togrouprank() returns the mapping from objects to group ranks. ### An important property of togrouprank() is that: ### togrouprank(x, neg_idx) ### and ### seq_len(length(neg_idx)) ### are identical, where 'neg_idx' is the vector of the indices of ### the non-empty groups i.e. ### neg_idx <- which(grouplength(x) != 0L) setGeneric("togrouprank", signature="x", function(x, j=NULL) standardGeneric("togrouprank") ) setMethod("togrouprank", "H2LGrouping", function(x, j=NULL) { to_group <- togroup(x) group_rank <- grouprank(x) ans <- group_rank[to_group] if (!is.null(j)) ans <- ans[j] return(ans) } ) makeLow2highFromHigh2low <- function(high2low) { ans <- vector(mode="list", length=length(high2low)) sparse_ans <- split(seq_along(high2low), high2low) ans[as.integer(names(sparse_ans))] <- sparse_ans ans } setReplaceMethod("length", "H2LGrouping", function(x, value) { if (!isSingleNumber(value)) stop("length must be a single integer") if (!is.integer(value)) value <- as.integer(value) if (value < 0L) stop("length cannot be negative") if (value > length(x)) stop("cannot make a ", class(x), " instance longer") length(x@high2low) <- value x@low2high <- makeLow2highFromHigh2low(x@high2low) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.H2LGrouping <- function(x) { if (!is.integer(x@high2low)) return("the 'high2low' slot must contain an integer vector") if (!all(x@high2low >= 1L, na.rm=TRUE)) return("the 'high2low' slot must contain integer values >= 1") if (!all(x@high2low < seq_along(x@high2low), na.rm=TRUE)) { problem <- c("when mapped, elements in the 'high2low' slot must be mapped ", "to elements at a lower position") return(paste(problem, collapse="")) } if (!all(is.na(x@high2low[x@high2low]))) { problem <- c("when mapped, elements in the 'high2low' slot must be mapped ", "to unmapped elements") return(paste(problem, collapse="")) } if (!is.list(x@low2high)) return("the 'low2high' slot must contain a list") if (length(x@high2low) != length(x@low2high)) return("the 'high2low' and 'low2high' slots must have the same length") if (!identical(makeLow2highFromHigh2low(x@high2low), x@low2high)) { problem <- c("the 'low2high' slot must contain the reverse mapping ", "of the 'high2low' slot") return(paste(problem, collapse="")) } NULL } setValidity("H2LGrouping", function(object) { problems <- .valid.H2LGrouping(object) if (is.null(problems)) TRUE else problems } ) ### For Dups objects only. .duplicated.Dups <- function(x, incomparables=FALSE) { if (!identical(incomparables, FALSE)) stop("\"duplicated\" method for Dups objects ", "only accepts 'incomparables=FALSE'") !is.na(high2low(x)) } ### S3/S4 combo for duplicated.Dups duplicated.Dups <- function(x, incomparables=FALSE, ...) .duplicated.Dups(x, incomparables=incomparables, ...) setMethod("duplicated", "Dups", duplicated.Dups) ### For Dups objects only. setMethod("show", "Dups", function(object) { percentage <- 100.00 * sum(duplicated(object)) / length(object) cat(class(object), " of length ", length(object), " (", percentage, "% of duplicates)\n", sep="") } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructors. ### .newH2LGrouping <- function(Class, high2low) { if (!is.numeric(high2low)) stop("'high2low' must be a vector of integers") if (!is.integer(high2low)) high2low <- as.integer(high2low) new2(Class, high2low=high2low, low2high=makeLow2highFromHigh2low(high2low), check=FALSE) } H2LGrouping <- function(high2low=integer()) .newH2LGrouping("H2LGrouping", high2low) Dups <- function(high2low=integer()) .newH2LGrouping("Dups", high2low) ### If 'x' is a vector-like object for which "[" and "==" are defined, then ### 'high2low(x)' can be *conceptually* defined with: ### ### high2low <- function(x) ### sapply(seq_len(length(x)), ### function(i) match(x[i], x[seq_len(i-1L)])) ### ### Of course this is *very* inefficient (quadratic in time), its only value ### being to describe the semantic: ### ### > x <- as.integer(c(2,77,4,4,7,2,8,8,4,99)) ### > high2low(x) ### [1] NA NA NA 3 NA 1 NA 7 3 NA ### > bigx <- rep.int(x, 10000) ### > system.time(high2low(bigx)) ### user system elapsed ### 284.805 9.792 294.888 ### setMethod("high2low", "vector", function(x) { ## Author: Harris A. Jaffee ans <- match(x, x) ans[ans == seq_len(length(x))] <- NA_integer_ return(ans) } ) ### The "high2low" method for Vector objects uses an implementation that ### is O(n*log(n)) in time but it requires that "order" be defined for 'x' ### (in addition to "[" and "=="). setMethod("high2low", "Vector", function(x) { ## The 2 lines below are equivalent but much faster than ## ans <- rep.int(NA_integer_, length(x)) ans <- integer(length(x)) ans[] <- NA_integer_ if (length(x) <= 1L) return(ans) x_order <- order(x) low <- x_order[1L] for (i in 2:length(x)) { high <- x_order[i] if (x[high] == x[low]) ans[high] <- low else low <- high } return(ans) } ) ### ------------------------------------------------------------------------- ### Partitioning objects ### -------------------- ### ### A Partitioning container represents a block-grouping i.e. a grouping ### where each group contains objects that are neighbors in the original ### collection of objects. More formally, a grouping 'x' is a block-grouping ### iff 'togroup(x)' is sorted in increasing order (not necessarily strictly ### increasing). In addition, a Partitioning object can be seen (and ### manipulated) as a Ranges object where all the ranges are adjacent ### starting at 1 (i.e. it covers an integer interval starting at 1 ### and with no overlap between the ranges). Therefore the "start/end/width" ### API is implemented on Partitioning objects (in addition to the Grouping ### API). ### ### The Partitioning class is virtual with 2 concrete subclasses: ### PartitioningByEnd and PartitioningByWidth. ### Note that we put Ranges before Grouping in order to have Partitioning ### objects inherit the "show" method for Ranges objects. setClass("Partitioning", contains=c("Ranges", "Grouping"), representation( "VIRTUAL", NAMES="characterORNULL" # R doesn't like @names !! ), prototype( NAMES=NULL ) ) ### The default methods below assume that the "length + start/end/width" API ### is already implemented. setMethod("getListElement", "Partitioning", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=TRUE) ## The purpose of the code below is to extract 'start(x)[i] - 1' ## (stored in 'ans_shift') and 'width(x)[i]' (stored in 'ans_length') ## in the fastest possible way. Looks like a convoluted way to ## extract those 2 values but it is actually 1000x faster than the ## naive way. ans_shift <- 0L ans_length <- end(x)[i] if (i >= 2L) { ans_shift <- end(x)[i - 1L] ans_length <- ans_length - ans_shift } seq_len(ans_length) + ans_shift } ) ### Should be more efficient than the default method for Grouping objects. setMethod("grouplength", "Partitioning", function(x, i=NULL) { x_width <- width(x) if (is.null(i)) return(x_width) if (!is.numeric(i)) stop("subscript 'i' must be a vector of integers or NULL") if (!is.integer(i)) i <- as.integer(i) bound <- length(x_width) if (anyMissingOrOutside(i, -bound, bound)) stop("subscript 'i' contains NAs or out of bounds indices") x_width[i] } ) setMethod("names", "Partitioning", function(x) x@NAMES) setReplaceMethod("names", "Partitioning", function(x, value) { if (!is.null(value)) value <- as.character(value) unsafe.names(x) <- value x } ) .valid.Partitioning <- function(x) { if (is.null(names(x))) return(NULL) if (!is.character(names(x))) return("the names must be a character vector or NULL") if (length(names(x)) != length(x)) return("number of names and number of elements differ") NULL } setValidity2("Partitioning", .valid.Partitioning) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### PartitioningByEnd uses a compact internal representation that allows ### fast mapping from groups to objects. However, it is not efficient for ### mapping from objects to groups. ### setClass("PartitioningByEnd", contains="Partitioning", representation( end="integer" ), prototype( end=integer() ) ) setMethod("end", "PartitioningByEnd", function(x) x@end) setMethod("length", "PartitioningByEnd", function(x) length(end(x))) setMethod("nobj", "PartitioningByEnd", function(x) { x_end <- end(x) if (length(x_end) == 0L) return(0L) x_end[length(x_end)] } ) setMethod("start", "PartitioningByEnd", function(x) { x_end <- end(x) if (length(x_end) == 0L) return(integer()) c(1L, x_end[-length(x_end)] + 1L) } ) setMethod("width", "PartitioningByEnd", function(x) diffWithInitialZero(end(x))) .valid.PartitioningByEnd <- function(x) { if (!is.integer(end(x))) return("the ends must be integers") if (length(x) == 0L) return(NULL) if (anyMissing(end(x))) return("the ends cannot be NAs") if (isNotSorted(end(x))) return("the ends must be sorted") if (end(x)[1L] < 0L) return("the ends cannot be negative") if (!is.null(names(end(x)))) return("the ends should not be named") NULL } setValidity2("PartitioningByEnd", .valid.PartitioningByEnd) PartitioningByEnd <- function(x=integer(), NG=NULL, names=NULL) { if (is(x, "CompressedList")) { ## Behaves like a getter for the 'partitioning' slot. if (!is.null(NG)) warning("when 'x' is a CompressedList object, ", "the 'NG' argument is ignored") if (!is.null(names)) warning("when 'x' is a CompressedList object, ", "the 'names' argument is ignored") return(x@partitioning) } if (is.list(x) || is(x, "List")) { if (!is.null(NG)) warning("'NG' argument is ignored when 'x' is ", "a CompressedList object") x <- cumsum(elementLengths(x)) } else { if (!is.numeric(x)) stop("'x' must be either a list-like object ", "or a sorted integer vector") if (!is.integer(x)) x <- as.integer(x) if (isNotSorted(x)) stop("when 'x' is an integer vector, it must be sorted") if (!is.null(NG)) { ## When 'NG' (number of groups) is supplied, then 'x' is considered ## to represent the group assignment of a collection of 'length(x)' ## objects. Therefore the values in 'x' must be >= 1 and <= 'NG'. ## ADDITIONALLY, 'x' must be *sorted* (not strictly) so it can be ## reconstructed from the object returned by PartitioningByEnd() ## by doing togroup() on that object. if (!isSingleNumber(NG)) stop("'NG' must be either NULL or a single integer") if (!is.integer(NG)) NG <- as.integer(NG) NO <- length(x) # nb of objects if (NG == 0L) { if (NO != 0L) stop("when 'NG' is 0, 'x' must be of length 0") } else { ## 'x' is expected to be non-decreasing and with values >= 1 ## and <= 'NG'. x <- cumsum(tabulate(x, nbins=NG)) ## 'x[NG]' is guaranteed to be <= 'NO'. if (x[NG] != NO) stop("when 'NG' is supplied, values in 'x' must ", "be >= 1 and <= 'NG'") } } } if (is.null(names)) { ans_names <- names(x) } else { if (!is.character(names) || length(names) != length(x)) stop("'names' must be either NULL or a character vector of length ", "'NG' (if supplied) or 'length(x)' (if 'NG' is not supplied)") ans_names <- names } new2("PartitioningByEnd", end=unname(x), NAMES=ans_names, check=FALSE) } setAs("Ranges", "PartitioningByEnd", function(from) { ans <- PartitioningByEnd(end(from), names(from)) if (!identical(start(ans), start(from))) stop("the Ranges object to coerce does not represent a partitioning") ans } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### PartitioningByWidth uses a compact internal representation too. Storing ### the widths instead of the ends would allow the total number of objects ### (nobj(x)) to be greater than 2^31-1 but note that some methods will break ### when this happens, e.g. nobj, end, etc... ### setClass("PartitioningByWidth", contains="Partitioning", representation( width="integer" ), prototype( width=integer() ) ) setMethod("width", "PartitioningByWidth", function(x) x@width) setMethod("length", "PartitioningByWidth", function(x) length(width(x))) setMethod("end", "PartitioningByWidth", function(x) cumsum(width(x))) setMethod("nobj", "PartitioningByWidth", function(x) { x_end <- end(x) if (length(x_end) == 0L) return(0L) x_end[length(x_end)] } ) setMethod("start", "PartitioningByWidth", function(x) { x_width <- width(x) if (length(x_width) == 0L) return(integer()) c(1L, cumsum(x_width[-length(x_width)]) + 1L) } ) .valid.PartitioningByWidth <- function(x) { if (!is.integer(width(x))) return("the widths must be integers") if (length(x) == 0L) return(NULL) if (anyMissing(width(x))) return("the widths cannot be NAs") if (any(width(x) < 0L)) return("the widths cannot be negative") if (!is.null(names(width(x)))) return("the widths should not be named") NULL } setValidity2("PartitioningByWidth", .valid.PartitioningByWidth) PartitioningByWidth <- function(x=integer(), NG=NULL, names=NULL) { if (is.list(x) || is(x, "List")) { if (!is.null(NG)) warning("'NG' argument is ignored when 'x' is ", "a CompressedList object") x <- elementLengths(x) } else { if (!is.numeric(x)) stop("'x' must be either a list-like object or an integer vector") if (!is.integer(x)) x <- as.integer(x) if (!is.null(NG)) { ## When 'NG' (number of groups) is supplied, then 'x' is considered ## to represent the group assignment of a collection of 'length(x)' ## objects. Therefore the values in 'x' must be >= 1 and <= 'NG'. ## ADDITIONALLY, 'x' must be *sorted* (not strictly) so it can be ## reconstructed from the object returned by PartitioningByWidth() ## by doing togroup() on that object. if (isNotSorted(x)) stop("when 'x' is an integer vector, it must be sorted") if (!isSingleNumber(NG)) stop("'NG' must be either NULL or a single integer") if (!is.integer(NG)) NG <- as.integer(NG) NO <- length(x) # nb of objects if (NG == 0L) { if (NO != 0L) stop("when 'NG' is 0, 'x' must be of length 0") } else { ## 'x' is expected to be non-decreasing and with values >= 1 ## and <= 'NG'. x <- tabulate(x, nbins=NG) ## 'sum(x)' is guaranteed to be <= 'NO'. if (sum(x) != NO) stop("when 'NG' is supplied, values in 'x' must ", "be >= 1 and <= 'NG'") } } } if (is.null(names)) { ans_names <- names(x) } else { if (!is.character(names) || length(names) != length(x)) stop("'names' must be either NULL or a character vector of length ", "'NG' (if supplied) or 'length(x)' (if 'NG' is not supplied)") ans_names <- names } new2("PartitioningByWidth", width=unname(x), NAMES=ans_names, check=FALSE) } setAs("Ranges", "PartitioningByWidth", function(from) { ans <- PartitioningByWidth(width(from), names(from)) if (!identical(start(ans), start(from))) stop("the Ranges object to coerce does not represent a partitioning") ans } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### findOverlaps() ### ### A simple findOverlaps method that doesn't use IntervalTree but works only ### on a subject with *adjacent* ranges sorted non-decreasingly. ### Can be 30% faster or more than the real findOverlaps() (IntervalTree-based) ### when 'query' is such that 'start(query)' and 'end(query)' are also sorted ### non-decreasingly (which is the case if for example 'query' is a ### Partitioning object). ### TODO: Add a "findOverlaps" method for Partitioning,Partitioning in the ### findOverlaps-methods.R file that calls this. findOverlaps_Ranges_Partitioning <- function(query, subject, hit.empty.query.ranges=FALSE, hit.empty.subject.ranges=FALSE) { if (!is(query, "Ranges")) stop("'query' must be a Ranges object") if (!is(subject, "Partitioning")) stop("'subject' must be a Partitioning object") if (!isTRUEorFALSE(hit.empty.query.ranges) || !isTRUEorFALSE(hit.empty.subject.ranges)) stop("'hit.empty.query.ranges' and 'hit.empty.subject.ranges' ", "must be TRUE or FALSE") q_len <- length(query) q_start <- start(query) q_end <- end(query) s_len <- length(subject) s_end <- end(subject) if (!hit.empty.query.ranges) { q_idx <- which(width(query) != 0L) q_start <- q_start[q_idx] q_end <- q_end[q_idx] } if (!hit.empty.subject.ranges) { s_idx <- which(width(subject) != 0L) s_end <- s_end[s_idx] } vec <- c(0L, s_end) + 0.5 q_start2subject <- findInterval(q_start, vec) q_end2subject <- findInterval(q_end, vec) q_hits <- rep.int(seq_len(length(q_start)), q_end2subject - q_start2subject + 1L) s_hits <- mseq(q_start2subject, q_end2subject) ## If 'query' is a Partitioning object, all hits are guaranteed to be ## valid. if (!is(query, "Partitioning")) { ## Remove invalid hits. is_valid <- 1L <= s_hits & s_hits <= length(s_end) q_hits <- q_hits[is_valid] s_hits <- s_hits[is_valid] } ## Remap hits to original query/subject. if (!hit.empty.query.ranges) q_hits <- q_idx[q_hits] if (!hit.empty.subject.ranges) s_hits <- s_idx[s_hits] ## Make and return Hits object. new2("Hits", queryHits=q_hits, subjectHits=s_hits, queryLength=q_len, subjectLength=s_len) } IRanges/R/Hits-class.R0000644000126300012640000002507612227064470016041 0ustar00biocbuildphs_compbio### ========================================================================= ### Hits objects ### ------------------------------------------------------------------------- setClass("Hits", contains="Vector", representation( queryHits="integer", # integer vector of length N subjectHits="integer", # integer vector of length N queryLength="integer", # single integer subjectLength="integer" # single integer ), prototype( queryLength=0L, subjectLength=0L ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessors ### setMethod("length", "Hits", function(x) { length(queryHits(x)) }) setGeneric("queryHits", function(x, ...) standardGeneric("queryHits")) setMethod("queryHits", "Hits", function(x) x@queryHits) setGeneric("subjectHits", function(x, ...) standardGeneric("subjectHits")) setMethod("subjectHits", "Hits", function(x) x@subjectHits) setGeneric("queryLength", function(x, ...) standardGeneric("queryLength")) setMethod("queryLength", "Hits", function(x) x@queryLength) setGeneric("subjectLength", function(x, ...) standardGeneric("subjectLength")) setMethod("subjectLength", "Hits", function(x) x@subjectLength) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("extractROWS", "Hits", function(x, i) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) if ((is.integer(i) && isNotStrictlySorted(i)) || (is(i, "Ranges") && !isNormal(i))) stop("subscript cannot contain duplicates and must preserve the ", "order of elements when subsetting a ", class(x), " object") x@queryHits <- extractROWS(x@queryHits, i) x@subjectHits <- extractROWS(x@subjectHits, i) x@elementMetadata <- extractROWS(x@elementMetadata, i) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### ## return a matrix where each row indicates a hit (query and subject index) setMethod("as.matrix", "Hits", function(x) cbind(queryHits=queryHits(x), subjectHits=subjectHits(x)) ) setAs("Hits", "DataFrame", function(from) { DataFrame(as.matrix(from), if (!is.null(mcols(from))) mcols(from) else new("DataFrame", nrows = length(from))) }) ### S3/S4 combo for as.data.frame.Hits as.data.frame.Hits <- function(x, row.names=NULL, optional=FALSE, ...) { if (!(is.null(row.names) || is.character(row.names))) stop("'row.names' must be NULL or a character vector") if (!identical(optional, FALSE) || length(list(...))) warning("'optional' and arguments in '...' are ignored") as.data.frame(as(x, "DataFrame"), row.names = row.names) } setMethod("as.data.frame", "Hits", as.data.frame.Hits) ### S3/S4 combo for as.list.Hits ### Returns a list, with an element for each query, containing the subject hits .as.list.Hits <- function(x, values=seq_len(subjectLength(x))) { unname(split(values[subjectHits(x)], factor(queryHits(x), levels = seq_len(queryLength(x))))) } as.list.Hits <- function(x, ...) .as.list.Hits(x, ...) setMethod("as.list", "Hits", as.list.Hits) setAs("Hits", "list", function(from) as.list(from)) setAs("Hits", "List", function(from) { unname(seqsplit(subjectHits(from), factor(queryHits(from), levels = seq_len(queryLength(from))))) }) ## count up the hits for each query setMethod("as.table", "Hits", function(x, ...) { tabulate(queryHits(x), queryLength(x)) }) ### FIXME: this needs a new name given the switch to Vector setMethod("t", "Hits", function(x) { tmp <- x@queryHits x@queryHits <- x@subjectHits x@subjectHits <- tmp tmp <- x@queryLength x@queryLength <- x@subjectLength x@subjectLength <- tmp x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Splitting / relisting. ### setMethod("splitAsListReturnedClass", "Hits", function(x) "HitsList") ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### match() ### compatibleHits <- function(x, y) { subjectLength(x) == subjectLength(y) && queryLength(x) == queryLength(y) } setMethod("match", c("Hits", "Hits"), function(x, table, nomatch=NA_integer_, incomparables=NULL) { if (!compatibleHits(x, table)) stop("'x' and 'table' are incompatible by subject and query length") if (!is.null(incomparables)) stop("\"match\" method for Hits objects ", "only accepts 'incomparables=NULL'") matchIntegerPairs(queryHits(x), subjectHits(x), queryHits(table), subjectHits(table), nomatch=nomatch) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Utilities ### countHits <- tabulate2 setGeneric("countSubjectHits", function(x, ...) standardGeneric("countSubjectHits")) setMethod("countSubjectHits", "Hits", function(x) { countHits(subjectHits(x), subjectLength(x)) }) setGeneric("countQueryHits", function(x, ...) standardGeneric("countQueryHits")) setMethod("countQueryHits", "Hits", function(x) { countHits(queryHits(x), queryLength(x)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### makeAllGroupInnerHits() ### ### NOT exported. ### About 10x faster and uses 4x less memory than my first attempt in pure ### R below. makeAllGroupInnerHits <- function(group.sizes, hit.type=0L) { if (!is.integer(group.sizes)) stop("'group.sizes' must be an integer vector") if (!isSingleNumber(hit.type)) stop("'hit.type' must be a single integer") if (!is.integer(hit.type)) hit.type <- as.integer(hit.type) .Call2("make_all_group_inner_hits", group.sizes, hit.type, PACKAGE="IRanges") } ### TODO: Remove this. makeAllGroupInnerHits.old <- function(GS) { NG <- length(GS) # nb of groups ## First Element In group i.e. first elt associated with each group. FEIG <- cumsum(c(1L, GS[-NG])) GSr <- c(0L, GS[-NG]) CGSr2 <- cumsum(GSr * GSr) GS2 <- GS * GS N <- sum(GS) # length of original vector (i.e. before grouping) ## Original Group Size Assignment i.e. group size associated with each ## element in the original vector. OGSA <- rep.int(GS, GS) # has length N query_hits <- rep.int(seq_len(N), OGSA) NH <- length(query_hits) # same as sum(GS2) ## Hit Group Assignment i.e. group associated with each hit. HGA <- rep.int(seq_len(NG), GS2) ## Hit Group Size Assignment i.e. group size associated with each hit. HGSA <- GS[HGA] subject_hits <- (0:(NH-1L) - CGSr2[HGA]) %% GS[HGA] + FEIG[HGA] new2("Hits", queryHits=query_hits, subjectHits=subject_hits, queryLength=N, subjectLength=N, check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Show ### setMethod("show", "Hits", function(object) { cat("Hits of length ", length(object), "\n", sep = "") cat("queryLength: ", queryLength(object), "\n", sep = "") cat("subjectLength: ", subjectLength(object), "\n", sep = "") df_show <- capture.output(show(as(object, "DataFrame"))) cat(paste(tail(df_show, -1), "\n")) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Remap the query and/or subject hits. ### ### Returns 'arg' as a NULL, an integer vector, or a factor. .normargMap <- function(arg, sidename, old.length) { if (is.null(arg)) return(arg) if (!is.factor(arg)) { if (!is.numeric(arg)) stop("'" , sidename, ".map' must be a vector of integers") if (!is.integer(arg)) arg <- as.integer(arg) } if (length(arg) != old.length) stop("'" , sidename, ".map' must have the length of the ", sidename) arg } .normargNewLength <- function(arg, sidename, map) { if (!isSingleNumberOrNA(arg)) stop("'new.", sidename, "Length' must be a single number or NA") if (!is.integer(arg)) arg <- as.integer(arg) if (is.null(map)) { if (!is.na(arg)) stop("'new.", sidename, "Length' must be NA ", "when '" , sidename, ".map' is NULL") return(arg) } if (is.factor(map)) { if (is.na(arg)) return(nlevels(map)) if (arg < nlevels(map)) stop("supplied 'new.", sidename, "Length' must ", "be >= 'nlevels(", sidename, ".map)'") return(arg) } if (is.na(arg)) stop("'new.", sidename, "Length' must be specified when ", "'" , sidename, ".map' is specified and is not a factor") arg } remapHits <- function(x, query.map=NULL, new.queryLength=NA, subject.map=NULL, new.subjectLength=NA) { if (!is(x, "Hits")) stop("'x' must be a Hits object") query.map <- .normargMap(query.map, "query", queryLength(x)) new.queryLength <- .normargNewLength(new.queryLength, "query", query.map) subject.map <- .normargMap(subject.map, "subject", subjectLength(x)) new.subjectLength <- .normargNewLength(new.subjectLength, "subject", subject.map) query_hits <- queryHits(x) subject_hits <- subjectHits(x) if (is.null(query.map)) { new.queryLength <- queryLength(x) } else { if (is.factor(query.map)) query.map <- as.integer(query.map) if (anyMissingOrOutside(query.map, 1L, new.queryLength)) stop("'query.map' cannot contain NAs, or values that ", "are < 1, or > 'new.queryLength'") query_hits <- query.map[query_hits] } if (is.null(subject.map)) { new.subjectLength <- subjectLength(x) } else { if (is.factor(subject.map)) subject.map <- as.integer(subject.map) if (anyMissingOrOutside(subject.map, 1L, new.subjectLength)) stop("'subject.map' cannot contain NAs, or values that ", "are < 1, or > 'new.subjectLength'") subject_hits <- subject.map[subject_hits] } not_dup <- !duplicatedIntegerPairs(query_hits, subject_hits) query_hits <- query_hits[not_dup] subject_hits <- subject_hits[not_dup] oo <- orderIntegerPairs(query_hits, subject_hits) new("Hits", queryHits=query_hits[oo], subjectHits=subject_hits[oo], queryLength=new.queryLength, subjectLength=new.subjectLength) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### TODO: More convenience methods ### IRanges/R/HitsList-class.R0000644000126300012640000000747412227064470016677 0ustar00biocbuildphs_compbio### ========================================================================= ### HitsList objects ### ------------------------------------------------------------------------- setClass("HitsList", contains="SimpleList", representation( subjectOffsets="integer" ), prototype(elementType="Hits") ) setClass("CompressedHitsList", prototype = prototype(elementType = "Hits", unlistData = new("Hits")), contains="CompressedList") ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessors ### setMethod("space", "HitsList", function(x) { space <- names(x) if (!is.null(space)) space <- rep.int(space, sapply(as.list(x, use.names = FALSE), length)) space }) setMethod("subjectHits", "HitsList", function(x) { as.matrix(x)[,2L,drop=TRUE] }) setMethod("subjectHits", "CompressedHitsList", function(x) subjectHits(x@unlistData)) setMethod("queryHits", "HitsList", function(x) { as.matrix(x)[,1L,drop=TRUE] }) setMethod("queryHits", "CompressedHitsList", function(x) queryHits(x@unlistData)) setMethod("queryLength", "CompressedHitsList", function(x) queryLength(x@unlistData)) setMethod("subjectLength", "CompressedHitsList", function(x) subjectLength(x@unlistData)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor ### HitsList <- function(list_of_hits, subject) { subjectOffsets <- c(0L, head(cumsum(sapply(subject, length)), -1)) subjectToQuery <- seq_along(list_of_hits) if (!is.null(names(list_of_hits)) && !is.null(names(subject))) subjectToQuery <- match(names(list_of_hits), names(subject)) subjectOffsets <- subjectOffsets[subjectToQuery] newList("HitsList", list_of_hits, subjectOffsets = subjectOffsets) } CompressedHitsList <- function(hits, query) { if (!(is(query, "CompressedIRangesList"))) stop("'query' must be a 'CompressedIRangesList' object") if (!is(hits, "Hits")) stop("'hits' must be a 'Hits' object") qspace <- space(query) hspace <- as.integer(qspace[queryHits(hits)]) partitioning <- PartitioningByEnd(hspace, names=names(query@partitioning), NG=length(names(query@partitioning))) newCompressedList0("CompressedHitsList", unlistData=hits, partitioning=partitioning) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### ## return as.matrix as on Hits, with indices adjusted setMethod("as.matrix", "HitsList", function(x) { mats <- lapply(x, as.matrix) mat <- do.call(rbind, mats) rows <- c(0L, head(cumsum(sapply(x, queryLength)), -1)) nr <- sapply(mats, nrow) mat + cbind(rep.int(rows, nr), rep.int(x@subjectOffsets, nr)) }) setMethod("as.matrix", "CompressedHitsList", function(x) { cbind(queryHits=queryHits(x), subjectHits=subjectHits(x)) }) ## count up the matches for each query in every matching setMethod("as.table", "HitsList", function(x, ...) { counts <- unlist(lapply(x, as.table)) as.table(array(counts, length(counts), list(range = seq_along(counts)))) }) setMethod("t", "HitsList", function(x) { x@elements <- lapply(as.list(x, use.names = FALSE), t) x }) setMethod("ranges", "HitsList", function(x, query, subject) { if (!is(query, "RangesList") || length(query) != length(x)) stop("'query' must be a RangesList of length equal to that of 'x'") if (!is(subject, "RangesList") || length(subject) != length(x)) stop("'subject' must be a RangesList of length equal to that of 'x'") els <- as.list(x, use.names = FALSE) queries <- as.list(query, use.names = FALSE) subjects <- as.list(subject, use.names = FALSE) ans <- do.call(RangesList, lapply(seq_len(length(x)), function(i) { ranges(els[[i]], queries[[i]], subjects[[i]]) })) names(ans) <- names(x) ans }) ### TODO: many convenience methods IRanges/R/IRanges-class.R0000644000126300012640000004464212227064470016462 0ustar00biocbuildphs_compbio### ========================================================================= ### IRanges objects ### ------------------------------------------------------------------------- ### ### The IRanges class is a simple container for storing a vector of integer ### ranges. ### setClass("IRanges", contains="Ranges", representation( start="integer", width="integer", NAMES="characterORNULL" # R doesn't like @names !! ), prototype( start=integer(), width=integer(), NAMES=NULL ) ) ### A NormalIRanges object is an IRanges object where the ranges are: ### (a) not empty (i.e. they have a non-null width); ### (b) not overlapping; ### (c) ordered from left to right; ### (d) not even adjacent (i.e. there must be a non empty gap between 2 ### consecutive ranges). ### If 'x' is an IRanges object of length >= 2, then 'x' is normal iff: ### start(x)[i] <= end(x)[i] < start(x)[i+1] <= end(x)[i+1] ### for every 1 <= i < length(x). ### If length(x) == 1, then 'x' is normal iff width(x)[1] >= 1. ### If length(x) == 0, then 'x' is normal. setClass("NormalIRanges", contains="IRanges") ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("start", "IRanges", function(x, ...) x@start) setMethod("width", "IRanges", function(x) x@width) setMethod("names", "IRanges", function(x) x@NAMES) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Efficient "isNormal" method for IRanges objects. setMethod("isNormal", "IRanges", function(x) .Call2("IRanges_isNormal", x, PACKAGE="IRanges") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "isEmpty" default method for Ranges objects would work just fine on a ### NormalIRanges object but we can take advantage of the normality to make ### it slightly more efficient. ### setMethod("isEmpty", "NormalIRanges", function(x) length(x) == 0L) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "max" and "min" methods. ### ### Note: defined for NormalIRanges objects only. ### For an ordinary IRanges object 'x', it's not clear what the semantic ### should be. In particular, should empty ranges be ignored or not? If not ### then we could end up with 'min(x)' > 'max(x)' (e.g. when 'x' is made of 1 ### empty range) which is not nice. Another (and more pragmatic) reason for ### not defining these methods for IRanges objects is that I don't need them ### at the moment. ### setMethod("max", "NormalIRanges", function(x, ..., na.rm) { if (isEmpty(x)) { warning("empty ", class(x), " object; returning -Inf") -Inf } else { end(x)[length(x)] } } ) setMethod("min", "NormalIRanges", function(x, ..., na.rm) { if (isEmpty(x)) { warning("empty ", class(x), " object; returning Inf") Inf } else { start(x)[1L] } } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### ### Both 'start(x)' and 'width(x)' must be unnamed integer vectors of equal ### length (eventually 0) with no NAs and such that 'all(width >= 0)' is TRUE. ### 'names(x)' must be NULL or an unnamed character vector of the same length ### as 'start(x)' (or 'width(x)'). ### ### Note that we use 'min(width(x)) < 0L' in .valid.IRanges.width() because ### the 'min(x) < val' test is generally faster and more memory efficent than ### the 'any(x < val)' test, especially when 'x' is a big vector (the speedup ### is around 10x or more when 'length(x)' is >= 100000). The 2 tests are ### equivalent when 'length(x)' != 0 and 'length(val)' == 1. ### ### IRanges objects .valid.IRanges.start <- function(x) { x_start <- start(x) if (!is.integer(x_start) || !is.null(names(x_start)) || anyMissing(x_start)) return("'start(x)' must be an unnamed integer vector with no NAs") if (length(x_start) != length(width(x))) return("'start(x)' and 'width(x)' must have the same length") NULL } .valid.IRanges.width <- function(x) { x_width <- width(x) if (!is.integer(x_width) || !is.null(names(x_width)) || anyMissing(x_width)) return("'width(x)' must be an unnamed integer vector with no NAs") if (length(start(x)) != length(x_width)) return("'start(x)' and 'width(x)' must have the same length") if (length(x_width) != 0L && min(x_width) < 0L) return("'widths(x)' cannot contain negative values") NULL } .valid.IRanges.end <- function(x) { ## Even if 'start(x)' and 'width(x)' are valid, 'end(x)' (which is ## obtained by doing 'start(x) + width(x) - 1L') could contain NAs ## in case of an integer overflow. x_end <- end(x) if (anyMissing(x_end)) return("'end(x)' cannot contain NAs") NULL } .valid.IRanges <- function(x) { c(.valid.IRanges.start(x), .valid.IRanges.width(x), .valid.IRanges.end(x)) } setValidity2("IRanges", .valid.IRanges) ### NormalIRanges objects .valid.NormalIRanges <- function(x) { if (!isNormal(x)) return("object is not normal") NULL } setValidity2("NormalIRanges", .valid.NormalIRanges) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ### Any Ranges object can be turned into an IRanges instance. setAs("Ranges", "IRanges", function(from) new2("IRanges", start=start(from), width=width(from), NAMES=names(from), check=FALSE) ) ### Helper function (not exported) used by the "coerce" methods defined in ### IRanges-utils.R. Believe it or not but the implicit "coerce" methods do ### NOT check that they return a valid object! newNormalIRangesFromIRanges <- function(x, check=TRUE) { if (!is(x, "IRanges")) stop("'x' must be an IRanges object") if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") ## Check only what needs to be checked. if (check) stopIfProblems(.valid.NormalIRanges(x)) ## Make a "hard copy" of the slots. No need to check anything! new2("NormalIRanges", start=x@start, width=x@width, NAMES=x@NAMES, check=FALSE) } ### The returned IRanges instance is guaranteed to be normal. setAs("logical", "IRanges", function(from) as(as(from, "NormalIRanges"), "IRanges") ) setAs("logical", "NormalIRanges", function(from) .Call2("NormalIRanges_from_logical", from, PACKAGE="IRanges") ) ### coersion from integer setAs("integer", "IRanges", function(from) .Call2("IRanges_from_integer", from, PACKAGE="IRanges") ) setAs("integer", "NormalIRanges", function(from) newNormalIRangesFromIRanges(as(from, "IRanges")) ) setAs("numeric", "IRanges", function(from) as(as.integer(from), "IRanges")) setAs("numeric", "NormalIRanges", function(from) newNormalIRangesFromIRanges(as(as.integer(from), "IRanges"))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Low-level (i.e. non-exported and unsafe) replacement functions for ### IRanges objects. ### ### The choice was made to implement a "resizing" semantic: ### (1) changing the start preserves the end (so it changes the width) ### (2) changing the end preserves the start (so it changes the width) ### (3) changing the width preserves the start (so it changes the end) ### ### IMPORTANT: They do NOT check their arguments ('x' and 'value'). In ### particular they do not check that 'value' is of the expected type (integer ### for "unsafe.start<-", "unsafe.width<-", "unsafe.end<-", and character for ### "unsafe.names<-"). Also they don't check that the resulting IRanges object ### is valid! ### ### 'value' is recycled. `unsafe.start<-` <- function(x, value) { old_start <- start(x) ## Use 'x@start[]' instead of just 'x@start' so the right value is recycled x@start[] <- numeric2integer(value) x@width <- width(x) - start(x) + old_start x } ### 'value' is recycled. `unsafe.end<-` <- function(x, value) { ## Use 'x@width[]' instead of just 'x@width' so the right value is recycled x@width[] <- width(x) + numeric2integer(value) - end(x) x } ### 'value' is recycled. `unsafe.width<-` <- function(x, value) { ## Use 'x@width[]' instead of just 'x@width' so the right value is recycled x@width[] <- numeric2integer(value) x } ### 'value' is NOT recycled so we stay close to what the standard R "names<-" ### methods generally do `unsafe.names<-` <- function(x, value) { if (is.null(value)) x@NAMES <- NULL else { if (length(value) > length(x)) stop("too many names") if (length(value) < length(x)) value <- c(value, rep.int(NA, length(x) - length(value))) x@NAMES <- value } x } unsafe.update <- function(object, ...) { valid_argnames <- c("start", "end", "width", "names") args <- extraArgsAsList(valid_argnames, ...) argnames <- names(args) sew <- c("start", "end", "width") narg_in_sew <- sum(sew %in% argnames) if (narg_in_sew == 3L) stop("at most 2 out of the ", paste("'", sew, "'", sep="", collapse=", "), " arguments can be supplied") do_atomic_update <- narg_in_sew == 2L && (is.null(names(object)) || ("names" %in% argnames)) if (do_atomic_update) { if ("end" %in% argnames) { if ("width" %in% argnames) { width <- args$width start <- args$end - width + 1L } else { start <- args$start width <- args$end - start + 1L } } else { start <- args$start width <- args$width } object@start <- numeric2integer(start) object@width <- numeric2integer(width) object@NAMES <- args$names return(object) } if ("start" %in% argnames) unsafe.start(object) <- args$start if ("end" %in% argnames) unsafe.end(object) <- args$end if ("width" %in% argnames) unsafe.width(object) <- args$width if ("names" %in% argnames) unsafe.names(object) <- args$names object } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Exported (and safe) replacement methods. ### ### See the unsafe replacement functions for IRanges objects above for the ### "sliding rules". ### ### Note that we don't call validObject(x) after 'x' has been modified because ### we don't need to revalidate the entire object: validating the bits that ### have been touched is enough (and faster). However, because of this, when ### defining a new class that contains the IRanges class, if objects of ### the new class must satisfy additional constraints, then some of the ### replacement methods below need to be overridden for this new class. ### setReplaceMethod("start", "IRanges", function(x, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") unsafe.start(x) <- value if (check) validObject(x) x } ) setReplaceMethod("width", "IRanges", function(x, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") unsafe.width(x) <- value if (check) validObject(x) x } ) setReplaceMethod("end", "IRanges", function(x, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") unsafe.end(x) <- value if (check) validObject(x) x } ) setReplaceMethod("names", "IRanges", function(x, value) { if (!is.null(value)) value <- as.character(value) unsafe.names(x) <- value x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "update" method. ### ### This is a convenience method for combining multiple modifications in one ### single call. ### ### It must verify 2 important properties: ### (1) update(x) must be identical to x (doesn't touch x at all) ### (2) update(x, start=start(x), width=width(x), names=names(x)) ### must be identical to x too (but this time it updates x with its own ### content) ### ### FIXME: need some way of specifying the extent of validity ### checking, like giving the class up to which the object is ### assumed valid. setMethod("update", "IRanges", function(object, ..., check = TRUE) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") object <- unsafe.update(object, ...) if (check) validObject(object) object } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("extractROWS", "IRanges", function(x, i) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) if (is(x, "NormalIRanges") && ((is.integer(i) && isNotStrictlySorted(i)) || (is(i, "Ranges") && !isNormal(i)))) stop("subscript cannot contain duplicates and must preserve the ", "order of elements when subsetting a ", class(x), " object") ans_start <- extractROWS(start(x), i) ans_width <- extractROWS(width(x), i) ans_names <- extractROWS(names(x), i) ans_mcols <- extractROWS(mcols(x), i) initialize(x, start=ans_start, width=ans_width, NAMES=ans_names, elementMetadata=ans_mcols) } ) setMethod("replaceROWS", "IRanges", function(x, i, value) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) ans_start <- replaceROWS(start(x), i, start(value)) ans_width <- replaceROWS(width(x), i, width(value)) ans <- initialize(x, start=ans_start, width=ans_width) if (is(x, "NormalIRanges")) validObject(ans) ans } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining. ### ### The "c" method for IRanges objects is implemented to behave like an ### endomorphism i.e. to return an object of the same class as 'x'. In ### particular 'c(x)' now returns 'x' and not 'as(x, "IRanges")'. ### It's easy to implement specific "c" methods for IRanges subclasses. ### Typically they just need to do something like: ### ### old_val <- disableValidity() ### on.exit(disableValidity(old_val)) ### disableValidity(TRUE) ### ans <- callNextMethod(x, ..., recursive=FALSE) ### ... ### ### and to take care of the additional slots (aka the subclass-specific ### slots). If there aren't any additional slots (e.g. NormalIRanges), or ### if the additional slots don't need to be modified (e.g. the "subject" ### slot of the Views subclass), then no need to implement a specific method ### at all. ### ### In the case of NormalIRanges objects, 'c(x1, x2)' will fail if the result ### is not normal, but 'c(as(x1, "IRanges"), x2)' or 'c(IRanges(), x1, x2)' ### would work. Note that, in general, 'c(IRanges(), x)' is not the same as ### 'c(x, IRanges())' (the former is equivalent to 'as(x, IRanges)' and the ### latter to 'c(x)' or 'x'). ### Also note that the user needs to be carefull when passing named arguments ### to c() (there is no good reason to do this in the first place) because of ### the following pitfalls: ### (1) If all the arguments are named (e.g. 'c(a=x1, b=x2)') then the first ### argument must be an IRanges *instance* otherwise dispatch will fail. ### It's not clear why dispatch works when 'x1' is an IRanges instance ### because, in that case, formal argument 'x' is missing. It's even ### less clear why it fails when 'x1' is an IRanges object without being ### an IRanges instance. For example: ### x1 <- IRanges(1, 11) ### x2 <- IRanges(22, 33) ### ## works as expected: ### c(a=x1, b=x2) ### ## works as expected: ### c(a=x1, asNormalIRanges(x2)) ### ## dispatch fails (the default "c" method is selected) ### c(a=asNormalIRanges(x1), b=x2)) ### (2) When named and unnamed arguments are mixed and no named argument has ### name 'x' (e.g. 'c(a=x1, x2)'), then, following the standard rules of ### argument matching in R, one would expect that the first unnamed ### argument will match formal argument 'x'. This is more or less what ### happens: ### > c(a=x1, x2) ### IRanges object: ### start end width ### [1] 2 22 21 ### [2] 1 11 11 ### but there are some surprises: ### > c(a=x1, TRUE) ### Error in c(a = x1, TRUE) : ### all arguments in '...' must be logical objects (or NULLs) ### > c(a=asNormalIRanges(x1), TRUE) ### $a ### NormalIRanges object: ### start end width ### [1] 1 11 11 ### ### [[2]] ### [1] TRUE ### setMethod("c", "IRanges", function(x, ..., ignore.mcols=FALSE, recursive=FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for IRanges objects ", "does not support the 'recursive' argument") if (!isTRUEorFALSE(ignore.mcols)) stop("'ignore.mcols' must be TRUE or FALSE") if (missing(x)) { args <- unname(list(...)) x <- args[[1L]] } else { args <- unname(list(x, ...)) } if (length(args) == 1L) return(x) arg_is_null <- sapply(args, is.null) if (any(arg_is_null)) args[arg_is_null] <- NULL # remove NULL elements by setting them to NULL! if (!all(sapply(args, is, class(x)))) stop("all arguments in '...' must be ", class(x), " objects (or NULLs)") new_start <- unlist(lapply(args, start), use.names=FALSE) new_width <- unlist(lapply(args, width), use.names=FALSE) names_list <- lapply(args, names) arg_has_no_names <- sapply(names_list, is.null) if (all(arg_has_no_names)) { new_names <- NULL } else { names_list[arg_has_no_names] <- lapply(args[arg_has_no_names], function(arg) character(length(arg))) new_names <- unlist(names_list, use.names=FALSE) } ans <- update(x, start=new_start, width=new_width, names=new_names, check=FALSE) if (ignore.mcols) { mcols(ans) <- NULL } else { mcols(ans) <- do.call(rbind.mcols, args) } validObject(ans) ans } ) IRanges/R/IRanges-constructor.R0000644000126300012640000001541612227064470017737 0ustar00biocbuildphs_compbio### ========================================================================= ### The IRanges constructor ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The SEW0 interface: start=NULL/end=NULL/width=NULL ### .normargSEW0 <- function(x, argname) { if (is.null(x)) return(integer()) if (!is.numeric(x) && !(is.atomic(x) && all(is.na(x)))) stop("'", argname, "' must be a numeric vector (or NULL)") if (!is.integer(x)) x <- as.integer(x) x } ### Some of the functions that support the SEW0 interface: IRanges(), Views(), ### etc... solveUserSEW0 <- function(start=NULL, end=NULL, width=NULL) { start <- .normargSEW0(start, "start") end <- .normargSEW0(end, "end") width <- .normargSEW0(width, "width") L1 <- length(start) L2 <- length(end) L3 <- length(width) L123 <- c(L1, L2, L3) max123 <- max(L123) ## We want IRanges(start=integer(0), width=5) and ## IRanges(end=integer(0), width=5) to work and return an empty IRanges ## object. if (max123 == 0L || L1 == 0L && L2 == 0L && L3 == 1L) return(new("IRanges")) ## Recycle start/end/width. if (L1 < max123) { if (L1 == 0L) start <- rep.int(NA_integer_, max123) else start <- recycleVector(start, max123) } if (L2 < max123) { if (L2 == 0L) end <- rep.int(NA_integer_, max123) else end <- recycleVector(end, max123) } if (L3 < max123) { if (L3 == 0L) width <- rep.int(NA_integer_, max123) else width <- recycleVector(width, max123) } .Call2("solve_user_SEW0", start, end, width, PACKAGE="IRanges") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The safe and user-friendly "IRanges" constructor. ### IRanges <- function(start=NULL, end=NULL, width=NULL, names=NULL) { if (is(start, "Ranges")) { if (!is.null(end) || !is.null(width)) stop("'end' and 'width' must be NULLs ", "when 'start' is a Ranges object") ans <- new2("IRanges", start=start(start), width=width(start), NAMES=names, check=FALSE) return(ans) } if ((is.logical(start) && !all(is.na(start))) || is(start, "Rle")) { if (is(start, "Rle") && !is.logical(runValue(start))) stop("'start' is an Rle, but not a logical Rle object") if (!is.null(end) || !is.null(width)) stop("'end' and 'width' must be NULLs when 'start' is a logical ", "vector or logical Rle") ## The returned IRanges instance is guaranteed to be normal. ans <- as(start, "IRanges") names(ans) <- names return(ans) } ans <- solveUserSEW0(start=start, end=end, width=width) names(ans) <- names return(ans) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The SEW interface: start=NA/end=NA/width=NA ### ### Some of the functions that support the SEW interface: narrow(), ### XVector::subseq(), XVector::xvcopy(), Biostrings::BStringSet() (and ### family), BSgenome::getSeq(), etc... ### .normargSEW <- function(x, argname) { if (!isNumericOrNAs(x)) stop("'", argname, "' must be a vector of integers") if (!is.integer(x)) x <- as.integer(x) x } ### Use of 'rep.refwidths=TRUE' is supported only when 'refwidths' is of ### length 1. ### If 'rep.refwidths=FALSE' (the default) then 'start', 'end' and 'width' ### are recycled to 'length(refwidths)' (it's an error if one of them is ### longer than 'refwidths'). Otherwise, 'refwidths' is replicated L times ### where L is the length of the longest of 'start', 'end' and 'width'. ### The returned value is an IRanges object of the same length as 'refwidths' ### (after replication if 'rep.refwidths=TRUE'). solveUserSEW <- function(refwidths, start=NA, end=NA, width=NA, rep.refwidths=FALSE, translate.negative.coord=TRUE, allow.nonnarrowing=FALSE) { if (!is.numeric(refwidths)) stop("'refwidths' must be a vector of integers") if (!is.integer(refwidths)) refwidths <- as.integer(refwidths) start <- .normargSEW(start, "start") end <- .normargSEW(end, "end") width <- .normargSEW(width, "width") ## From here, 'refwidths', 'start', 'end' and 'width' are guaranteed to be ## integer vectors. NAs in 'start', 'end' and 'width' are OK but not in ## 'refwidths' so this should be checked at the C level. if (!isTRUEorFALSE(rep.refwidths)) stop("'rep.refwidths' must be TRUE or FALSE") if (!isTRUEorFALSE(translate.negative.coord)) stop("'translate.negative.coord' must be TRUE or FALSE") if (!isTRUEorFALSE(allow.nonnarrowing)) stop("'allow.nonnarrowing' must be TRUE or FALSE") Lsew <- c(length(start), length(end), length(width)) maxLsew <- max(Lsew) minLsew <- min(Lsew) if (minLsew == 0L && maxLsew > 1L) stop("'start', 'end' and 'width' cannot mix zero-length ", "and longer-than-one vectors") ## Check 'start', 'end', and 'width' *without* recycling them. Recycling ## is done at the C level. if (rep.refwidths) { if (length(refwidths) != 1L) stop("'rep.refwidths=TRUE' can be used only when 'refwidths' ", "is of length 1") ## 'ans_len' is the length of the longest of 'start', 'end' ## and 'width'. if (minLsew == 0L) { ans_len <- 0L } else { ans_len <- maxLsew } refwidths <- rep.int(refwidths, ans_len) } else { ans_len <- length(refwidths) if (ans_len == 0L) { if (maxLsew > 1L) stop("'start', 'end' or 'width' is longer than 'refwidths'") } else { if (minLsew == 0L) stop("cannot recycle empty 'start', 'end' or 'width'") if (maxLsew > ans_len) stop("'start', 'end' or 'width' is longer than 'refwidths'") } } .Call2("solve_user_SEW", refwidths, start, end, width, translate.negative.coord, allow.nonnarrowing, PACKAGE="IRanges") } ### Returns an IRanges instance of length 1. Not exported. solveUserSEWForSingleSeq <- function(x_length, start=NA, end=NA, width=NA) { solved_SEW <- try(solveUserSEW(x_length, start=start, end=end, width=width), silent = TRUE) if (is(solved_SEW, "try-error")) stop("Invalid sequence coordinates.\n", " Please make sure the supplied 'start', 'end' and 'width' arguments\n", " are defining a region that is within the limits of the sequence.") solved_SEW } IRanges/R/IRanges-utils.R0000644000126300012640000001041712227064470016506 0ustar00biocbuildphs_compbio### ========================================================================= ### Utility functions for creating or modifying IRanges objects ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "successiveIRanges" function. ### ### Note that the returned IRanges object is guaranteed to be normal in the ### following cases: ### (a) when length(width) == 0 ### (b) when length(width) == 1 and width > 0 ### (c) when length(width) >= 2 and all(width > 0) and all(gapwidth > 0) ### However, the function doesn't try to turn the result into a NormalIRanges ### object. ### successiveIRanges <- function(width, gapwidth=0, from=1) { if (!is.numeric(width)) stop("'width' must be an integer vector") if (length(width) == 0L) return(IRanges()) if (!is.integer(width)) width <- as.integer(width) # this drops the names else if (!is.null(names(width))) names(width) <- NULL # unname() used to be broken on 0-length vectors if (anyMissingOrOutside(width, 0L)) stop("'width' cannot contain NAs or negative values") if (!is.numeric(gapwidth)) stop("'gapwidth' must be an integer vector") if (!is.integer(gapwidth)) gapwidth <- as.integer(gapwidth) if (anyMissing(gapwidth)) stop("'gapwidth' cannot contain NAs") if (length(gapwidth) != length(width) - 1L) { if (length(gapwidth) != 1L) stop("'gapwidth' must a single integer or an integer vector ", "with one less element than the 'width' vector") gapwidth <- rep.int(gapwidth, length(width) - 1L) } if (!isSingleNumber(from)) stop("'from' must be a single integer") if (!is.integer(from)) from <- as.integer(from) ans_start <- cumsum(width[-length(width)] + gapwidth) ans_start <- from + c(0L, ans_start) ## 'ans_start' could contain NAs in case of an integer overflow in ## cumsum(), hence the use of 'check=TRUE' here: new2("IRanges", start=ans_start, width=width, check=TRUE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "breakInChunks" function. ### breakInChunks <- function(totalsize, chunksize) { if (!isSingleNumber(totalsize)) stop("'totalsize' must be a single integer") if (!is.integer(totalsize)) totalsize <- as.integer(totalsize) if (totalsize < 0L) stop("'totalsize' must be a non-negative integer") if (!isSingleNumber(chunksize)) stop("'chunksize' must be a single integer") if (!is.integer(chunksize)) chunksize <- as.integer(chunksize) if (chunksize <= 0L) stop("'chunksize' must be a positive integer") quot <- totalsize %/% chunksize ans_width <- rep.int(chunksize, quot) rem <- totalsize %% chunksize if (rem > 0L) ans_width <- c(ans_width, rem) PartitioningByWidth(ans_width) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "centeredIRanges" function. ### centeredIRanges <- function(center, flank) { if (!is.numeric(center)) stop("'center' must be a numeric vector") if (!is.numeric(flank)) stop("'flank' must be a numeric vector") IRanges(start=center-flank, end=center+flank) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "whichAsIRanges" function. ### ### Note that unlike the standard which() function, whichAsIRanges() drops ### the names of 'x'. ### whichAsIRanges <- function(x) { if (!is.logical(x)) stop("'x' must be a logical vector") as(x, "NormalIRanges") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercing an IRanges object to a NormalIRanges object. ### asNormalIRanges <- function(x, force=TRUE) { if (!is(x, "Ranges")) stop("'x' must be an Ranges object") else if (!is(x, "IRanges")) x <- as(x, "IRanges") if (!isTRUEorFALSE(force)) stop("'force' must be TRUE or FALSE") if (force) x <- reduce(x, drop.empty.ranges=TRUE) newNormalIRangesFromIRanges(x, check=!force) } .asNormalIRanges <- function(from) asNormalIRanges(from, force=TRUE) setAs("IRanges", "NormalIRanges", .asNormalIRanges) IRanges/R/IntervalForest-class.R0000644000126300012640000001116212227064470020070 0ustar00biocbuildphs_compbio### ========================================================================= ### IntervalForest objects ### ------------------------------------------------------------------------- setClass("IntervalForest", representation(ptr="externalptr", mode="character", partitioning="PartitioningByEnd"), contains = c("RangesList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity ### .valid.IntervalForest.partitioning <- function(x) { dataLength <- .IntervalForestCall(x,"nobj") if (nobj(x@partitioning) != dataLength) "improper partitioning" else NULL } .valid.IntervalForest.mode <- function(x) { if (x@mode != "integer") return("mode is not 'integer'") NULL } .valid.IntervalForest <- function(x) { c(.valid.IntervalForest.partitioning(x), .valid.IntervalForest.mode(x)) } setValidity2("IntervalForest", .valid.IntervalForest) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor ### IntervalForest <- function(x) { if (!is(x, "IRangesList")) { stop("'x' must be an 'IRangesList' object") } if (elementType(x) != "IRanges") { stop("'elementType(x)' must be of class 'IRanges'") } as(x, "IntervalForest") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### setAs("IntervalForest", "CompressedIRangesList", function(from) { new2("CompressedIRangesList", unlistData=.IntervalForestCall(from, "asIRanges"), partitioning=from@partitioning, elementType="IRanges", check=FALSE) }) setAs("IntervalForest", "IRanges", function(from) .IntervalForestCall(from, "asIRanges")) setAs("CompressedIRangesList", "IntervalForest", function(from) { validObject(from) npartitions <- length(from@partitioning) partitionLengths <- elementLengths(from) ptr <- .Call2("IntegerIntervalForest_new", from@unlistData, partitionLengths, npartitions, PACKAGE="IRanges") new2("IntervalForest", ptr = ptr, mode="integer", partitioning=from@partitioning, check=FALSE) }) setAs("RangesList", "IntervalForest", function(from) as(as(from, "CompressedIRangesList"), "IntervalForest")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessors ### setMethod("start", "IntervalForest", function(x) new2("CompressedIntegerList", unlistData = .IntervalForestCall(x, "start"), partitioning = x@partitioning, check=FALSE)) setMethod("end", "IntervalForest", function(x) new2("CompressedIntegerList", unlistData = .IntervalForestCall(x, "end"), partitioning = x@partitioning, check=FALSE)) setMethod("width", "IntervalForest", function(x) new2("CompressedIntegerList", unlistData = .IntervalForestCall(x, "end") - .IntervalForestCall(x, "start") + 1L, partitioning = x@partitioning, check=FALSE)) setMethod("elementLengths", "IntervalForest", function(x) { ans <- elementLengths(x@partitioning) names(ans) <- names(x) ans } ) setMethod("length", "IntervalForest", function(x) length(x@partitioning)) setMethod("names", "IntervalForest", function(x) names(x@partitioning)) ### - - - - ### Subsetting ### setMethod("[", "IntervalForest", function(x, i, j, ..., drop=TRUE) { if (!missing(j) || length(list(...)) > 0L) stop("invalid subsetting") rl <- split(callGeneric(as(x, "IRanges"), i = i, ...), callGeneric(space(x), i = i, ...)) as(rl, "IntervalForest") } ) ### - - - - ### show ### - - - - setMethod("show", "IntervalForest", function(object) { newobj <- as(object, "CompressedIRangesList") cat("IntervalForest of length ", length(newobj), "\n", sep="") showRangesList(newobj, with.header=FALSE) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Low-level utilities ### .IntervalForestCall <- function(object, fun, ...) { # validObject(object) fun <- paste("IntervalForest", fun, sep = "_") if (object@mode == "integer") { fun <- paste("Integer", fun, sep = "") .Call2(fun, object@ptr, ..., PACKAGE="IRanges") } else stop("unknown interval forest mode: ", object@mode) } ## not for exporting, just a debugging utility IntervalForestDump <- function(object) { cat("IntervalForest, levels: ", levels(object), "\n") .IntervalForestCall(object, "dump") } IRanges/R/IntervalTree-class.R0000644000126300012640000000362512227064470017532 0ustar00biocbuildphs_compbio### ========================================================================= ### IntervalTree objects ### ------------------------------------------------------------------------- setClass("IntervalTree", representation(ptr = "externalptr", mode = "character"), contains = "Ranges") ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessors ### setMethod("length", "IntervalTree", function(x) IntervalTreeCall(x, "length")) setMethod("start", "IntervalTree", function(x) IntervalTreeCall(x, "start")) setMethod("end", "IntervalTree", function(x) IntervalTreeCall(x, "end")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor ### IntervalTree <- function(ranges) { as(ranges, "IntervalTree") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### setAs("IntervalTree", "IRanges", function(from) { IntervalTreeCall(from, "asIRanges") }) setAs("IRanges", "IntervalTree", function(from) { validObject(from) ptr <- .Call2("IntegerIntervalTree_new", from, PACKAGE="IRanges") new2("IntervalTree", ptr = ptr, mode = "integer", check=FALSE) }) setAs("Ranges", "IntervalTree", function(from) { as(as(from, "IRanges"), "IntervalTree") }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Low-level utilities ### IntervalTreeCall <- function(object, fun, ...) { #validObject(object) # causes an infinite recursion, because calls # .valid.Vector.length(), which calls length(), # which calls IntervalTreeCall(), which calls # validObject(), etc... fun <- paste("IntervalTree", fun, sep = "_") if (object@mode == "integer") { fun <- paste("Integer", fun, sep = "") .Call2(fun, object@ptr, ..., PACKAGE="IRanges") } else stop("unknown interval tree mode: ", object@mode) } IRanges/R/IntervalTree-utils.R0000644000126300012640000000536012227064470017563 0ustar00biocbuildphs_compbio### ========================================================================= ### IntervalTree utilities ### ------------------------------------------------------------------------- ## internal generic setGeneric("processSelfMatching", # not exported function(x, select = c("all", "first", "last", "arbitrary"), ignoreSelf = FALSE, ignoreRedundant = FALSE) standardGeneric("processSelfMatching")) setMethod("processSelfMatching", "Hits", function(x, select = c("all", "first", "last", "arbitrary"), ignoreSelf = FALSE, ignoreRedundant = FALSE) { mat <- as.matrix(x) if (ignoreSelf) mat <- mat[mat[,1L] != mat[,2L],,drop=FALSE] if (ignoreRedundant) { norm_mat <- cbind(pmin.int(mat[,1L], mat[,2L]), pmax.int(mat[,1L], mat[,2L])) mat <- mat[!duplicated(norm_mat),,drop=FALSE] } if (select != "all") { # relies on 'mat' sorted by subject if (select == "last") mat <- mat[seq(nrow(mat), 1),,drop=FALSE] .hitsMatrixToVector(mat, queryLength(x)) } else { ## unname() required because in case 'm' has only 1 row ## 'm[ , 1L]' and 'm[ , 2L]' will return a named atomic vector x@queryHits <- unname(mat[ , 1L]) x@subjectHits <- unname(mat[ , 2L]) x } }) setMethod("processSelfMatching", "HitsList", function(x, select = c("all", "first", "last", "arbitrary"), ignoreSelf = FALSE, ignoreRedundant = FALSE) { select <- match.arg(select) ans <- lapply(x, processSelfMatching, select, ignoreSelf, ignoreRedundant) if (select != "all") IntegerList(ans) else newList("HitsList", ans, subjectOffsets = x@subjectOffsets) }) setMethod("processSelfMatching", "CompressedHitsList", function(x, select = c("all", "first", "last", "arbitrary"), ignoreSelf = FALSE, ignoreRedundant = FALSE) { select <- match.arg(select) ans <- processSelfMatching(x@unlistData, select = select, ignoreSelf = ignoreSelf, ignoreRedundant = ignoreRedundant) if (select != "all") new2("CompressedIntegerList", unlistData=ans, partitioning=x@partitioning) else new2("CompressedHitsList", unlistData=ans, partitioning=x@partitioning) }) ## not for exporting, just a debugging utility IntervalTreeDump <- function(object) { IntervalTreeCall(object, "dump") } IRanges/R/List-class.R0000644000126300012640000006005612227064470016042 0ustar00biocbuildphs_compbio### ========================================================================= ### List objects ### ------------------------------------------------------------------------- ### ### List objects are Vector objects with "[[", "elementType" and ### "elementLengths" methods. ### setClass("List", contains="Vector", representation( "VIRTUAL", elementType="character" ), prototype(elementType="ANY") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setGeneric("elementType", function(x, ...) standardGeneric("elementType")) setMethod("elementType", "List", function(x) x@elementType) setMethod("elementType", "vector", function(x) mode(x)) setGeneric("elementLengths", function(x) standardGeneric("elementLengths")) setMethod("elementLengths", "ANY", function(x) { x <- as.list(x) ans <- try(.Call2("sapply_NROW", x, PACKAGE="IRanges"), silent=TRUE) if (!inherits(ans, "try-error")) { names(ans) <- names(x) return(ans) } ## From here, 'length(x)' is guaranteed to be != 0 return(sapply(x, NROW)) } ) setMethod("elementLengths", "List", function(x) { y <- as.list(x) if (length(y) == 0L) { ans <- integer(0) ## We must return a named integer(0) if 'x' is named names(ans) <- names(x) return(ans) } if (length(dim(y[[1L]])) < 2L) return(elementLengths(y)) return(sapply(y, NROW)) } ) setGeneric("isEmpty", function(x) standardGeneric("isEmpty")) setMethod("isEmpty", "ANY", function(x) { if (is.atomic(x)) return(length(x) == 0L) if (!is.list(x) && !is(x, "List")) stop("isEmpty() is not defined for objects of class ", class(x)) ## Recursive definition if (length(x) == 0) return(logical(0)) sapply(x, function(xx) all(isEmpty(xx))) }) ### A List object is considered empty iff all its elements are empty. setMethod("isEmpty", "List", function(x) all(elementLengths(x) == 0L)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructors. ### compress_listData <- function(x) { if (length(x) > 0L) { if (length(dim(x[[1L]])) < 2L) { x <- do.call(c, unname(x)) } else { x <- do.call(rbind, unname(x)) } } else { x <- vector() } x } reconcileMetadatacols <- function(x) { x_mcols <- mcols(x) if (is(x_mcols, "DataFrame") && nrow(x_mcols) == 0L && ncol(x_mcols) == 0L) { x_mcols <- new("DataFrame", nrows=length(x)) mcols(x) <- x_mcols } x } ### NOT exported. ### Value for elementMetadata slot can be passed either with ### newList(..., elementMetadata=somestuff) ### or with ### newList(..., mcols=somestuff) ### The latter is the new recommended form. newList <- function(Class, listData, ..., mcols) { if (!extends(Class, "SimpleList") && !extends(Class, "CompressedList")) stop("class ", Class, " must extend SimpleList or CompressedList") if (!is.list(listData)) stop("'listData' must be a list object") if (is.array(listData)) { # drop any unwanted dimensions tmp_names <- names(listData) dim(listData) <- NULL # clears the names names(listData) <- tmp_names } class(listData) <- "list" ans_elementType <- elementType(new(Class)) if (!all(sapply(listData, function(x) extends(class(x), ans_elementType)))) stop("all elements in 'listData' must be ", ans_elementType, " objects") if (extends(Class, "SimpleList")) { if (missing(mcols)) return(new2(Class, listData=listData, ..., check=FALSE)) return(new2(Class, listData=listData, ..., elementMetadata=mcols, check=FALSE)) } ans_partitioning <- PartitioningByEnd(listData) if (length(listData) == 0L) { if (missing(mcols)) return(new2(Class, partitioning=ans_partitioning, ..., check=FALSE)) return(new2(Class, partitioning=ans_partitioning, ..., elementMetadata=mcols, check=FALSE)) } ans_unlistData <- compress_listData(listData) if (missing(mcols)) { ans <- new2(Class, unlistData=ans_unlistData, partitioning=ans_partitioning, ..., check=FALSE) } else { ans <- new2(Class, unlistData=ans_unlistData, partitioning=ans_partitioning, ..., elementMetadata=mcols, check=FALSE) } reconcileMetadatacols(ans) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### setMethod("show", "List", function(object) { lo <- length(object) cat(classNameForDisplay(object), " of length ", lo, "\n", sep = "") if (!is.null(names(object))) cat(BiocGenerics:::labeledLine("names", names(object))) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### List-like API: Element extraction. ### setMethod("$", "List", function(x, name) x[[name, exact=FALSE]]) ### Assumes 'i' to be either a LogicalList or a logical-RleList of the same ### length as 'x'. Truncate or recycle each list element of 'i' to the length ### of the corresponding element in 'x'. .normalizeLogicalListSubscript <- function(i, x) { x_eltlens <- unname(elementLengths(x)) i_eltlens <- unname(elementLengths(i)) idx <- which(x_eltlens != i_eltlens) ## FIXME: This is rough and doesn't follow exactly the truncate-or-recycle ## semantic of normalizeSingleBracketSubscript() on a logical vector or ## logical Rle. for (k in idx) i[[k]] <- rep(i[[k]], length.out=x_eltlens[k]) return(i) } ### Subset a List object by a list-like subscript. subsetListByList <- function(x, i) { x_class <- class(x) li <- length(i) if (is.null(names(i))) { lx <- length(x) if (li > lx) stop("list-like subscript is longer than ", "list-like object to subset") if (li < lx) x <- x[seq_len(li)] } else { if (is.null(names(x))) stop("cannot subscript an unnamed list-like object ", "by a named list-like object") if (!identical(names(i), names(x))) { j <- match(names(i), names(x)) if (anyMissing(j)) stop("list-like subscript has names not in ", "list-like object to subset") x <- x[j] } } ## From here, 'x' and 'i' are guaranteed to have the same length. if (li == 0L) return(x) if (!is(x, "SimpleList")) { if (!is(i, "List")) i <- as(i, "List") ## List element pseudo-type: same as "elementType" except for RleList ## objects. if (is(i, "RleList")) leptype <- elementType(runValue(i)) else leptype <- elementType(i) x_names <- names(x) if (extends(leptype, "logical")) { unlisted_x <- unlist(x, use.names=FALSE) i <- .normalizeLogicalListSubscript(i, x) unlisted_i <- unlist(i, use.names=FALSE) unlisted_ans <- extractROWS(unlisted_x, unlisted_i) group <- rep.int(seq_along(x), elementLengths(x)) group <- extractROWS(group, unlisted_i) ans_skeleton <- PartitioningByEnd(group, NG=length(x), names=x_names) ans <- as(relist(unlisted_ans, ans_skeleton), x_class) metadata(ans) <- metadata(x) return(ans) } if (extends(leptype, "numeric")) { unlisted_x <- unlist(x, use.names=FALSE) offsets <- c(0L, end(PartitioningByEnd(x))[-length(x)]) i <- i + offsets unlisted_i <- unlist(i, use.names=FALSE) unlisted_ans <- extractROWS(unlisted_x, unlisted_i) ans_breakpoints <- cumsum(unname(elementLengths(i))) ans_skeleton <- PartitioningByEnd(ans_breakpoints, names=x_names) ans <- as(relist(unlisted_ans, ans_skeleton), x_class) metadata(ans) <- metadata(x) return(ans) } if (extends(leptype, "Ranges")) { unlisted_x <- unlist(x, use.names=FALSE) offsets <- c(0L, end(PartitioningByEnd(x))[-length(x)]) unlisted_i <- unlist(i, use.names=FALSE) unlisted_i <- shift(unlisted_i, shift=rep.int(offsets, elementLengths(i))) unlisted_ans <- extractROWS(unlisted_x, unlisted_i) ans_breakpoints <- cumsum(unlist(sum(width(i)), use.names=FALSE)) ans_skeleton <- PartitioningByEnd(ans_breakpoints, names=x_names) ans <- as(relist(unlisted_ans, ans_skeleton), x_class) metadata(ans) <- metadata(x) return(ans) } } ## NOT efficient because it loops over the elements of 'x'. for (k in seq_len(li)) x[[k]] <- extractROWS(x[[k]], i[[k]]) return(x) } subsetListByList_replace <- function(x, i, value, byrow=FALSE) { lx <- length(x) li <- length(i) if (li == 0L) { ## Surprisingly, in that case, `[<-` on standard vectors does not ## even look at 'value'. So neither do we... return(x) } lv <- length(value) if (lv == 0L) stop("replacement has length zero") value <- normalizeSingleBracketReplacementValue(value, x) if (li != lv) { if (li %% lv != 0L) warning("number of values supplied is not a sub-multiple ", "of the number of values to be replaced") value <- rep(value, length.out = li) } if (is.null(names(i))) { if (li > lx) stop("list-like subscript is longer than ", "list-like object to subset") for (ii in seq_len(li)) { xx <- x[[ii]] if (byrow) xx[i[[ii]], ] <- value[[ii]] else xx[i[[ii]]] <- value[[ii]] x[[ii]] <- xx } return(x) } if (is.null(names(x))) stop("cannot subscript an unnamed list-like object ", "by a named list-like object") j <- match(names(i), names(x)) if (anyMissing(j)) stop("list-like subscript has names not in list-like object to subset") for (ii in seq_len(li)) { xx <- x[[j[ii]]] if (byrow) xx[i[[ii]], ] <- value[[ii]] else xx[i[[ii]]] <- value[[ii]] x[[j[ii]]] <- xx } return(x) } setMethod("[", "List", function(x, i, j, ..., drop=TRUE) { if (!missing(j) || length(list(...)) > 0L) stop("invalid subsetting") if (!missing(i) && (is.list(i) || (is(i, "List") && !is(i, "Ranges")))) return(subsetListByList(x, i)) callNextMethod(x, i) } ) setReplaceMethod("[", "List", function(x, i, j, ..., value) { if (!missing(j) || length(list(...)) > 0L) stop("invalid subsetting") if (!missing(i) && (is.list(i) || (is(i, "List") && !is(i, "Ranges")))) return(subsetListByList_replace(x, i, value)) callNextMethod(x, i, value=value) } ) setMethod("[[", "List", function(x, i, j, ...) { dotArgs <- list(...) if (length(dotArgs) > 0L) dotArgs <- dotArgs[names(dotArgs) != "exact"] if (!missing(j) || length(dotArgs) > 0L) stop("incorrect number of subscripts") ## '...' is either empty or contains only the 'exact' arg. getListElement(x, i, ...) } ) setReplaceMethod("[[", "List", function(x, i, j, ..., value) { if (!missing(j) || length(list(...)) > 0) stop("invalid replacement") origLen <- length(x) x <- setListElement(x, i, value) if (origLen < length(x)) x <- rbindRowOfNAsToMetadatacols(x) x }) setReplaceMethod("$", "List", function(x, name, value) { x[[name]] <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Looping methods. ### setMethod("lapply", "List", function(X, FUN, ...) { FUN <- match.fun(FUN) ii <- seq_len(length(X)) names(ii) <- names(X) lapply(ii, function(i) FUN(X[[i]], ...)) }) .sapplyDefault <- base::sapply environment(.sapplyDefault) <- topenv() setMethod("sapply", "List", .sapplyDefault) .mapply_List <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE) { seqs <- list(...) isListOrVector <- function(x) is.vector(x) | is(x, "List") if (any(!sapply(seqs, isListOrVector))) stop("all objects in ... should be a vector or 'List'") elens <- sapply(seqs, length) ## elementLengths uses NROW, inappropriate if (any(elens == 0L)) return(list()) N <- max(elens) if (any(N %% elens != 0L)) stop("all object lengths must be multiple of longest object length") recycleExtract <- function(x, i) x[[(i - 1L) %% length(x) + 1L]] FUNprime <- function(.__INDEX__, ...) { do.call(FUN, c(lapply(seqs, recycleExtract, .__INDEX__), ...)) } nms <- names(seqs[[1]]) if (is.null(nms) && is.character(seqs[[1]])) nms <- seqs[[1]] mapply(FUNprime, structure(seq_len(N), names = nms), MoreArgs = MoreArgs, SIMPLIFY = SIMPLIFY, USE.NAMES = USE.NAMES) } setMethod("mapply", "List", .mapply_List) setMethod("endoapply", "List", function(X, FUN, ...) { elementTypeX <- elementType(X) FUN <- match.fun(FUN) for (i in seq_len(length(X))) { elt <- FUN(X[[i]], ...) if (!extends(class(elt), elementTypeX)) stop("'FUN' must return elements of class ", elementTypeX) X[[i]] <- elt } X }) setMethod("mendoapply", "List", function(FUN, ..., MoreArgs = NULL) { X <- list(...)[[1L]] elementTypeX <- elementType(X) listData <- mapply(FUN = FUN, ..., MoreArgs = MoreArgs, SIMPLIFY = FALSE) for (i in seq_len(length(listData))) { if (!extends(class(listData[[i]]), elementTypeX)) stop("'FUN' must return elements of class ", elementTypeX) X[[i]] <- listData[[i]] } X }) asList <- function(x, ...) { if (is(x, "List")) return(x) if (!is.list(x)) stop("'x' must be a 'list'") cl <- lapply(x, class) clnames <- unique(unlist(cl, use.names=FALSE)) cons <- SimpleList if (length(clnames) == 1L) { cl <- cl[[1]] pkg <- packageSlot(cl) } else if (length(clnames)) { contains <- lapply(cl, function(x) getClass(x, TRUE)@contains) clnames <- c(clnames, unlist(lapply(contains, names), use.names=FALSE)) contab <- table(factor(clnames, unique(clnames))) cl <- names(contab)[contab == length(x)] if (length(cl)) pkg <- sapply(do.call(c, unname(contains))[cl], packageSlot) } if (length(cl)) { constructorName <- function(x) { substring(x, 1, 1) <- toupper(substring(x, 1, 1)) paste(x, "List", sep = "") } if (is.null(pkg)) ns <- topenv() else ns <- getNamespace(pkg[1]) consym <- constructorName(cl[1]) if (exists(consym, ns)) cons <- get(consym, ns) else { if (length(cl) == 1L) { contains <- getClass(cl, TRUE)@contains cl <- names(contains) pkg <- sapply(contains, packageSlot) } else { cl <- tail(cl, -1) pkg <- tail(pkg, -1) } if (length(cl)) { if (!length(pkg)) ns <- list(topenv()) connms <- constructorName(cl) ns <- lapply(pkg, getNamespace) coni <- head(which(mapply(exists, connms, ns)), 1) if (length(coni)) cons <- get(connms[coni], ns[[coni]]) } } } cons(x, ...) } ## FIXME: these functions should probably be renamed to c[apply], i.e., ## clapply, cmapply, ctapply, csplit, cby. seqapply <- function(X, FUN, ...) { asList(lapply(X, FUN, ...)) } mseqapply <- function(FUN, ..., MoreArgs = NULL, USE.NAMES = TRUE) { asList(.mapply_List(FUN, ..., MoreArgs = MoreArgs, SIMPLIFY = FALSE, USE.NAMES = USE.NAMES)) } tseqapply <- function(X, INDEX, FUN = NULL, ...) { asList(tapply(X, INDEX, FUN, ..., simplify = FALSE)) } seqsplit <- function(x, f, drop=FALSE) { ans_class <- try(splitAsListReturnedClass(x), silent=TRUE) if (inherits(ans_class, "try-error")) return(asList(split(x, f, drop))) splitAsList(x, f, drop=drop) } seqby <- function(data, INDICES, FUN, ...) { asList(by(data, INDICES, FUN, ..., simplify = FALSE)) } setGeneric("revElements", signature="x", function(x, i) standardGeneric("revElements") ) ### This method explains the concept of revElements() but is NOT efficient ### because endoapply() loops over the elements of 'i'. ### There is a fast method for CompressedList objects though. setMethod("revElements", "List", function(x, i) { if (missing(i)) i <- seq_len(length(x)) x[i] <- endoapply(x[i], rev) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setAs("List", "list", function(from) as.list(from)) .as.list.List <- function(x, use.names=TRUE) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") ans <- lapply(x, identity) if (!use.names) names(ans) <- NULL ans } ### S3/S4 combo for as.list.List as.list.List <- function(x, ...) .as.list.List(x, ...) setMethod("as.list", "List", as.list.List) setGeneric("as.env", function(x, ...) standardGeneric("as.env")) setMethod("as.env", "List", function(x, enclos = parent.frame(2)) { nms <- names(x) if (is.null(nms)) stop("cannot convert to environment when names are NULL") env <- new.env(parent = enclos) lapply(nms, function(col) { colFun <- function() { val <- x[[col]] rm(list=col, envir=env) assign(col, val, env) val } makeActiveBinding(col, colFun, env) }) env }) listClassName <- function(impl, element.type) { if (is.null(impl)) impl <- "" if (!is.null(element.type)) { cl <- c(element.type, names(getClass(element.type)@contains)) cl <- capitalize(cl) } else { cl <- "" } listClass <- c(paste0(impl, cl, "List"), paste0(cl, "List")) clExists <- which(sapply(listClass, isClass) & sapply(listClass, extends, paste0(impl, "List"))) if (length(clExists) == 0L) { stop("Could not find a '", impl, "List' subclass for values of type '", cl, "'") } listClass[clExists[1L]] } coerceToList <- function(from, element.type = NULL, ...) { if (is(from, listClassName(NULL, element.type))) return(from) coerceToCompressedList(from, element.type, ...) } setAs("ANY", "List", function(from) { coerceToList(from) }) ## Special cased, because integer extends ANY (somehow) and numeric, ## so ambiguities are introduced due to method caching. setAs("integer", "List", getMethod(coerce, c("ANY", "List"))) ### NOT exported. Assumes 'names1' is not NULL. make.unlist.result.names <- function(names1, names2) { if (is.null(names2)) return(names1) idx2 <- names2 != "" | is.na(names2) idx1 <- names1 != "" | is.na(names1) idx <- idx1 & idx2 if (any(idx)) names1[idx] <- paste(names1[idx], names2[idx], sep = ".") idx <- !idx1 & idx2 if (any(idx)) names1[idx] <- names2[idx] names1 } setMethod("unlist", "List", function(x, recursive=TRUE, use.names=TRUE) { if (!identical(recursive, TRUE)) stop("\"unlist\" method for List objects ", "does not support the 'recursive' argument") if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") if (length(x) == 0L) return(NULL) x_names <- names(x) if (!is.null(x_names)) names(x) <- NULL xx <- as.list(x) if (length(dim(xx[[1L]])) < 2L) { ans <- do.call(c, xx) ans_names0 <- names(ans) if (use.names) { if (!is.null(x_names)) { ans_names <- rep.int(x_names, elementLengths(x)) ans_names <- make.unlist.result.names(ans_names, ans_names0) try_result <- try(names(ans) <- ans_names, silent=TRUE) if (inherits(try_result, "try-error")) warning("failed to set names on the result ", "of unlisting a ", class(x), " object") } } else { ## This is consistent with base::unlist but is not consistent ## with unlist,CompressedList. See comments and FIXME note in ## the unlist,CompressedList code for more details. if (!is.null(ans_names0)) names(ans) <- NULL } } else { ans <- do.call(rbind, xx) if (!use.names) rownames(ans) <- NULL } ans } ) setMethod("unsplit", "List", function(value, f, drop = FALSE) { value_flat <- unlist(value, use.names = FALSE) if (length(value_flat) != length(f)) stop("Length of 'unlist(value)' must equal length of 'f'") seqsplit(value_flat, f, drop = drop) <- value value_flat }) .stack.ind <- function(x, index.var = "name") { if (length(names(x)) > 0) { spaceLabels <- names(x) } else { spaceLabels <- seq_len(length(x)) } ind <- Rle(factor(spaceLabels, levels = unique(spaceLabels)), elementLengths(x)) do.call(DataFrame, structure(list(ind), names = index.var)) } setMethod("stack", "List", function(x, index.var = "name", value.var = "value", name.var = NULL) { df <- DataFrame(.stack.ind(x, index.var), as(unlist(x, use.names=FALSE), "DataFrame")) colnames(df)[2] <- value.var if (!is.null(name.var)) { nms <- as.character(unlist(lapply(x, names))) if (length(nms) == 0L) nms <- as.character(unlist(lapply(elementLengths(x), seq_len))) df[[name.var]] <- factor(nms, unique(nms)) } df }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Evaluating. ### setMethod("eval", c("expression", "List"), function(expr, envir, enclos = parent.frame()) eval(expr, as.env(envir, enclos)) ) setMethod("eval", c("language", "List"), function(expr, envir, enclos = parent.frame()) eval(expr, as.env(envir, enclos)) ) setMethod("with", "List", function(data, expr, ...) { eval(substitute(expr), data, parent.frame()) }) setMethod("within", "List", function(data, expr, ...) { ## cannot use active bindings here, as they break for replacement e <- list2env(as.list(data)) ##e <- as.env(data) eval(substitute(expr), e, parent.frame(2)) l <- mget(ls(e), e) l <- l[!sapply(l, is.null)] nD <- length(del <- setdiff(names(data), (nl <- names(l)))) for (nm in nl) data[[nm]] <- l[[nm]] for (nm in del) data[[nm]] <- NULL data }) IRanges/R/MaskCollection-class.R0000644000126300012640000003056112227064470020034 0ustar00biocbuildphs_compbio### ========================================================================= ### MaskCollection objects ### ------------------------------------------------------------------------- setClass("MaskCollection", contains="RangesList", representation( nir_list="list", # a list of NormalIRanges objects width="integer", active="logical", NAMES="character", # R doesn't like @names !! desc="character" ), prototype( nir_list=list(), width=0L, active=logical(0), NAMES=as.character(NA), desc=as.character(NA) ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "length" and accessor methods. ### setGeneric("nir_list", function(x) standardGeneric("nir_list")) setMethod("nir_list", "MaskCollection", function(x) x@nir_list) setMethod("length", "MaskCollection", function(x) length(nir_list(x))) setMethod("width", "MaskCollection", function(x) x@width) setGeneric("active", function(x) standardGeneric("active")) setMethod("active", "MaskCollection", function(x) { ans <- x@active names(ans) <- names(x) ans } ) setGeneric("active<-", signature="x", function(x, value) standardGeneric("active<-") ) setReplaceMethod("active", "MaskCollection", function(x, value) { if (!is.logical(value) || anyMissing(value)) stop("'value' must be a logical vector with no NAs") x@active[] <- value x } ) setMethod("names", "MaskCollection", function(x) if (length(x@NAMES) == 1 && is.na(x@NAMES)) NULL else x@NAMES ) setReplaceMethod("names", "MaskCollection", function(x, value) { if (is.null(value)) { x@NAMES <- as.character(NA) return(x) } else { value <- as.character(value) } ii <- is.na(value) if (any(ii)) value[ii] <- "" if (length(value) > length(x)) stop("too many names") if (length(value) < length(x)) value <- c(value, character(length(x) - length(value))) x@NAMES <- value x } ) setGeneric("desc", function(x) standardGeneric("desc")) setMethod("desc", "MaskCollection", function(x) if (length(x@desc) == 1 && is.na(x@desc)) NULL else x@desc ) setGeneric("desc<-", signature="x", function(x, value) standardGeneric("desc<-") ) setReplaceMethod("desc", "MaskCollection", function(x, value) { if (is.null(value)) { x@desc <- as.character(NA) return(x) } if (!is.character(value)) stop("'value' must be NULL or a character vector") ii <- is.na(value) if (any(ii)) value[ii] <- "" if (length(value) > length(x)) stop("too many names") if (length(value) < length(x)) value <- c(value, character(length(x) - length(value))) x@desc <- value x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.MaskCollection.width <- function(x) { if (!isSingleInteger(width(x)) || width(x) < 0) return("the width of the collection must be a single non-negative integer") NULL } .valid.MaskCollection.nir_list <- function(x) { if (!is.list(nir_list(x)) || !all(sapply(nir_list(x), function(nir) is(nir, "NormalIRanges")))) return("the 'nir_list' slot must contain a list of NormalIRanges objects") if (!all(1 <= min(x)) || !all(max(x) <= width(x))) return("the min and max of the masks must be >= 1 and <= width of the collection") NULL } .valid.MaskCollection.active <- function(x) { if (!is.logical(active(x)) || anyMissing(active(x))) return("the 'active' slot must be a logical vector with no NAs") if (length(active(x)) != length(x)) return("the length of the 'active' slot differs from the length of the object") NULL } .valid.MaskCollection.names <- function(x) { if (anyMissing(names(x))) return("the names must be non-NA strings") NULL } .valid.MaskCollection.desc <- function(x) { if (!is.character(x@desc)) return("the 'desc' slot must contain a character vector") if (is.null(desc(x))) return(NULL) if (anyMissing(desc(x))) return("the descriptions must be non-NA strings") if (length(desc(x)) != length(x)) return("number of descriptions and number of elements differ") NULL } .valid.MaskCollection <- function(x) { ## The 'width' slot needs to be checked separately and we must return ## if it's invalid. This is because .valid.MaskCollection.nir_list() ## won't work properly if 'x@width' is NA. problems <- .valid.MaskCollection.width(x) if (!is.null(problems)) return(problems) c(.valid.MaskCollection.nir_list(x), .valid.MaskCollection.active(x), .valid.MaskCollection.names(x), .valid.MaskCollection.desc(x)) } setValidity2("MaskCollection", .valid.MaskCollection) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The safe and user-friendly "Mask" constructor. ### Mask <- function(mask.width, start=NULL, end=NULL, width=NULL) { nir <- asNormalIRanges(IRanges(start=start, end=end, width=width), force=FALSE) new2("MaskCollection", nir_list=list(nir), width=numeric2integer(mask.width), active=TRUE, check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "max" and "min" methods. ### setMethod("max", "MaskCollection", function(x, ..., na.rm) { if (length(x) == 0) return(integer(0)) sapply(nir_list(x), max) } ) setMethod("min", "MaskCollection", function(x, ..., na.rm) { if (length(x) == 0) return(integer(0)) sapply(nir_list(x), min) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "maskedwidth" and "maskedratio" generics and methods. ### setGeneric("maskedwidth", function(x) standardGeneric("maskedwidth")) setMethod("maskedwidth", "MaskCollection", function(x) { nir_list <- nir_list(x) if (length(nir_list) == 0) integer(0) else sapply(nir_list, function(nir) sum(width(nir))) } ) setGeneric("maskedratio", function(x) standardGeneric("maskedratio")) setMethod("maskedratio", "MaskCollection", function(x) maskedwidth(x) / width(x)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("getListElement", "MaskCollection", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=TRUE) nir_list(x)[[i]] } ) ### Always behaves like an endomorphism (i.e. ignores the 'drop' argument and ### behaves like if it was actually set to FALSE). setMethod("[", "MaskCollection", function(x, i, j, ..., drop=TRUE) { if (!missing(j) || length(list(...)) > 0) stop("invalid subsetting") if (missing(i)) i <- seq_len(length(x)) else i <- normalizeSingleBracketSubscript(i, x) if (any(i > 0L)) { # then 'all(i >= 0)' must be TRUE i <- i[i > 0L] if (anyDuplicated(i)) stop("subscript would generate duplicated elements") } slot(x, "nir_list", check=FALSE) <- nir_list(x)[i] slot(x, "active", check=FALSE) <- active(x)[i] if (!is.null(names(x))) slot(x, "NAMES", check=FALSE) <- names(x)[i] if (!is.null(desc(x))) slot(x, "desc", check=FALSE) <- desc(x)[i] mcols(x) <- mcols(x)[i, , drop=FALSE] x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "append" method. ### ### TODO: Be more consistent with "[" which doesn't allow subscripts with ### duplicated positive values in order to make it harder for the user to ### produce a MaskCollection object with duplicated names. ### The "append" method below makes this too easy (with append(x, x)). ### .append.names.or.desc <- function(nm1, l1, nm2, l2, after) { if (is.null(nm1) && is.null(nm2)) return(as.character(NA)) if (is.null(nm1)) nm1 <- rep.int("", l1) if (is.null(nm2)) nm2 <- rep.int("", l2) append(nm1, nm2, after=after) } setMethod("append", c("MaskCollection", "MaskCollection"), function(x, values, after=length(x)) { if (width(values) != width(x)) stop("'x' and 'values' must have the same width") if (!isSingleNumber(after)) stop("'after' must be a single number") if (length(values) == 0) return(x) ans_nir_list <- append(nir_list(x), nir_list(values), after=after) ans_active <- append(active(x), active(values), after=after) l1 <- length(x) l2 <- length(values) ans_NAMES <- .append.names.or.desc(names(x), l1, names(values), l2, after) ans_desc <- .append.names.or.desc(desc(x), l1, desc(values), l2, after) ## This transformation must be atomic. x@nir_list <- ans_nir_list x@active <- ans_active x@NAMES <- ans_NAMES x@desc <- ans_desc x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### collapse() ### setGeneric("collapse", function(x) standardGeneric("collapse")) ### Always return a MaskCollection object of length 1 where the mask is active. setMethod("collapse", "MaskCollection", function(x) { keep_it <- active(x) if (!all(keep_it)) x <- x[keep_it] if (length(x) == 1) return(x) nir_list <- nir_list(x) if (length(nir_list) == 0) { nir1 <- new("NormalIRanges") } else { start1 <- unlist(lapply(nir_list, start)) width1 <- unlist(lapply(nir_list, width)) ranges <- new2("IRanges", start=start1, width=width1, check=FALSE) nir1 <- asNormalIRanges(ranges, force=TRUE) } ## This transformation must be atomic. x@nir_list <- list(nir1) x@active <- TRUE x@NAMES <- as.character(NA) x@desc <- as.character(NA) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ### From a MaskCollection object to a NormalIRanges object. setAs("MaskCollection", "NormalIRanges", function(from) collapse(from)[[1L]] ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### MaskCollection.show_frame <- function(x) { lx <- length(x) cat("masks:") if (lx == 0) { cat(" NONE\n") } else { cat("\n") ## Explictely specify 'row.names=NULL' otherwise data.frame() will ## try to use the names of the first component that has suitable ## names, which could be 'active(x)' (3rd component) if 'x' has names. frame <- data.frame(maskedwidth=maskedwidth(x), maskedratio=maskedratio(x), active=active(x), row.names=NULL, check.names=FALSE) frame$names <- names(x) frame$desc <- desc(x) show(frame) if (lx >= 2) { margin <- format("", width=nchar(as.character(lx))) cat("all masks together:\n") mask0 <- collapse(`active<-`(x, TRUE)) frame <- data.frame(maskedwidth=maskedwidth(mask0), maskedratio=maskedratio(mask0), check.names=FALSE) row.names(frame) <- margin show(frame) if (sum(active(x)) < lx) { cat("all active masks together:\n") mask1 <- collapse(x) frame <- data.frame(maskedwidth=maskedwidth(mask1), maskedratio=maskedratio(mask1), check.names=FALSE) row.names(frame) <- margin show(frame) } } } } setMethod("show", "MaskCollection", function(object) { lo <- length(object) cat(class(object), " of length ", lo, " and width ", width(object), "\n", sep="") MaskCollection.show_frame(object) } ) IRanges/R/OverlapEncodings-class.R0000644000126300012640000002223612227064470020367 0ustar00biocbuildphs_compbio### ========================================================================= ### OverlapEncodings objects ### ------------------------------------------------------------------------- ### setClass("OverlapEncodings", contains="Vector", representation( Loffset="integer", # no NAs, >= 0 Roffset="integer", # no NAs, >= 0 encoding="factor", # no NAs flippedQuery="logical" # no NAs ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Slot getters. ### setGeneric("Loffset", function(x) standardGeneric("Loffset")) setMethod("Loffset", "OverlapEncodings", function(x) x@Loffset) setGeneric("Roffset", function(x) standardGeneric("Roffset")) setMethod("Roffset", "OverlapEncodings", function(x) x@Roffset) setGeneric("encoding", function(x) standardGeneric("encoding")) setMethod("encoding", "OverlapEncodings", function(x) x@encoding) ### S3/S4 combo for levels.OverlapEncodings levels.OverlapEncodings <- function(x) levels(encoding(x)) setMethod("levels", "OverlapEncodings", levels.OverlapEncodings) setGeneric("flippedQuery", function(x) standardGeneric("flippedQuery")) setMethod("flippedQuery", "OverlapEncodings", function(x) x@flippedQuery) setMethod("length", "OverlapEncodings", function(x) length(encoding(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The Lencoding() and Rencoding() getters. ### .extract_LRencoding_from_encoding_levels <- function(x, L.or.R) { if (!is.character(x)) stop("'x' must be a character vector") if (length(x) == 0L) return(character(0)) encoding_blocks <- strsplit(x, ":", fixed=TRUE) nblock <- elementLengths(encoding_blocks) tmp <- strsplit(unlist(encoding_blocks, use.names=FALSE), "--", fixed=TRUE) tmp_elt_lens <- elementLengths(tmp) tmp_is_single_end <- tmp_elt_lens == 1L tmp_is_paired_end <- tmp_elt_lens == 2L nblock1 <- sum(LogicalList(relist(tmp_is_single_end, encoding_blocks))) nblock2 <- sum(LogicalList(relist(tmp_is_paired_end, encoding_blocks))) is_single_end_encoding <- nblock1 == nblock is_paired_end_encoding <- nblock2 == nblock if (!all(is_single_end_encoding | nblock1 == 0L) || !all(is_paired_end_encoding | nblock2 == 0L) || !all(is_single_end_encoding | is_paired_end_encoding)) stop("'x' contains ill-formed encodings") any_single_end <- any(is_single_end_encoding) any_paired_end <- any(is_paired_end_encoding) if (any_single_end && any_paired_end) warning("'x' contains a mix of single-end and paired-end encodings") ans <- character(length(x)) ans[] <- NA_character_ if (any_paired_end) { tmp2 <- unlist(tmp[tmp_is_paired_end], use.names=FALSE) encodings_blocks2 <- encoding_blocks[is_paired_end_encoding] if (identical(L.or.R, "L")) { tmp2 <- tmp2[c(TRUE, FALSE)] } else if (identical(L.or.R, "R")) { tmp2 <- tmp2[c(FALSE, TRUE)] } else { stop("invalid supplied 'L.or.R' argument") } ans2 <- sapply(relist(tmp2, encodings_blocks2), function(blocks) paste(blocks, collapse=":")) ans[is_paired_end_encoding] <- paste(ans2, ":", sep="") } ans } setGeneric("Lencoding", function(x) standardGeneric("Lencoding")) setGeneric("Rencoding", function(x) standardGeneric("Rencoding")) setMethod("Lencoding", "character", function(x) .extract_LRencoding_from_encoding_levels(x, L.or.R="L") ) setMethod("Rencoding", "character", function(x) .extract_LRencoding_from_encoding_levels(x, L.or.R="R") ) setMethod("Lencoding", "factor", function(x) { levels_Lencoding <- Lencoding(levels(x)) factor(levels_Lencoding)[as.integer(x)] } ) setMethod("Rencoding", "factor", function(x) { levels_Rencoding <- Rencoding(levels(x)) factor(levels_Rencoding)[as.integer(x)] } ) setMethod("Lencoding", "OverlapEncodings", function(x) Lencoding(encoding(x))) setMethod("Rencoding", "OverlapEncodings", function(x) Rencoding(encoding(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The ngap(), Lngap(), and Rngap() getters. ### .extract_ngap_from_encoding_levels <- function(x, L.or.R=NA) { if (!is.character(x)) stop("'x' must be a character vector") if (length(x) == 0L) return(integer(0)) tmp <- strsplit(sub(":.*", "", x), "--", fixed=TRUE) elt_lens <- elementLengths(tmp) is_single_end_encoding <- elt_lens == 1L is_paired_end_encoding <- elt_lens == 2L if (!all(is_single_end_encoding | is_paired_end_encoding)) stop("'x' contains ill-formed encodings") any_single_end <- any(is_single_end_encoding) any_paired_end <- any(is_paired_end_encoding) if (any_single_end && any_paired_end) warning("'x' contains a mix of single-end and paired-end encodings") ans <- integer(length(x)) if (any_single_end) { if (identical(L.or.R, NA)) { tmp1 <- tmp[is_single_end_encoding] ngap1 <- suppressWarnings(as.integer(unlist(tmp1, use.names=FALSE))) if (any(is.na(ngap1))) stop("'x' contains ill-formed encodings") ngap1 <- ngap1 - 1L if (min(ngap1) < 0L) warning("some encodings in 'x' have a negative number of gaps") } else { ngap1 <- NA_integer_ } ans[is_single_end_encoding] <- ngap1 } if (any_paired_end) { tmp2 <- tmp[is_paired_end_encoding] ngap2 <- suppressWarnings(as.integer(unlist(tmp2, use.names=FALSE))) if (any(is.na(ngap2))) stop("'x' contains ill-formed encodings") ngap2 <- ngap2 - 1L if (min(ngap2) < 0L) warning("some encodings in 'x' have a negative number of gaps") Lngap2 <- ngap2[c(TRUE, FALSE)] Rngap2 <- ngap2[c(FALSE, TRUE)] if (identical(L.or.R, NA)) { ngap2 <- Lngap2 + Rngap2 } else if (identical(L.or.R, "L")) { ngap2 <- Lngap2 } else if (identical(L.or.R, "R")) { ngap2 <- Rngap2 } else { stop("invalid supplied 'L.or.R' argument") } ans[is_paired_end_encoding] <- ngap2 } ans } setGeneric("Lngap", function(x) standardGeneric("Lngap")) setGeneric("Rngap", function(x) standardGeneric("Rngap")) setMethod("ngap", "character", function(x) .extract_ngap_from_encoding_levels(x) ) setMethod("Lngap", "character", function(x) .extract_ngap_from_encoding_levels(x, L.or.R="L") ) setMethod("Rngap", "character", function(x) .extract_ngap_from_encoding_levels(x, L.or.R="R") ) setMethod("ngap", "factor", function(x) { levels_ngap <- ngap(levels(x)) levels_ngap[as.integer(x)] } ) setMethod("Lngap", "factor", function(x) { levels_Lngap <- Lngap(levels(x)) levels_Lngap[as.integer(x)] } ) setMethod("Rngap", "factor", function(x) { levels_Rngap <- Rngap(levels(x)) levels_Rngap[as.integer(x)] } ) setMethod("ngap", "OverlapEncodings", function(x) ngap(encoding(x))) setMethod("Lngap", "OverlapEncodings", function(x) Lngap(encoding(x))) setMethod("Rngap", "OverlapEncodings", function(x) Rngap(encoding(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ### S3/S4 combo for as.data.frame.OverlapEncodings as.data.frame.OverlapEncodings <- function(x, row.names=NULL, optional=FALSE, ...) { if (!(is.null(row.names) || is.character(row.names))) stop("'row.names' must be NULL or a character vector") data.frame(Loffset=Loffset(x), Roffset=Roffset(x), encoding=encoding(x), flippedQuery=flippedQuery(x), row.names=row.names, check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) } setMethod("as.data.frame", "OverlapEncodings", as.data.frame.OverlapEncodings) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### "show" method. ### setMethod("show", "OverlapEncodings", function(object) { lo <- length(object) cat(class(object), " of length ", lo, "\n", sep="") if (lo == 0L) return(NULL) if (lo < 20L) { showme <- as.data.frame(object, row.names=paste("[", seq_len(lo), "]", sep="")) } else { sketch <- function(x) c(as.character(head(x, n=9L)), "...", as.character(tail(x, n=9L))) showme <- data.frame(Loffset=sketch(Loffset(object)), Roffset=sketch(Roffset(object)), encoding=sketch(encoding(object)), flippedQuery=sketch(flippedQuery(object)), row.names=c(paste("[", 1:9, "]", sep=""), "...", paste("[", (lo-8L):lo, "]", sep="")), check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) } show(showme) } ) IRanges/R/RDApplyParams-class.R0000644000126300012640000001700312227064470017600 0ustar00biocbuildphs_compbio### ========================================================================= ### RDApplyParams objects ### ------------------------------------------------------------------------- setClassUnion("functionORNULL", c("function", "NULL")) setClass("RDApplyParams", representation(rangedData = "RangedData", applyFun = "function", applyParams = "list", ##excludePattern = "character", filterRules = "FilterRules", simplify = "logical", reducerFun = "functionORNULL", reducerParams = "list", iteratorFun = "function"), prototype(applyFun = function(rd) NULL, simplify = FALSE, iteratorFun = sapply)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setGeneric("rangedData", function(x, ...) standardGeneric("rangedData")) setMethod("rangedData", "RDApplyParams", function(x) x@rangedData) setGeneric("rangedData<-", function(x, ..., value) standardGeneric("rangedData<-")) setReplaceMethod("rangedData", "RDApplyParams", function(x, value) { x@rangedData <- value validObject(x) x }) setGeneric("applyFun", function(x, ...) standardGeneric("applyFun")) setMethod("applyFun", "RDApplyParams", function(x) x@applyFun) setGeneric("applyFun<-", function(x, ..., value) standardGeneric("applyFun<-")) setReplaceMethod("applyFun", "RDApplyParams", function(x, value) { x@applyFun <- value validObject(x) x }) setGeneric("applyParams", function(x, ...) standardGeneric("applyParams")) setMethod("applyParams", "RDApplyParams", function(x) x@applyParams) setGeneric("applyParams<-", function(x, ..., value) standardGeneric("applyParams<-")) setReplaceMethod("applyParams", "RDApplyParams", function(x, value) { x@applyParams <- value validObject(x) x }) ## setGeneric("excludePattern", ## function(x, ...) standardGeneric("excludePattern")) ## setMethod("excludePattern", "RDApplyParams", function(x) x@excludePattern) ## setGeneric("excludePattern<-", ## function(x, ..., value) standardGeneric("excludePattern<-")) ## setReplaceMethod("excludePattern", "RDApplyParams", function(x, value) { ## x@excludePattern <- value ## validObject(x) ## x ## }) setMethod("filterRules", "RDApplyParams", function(x) x@filterRules) setGeneric("filterRules<-", function(x, ..., value) standardGeneric("filterRules<-")) setReplaceMethod("filterRules", "RDApplyParams", function(x, value) { x@filterRules <- value validObject(x) x }) setGeneric("simplify", function(x, ...) standardGeneric("simplify")) setMethod("simplify", "RDApplyParams", function(x) x@simplify) setGeneric("simplify<-", function(x, ..., value) standardGeneric("simplify<-")) setReplaceMethod("simplify", "RDApplyParams", function(x, value) { x@simplify <- value validObject(x) x }) setGeneric("reducerFun", function(x, ...) standardGeneric("reducerFun")) setMethod("reducerFun", "RDApplyParams", function(x) x@reducerFun) setGeneric("reducerFun<-", function(x, ..., value) standardGeneric("reducerFun<-")) setReplaceMethod("reducerFun", "RDApplyParams", function(x, value) { x@reducerFun <- value validObject(x) x }) setGeneric("reducerParams", function(x, ...) standardGeneric("reducerParams")) setMethod("reducerParams", "RDApplyParams", function(x) x@reducerParams) setGeneric("reducerParams<-", function(x, ..., value) standardGeneric("reducerParams<-")) setReplaceMethod("reducerParams", "RDApplyParams", function(x, value) { x@reducerParams <- value validObject(x) x }) setGeneric("iteratorFun", function(x, ...) standardGeneric("iteratorFun")) setMethod("iteratorFun", "RDApplyParams", function(x) x@iteratorFun) setGeneric("iteratorFun<-", function(x, ..., value) standardGeneric("iteratorFun<-")) setReplaceMethod("iteratorFun", "RDApplyParams", function(x, value) { x@iteratorFun <- value validObject(x) x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor ### ## Simple convenience constructor around RDApplyParams's initializer RDApplyParams <- function(rangedData, applyFun, applyParams, #excludePattern, filterRules, simplify, reducerFun, reducerParams, iteratorFun) { params <- new("RDApplyParams", applyFun = applyFun, applyParams = applyParams, filterRules = filterRules, simplify = simplify, reducerFun = reducerFun, reducerParams = reducerParams, iteratorFun = iteratorFun) params@rangedData <- rangedData ## set rangedData last for efficiency params } ## get the defaults from the class prototype formals(RDApplyParams) <- structure(lapply(slotNames("RDApplyParams"), function(x) { slot(new("RDApplyParams"), x) }), names = slotNames("RDApplyParams")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.RDApplyParams.applyFun <- function(x) { formals <- formals(applyFun(x)) if (anyDuplicated(names(applyParams(x)))) "apply parameters have duplicated names" else if (!("..." %in% names(formals))) { if (length(formals) < (length(applyParams(x)) + 1)) "'applyFun' does not take enough parameters" else { nms <- names(applyParams(x)) if (!is.null(nms) && !all(nms[nchar(nms) > 0] %in% names(formals))) "mismatch between names of 'applyParams' and formals of 'applyFun'" else NULL } } else NULL } ## .valid.RDApplyParams.excludePattern <- function(x) { ## if (!isSingleString(excludePattern(x))) ## "'excludePattern' must be a single, non-missing string" ## else NULL ## } .valid.RDApplyParams.simplify <- function(x) { if (!isTRUEorFALSE(simplify(x))) "'simplify' must be TRUE or FALSE" else if (!is.null(reducerFun(x)) && simplify(x)) "'simplify' must be FALSE for there to be a 'reducerFun'" else NULL } .valid.RDApplyParams.reducerParams <- function(x) { if (length(reducerParams(x)) && is.null(reducerFun(x))) return("there must be a 'reducerFun' for there to be 'reducerParams'") else if (anyDuplicated(names(reducerParams(x)))) return("reducer parameters have duplicated names") else if (!is.null(reducerFun(x))) { formals <- formals(reducerFun(x)) if (!("..." %in% names(formals))) { if (length(formals) < (length(reducerParams(x)) + 1)) return("'reducerFun' does not take enough parameters") else { nms <- names(reducerParams(x)) if (!is.null(nms) && !all(nms[nchar(nms) > 0] %in% names(formals)) && !("..." %in% names(formals))) return("mismatch b/w 'reducerParams' names and 'reducerFun' formals") } } } NULL } .valid.RDApplyParams.iteratorFun <- function(x) { formals <- formals(iteratorFun(x)) if (length(formals) < 2) "'iteratorFun' must take at least two parameters" else if ("simplify" %in% names(formals) && length(formals) < 3) "'iteratorFun' must take at least three parameters if one is 'simplify'" else NULL } .valid.RDApplyParams <- function(x) c(##.valid.RDApplyParams.rangedData(x), .valid.RDApplyParams.applyFun(x), ##.valid.RDApplyParams.excludePattern(x), .valid.RDApplyParams.simplify(x), .valid.RDApplyParams.reducerParams(x), .valid.RDApplyParams.iteratorFun(x)) setValidity2("RDApplyParams", .valid.RDApplyParams) IRanges/R/RangedData-class.R0000644000126300012640000007772412227064470017133 0ustar00biocbuildphs_compbio### ========================================================================= ### RangedData objects ### ------------------------------------------------------------------------- ## For keeping data with your ranges ## There are two design aims: ## 1) Efficiency when data is large (i.e. apply by chromosome) ## 2) Convenience when data is not so large (i.e. unrolling the data) ## The ranges are stored in a RangesList, while the data is stored in ## a SplitDataFrameList. The RangesList is uncompressed, because ## users will likely want to apply over each Ranges separately, as ## they are usually in separate spaces. Also, it is difficult to ## compress RangesLists, as lists containing Views or IntervalTrees ## are uncompressible. The SplitDataFrameList should be compressed, ## because it's cheap to create from a split factor and, more ## importantly, cheap to get and set columns along the entire dataset, ## which is common. Usually the data columns are atomic vectors and ## thus trivially compressed. It does, however, incur a slight ## performance penalty when applying over the RangedData. setClass("RangedData", contains = c("DataTable", "List"), representation(ranges = "RangesList", values = "SplitDataFrameList"), prototype = prototype(ranges = new("SimpleRangesList"), values = new("CompressedSplitDataFrameList"))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("values", "RangedData", function(x) x@values) setReplaceMethod("values", "RangedData", function(x, value) { if (extends(class(value), "SplitDataFrameList")) { if (!identical(elementLengths(values(x)), elementLengths(value))) stop("'value' must have same elementLengths as current 'values'") } else if (extends(class(value), "DataFrame")) { value <- split(value, space(x)) } else { stop("'value' must extend class SplitDataFrameList or DataFrame") } if (is.null(rownames(value)) && !is.null(rownames(x))) rownames(value) <- rownames(x) else if (!identical(rownames(value), rownames(values(x)))) stop("rownames of 'value', if non-NULL, must match the ", "rownames of 'x'") x@values <- value x }) setMethod("ranges", "RangedData", function(x) x@ranges) setReplaceMethod("ranges", "RangedData", function(x, value) { if (extends(class(value), "RangesList")) { if (!identical(lapply(ranges(x), names), lapply(value, names))) stop("'value' must have same length and names as current 'ranges'") } else if (extends(class(value), "IRanges")) { value <- split(value, space(x)) } else { stop("'value' must extend class RangesList or IRanges") } x@ranges <- value x }) ## range delegates setMethod("start", "RangedData", function(x) { start(unlist(ranges(x), use.names=FALSE)) }) setMethod("end", "RangedData", function(x) { end(unlist(ranges(x), use.names=FALSE)) }) setMethod("width", "RangedData", function(x) { width(unlist(ranges(x), use.names=FALSE)) }) setReplaceMethod("start", "RangedData", function(x, check=TRUE, value) { start(ranges(x), check=check) <- value x }) setReplaceMethod("end", "RangedData", function(x, check=TRUE, value) { end(ranges(x), check=check) <- value x }) setReplaceMethod("width", "RangedData", function(x, check=TRUE, value) { width(ranges(x), check=check) <- value x }) setMethod("length", "RangedData", function(x) length(ranges(x))) setMethod("names", "RangedData", function(x) names(ranges(x))) setReplaceMethod("names", "RangedData", function(x, value) { if (!is.null(value) && !is.character(value)) stop("'value' must be NULL or a character vector") names(x@ranges) <- value names(x@values) <- value x }) setMethod("elementLengths", "RangedData", function(x) elementLengths(ranges(x))) setMethod("space", "RangedData", function(x) space(ranges(x))) setMethod("universe", "RangedData", function(x) universe(ranges(x))) setReplaceMethod("universe", "RangedData", function(x, value) { universe(x@ranges) <- value x }) setGeneric("score", function(x, ...) standardGeneric("score")) setMethod("score", "RangedData", function(x) { score <- x[["score"]] ## if (is.null(score) && ncol(x) > 0 && is.numeric(x[[1L]])) ## score <- x[[1L]] score }) setGeneric("score<-", function(x, ..., value) standardGeneric("score<-")) setReplaceMethod("score", "RangedData", function(x, value) { if (!is.numeric(value)) stop("score must be numeric") if (length(value) != nrow(x)) stop("number of scores must equal the number of rows") x[["score"]] <- value x }) ## values delegates setMethod("nrow", "RangedData", function(x) { sum(nrow(values(x))) }) setMethod("ncol", "RangedData", function(x) { ncol(values(x))[[1L]] }) setMethod("rownames", "RangedData", function(x, do.NULL = TRUE, prefix = "row") { rn <- unlist(rownames(values(x), do.NULL = do.NULL, prefix = prefix), use.names=FALSE) if (length(rn) == 0) rn <- NULL rn }) setMethod("colnames", "RangedData", function(x, do.NULL = TRUE, prefix = "col") { if (length(x) == 0) character() else colnames(values(x), do.NULL = do.NULL, prefix = prefix)[[1L]] }) setReplaceMethod("rownames", "RangedData", function(x, value) { if (!is.null(value)) { if (length(value) != nrow(x)) { stop("invalid 'row.names' length") } else { if (!is.character(value)) value <- as.character(value) ends <- cumsum(elementLengths(x)) value <- new("CompressedCharacterList", unlistData = value, partitioning = PartitioningByEnd(ends)) } } ranges <- ranges(x) for(i in seq_len(length(ranges))) { names(ranges[[i]]) <- value[[i]] } x@ranges <- ranges rownames(x@values) <- value x }) setReplaceMethod("colnames", "RangedData", function(x, value) { colnames(x@values) <- value x }) setMethod("columnMetadata", "RangedData", function(x) { columnMetadata(values(x)) }) setReplaceMethod("columnMetadata", "RangedData", function(x, value) { columnMetadata(values(x)) <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.RangedData.ranges <- function(x) { if (!identical(lapply(ranges(x), length), lapply(values(x), nrow))) "'ranges' and 'values' must be of the same length and have the same names" else if (!identical(unlist(lapply(ranges(x), names), use.names=FALSE), rownames(x))) "the names of the ranges must equal the rownames" else NULL } .valid.RangedData.names <- function(x) { nms <- names(x) if (length(nms) != length(x)) "length(names(x)) must equal length(x)" else if (!is.character(nms) || anyMissing(nms) || anyDuplicated(nms)) "names(x) must be a character vector without any NA's or duplicates" else NULL } .valid.RangedData <- function(x) { c(.valid.RangedData.ranges(x), .valid.RangedData.names(x)) } setValidity2("RangedData", .valid.RangedData) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### ## creates a single-element RangedData (unless splitter (space) is specified) RangedData <- function(ranges = IRanges(), ..., space = NULL, universe = NULL) { hasDots <- (((nargs() - !missing(space)) - !missing(universe)) > 1) if (!is.null(universe) && !isSingleString(universe)) stop("'universe' must be a single string") if (is(ranges, "RangesList")) { if (!is.null(space)) warning("since 'class(ranges)' extends RangesList, 'space' argument is ignored") if (is.null(names(ranges))) names(ranges) <- as.character(seq_len(length(ranges))) space <- Rle(factor(names(ranges), levels = names(ranges)), elementLengths(ranges)) N <- sum(elementLengths(ranges)) NAMES <- unlist(lapply(ranges, names), use.names=FALSE) } else { if (!is(ranges, "Ranges")) { coerced <- try(as(ranges, "RangedData"), silent=TRUE) if (is(coerced, "RangedData")) return(coerced) stop("'ranges' must be a Ranges or directly coercible to RangedData") } N <- length(ranges) NAMES <- names(ranges) if (is.null(space)) { if (N == 0) space <- Rle(factor()) else space <- Rle(factor("1")) } else if (!is(space, "Rle")) { space <- Rle(space) } if (!is.factor(runValue(space))) runValue(space) <- factor(runValue(space)) if (length(space) != N) { if (length(space) == 0L) stop("'space' is a 0-length vector but length of 'ranges' is > 0") ## We make an exception to the "length(space) must be <= N" rule when ## N != 0L so we can support the direct creation of RangedData objects ## with 0 rows across 1 or more user-specified spaces like in: ## RangedData(ranges=IRanges(), space=letters) if (N != 0L && length(space) > N) stop("length of 'space' greater than length of 'ranges'") if (N %% length(space) != 0) stop("length of 'ranges' not a multiple of 'space' length") space <- rep(space, length.out = N) } if (!is(ranges, "IRanges")) ranges <- as(ranges, "IRanges") ranges <- split(ranges, space) } universe(ranges) <- universe if (hasDots) values <- DataFrame(...) ## at least one column specified else values <- new2("DataFrame", nrows = N, check=FALSE) if (N != nrow(values)) { if (nrow(values) > N) stop("length of value(s) in '...' greater than length of 'ranges'") if (nrow(values) == 0 || N %% nrow(values) != 0) stop("length of 'ranges' not a multiple of length of value(s) in '...'") rind <- recycleVector(seq_len(nrow(values)), N) values <- values[rind,,drop=FALSE] } rownames(values) <- NAMES ## ensure these are identical values <- split(values, space) new2("RangedData", ranges = ranges, values = values, check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### ## The extraction operator delegates to the values (extracts columns) setMethod("[[", "RangedData", function(x, i, j, ...) { dotArgs <- list(...) if (length(dotArgs) > 0) dotArgs <- dotArgs[names(dotArgs) != "exact"] if (!missing(j) || length(dotArgs) > 0) stop("invalid subsetting") if (missing(i)) stop("subscript is missing") if (!is.character(i) && !is.numeric(i)) stop("invalid subscript type") if (length(i) < 1L) stop("attempt to select less than one element") if (length(i) > 1L) stop("attempt to select more than one element") if (is.numeric(i) && !is.na(i) && (i < 1L || i > ncol(x))) stop("subscript out of bounds") if (is.na(i) || (is.character(i) && !(i %in% c("space", "ranges", colnames(x))))) NULL else if (i == "space") space(x) else if (i == "ranges") unlist(ranges(x), use.names=FALSE) else unlist(values(x), use.names=FALSE)[[i]] }) setReplaceMethod("[[", "RangedData", function(x, i, j,..., value) { if (!missing(j) || length(list(...)) > 0) stop("invalid subsetting") if (missing(i)) stop("subscript is missing") if (!is.character(i) && !is.numeric(i)) stop("invalid subscript type") if (length(i) < 1L) stop("attempt to select less than one element") if (length(i) > 1L) stop("attempt to select more than one element") if (is.numeric(i) && (i < 1L || i > ncol(x) + 1L)) stop("subscript out of bounds") if (i == "space") stop("cannot replace \"space\" information") if (i == "ranges") { ranges(x) <- value } else { nrx <- nrow(x) lv <- length(value) if (!is.null(value) && (nrx != lv)) { if ((nrx == 0) || (nrx %% lv != 0)) stop(paste(lv, "elements in value to replace", nrx, "elements")) else value <- rep(value, length.out = nrx) } nrows <- elementLengths(values(x)) inds <- seq_len(length(x)) spaces <- factor(rep.int(inds, nrows), inds) values <- unlist(values(x), use.names=FALSE) values[[i]] <- value x@values <- split(values, spaces) names(x@values) <- names(x) } x }) setReplaceMethod("$", "RangedData", function(x, name, value) { x[[name]] <- value x }) ### Supported index types: numeric, logical, character, NULL and missing. ## Two index modes: ## - list style ([i]): subsets by range space (e.g. chromosome) ## - matrix style ([i,j]): subsets the data frame setMethod("[", "RangedData", function(x, i, j, ..., drop=FALSE) { if (length(list(...)) > 0) stop("parameters in '...' not supported") if (missing(i) && missing(j)) return(x) checkIndex <- function(i, lx, nms) { if (!is.atomic(i)) return("invalid subscript type") if (is.numeric(i)) { if (!is.integer(i)) i <- as.integer(i) if (anyMissingOrOutside(i, upper = lx)) return("subscript contains NAs or out of bounds indices") if (anyMissingOrOutside(i, 0L, lx) && anyMissingOrOutside(i, upper = 0L)) return("negative and positive indices cannot be mixed") } else if (is.logical(i)) { if (anyMissing(i)) return("subscript contains NAs") if (length(i) > lx) return("subscript out of bounds") } else if ((is.character(i) || is.factor(i))) { if (anyMissing(i)) return("subscript contains NAs") if (anyMissing(match(i, nms))) return("mismatching names") } else if (!is.null(i)) { return("invalid subscript type") } NULL } mstyle <- nargs() > 2 if (mstyle) { ranges <- ranges(x) values <- values(x) if (!missing(j)) { prob <- checkIndex(j, ncol(x), colnames(x)) if (!is.null(prob)) stop("selecting cols: ", prob) values <- values[, j, drop=FALSE] } if (!missing(i)) { if (is(i, "RangesList")) stop("subsetting a RangedData object ", "by a RangesList subscript is not supported") if (is(i, "LogicalList")) { xeltlen <- elementLengths(ranges(x)) whichRep <- which(xeltlen != elementLengths(i)) for (k in whichRep) i[[k]] <- rep(i[[k]], length.out = xeltlen[k]) i <- unlist(i, use.names=FALSE) } else if (is(i, "IntegerList")) { itemp <- LogicalList(lapply(elementLengths(ranges(x)), rep, x = FALSE)) for (k in seq_len(length(itemp))) itemp[[k]][i[[k]]] <- TRUE i <- unlist(itemp, use.names=FALSE) } prob <- checkIndex(i, nrow(x), rownames(x)) if (!is.null(prob)) stop("selecting rows: ", prob) if (is.numeric(i) && any(i < 0)) i <- setdiff(seq(nrow(x)), -i) if (is.logical(i)) { igroup <- factor(rep.int(seq_len(length(x)), elementLengths(x)), levels = seq_len(length(x))) if (length(i) < nrow(x)) i <- rep(i, length.out = nrow(x)) } else { if (is.null(i)) i <- integer(0) if (is.factor(i)) i <- as.character(i) if (is.character(i)) { dummy <- seq_len(nrow(x)) names(dummy) <- rownames(x) i <- dummy[i] if (anyMissing(i)) ## cannot subset by NAs yet stop("invalid rownames specified") } starts <- cumsum(c(1L, head(elementLengths(x), -1))) igroup <- factor(findInterval(i, starts), levels = seq_len(length(x))) if (anyDuplicated(runValue(Rle(igroup)))) stop("cannot mix row indices from different spaces") i <- i - (starts - 1L)[as.integer(igroup)] } isplit <- split(i, igroup) names(isplit) <- names(x) ranges <- subsetListByList(ranges, isplit) values <- subsetListByList(values, isplit) if (drop) { ok <- (elementLengths(ranges) > 0) ranges <- ranges[ok] values <- values[ok] } } } else { if (!missing(i)) { prob <- checkIndex(i, length(x), names(x)) if (!is.null(prob)) stop("selecting spaces: ", prob) ranges <- ranges(x)[i] values <- values(x)[i] } } x@ranges <- ranges x@values <- values x }) ### Dummy "extractROWS" method. setMethod("extractROWS", "RangedData", function(x, i) { if (is(i, "Ranges")) i <- as.integer(i) x[i, , drop=FALSE] } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining and splitting. ### setMethod("c", "RangedData", function(x, ..., recursive = FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for RangedData objects ", "does not support the 'recursive' argument") if (missing(x)) rds <- unname(list(...)) else rds <- unname(list(x, ...)) rd <- rds[[1L]] if (!all(sapply(rds, is, "RangedData"))) stop("all arguments in '...' must be RangedData objects") nms <- lapply(rds, ## figure out names like 'c' on an ordinary vector function(rd) structure(logical(length(rd)), names = names(rd))) nms <- names(do.call(c, nms)) names(rds) <- NULL # critical for dispatch to work ranges <- do.call(c, lapply(rds, ranges)) values <- do.call(c, lapply(rds, values)) names(ranges) <- nms rd@ranges <- ranges names(values) <- nms rd@values <- values rd }) setMethod("split", "RangedData", function(x, f, drop = FALSE) { if (length(f) > nrow(x) || nrow(x) %% length(f) > 0) stop("nrow(x) is not a multiple of length(f)") splitInd <- split(seq_len(nrow(x)), f, drop) do.call(RangedDataList, lapply(splitInd, function(ind) x[ind,])) }) setMethod("rbind", "RangedData", function(..., deparse.level=1) { args <- unname(list(...)) rls <- lapply(args, ranges) if (!all(sapply(sapply(rls, universe), identical, universe(rls[[1L]])))) stop("All args in '...' must have the same universe") nms <- unique(unlist(lapply(args, names), use.names=FALSE)) rls <- lapply(rls, function(x) {y <- as.list(x)[nms];names(y) <- nms;y}) dfs <- lapply(args, function(x) {y <- as.list(values(x))[nms];names(y) <- nms;y}) safe.c <- function(...) { x <- list(...) do.call(c, x[!sapply(x, is.null)]) } rls <- IRangesList(do.call(Map, c(list(safe.c), rls))) safe.rbind <- function(...) { x <- list(...) do.call(rbind, x[!sapply(x, is.null)]) } dfs <- SplitDataFrameList(do.call(Map, c(list(safe.rbind), dfs))) for (i in seq_len(length(rls))) names(rls[[i]]) <- rownames(dfs[[i]]) initialize(args[[1L]], ranges = rls, values = dfs) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### ### S3/S4 combo for as.data.frame.RangedData as.data.frame.RangedData <- function(x, row.names=NULL, optional=FALSE, ...) { if (!(is.null(row.names) || is.character(row.names))) stop("'row.names' must be NULL or a character vector") if (!missing(optional) || length(list(...))) warning("'optional' and arguments in '...' ignored") data.frame(as.data.frame(ranges(x)), as.data.frame(values(x))[-1L], row.names = row.names, stringsAsFactors = FALSE) } setMethod("as.data.frame", "RangedData",as.data.frame.RangedData) setAs("RangedData", "DataFrame", function(from) { DataFrame(as.data.frame(ranges(from)), values(from)) }) setAs("Rle", "RangedData", function(from) { new2("RangedData", ranges = IRangesList("1" = successiveIRanges(runLength(from))), values = SplitDataFrameList("1" = DataFrame(score = runValue(from))), metadata = metadata(from), check = FALSE) }) setAs("RleList", "RangedData", function(from) { ranges <- IRangesList(lapply(from, function(x) successiveIRanges(runLength(x)))) values <- SplitDataFrameList(lapply(from, function(x) DataFrame(score = runValue(x)))) if (is.null(names(from))) { nms <- as.character(seq_len(length(from))) names(ranges) <- nms names(values) <- nms } new2("RangedData", ranges = ranges, values = values, metadata = metadata(from), elementMetadata = elementMetadata(from), check = FALSE) }) setAs("RleViewsList", "RangedData", function(from) { subject <- subject(from) from_ranges <- restrict(ranges(from), 1L, elementLengths(subject), keep.all.ranges = TRUE) ### FIXME: do we want to insert NAs for out of bounds views? score <- extractROWS(subject, from_ranges) score_part <- seqapply(width(from_ranges), PartitioningByWidth) score_ranges <- ranges(score) ol <- findOverlaps(score_ranges, score_part) offset <- (start(from_ranges) - start(score_part))[seqapply(ol, subjectHits)] ranges <- shift(ranges(ol, score_ranges, score_part), offset) viewNames <- lapply(from_ranges, function(x) { if (is.null(names(x))) seq_len(length(x)) else names(x) }) RangedData(ranges, score = unlist(runValue(score), use.names = FALSE)[queryHits(ol)], view = unlist(viewNames, use.names = FALSE)[subjectHits(ol)]) }) setAs("Ranges", "RangedData", function(from) { RangedData(from) }) setAs("RangesList", "RangedData", function(from) { from_names <- names(from) if (is.null(from_names) || anyDuplicated(from_names)) stop("cannot coerce a RangesList object with no names ", "or duplicated names to a RangedData object") unlisted_from <- unlist(from, use.names=FALSE) unlisted_values <- mcols(unlisted_from) mcols(unlisted_from) <- NULL ans_ranges <- relist(unlisted_from, skeleton=from) metadata(ans_ranges) <- metadata(from) if (!is(unlisted_values, "DataFrame")) { if (!is.null(unlisted_values)) warning("could not propagate the inner metadata columns of ", "'from' (accessed with 'mcols(unlist(from))') ", "to the data columns (aka values) of the returned ", "RangedData object") unlisted_values <- new2("DataFrame", nrows=length(unlisted_from), check=FALSE) } ans_values <- newCompressedList0("CompressedSplitDataFrameList", unlisted_values, PartitioningByEnd(ans_ranges)) new2("RangedData", ranges=ans_ranges, values=ans_values, #metadata=metadata(from), elementMetadata=elementMetadata(from), check=FALSE) } ) .fromRangedDataToCompressedIRangesList <- function(from) { ans <- ranges(from) ## Propagate 'values(from)'. ans_unlisted_values <- unlist(values(from), use.names=FALSE) mcols(ans@unlistData) <- ans_unlisted_values ans } setAs("RangedData", "CompressedIRangesList", .fromRangedDataToCompressedIRangesList ) setAs("RangedData", "IRangesList", .fromRangedDataToCompressedIRangesList) setAs("RangedData", "RangesList", .fromRangedDataToCompressedIRangesList) setMethod("as.env", "RangedData", function(x, enclos = parent.frame(2)) { env <- callNextMethod(x, enclos) makeAccessorBinding <- function(fun, name = deparse(substitute(fun))) { makeActiveBinding(name, function() { val <- fun(x) rm(list=name, envir=env) assign(name, val, env) ## cache for further use val }, env) } makeAccessorBinding(ranges) makeAccessorBinding(space) makeAccessorBinding(start) makeAccessorBinding(width) makeAccessorBinding(end) env }) .RangedData_fromDataFrame <- function(from) { required <- c("start", "end") if (!all(required %in% colnames(from))) stop("'from' must at least include a 'start' and 'end' column") datacols <- setdiff(colnames(from), c(required, "space", "width")) RangedData(IRanges(from$start, from$end), from[,datacols,drop=FALSE], space = from$space) } setAs("data.frame", "RangedData", .RangedData_fromDataFrame) setAs("DataTable", "RangedData", .RangedData_fromDataFrame) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Show ### setMethod("show", "RangedData", function(object) { nr <- nrow(object) nc <- ncol(object) lo <- length(object) cat(class(object), " with ", nr, ifelse(nr == 1, " row and ", " rows and "), nc, ifelse(nc == 1, " value column across ", " value columns across "), lo, ifelse(lo == 1, " space\n", " spaces\n"), sep = "") if (nr > 0) { nms <- rownames(object) if (nr < 20) { ranges <- unlist(ranges(object), use.names=FALSE) values <- unlist(values(object), use.names=FALSE) out <- cbind(space = as.character(space(object)), ranges = showAsCell(ranges), "|" = rep.int("|", nr)) if (nc > 0) out <- cbind(out, as.matrix(format(do.call(data.frame, lapply(values, showAsCell))))) if (is.null(nms)) rownames(out) <- as.character(seq_len(nr)) else rownames(out) <- nms classinfo <- matrix(c("", "", "|", unlist(lapply(values, function(x) { paste("<", classNameForDisplay(x), ">", sep = "") }), use.names = FALSE)), nrow = 1, dimnames = list("", colnames(out))) } else { top <- object[1:9, ] topRanges <- unlist(ranges(top), use.names=FALSE) topValues <- unlist(values(top), use.names=FALSE) bottom <- object[(nr-8L):nr, ] bottomRanges <- unlist(ranges(bottom), use.names=FALSE) bottomValues <- unlist(values(bottom), use.names=FALSE) out <- rbind(cbind(space = as.character(space(top)), ranges = showAsCell(topRanges), "|" = rep.int("|", 9)), rbind(rep.int("...", 3)), cbind(space = as.character(space(bottom)), ranges = showAsCell(bottomRanges), "|" = rep.int("|", 9))) if (nc > 0) out <- cbind(out, rbind(as.matrix(format(do.call(data.frame, lapply(topValues, showAsCell)))), rbind(rep.int("...", nc)), rbind(as.matrix(format(do.call(data.frame, lapply(bottomValues, showAsCell))))))) if (is.null(nms)) { rownames(out) <- c(as.character(1:9), "...", as.character((nr-8L):nr)) } else { rownames(out) <- c(head(nms, 9), "...", tail(nms, 9)) } classinfo <- matrix(c("", "", "|", unlist(lapply(topValues, function(x) { paste("<", classNameForDisplay(x), ">", sep = "") }), use.names = FALSE)), nrow = 1, dimnames = list("", colnames(out))) } out <- rbind(classinfo, out) print(out, quote = FALSE, right = TRUE) } }) ### ========================================================================= ### RangedDataList objects ### ------------------------------------------------------------------------- ### Lists of RangedData objects setClass("RangedDataList", prototype = prototype(elementType = "RangedData"), contains = "SimpleList") RangedDataList <- function(...) { listData <- list(...) if (length(listData) == 1 && is.list(listData[[1L]])) listData <- listData[[1L]] newList("RangedDataList", listData) } setMethod("unlist", "RangedDataList", function(x, recursive = TRUE, use.names = TRUE) { if (!identical(recursive, TRUE)) stop("\"unlist\" method for RangedDataList objects ", "does not support the 'recursive' argument") ans <- do.call(rbind, unname(as.list(x))) if (!use.names) rownames(ans) <- NULL ans }) setMethod("stack", "RangedDataList", function(x, index.var = "name") { rd <- do.call(rbind, unname(as.list(x))) spaces <- unlist(lapply(x, space), use.names=FALSE) ids <- names(x) if (is.null(ids)) ids <- seq_len(length(x)) spaceOrd <- order(factor(spaces, names(rd))) rd[[index.var]] <- rep(factor(ids), sapply(x, nrow))[spaceOrd] rd }) IRanges/R/RangedData-utils.R0000644000126300012640000000642312227064470017152 0ustar00biocbuildphs_compbio### ========================================================================= ### RangedData utilities ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Applying ### setMethod("lapply", "RangedData", function(X, FUN, ...) { FUN <- match.fun(FUN) inds <- structure(seq(length(X)), names = names(X)) lapply(inds, function(i) FUN(X[i], ...)) }) setMethod("endoapply", "RangedData", function(X, FUN, ...) { ans <- try(do.call(c, unname(lapply(X, FUN, ...))), silent = TRUE) if (inherits(ans, "try-error") || (class(ans) != class(X))) stop("'FUN' did not produce an endomorphism") ans }) setGeneric("rdapply", function(x, ...) standardGeneric("rdapply")) setMethod("rdapply", "RDApplyParams", function(x) { rd <- rangedData(x) applyFun <- applyFun(x) applyParams <- applyParams(x) rules <- filterRules(x) simplify <- simplify(x) reducerFun <- reducerFun(x) reducerParams <- reducerParams(x) enclos <- parent.frame(2) inds <- seq(length(rd)) names(inds) <- names(rd) ## if (length(excludePattern)) { ## excludePattern <- grep(excludePattern, names(rd)) ## if (length(excludePattern)) ## inds <- inds[-excludePattern] ## } forEachSpace <- function(i) { rdi <- rd[i] if (length(rules)) { filter <- eval(rules, rdi, enclos) rdi <- rdi[filter,] } do.call(applyFun, c(list(rdi), applyParams)) } iteratorFun <- iteratorFun(x) if ("simplify" %in% names(formals(iteratorFun))) ans <- iteratorFun(inds, forEachSpace, simplify = simplify) else ans <- iteratorFun(inds, forEachSpace) if (!is.null(reducerFun)) ans <- do.call(reducerFun, c(list(ans), reducerParams)) ans }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### within() ### setMethod("within", "RangedData", function(data, expr, ...) { e <- list2env(as.list(as(data, "DataFrame"))) e$ranges <- ranges(data) eval(substitute(expr), e, parent.frame(2)) reserved <- c("ranges", "start", "end", "width", "space") l <- mget(setdiff(ls(e), reserved), e) l <- l[!sapply(l, is.null)] nD <- length(del <- setdiff(colnames(data), (nl <- names(l)))) for (nm in nl) data[[nm]] <- l[[nm]] for (nm in del) data[[nm]] <- NULL if (!identical(ranges(data), e$ranges)) ranges(data) <- e$ranges else { if (!identical(start(data), e$start)) start(data) <- e$start if (!identical(end(data), e$end)) end(data) <- e$end if (!identical(width(data), e$width)) width(data) <- e$width } data }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Merging (TODO) ### #setMethod("merge", "RangedData", # function(x, y, by = 1, all = FALSE, all.x = all, all.y = all, # resolver = intersect, sort = TRUE, suffixes = c(".x",".y")) # { # # }) IRanges/R/RangedSelection-class.R0000644000126300012640000000301512227064470020165 0ustar00biocbuildphs_compbio### ========================================================================= ### Selection of features and columns by intervals and column names ### ------------------------------------------------------------------------- setClass("RangedSelection", representation(ranges = "RangesList", colnames = "character")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("ranges", "RangedSelection", function(x) x@ranges) setReplaceMethod("ranges", "RangedSelection", function(x, value) { x@ranges <- value x }) setMethod("colnames", "RangedSelection", function(x, do.NULL = TRUE, prefix = "col") x@colnames) setReplaceMethod("colnames", "RangedSelection", function(x, value) { x@colnames <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### RangedSelection <- function(ranges = RangesList(), colnames = character()) { if (!is(ranges, "RangesList")) stop("'ranges' must be a RangesList") if (!is.character(colnames) || anyMissing(colnames)) stop("'colnames' must be a character vector without missing values") new("RangedSelection", ranges = ranges, colnames = colnames) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setAs("RangesList", "RangedSelection", function(from) RangedSelection(from)) IRanges/R/Ranges-class.R0000644000126300012640000001650212227064470016343 0ustar00biocbuildphs_compbio### ========================================================================= ### Ranges objects ### ------------------------------------------------------------------------- ### ### Ranges is a virtual class that serves as the base for all range containers ### Conceptually Ranges are closed, one-dimensional intervals with integer end ### points and on the domain of integers. ### setClass("Ranges", contains="IntegerList", representation("VIRTUAL")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The Ranges API (work still very much in progress): ### ### Basic get/set methods: ### length ### start, width, end, names ### start<-, width<-, end<-, names<- ### ### More basic stuff: ### as.matrix, as.data.frame ### as.integer, unlist ### show ### ### Testing a Ranges object: ### isEmpty ### isNormal, whichFirstNotNormal ### ### Core endomorphisms: ### update ### [, [<-, rep ### setMethod("length", "Ranges", function(x) length(start(x))) ### Without this definition, we inherit the method for Vector objects ### which is very inefficient on Ranges objects! setMethod("elementLengths", "Ranges", function(x) width(x)) ### The "start" and "end" generics are defined in the stats package. setGeneric("width", function(x) standardGeneric("width")) ### The 3 default methods below provide a formalization of the relationship ### between the starts/widths/ends of a Ranges object. Of course Ranges ### subclasses need to implement at least 2 of them! ### Note that when width(x)[i] is 0, then end(x)[i] is start(x)[i] - 1 setMethod("start", "Ranges", function(x, ...) {end(x) - width(x) + 1L}) setMethod("width", "Ranges", function(x) {end(x) - start(x) + 1L}) setMethod("end", "Ranges", function(x, ...) {start(x) + width(x) - 1L}) setGeneric("mid", function(x, ...) standardGeneric("mid")) setMethod("mid", "Ranges", function(x) start(x) + as.integer((width(x)-1) / 2)) setGeneric("start<-", signature="x", function(x, check=TRUE, value) standardGeneric("start<-") ) setGeneric("width<-", signature="x", function(x, check=TRUE, value) standardGeneric("width<-") ) setGeneric("end<-", signature="x", function(x, check=TRUE, value) standardGeneric("end<-") ) setMethod("update", "Ranges", function(object, ...) as(update(as(object, "IRanges"), ...), class(object)) ) setMethod("as.matrix", "Ranges", function(x, ...) matrix(data=c(start(x), width(x)), ncol=2, dimnames=list(names(x), NULL)) ) ### S3/S4 combo for as.data.frame.Ranges as.data.frame.Ranges <- function(x, row.names=NULL, optional=FALSE, ...) { if (!(is.null(row.names) || is.character(row.names))) stop("'row.names' must be NULL or a character vector") ans <- data.frame(start=start(x), end=end(x), width=width(x), row.names=row.names, check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) ans$names <- names(x) ans } setMethod("as.data.frame", "Ranges", as.data.frame.Ranges) setMethod("as.integer", "Ranges", function(x, ...) { x <- x[width(x) > 0L] mseq(start(x), end(x)) } ) setMethod("unlist", "Ranges", function(x, recursive=TRUE, use.names=TRUE) { if (!identical(recursive, TRUE)) stop("\"unlist\" method for Ranges objects ", "does not support the 'recursive' argument") if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") ans <- as.integer(x) # 'ans' should have no names stopifnot(is.null(names(ans))) # sanity check if (use.names && !is.null(names(x))) names(ans) <- rep.int(names(x), elementLengths(x)) ans } ) setMethod("getListElement", "Ranges", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=TRUE) ans_shift <- start(x)[i] - 1L ans_length <- width(x)[i] seq_len(ans_length) + ans_shift } ) setMethod("show", "Ranges", function(object) { nhead <- get_showHeadLines() ntail <- get_showTailLines() lo <- length(object) cat(class(object), " of length ", lo, "\n", sep="") if (lo == 0L) return(NULL) if (lo < (nhead + ntail + 1L)) { showme <- as.data.frame(object, row.names=paste0("[", seq_len(lo), "]")) } else { showme <- data.frame(start=.sketch(start(object), nhead, ntail), end=.sketch(end(object), nhead, ntail), width=.sketch(width(object), nhead, ntail), row.names=.sketch(start(object), nhead, ntail, TRUE), check.rows=TRUE, check.names=FALSE, stringsAsFactors=FALSE) NAMES <- names(object) if (!is.null(NAMES)) showme$names <- .sketch(NAMES, nhead, ntail) } show(showme) } ) .sketch <- function(x, nhead, ntail, rownames=FALSE) { len <- length(x) p1 <- ifelse (nhead == 0, 0L, 1L) p2 <- ifelse (ntail == 0, 0L, ntail-1L) s1 <- s2 <- character(0) if (rownames) { if (nhead > 0) s1 <- paste0("[", p1:nhead, "]") if (ntail > 0) s2 <- paste0("[", (len-p2):len, "]") } else { if (nhead > 0) s1 <- paste0(as.character(x[p1:nhead])) if (ntail > 0) s2 <- paste0(as.character(x[(len-p2):len])) } c(s1, "...", s2) } setMethod("showAsCell", "Ranges", function(object) { if (length(object) == 0L) return(character(0)) paste("[", format(start(object)), ", ", format(end(object)), "]", sep = "") } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Testing a Ranges object. ### ### A Ranges object is considered empty iff all its ranges are empty. setMethod("isEmpty", "Ranges", function(x) all(width(x) == 0L)) setGeneric("isNormal", function(x) standardGeneric("isNormal")) setMethod("isNormal", "Ranges", function(x) { all_ok <- all(width(x) >= 1L) if (length(x) >= 2) all_ok <- all_ok && all(start(x)[-1L] - end(x)[-length(x)] >= 2L) all_ok } ) setGeneric("whichFirstNotNormal", function(x) standardGeneric("whichFirstNotNormal") ) setMethod("whichFirstNotNormal", "Ranges", function(x) { is_ok <- width(x) >= 1L if (length(x) >= 2) is_ok <- is_ok & c(TRUE, start(x)[-1L] - end(x)[-length(x)] >= 2L) which(!is_ok)[1L] } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Core endomorphisms. ### ### TODO: "extractROWS" and most of the Ranges endomorphisms are only ### defined for IRanges objects. Need to fix up the update mechanism, so that ### they can be defined on Ranges. "extractROWS" and other endomorphisms ### are currently implemented as wrappers that coerce to IRanges, which is not ### efficient so not a general, long-term solution. setMethod("extractROWS", "Ranges", function(x, i) { as(callGeneric(as(x, "IRanges"), i), class(x)) } ) IRanges/R/Ranges-comparison.R0000644000126300012640000001725412227064470017415 0ustar00biocbuildphs_compbio### ========================================================================= ### Comparing and ordering ranges ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### compare() ### ### Ranges are ordered by starting position first and then by width. ### This way, the space of ranges is totally ordered. ### This "compare" method returns one of the 13 predefined codes (>= -6 and ### <= 6) described in the man page. The signs of those codes reflect this ### order. ### setMethod("compare", c("Ranges", "Ranges"), function(x, y) { .Call2("Ranges_compare", start(x), width(x), start(y), width(y), PACKAGE="IRanges") } ) rangeComparisonCodeToLetter <- function(code) { if (!is.integer(code)) stop("'code' must be an integer vector") code <- code + 7L code[code < 1L | 14L < code] <- 14L levels <- c(letters[1:13], "X") structure(code, levels=levels, class="factor") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### match() ### `%in%.warning.msg` <- function(classname) { msg <- c("Starting with BioC 2.12, the behavior of %%in%% ", "on %s objects\n has changed to use *equality* instead ", "of *overlap* for comparing\n elements between %s objects ", "'x' and 'table'. Now 'x[i]' and \n 'table[j]' are ", "considered to match when they are equal (i.e. 'x[i] ==\n ", "table[j]'), instead of when they overlap. ", "This new behavior is consistent\n with base::`%%in%%`(). ", "If you need the old behavior, please use:\n\n", " query %%over%% subject\n\n ", "If you need the new behavior, you can use suppressWarnings()\n ", "to suppress this warning.") fmt <- paste0(msg, collapse="") sprintf(fmt, classname, classname) } ### TODO: Defunct 'match.if.overlap' arg in BioC 2.14. setMethod("match", c("Ranges", "Ranges"), function(x, table, nomatch=NA_integer_, incomparables=NULL, method=c("auto", "quick", "hash"), match.if.overlap=FALSE) { if (!isSingleNumberOrNA(nomatch)) stop("'nomatch' must be a single number or NA") if (!is.integer(nomatch)) nomatch <- as.integer(nomatch) if (!is.null(incomparables)) stop("\"match\" method for Ranges objects ", "only accepts 'incomparables=NULL'") if (!isTRUEorFALSE(match.if.overlap)) stop("'match.if.overlap' must be TRUE or FALSE") if (match.if.overlap) { msg <- c(" In the near future (starting with BioC 2.14), ", "match() on Ranges objects\n won't support ", "the 'match.if.overlap' argument anymore. Please use\n\n", " findOverlaps(x, table, select=\"first\")\n\n", " instead of\n\n", " match(x, table, match.if.overlap=TRUE)") .Deprecated(msg=msg) ans <- findOverlaps(x, table, select="first") if (!is.na(nomatch) && anyMissing(ans)) ans[is.na(ans)] <- nomatch return(ans) } ## Equivalent to (but faster than): ## findOverlaps(x, table, type="equal", select="first") ## except when 'x' and 'table' both contain empty ranges. matchIntegerPairs(start(x), width(x), start(table), width(table), nomatch=nomatch, method=method) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### selfmatch() ### ### 'match.if.overlap' arg is ignored. ### TODO: Defunct 'match.if.overlap' arg in BioC 2.14. setMethod("selfmatch", "Ranges", function(x, method=c("auto", "quick", "hash"), match.if.overlap=FALSE) selfmatchIntegerPairs(start(x), width(x), method=method) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### duplicated() ### ### duplicated() would normally work out-of-the-box on Ranges objects thanks ### to the method for Vector objects. However the method for AtomicList ### vector is in the way and breaks this grand scheme. So we need to override ### it with a specific method for Ranges objects that calls the method for ### Vector objects. ### ### S3/S4 combo for duplicated.Ranges duplicated.Ranges <- duplicated.Vector setMethod("duplicated", "Ranges", duplicated.Ranges) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### %in% ### ### %in% will work out-of-the-box on Ranges objects thanks to the method ### for Vector objects. ### The only reason for overriding the method for Vector objects is to issue ### the warning. ### TODO: Remove this method in BioC 2.14 when the 'match.if.overlap' arg ### of match() is defunct. ### setMethod("%in%", c("Ranges", "Ranges"), function(x, table) { warning(`%in%.warning.msg`("Ranges")) !is.na(match(x, table)) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### findMatches() & countMatches() ### ### findMatches() & countMatches() will work out-of-the-box on Ranges objects ### thanks to the methods for Vector objects. ### The only reason for defining the 2 methods below is to prevent the ### warnings that otherwise would be issued when the user calls findMatches() ### or countMatches() on Ranges objects. ### TODO: Remove these methods in BioC 2.14 when the 'match.if.overlap' arg ### of match() is defunct. ### setMethod("findMatches", c("Ranges", "Ranges"), function(x, table, select=c("all", "first", "last"), ...) { select <- match.arg(select) if (select != "all") stop("'select' is not supported yet. Note that you can use ", "match() if you want to do 'select=\"first\"'. Otherwise ", "you're welcome to request this on the Bioconductor ", "mailing list.") .findAllMatchesInSmallTable(x, table, match.if.overlap=FALSE, ...) } ) setMethod("countMatches", c("Ranges", "Ranges"), function(x, table, ...) .countMatches.default(x, table, match.if.overlap=FALSE, ...) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### order() and related methods. ### ### The "order" and "rank" methods for Ranges objects are consistent with ### the order implied by compare(). ### setMethod("order", "Ranges", function(..., na.last=TRUE, decreasing=FALSE) { if (!isTRUEorFALSE(decreasing)) stop("'decreasing' must be TRUE or FALSE") ## All arguments in '...' are guaranteed to be Ranges objects. args <- list(...) if (length(args) == 1L) { x <- args[[1L]] return(orderIntegerPairs(start(x), width(x), decreasing=decreasing)) } order_args <- vector("list", 2L*length(args)) idx <- 2L*seq_len(length(args)) order_args[idx - 1L] <- lapply(args, start) order_args[idx] <- lapply(args, width) do.call(order, c(order_args, list(na.last=na.last, decreasing=decreasing))) } ) setMethod("rank", "Ranges", function(x, na.last=TRUE, ties.method=c("average", "first", "random", "max", "min")) { if (!missing(ties.method) && !identical(ties.method, "first")) stop("only 'ties.method=\"first\"' is supported ", "when ranking ranges") oo <- order(x) ## 'ans' is the reverse permutation of 'oo' ans <- integer(length(oo)) ans[oo] <- seq_len(length(oo)) ans } ) IRanges/R/RangesList-class.R0000644000126300012640000006224412227064470017203 0ustar00biocbuildphs_compbio### ========================================================================= ### RangesList objects ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### RangesList ### ### Accepts any type of Ranges object as an element. ### setClass("RangesList", representation("VIRTUAL"), prototype = prototype(elementType = "Ranges"), contains = "List") setClass("SimpleRangesList", prototype = prototype(elementType = "Ranges"), contains = c("RangesList", "SimpleList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### IRangesList ### setClass("IRangesList", representation("VIRTUAL"), prototype = prototype(elementType = "IRanges"), contains = "RangesList") setClass("CompressedIRangesList", prototype = prototype(elementType = "IRanges", unlistData = new("IRanges")), contains = c("IRangesList", "CompressedList")) setClass("SimpleIRangesList", prototype = prototype(elementType = "IRanges"), contains = c("IRangesList", "SimpleRangesList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### NormalIRangesList ### setClass("NormalIRangesList", representation("VIRTUAL"), prototype = prototype(elementType = "NormalIRanges"), contains = "IRangesList") ### CompressedNormalIRangesList cannot hold NormalIRanges as its elements, ### due to the compression combining everything into a single ### NormalIRanges (which could easily become non-normal). So just have it ### hold IRanges, instead. setClass("CompressedNormalIRangesList", prototype = prototype(elementType = "IRanges", unlistData = new("IRanges")), contains = c("NormalIRangesList", "CompressedIRangesList")) setClass("SimpleNormalIRangesList", prototype = prototype(elementType = "NormalIRanges"), contains = c("NormalIRangesList", "SimpleIRangesList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.NormalIRangesList <- function(x) { if (!all(isNormal(x))) return("at least one element of object is not normal") NULL } setValidity2("NormalIRangesList", .valid.NormalIRangesList) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("start", "RangesList", function(x) newList("SimpleIntegerList", lapply(x, start))) setMethod("end", "RangesList", function(x) newList("SimpleIntegerList", lapply(x, end))) setMethod("width", "RangesList", function(x) newList("SimpleIntegerList", lapply(x, width))) setGeneric(".SEW<-", signature="x", # not exported function(x, FUN, check=TRUE, value) standardGeneric(".SEW<-")) setReplaceMethod(".SEW", "RangesList", function(x, FUN, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") if (extends(class(value), "IntegerList")) { if (!identical(lapply(x, names), lapply(value, names)) && !all(elementLengths(x) == elementLengths(value))) stop("'value' must have same length and names as current 'ranges'") } else if (is.numeric(value)) { lelts <- sum(elementLengths(x)) if (lelts != length(value)) value <- rep(value, length.out = lelts) if (!is.integer(value)) value <- as.integer(value) value <- split(value, factor(space(x), names(x))) } else { stop("'value' must extend class IntegerList or integer") } FUN <- match.fun(FUN) for (i in seq_len(length(x))) x[[i]] <- FUN(x[[i]], check = check, value = value[[i]]) x }) setReplaceMethod("start", "RangesList", function(x, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") .SEW(x, FUN = "start<-", check = check) <- value x }) setReplaceMethod("end", "RangesList", function(x, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") .SEW(x, FUN = "end<-", check = check) <- value x }) setReplaceMethod("width", "RangesList", function(x, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") .SEW(x, FUN = "width<-", check = check) <- value x }) setMethod("start", "CompressedIRangesList", function(x) new2("CompressedIntegerList", unlistData = start(unlist(x, use.names=FALSE)), partitioning = x@partitioning, check=FALSE)) setMethod("end", "CompressedIRangesList", function(x) new2("CompressedIntegerList", unlistData = end(unlist(x, use.names=FALSE)), partitioning = x@partitioning, check=FALSE)) setMethod("width", "CompressedIRangesList", function(x) new2("CompressedIntegerList", unlistData = width(unlist(x, use.names=FALSE)), partitioning = x@partitioning, check=FALSE)) setReplaceMethod(".SEW", "CompressedIRangesList", function(x, FUN, check=TRUE, value) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") if (extends(class(value), "IntegerList")) { if (!identical(lapply(x, names), lapply(value, names)) && !all(elementLengths(x) == elementLengths(value))) stop("'value' must have same length and names as current 'ranges'") value <- unlist(value) } else if (is.numeric(value)) { lelts <- sum(elementLengths(x)) if (lelts != length(value)) value <- rep(value, length.out = lelts) if (!is.integer(value)) value <- as.integer(value) } else { stop("'value' must extend class IntegerList or integer") } FUN <- match.fun(FUN) slot(x, "unlistData", check=FALSE) <- FUN(x@unlistData, check = check, value = value) x }) setGeneric("space", function(x, ...) standardGeneric("space")) setMethod("space", "RangesList", function(x) { space <- names(x) if (!is.null(space)) space <- factor(rep.int(space, elementLengths(x)), space) space }) ### TODO: Why not define this at the List level? Or even at the Vector level? setGeneric("universe", function(x) standardGeneric("universe")) setMethod("universe", "RangesList", function(x) { metadata(x)$universe }) setGeneric("universe<-", function(x, value) standardGeneric("universe<-")) setReplaceMethod("universe", "RangesList", function(x, value) { if (!is.null(value) && !isSingleString(value)) stop("'value' must be a single string or NULL") metadata(x)$universe <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Testing a RangesList object. ### setMethod("isNormal", "RangesList", function(x) unlist(lapply(x, isNormal))) setMethod("isNormal", "CompressedIRangesList", function(x) .Call2("CompressedIRangesList_isNormal", x, TRUE, PACKAGE = "IRanges")) setMethod("isNormal", "SimpleIRangesList", function(x) .Call2("SimpleIRangesList_isNormal", x, PACKAGE = "IRanges")) setMethod("whichFirstNotNormal", "RangesList", function(x) unlist(lapply(x, whichFirstNotNormal))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### RangesList <- function(..., universe = NULL) { if (!is.null(universe) && !isSingleString(universe)) stop("'universe' must be a single string or NULL") ranges <- list(...) if (length(ranges) == 1 && is.list(ranges[[1L]])) ranges <- ranges[[1L]] if (!all(sapply(ranges, is, "Ranges"))) stop("all elements in '...' must be Ranges objects") ans <- newList("SimpleRangesList", ranges) universe(ans) <- universe ans } IRangesList <- function(..., universe = NULL, compress = TRUE) { if (!isTRUEorFALSE(compress)) stop("'compress' must be TRUE or FALSE") if (!is.null(universe) && !isSingleString(universe)) stop("'universe' must be a single string or NULL") ranges <- list(...) if (length(ranges) == 1 && (is(ranges[[1L]], "LogicalList") || is(ranges[[1L]], "RleList"))) { if (compress) ans <- as(ranges[[1L]], "CompressedIRangesList") else ans <- as(ranges[[1L]], "SimpleIRangesList") } else if (length(ranges) == 2 && setequal(names(ranges), c("start", "end")) && !is(ranges[[1L]], "Ranges") && !is(ranges[[2L]], "Ranges")) { if (!compress) stop("'compress' must be TRUE when passing the 'start' and 'end' arguments") ans_start <- IntegerList(ranges[["start"]], compress = TRUE) ans_end <- IntegerList(ranges[["end"]], compress = TRUE) if (!identical(ans_start@partitioning@end, ans_end@partitioning@end)) stop("'start' and 'end' are not compatible") ans_partitioning <- ans_start@partitioning ans_unlistData <- IRanges(start=ans_start@unlistData, end=ans_end@unlistData) ans <- new2("CompressedIRangesList", partitioning=ans_partitioning, unlistData=ans_unlistData, check=FALSE) } else { if (length(ranges) == 1 && is.list(ranges[[1L]])) ranges <- ranges[[1L]] if (!all(sapply(ranges, is, "IRanges"))) stop("all elements in '...' must be IRanges objects") if (compress) ans <- newList("CompressedIRangesList", ranges) else ans <- newList("SimpleIRangesList", ranges) } universe(ans) <- universe ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### ### Support subsetting by another RangesList rangesListSingleSquareBracket <- function(x, i, j, ..., drop) { if (!missing(j) || length(list(...)) > 0) stop("invalid subsetting") if (missing(i)) return(x) if (is(i, "RangesList")) stop("'[' subsetting by RangesList is defunct.\n", "Use 'subsetByOverlaps' instead.") callNextMethod(x, i) } setMethod("[", "SimpleRangesList", rangesListSingleSquareBracket) setMethod("[", "CompressedIRangesList", rangesListSingleSquareBracket) setMethod("[", "SimpleIRangesList", rangesListSingleSquareBracket) setMethod("getListElement", "CompressedNormalIRangesList", function(x, i, exact=TRUE) newNormalIRangesFromIRanges(callNextMethod()) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### merge() ### ### Merges various RangesList objects into a single RangesList object. ### The merging is either by name (if all the RangesList objects have names), ### or by position (if any RangesList object is missing names). ### When merging by name, and in case of duplicated names within a given ### RangesList, the elements corresponding to the duplicated names are ignored. ### When merging by position, all the RangesList objects must have the same ### length. ### Note that the "range" method for RangesList objects expects "merge" to ### behave like this. .RangesList.merge <- function(...) { args <- unname(list(...)) if (length(args) == 0L) stop("nothing to merge") x <- args[[1L]] if (!all(sapply(sapply(args, universe), identical, universe(x)))) stop("all RangesList objects to merge must have the same universe") spaceList <- lapply(args, names) names <- spaces <- unique(do.call(c, spaceList)) if (any(sapply(spaceList, is.null))) { ## Merging by position. if (!all(unlist(lapply(args, length)) == length(x))) stop("if any RangesList objects to merge are missing names, ", "all must have same length") names <- NULL spaces <- seq_len(length(x)) } ranges <- lapply(spaces, function(space) { r <- lapply(args, `[[`, space) do.call(c, r[!sapply(r, is.null)]) }) names(ranges) <- names newList(class(x), ranges) } setMethod("merge", c("RangesList", "missing"), function(x, y, ...) .RangesList.merge(x, ...) ) setMethod("merge", c("missing", "RangesList"), function(x, y, ...) .RangesList.merge(y, ...) ) setMethod("merge", c("RangesList", "RangesList"), function(x, y, ...) .RangesList.merge(x, y, ...) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### showRangesList <- function(x, with.header=TRUE) { x_len <- length(x) if (with.header) cat(classNameForDisplay(x), " of length ", x_len, "\n", sep = "") if (x_len == 0L) return(invisible(NULL)) cumsumN <- end(PartitioningByEnd(x)) N <- tail(cumsumN, 1) if (x_len <= 5L && N <= 20L) { show(as.list(x)) return(invisible(NULL)) } if (x_len >= 3L && cumsumN[3L] <= 20L) { showK <- 3L } else if (x_len >= 2L && cumsumN[2L] <= 20L) { showK <- 2L } else { showK <- 1L } show(as.list(x[seq_len(showK)])) diffK <- x_len - showK if (diffK > 0L) cat("...\n<", x_len - showK, ifelse(diffK == 1L, " more element>\n", " more elements>\n"), sep="") } setMethod("show", "RangesList", function(object) showRangesList(object)) setMethod("showAsCell", "RangesList", function(object) { unlist(lapply(object, function(x) { if (length(x) <= 3) paste(showAsCell(x), collapse = " ") else paste(c(showAsCell(head(x, 3)), "..."), collapse = " ") }), use.names = FALSE) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ### S3/S4 combo for as.data.frame.RangesList as.data.frame.RangesList <- function(x, row.names=NULL, optional=FALSE, ...) { if (!(is.null(row.names) || is.character(row.names))) stop("'row.names' must be NULL or a character vector") x <- as(x, "CompressedIRangesList") spaceLevels <- seq_len(length(x)) if (length(names(x)) > 0) { spaceLabels <- names(x) } else { spaceLabels <- as.character(spaceLevels) } data.frame(space = factor(rep.int(seq_len(length(x)), elementLengths(x)), levels = spaceLevels, labels = spaceLabels), as.data.frame(unlist(x, use.names = FALSE)), row.names = row.names, stringsAsFactors = FALSE) } setMethod("as.data.frame", "RangesList", as.data.frame.RangesList) .as.list.CompressedNormalIRangesList <- function(x, use.names = TRUE) { .CompressedList.list.subscript(X = x, INDEX = seq_len(length(x)), USE.NAMES = use.names, FUN = newNormalIRangesFromIRanges, COMPRESS = FALSE) } ### S3/S4 combo for as.list.CompressedNormalIRangesList as.list.CompressedNormalIRangesList <- function(x, ...) .as.list.CompressedNormalIRangesList(x, ...) setMethod("as.list", "CompressedNormalIRangesList", as.list.CompressedNormalIRangesList) setMethod("unlist", "SimpleNormalIRangesList", function(x, recursive = TRUE, use.names = TRUE) { x <- newList("SimpleIRangesList", lapply(x, as, "IRanges")) callGeneric() }) setAs("RangesList", "IRangesList", function(from) { if (is(from, "CompressedList")) as(from, "CompressedIRangesList") else as(from, "SimpleIRangesList") }) setAs("RangesList", "CompressedIRangesList", function(from) { if (is(from, "CompressedList")) coerceToCompressedList(from, "IRanges") ## this case handles RangesList of Partitioning objects (not combinable) else newList("CompressedIRangesList", lapply(from, as, "IRanges"), metadata = metadata(from), mcols = mcols(from)) }) .RangesListToSimpleIRangesList <- function(from) newList("SimpleIRangesList", lapply(from, as, "IRanges"), metadata = metadata(from), mcols = mcols(from)) ## otherwise, SimpleRangesList->SimpleIRangesList uses a methods package default setAs("SimpleRangesList", "SimpleIRangesList", .RangesListToSimpleIRangesList) setAs("RangesList", "SimpleIRangesList", .RangesListToSimpleIRangesList) setAs("RangesList", "SimpleRangesList", function(from) newList("SimpleRangesList", lapply(from, as, "Ranges"), metadata = metadata(from), mcols = mcols(from))) setAs("RangesList", "NormalIRangesList", function(from) { if (is(from, "CompressedList")) as(from, "CompressedNormalIRangesList") else as(from, "SimpleNormalIRangesList") }) setAs("RangesList", "CompressedNormalIRangesList", function(from) newList("CompressedNormalIRangesList", lapply(from, as, "NormalIRanges"), metadata = metadata(from), mcols = mcols(from))) setAs("RangesList", "SimpleNormalIRangesList", function(from) newList("SimpleNormalIRangesList", lapply(from, as, "NormalIRanges"), metadata = metadata(from), mcols = mcols(from))) setAs("CompressedIRangesList", "CompressedNormalIRangesList", function(from) { if (!all(isNormal(from))) from <- reduce(from, drop.empty.ranges=TRUE) new2("CompressedNormalIRangesList", from, check=FALSE) }) setAs("SimpleIRangesList", "SimpleNormalIRangesList", function(from) { if (!all(isNormal(from))) from <- reduce(from, drop.empty.ranges=TRUE) new2("SimpleNormalIRangesList", listData = lapply(from@listData, newNormalIRangesFromIRanges, check = FALSE), metadata = from@metadata, elementMetadata = from@elementMetadata, check=FALSE) }) setAs("LogicalList", "IRangesList", function(from) { if (is(from, "CompressedList")) as(from, "CompressedIRangesList") else as(from, "SimpleIRangesList") }) setAs("LogicalList", "CompressedIRangesList", function(from) newList("CompressedIRangesList", lapply(from, as, "IRanges"), metadata = metadata(from), mcols = mcols(from))) setAs("LogicalList", "SimpleIRangesList", function(from) newList("SimpleIRangesList", lapply(from, as, "IRanges"), metadata = metadata(from), mcols = mcols(from))) setAs("LogicalList", "NormalIRangesList", function(from) { if (is(from, "CompressedList")) as(from, "CompressedNormalIRangesList") else as(from, "SimpleNormalIRangesList") }) setAs("LogicalList", "CompressedNormalIRangesList", function(from) newList("CompressedNormalIRangesList", lapply(from, as, "NormalIRanges"), metadata = metadata(from), mcols = mcols(from))) setAs("LogicalList", "SimpleNormalIRangesList", function(from) newList("SimpleNormalIRangesList", lapply(from, as, "NormalIRanges"), metadata = metadata(from), mcols = mcols(from))) setAs("RleList", "IRangesList", function(from) { if (is(from, "CompressedList")) as(from, "CompressedIRangesList") else as(from, "SimpleIRangesList") }) setAs("RleList", "CompressedIRangesList", function(from) { if ((length(from) > 0) && (!is.logical(runValue(from[[1L]])) || anyMissing(runValue(from[[1L]])))) stop("cannot coerce a non-logical 'RleList' or a logical 'RleList' ", "with NAs to a CompressedIRangesList object") newList("CompressedIRangesList", lapply(from, as, "IRanges"), metadata = metadata(from), mcols = mcols(from)) }) setAs("CompressedRleList", "CompressedIRangesList", function(from) { if ((length(from) > 0) && (!is.logical(runValue(from[[1L]])) || anyMissing(runValue(from[[1L]])))) stop("cannot coerce a non-logical 'RleList' or a logical 'RleList' ", "with NAs to a CompressedIRangesList object") ranges <- as(unlist(from, use.names = FALSE), "IRanges") to <- diceRangesByList(ranges, from) metadata(to) <- metadata(from) mcols(to) <- mcols(from) to }) setAs("RleList", "SimpleIRangesList", function(from) { if ((length(from) > 0) && (!is.logical(runValue(from[[1L]])) || anyMissing(runValue(from[[1L]])))) stop("cannot coerce a non-logical 'RleList' or a logical 'RleList' ", "with NAs to a SimpleIRangesList object") newList("SimpleIRangesList", lapply(from, as, "IRanges"), metadata = metadata(from), mcols = mcols(from)) }) setAs("RleList", "NormalIRangesList", function(from) { if (is(from, "CompressedList")) as(from, "CompressedNormalIRangesList") else as(from, "SimpleNormalIRangesList") }) setAs("RleList", "CompressedNormalIRangesList", function(from) { if ((length(from) > 0) && (!is.logical(runValue(from[[1L]])) || anyMissing(runValue(from[[1L]])))) stop("cannot coerce a non-logical 'RleList' or a logical 'RleList' ", "with NAs to a CompressedNormalIRangesList object") newList("CompressedNormalIRangesList", lapply(from, as, "NormalIRanges"), metadata = metadata(from), mcols = mcols(from)) }) setAs("RleList", "SimpleNormalIRangesList", function(from) { if ((length(from) > 0) && (!is.logical(runValue(from[[1L]])) || anyMissing(runValue(from[[1L]])))) stop("cannot coerce a non-logical 'RleList' or a logical 'RleList' ", "with NAs to a SimpleNormalIRangesList object") newList("SimpleNormalIRangesList", lapply(from, as, "NormalIRanges"), metadata = metadata(from), mcols = mcols(from)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "max" and "min" methods for NormalIRangesList objects. ### CompressedNormalIRangesList.max <- function(x, use.names) { if (!is(x, "CompressedNormalIRangesList")) stop("'x' must be a CompressedNormalIRangesList object") use.names <- normargUseNames(use.names) .Call2("CompressedNormalIRangesList_max", x, use.names, PACKAGE="IRanges") } setMethod("max", "CompressedNormalIRangesList", function(x, ..., na.rm) CompressedNormalIRangesList.max(x, TRUE)) setMethod("max", "SimpleNormalIRangesList", function(x, ..., na.rm) .Call2("SimpleNormalIRangesList_max", x, PACKAGE="IRanges")) CompressedNormalIRangesList.min <- function(x, use.names) { if (!is(x, "CompressedNormalIRangesList")) stop("'x' must be a CompressedNormalIRangesList object") use.names <- normargUseNames(use.names) .Call2("CompressedNormalIRangesList_min", x, use.names, PACKAGE="IRanges") } setMethod("min", "CompressedNormalIRangesList", function(x, ..., na.rm) CompressedNormalIRangesList.min(x, TRUE)) setMethod("min", "SimpleNormalIRangesList", function(x, ..., na.rm) .Call2("SimpleNormalIRangesList_min", x, PACKAGE="IRanges")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "summary" method. ### setMethod("summary", "CompressedIRangesList", function(object) .Call2("CompressedIRangesList_summary", object, PACKAGE="IRanges")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Splitting. ### ### Seems broken to me. We probably don't need this anyway! #setMethod("split", "Ranges", # function(x, f, drop = FALSE, ...) # do.call(RangesList, callNextMethod())) IRanges/R/RangesMapping-class.R0000644000126300012640000000371412227064470017660 0ustar00biocbuildphs_compbio### ========================================================================= ### RangesMapping objects ### ------------------------------------------------------------------------- ### ### A RangesMapping encodes a mapping of a set of ranges to some other ### coordinate space. ### ## Conceptually, a RangesMapping is a matching of each query range to ## one or more elements in a subject. The geometry of the query range ## is then transformed according to that matching. Thus, this data ## class combines a Hits object with a set of transformed ranges. ## In IRanges, we do not have any tabular structure that links a space ## with an interval, except for RangedData. We could use a RangedData ## in place of this class, but that might be too low-level. Instead, ## we have an accessor for each, and support a coercion. setClass("RangesMapping", representation(hits = "Hits", space = "Rle", ranges = "Ranges")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessors ### hits <- function(x) x@hits setMethod("space", "RangesMapping", function(x) x@space) setMethod("ranges", "RangesMapping", function(x) x@ranges) setMethod("dim", "RangesMapping", function(x) dim(hits(x))) setMethod("length", "RangesMapping", function(x) length(ranges(x))) setMethod("subjectHits", "RangesMapping", function(x) subjectHits(hits(x))) setMethod("queryHits", "RangesMapping", function(x) queryHits(hits(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### setAs("RangesMapping", "RangedData", function(from) { RangedData(ranges(from), space = space(from), as(hits(from), "DataFrame")) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The 'map' generic, methods of which produce instances of this class ### setGeneric("map", function(from, to, ...) standardGeneric("map")) setGeneric("pmap", function(from, to, ...) standardGeneric("pmap")) IRanges/R/Rle-class.R0000644000126300012640000015347012227064470015654 0ustar00biocbuildphs_compbio### ========================================================================= ### Rle objects ### ------------------------------------------------------------------------- ### ### Class definitions ### setClass("Rle", representation(values = "vectorORfactor", lengths = "integer"), prototype = prototype(values = logical()), contains = "Vector", validity = function(object) { msg <- NULL run_values <- runValue(object) run_lengths <- runLength(object) if (length(run_values) != length(run_lengths)) msg <- c(msg, "run values and run lengths must have the same length") if (!all(run_lengths > 0L)) msg <- c(msg, "all run lengths must be positive") ## TODO: Fix the following test. #if (length(run_lengths) >= 2 && is.atomic(run_values) # && any(run_values[-1L] == run_values[-length(run_values)])) # msg <- c(msg, "consecutive runs must have different values") if (is.null(msg)) TRUE else msg }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setGeneric("runLength", signature = "x", function(x) standardGeneric("runLength")) setMethod("runLength", "Rle", function(x) x@lengths) setGeneric("runValue", signature = "x", function(x) standardGeneric("runValue")) setMethod("runValue", "Rle", function(x) x@values) setGeneric("nrun", signature = "x", function(x) standardGeneric("nrun")) setMethod("nrun", "Rle", function(x) length(runLength(x))) setMethod("start", "Rle", function(x) .Call2("Rle_start", x, PACKAGE="IRanges")) setMethod("end", "Rle", function(x) .Call2("Rle_end", x, PACKAGE="IRanges")) setMethod("width", "Rle", function(x) runLength(x)) setMethod("ranges", "Rle", function(x) IRanges(start(x), width = width(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Replace methods. ### setGeneric("runLength<-", signature="x", function(x, value) standardGeneric("runLength<-")) setReplaceMethod("runLength", "Rle", function(x, value) Rle(values = runValue(x), lengths = value)) setGeneric("runValue<-", signature="x", function(x, value) standardGeneric("runValue<-")) setReplaceMethod("runValue", "Rle", function(x, value) Rle(values = value, lengths = runLength(x))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructors ### setGeneric("Rle", signature = c("values", "lengths"), function(values, lengths, ...) standardGeneric("Rle")) setMethod("Rle", signature = c(values = "missing", lengths = "missing"), function(values, lengths) new2("Rle", values = vector(), lengths = integer(), check=FALSE)) setMethod("Rle", signature = c(values = "vectorORfactor", lengths = "missing"), function(values, lengths) Rle(values, integer(0), check = FALSE)) setMethod("Rle", signature = c(values = "vectorORfactor", lengths = "integer"), function(values, lengths, check = TRUE) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") ans <- .Call2("Rle_constructor", values, lengths, check, 0L, PACKAGE="IRanges") if (is.factor(values)) { ans@values <- factor(ans@values, levels = seq_len(length(levels(values))), labels = levels(values)) } ans }) setMethod("Rle", signature = c(values = "vectorORfactor", lengths = "numeric"), function(values, lengths, check = TRUE) Rle(values = values, lengths = as.integer(lengths), check = check)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### setAs("vector", "Rle", function(from) Rle(from)) setAs("logical", "Rle", function(from) Rle(from)) setAs("integer", "Rle", function(from) Rle(from)) setAs("numeric", "Rle", function(from) Rle(from)) setAs("complex", "Rle", function(from) Rle(from)) setAs("character", "Rle", function(from) Rle(from)) setAs("raw", "Rle", function(from) Rle(from)) setAs("factor", "Rle", function(from) Rle(from)) setAs("Rle", "vector", function(from) as.vector(from)) setAs("Rle", "logical", function(from) as.logical(from)) setAs("Rle", "integer", function(from) as.integer(from)) setAs("Rle", "numeric", function(from) as.numeric(from)) setAs("Rle", "complex", function(from) as.complex(from)) setAs("Rle", "character", function(from) as.character(from)) setAs("Rle", "raw", function(from) as.raw(from)) setAs("Rle", "factor", function(from) as.factor(from)) setAs("Rle", "list", function(from) as.list(from)) setAs("Rle", "data.frame", function(from) as.data.frame(from)) setAs("Rle", "IRanges", function(from) { if (!is.logical(runValue(from)) || anyMissing(runValue(from))) stop("cannot coerce a non-logical 'Rle' or a logical 'Rle' ", "with NAs to an IRanges object") keep <- runValue(from) ## The returned IRanges instance is guaranteed to be normal. ans_start <- start(from)[keep] ans_width <- runLength(from)[keep] new2("IRanges", start=ans_start, width=ans_width, check=FALSE) }) setAs("Rle", "NormalIRanges", function(from) newNormalIRangesFromIRanges(as(from, "IRanges"), check=FALSE)) setMethod("as.vector", "Rle", function(x, mode) rep.int(as.vector(runValue(x), mode), runLength(x))) setMethod("as.logical", "Rle", function(x) rep.int(as.logical(runValue(x)), runLength(x))) setMethod("as.integer", "Rle", function(x) rep.int(as.integer(runValue(x)), runLength(x))) setMethod("as.numeric", "Rle", function(x) rep.int(as.numeric(runValue(x)), runLength(x))) setMethod("as.complex", "Rle", function(x) rep.int(as.complex(runValue(x)), runLength(x))) setMethod("as.character", "Rle", function(x) rep.int(as.character(runValue(x)), runLength(x))) setMethod("as.raw", "Rle", function(x) rep.int(as.raw(runValue(x)), runLength(x))) setMethod("as.factor", "Rle", function(x) rep.int(as.factor(runValue(x)), runLength(x))) ### S3/S4 combo for as.list.Rle .as.list.Rle <- function(x) as.list(as.vector(x)) as.list.Rle <- function(x, ...) .as.list.Rle(x, ...) setMethod("as.list", "Rle", as.list.Rle) decodeRle <- function(x) rep.int(runValue(x), runLength(x)) ### S3/S4 combo for as.data.frame.Rle as.data.frame.Rle <- function(x, row.names=NULL, optional=FALSE, ...) { value <- decodeRle(x) as.data.frame(value, row.names=row.names, optional=optional, ...) } setMethod("as.data.frame", "Rle", as.data.frame.Rle) getStartEndRunAndOffset <- function(x, start, end) { .Call2("Rle_getStartEndRunAndOffset", x, start, end, PACKAGE="IRanges") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Group generic methods ### .sumprodRle <- function(e1, e2, na.rm = FALSE) { n1 <- length(e1) n2 <- length(e2) if (n1 == 0 || n2 == 0) { ends <- integer(0) which1 <- integer(0) which2 <- integer(0) } else { n <- max(n1, n2) if (max(n1, n2) %% min(n1, n2) != 0) warning("longer object length is not a multiple of shorter object length") if (n1 < n) e1 <- rep(e1, length.out = n) if (n2 < n) e2 <- rep(e2, length.out = n) # ends <- sort(unique(c(end(e1), end(e2)))) ends <- sortedMerge(end(e1), end(e2)) which1 <- findIntervalAndStartFromWidth(ends, runLength(e1))[["interval"]] which2 <- findIntervalAndStartFromWidth(ends, runLength(e2))[["interval"]] } lengths <- diffWithInitialZero(ends) values <- runValue(e1)[which1] * runValue(e2)[which2] sum(lengths * values, na.rm = na.rm) } setMethod("Ops", signature(e1 = "Rle", e2 = "Rle"), function(e1, e2) { n1 <- length(e1) n2 <- length(e2) if (n1 == 0 || n2 == 0) { ends <- integer(0) which1 <- integer(0) which2 <- integer(0) } else { n <- max(n1, n2) if (max(n1, n2) %% min(n1, n2) != 0) warning("longer object length is not a multiple of shorter object length") if (n1 < n) e1 <- rep(e1, length.out = n) if (n2 < n) e2 <- rep(e2, length.out = n) # ends <- sort(unique(c(end(e1), end(e2)))) ends <- sortedMerge(end(e1), end(e2)) which1 <- findIntervalAndStartFromWidth(ends, runLength(e1))[["interval"]] which2 <- findIntervalAndStartFromWidth(ends, runLength(e2))[["interval"]] } Rle(values = callGeneric(runValue(e1)[which1], runValue(e2)[which2]), lengths = diffWithInitialZero(ends), check = FALSE) }) setMethod("Ops", signature(e1 = "Rle", e2 = "vector"), function(e1, e2) callGeneric(e1, Rle(e2))) setMethod("Ops", signature(e1 = "vector", e2 = "Rle"), function(e1, e2) callGeneric(Rle(e1), e2)) setMethod("Math", "Rle", function(x) switch(.Generic, cumsum = { whichZero <- which(runValue(x) == 0) widthZero <- runLength(x)[whichZero] startZero <- cumsum(c(1L, runLength(x)))[whichZero] y <- x y@lengths[y@values == 0] <- 1L values <- cumsum(as.vector(y)) lengths <- rep.int(1L, length(values)) lengths[startZero - c(0L, cumsum(head(widthZero, -1) - 1L))] <- widthZero Rle(values = values, lengths = lengths, check = FALSE) }, cumprod = { whichOne <- which(runValue(x) == 0) widthOne <- runLength(x)[whichOne] startOne <- cumsum(c(1L, runLength(x)))[whichOne] y <- x y@lengths[y@values == 0] <- 1L values <- cumprod(as.vector(y)) lengths <- rep.int(1L, length(values)) lengths[startOne - c(0L, cumsum(head(widthOne, -1) - 1L))] <- widthOne Rle(values = values, lengths = lengths, check = FALSE) }, Rle(values = callGeneric(runValue(x)), lengths = runLength(x), check = FALSE))) setMethod("Math2", "Rle", function(x, digits) { if (missing(digits)) digits <- ifelse(.Generic == "round", 0, 6) Rle(values = callGeneric(runValue(x), digits = digits), lengths = runLength(x), check = FALSE) }) setMethod("Summary", "Rle", function(x, ..., na.rm = FALSE) { switch(.Generic, all =, any =, min =, max =, range = callGeneric(runValue(x), ..., na.rm=na.rm), sum = withCallingHandlers({ sum(runValue(x) * runLength(x), ..., na.rm=na.rm) }, warning=function(warn) { msg <- conditionMessage(warn) exp <- gettext("integer overflow - use sum(as.numeric(.))", domain="R") if (msg == exp) { msg <- sub("sum\\(as.numeric\\(.\\)\\)", "runValue(.) <- as.numeric(runValue(.))", msg) warning(simpleWarning(msg, conditionCall(warn))) invokeRestart("muffleWarning") } else { warn } }), prod = prod(runValue(x) ^ runLength(x), ..., na.rm=na.rm)) } ) setMethod("Complex", "Rle", function(z) Rle(values = callGeneric(runValue(z)), lengths = runLength(z), check = FALSE)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### General methods ### setMethod("extractROWS", "Rle", function(x, i) { if (!is(i, "Ranges")) { i <- normalizeSingleBracketSubscript(i, x) i <- as(i, "IRanges") } i <- i[width(i) != 0L] ansList <- .Call2("Rle_seqselect", x, start(i), width(i), PACKAGE="IRanges") ans_values <- ansList[["values"]] ans_lengths <- ansList[["lengths"]] if (is.factor(runValue(x))) attributes(ans_values) <- list(levels=levels(x), class="factor") ans <- Rle(ans_values, ans_lengths) ans <- as(ans, class(x)) mcols(ans) <- extractROWS(mcols(ans), i) ans } ) setMethod("[", "Rle", function(x, i, j, ..., drop=getOption("dropRle", default=FALSE)) { if (!missing(j) || length(list(...)) > 0) stop("invalid subsetting") if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) ans <- extractROWS(x, i) if (drop) ans <- decodeRle(ans) ans } ) setMethod("replaceROWS", "Rle", function(x, i, value) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) lv <- length(value) if (lv != 1L) { x <- decodeRle(x) if (is(i, "Ranges")) i <- as.integer(i) value <- as.vector(value) x[i] <- value return(Rle(x)) } ## From here, 'value' is guaranteed to be of length 1. if (!is(i, "Ranges")) i <- as(i, "IRanges") ir <- reduce(i) if (length(ir) == 0L) return(x) isFactorRle <- is.factor(runValue(x)) value <- normalizeSingleBracketReplacementValue(value, x) value <- as.vector(value) if (isFactorRle) { value <- factor(value, levels=levels(x)) dummy_value <- factor(levels(x), levels=levels(x)) } if (anyMissingOrOutside(start(ir), 1L, length(x)) || anyMissingOrOutside(end(ir), 1L, length(x))) stop("some ranges are out of bounds") valueWidths <- width(ir) ir <- gaps(ir, start=1, end=length(x)) k <- length(ir) start <- start(ir) end <- end(ir) info <- getStartEndRunAndOffset(x, start, end) runStart <- info[["start"]][["run"]] offsetStart <- info[["start"]][["offset"]] runEnd <- info[["end"]][["run"]] offsetEnd <- info[["end"]][["offset"]] if ((length(ir) == 0L) || (start(ir)[1L] != 1L)) { k <- k + 1L runStart <- c(1L, runStart) offsetStart <- c(0L, offsetStart) runEnd <- c(0L, runEnd) offsetEnd <- c(0L, offsetEnd) } if ((length(ir) > 0L) && (end(ir[length(ir)]) != length(x))) { k <- k + 1L runStart <- c(runStart, 1L) offsetStart <- c(offsetStart, 0L) runEnd <- c(runEnd, 0L) offsetEnd <- c(offsetEnd, 0L) } subseqs <- vector("list", length(valueWidths) + k) if (k > 0L) { if (isFactorRle) { subseqs[seq(1L, length(subseqs), by=2L)] <- lapply(seq_len(k), function(i) { ans <- .Call2("Rle_window_aslist", x, runStart[i], runEnd[i], offsetStart[i], offsetEnd[i], PACKAGE="IRanges") ans[["values"]] <- dummy_value[ans[["values"]]] ans}) } else { subseqs[seq(1L, length(subseqs), by=2L)] <- lapply(seq_len(k), function(i) .Call2("Rle_window_aslist", x, runStart[i], runEnd[i], offsetStart[i], offsetEnd[i], PACKAGE="IRanges")) } } if (length(valueWidths) > 0L) { subseqs[seq(2L, length(subseqs), by=2L)] <- lapply(seq_len(length(valueWidths)), function(i) list(values=value, lengths=valueWidths[i])) } values <- unlist(lapply(subseqs, "[[", "values")) if (isFactorRle) values <- dummy_value[values] Rle(values=values, lengths=unlist(lapply(subseqs, "[[", "lengths"))) } ) setReplaceMethod("[", "Rle", function(x, i, j,..., value) { if (!missing(j) || length(list(...)) > 0L) stop("invalid subsetting") if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) if (is(i, "Ranges")) li <- sum(width(i)) else li <- length(i) if (li == 0L) { ## Surprisingly, in that case, `[<-` on standard vectors does not ## even look at 'value'. So neither do we... return(x) } lv <- length(value) if (lv == 0L) stop("replacement has length zero") replaceROWS(x, i, value) } ) setMethod("%in%", "Rle", function(x, table) Rle(values = runValue(x) %in% table, lengths = runLength(x), check = FALSE)) ### S3/S4 combo for aggregate.Rle aggregate.Rle <- function(x, by, FUN, start=NULL, end=NULL, width=NULL, frequency=NULL, delta=NULL, ..., simplify=TRUE) { FUN <- match.fun(FUN) if (!missing(by)) { start <- start(by) end <- end(by) } else { if (!is.null(width)) { if (is.null(start)) start <- end - width + 1L else if (is.null(end)) end <- start + width - 1L } start <- as(start, "integer") end <- as(end, "integer") } if (length(start) != length(end)) stop("'start', 'end', and 'width' arguments have unequal length") n <- length(start) if (!is.null(names(start))) indices <- structure(seq_len(n), names = names(start)) else indices <- structure(seq_len(n), names = names(end)) if (is.null(frequency) && is.null(delta)) { info <- getStartEndRunAndOffset(x, start, end) runStart <- info[["start"]][["run"]] offsetStart <- info[["start"]][["offset"]] runEnd <- info[["end"]][["run"]] offsetEnd <- info[["end"]][["offset"]] ## Performance Optimization ## Use a stripped down loop with empty Rle object newRle <- new(class(x)) sapply(indices, function(i) FUN(.Call2("Rle_window", x, runStart[i], runEnd[i], offsetStart[i], offsetEnd[i], newRle, PACKAGE = "IRanges"), ...), simplify = simplify) } else { frequency <- rep(frequency, length.out = n) delta <- rep(delta, length.out = n) sapply(indices, function(i) FUN(window(x, start = start[i], end = end[i], frequency = frequency[i], delta = delta[i]), ...), simplify = simplify) } } setMethod("aggregate", "Rle", aggregate.Rle) setMethod("c", "Rle", function(x, ..., recursive = FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for Rle objects ", "does not support the 'recursive' argument") args <- RleList(unname(list(x, ...)), compress = FALSE) args <- args[elementLengths(args) > 0] if (length(args) == 0) x else Rle(values = unlist(lapply(args, slot, "values")), lengths = unlist(lapply(args, slot, "lengths"))) }) setGeneric("findRange", signature = "vec", function(x, vec) standardGeneric("findRange")) setMethod("findRange", signature = c(vec = "Rle"), function(x, vec) { run <- findRun(x, vec) if (anyMissing(run)) stop("all 'x' values must be in [1, 'length(vec)']") IRanges(start = start(vec)[run], width = width(vec)[run], names = names(x)) }) setGeneric("findRun", signature = "vec", function(x, vec) standardGeneric("findRun")) setMethod("findRun", signature = c(vec = "Rle"), function(x, vec) { runs <- findIntervalAndStartFromWidth(as.integer(x), runLength(vec))[["interval"]] runs[x == 0 | x > length(vec)] <- NA runs }) setMethod("is.na", "Rle", function(x) Rle(values = is.na(runValue(x)), lengths = runLength(x), check = FALSE)) setMethod("is.unsorted", "Rle", function(x, na.rm = FALSE, strictly = FALSE) { ans <- is.unsorted(runValue(x), na.rm = na.rm, strictly = strictly) if (strictly && !ans) ans <- any(runLength(x) > 1L) ans }) setMethod("length", "Rle", function(x) sum(runLength(x))) setMethod("match", "Rle", function(x, table, nomatch = NA_integer_, incomparables = NULL) Rle(values = match(runValue(x), table = table, nomatch = nomatch, incomparables = incomparables), lengths = runLength(x), check = FALSE)) setGeneric("orderAsRanges", signature = c("x"), # not exported function(x, na.last = TRUE, decreasing = FALSE) standardGeneric("orderAsRanges")) setMethod("orderAsRanges", "Rle", function(x, na.last = TRUE, decreasing = FALSE) { ord <- orderInteger(runValue(x), na.last = na.last, decreasing = decreasing) new2("IRanges", start = start(x)[ord], width = runLength(x)[ord], check = FALSE) }) setMethod("rep", "Rle", function(x, times, length.out, each) { usedEach <- FALSE if (!missing(each) && length(each) > 0) { each <- as.integer(each[1L]) if (!is.na(each)) { if (each < 0) stop("invalid 'each' argument") usedEach <- TRUE if (each == 0) x <- new(class(x), values = runValue(x)[0L]) else x@lengths <- each[1L] * runLength(x) } } if (!missing(length.out) && length(length.out) > 0) { n <- length(x) length.out <- as.integer(length.out[1L]) if (!is.na(length.out)) { if (length.out == 0) { x <- new(class(x), values = runValue(x)[0L]) } else if (length.out < n) { x <- window(x, 1, length.out) } else if (length.out > n) { x <- window(rep.int(x, ceiling(length.out / n)), 1, length.out) } } } else if (!missing(times)) { if (usedEach && length(times) != 1) stop("invalid 'times' argument") x <- rep.int(x, times) } x }) setMethod("rep.int", "Rle", function(x, times) { n <- length(x) if (!is.integer(times)) times <- as.integer(times) if ((length(times) > 1 && length(times) < n) || anyMissingOrOutside(times, 0L)) stop("invalid 'times' argument") if (length(times) == n) { runLength(x) <- diffWithInitialZero(cumsum(times)[end(x)]) } else if (length(times) == 1) { x <- Rle(values = rep.int(runValue(x), times), lengths = rep.int(runLength(x), times)) } x }) ### S3/S4 combo for rev.Rle rev.Rle <- function(x) { x@values <- rev(runValue(x)) x@lengths <- rev(runLength(x)) x } setMethod("rev", "Rle", rev.Rle) setMethod("shiftApply", signature(X = "Rle", Y = "Rle"), function(SHIFT, X, Y, FUN, ..., OFFSET = 0L, simplify = TRUE, verbose = FALSE) { FUN <- match.fun(FUN) N <- length(X) if (N != length(Y)) stop("'X' and 'Y' must be of equal length") if (!is.integer(SHIFT)) SHIFT <- as.integer(SHIFT) if (length(SHIFT) == 0 || anyMissingOrOutside(SHIFT, 0L)) stop("all 'SHIFT' values must be non-negative") if (!is.integer(OFFSET)) OFFSET <- as.integer(OFFSET) if (length(OFFSET) == 0 || anyMissingOrOutside(OFFSET, 0L)) stop("'OFFSET' must be non-negative") ## Perform X setup infoX <- getStartEndRunAndOffset(X, rep.int(1L + OFFSET, length(SHIFT)), N - SHIFT) runStartX <- infoX[["start"]][["run"]] offsetStartX <- infoX[["start"]][["offset"]] runEndX <- infoX[["end"]][["run"]] offsetEndX <- infoX[["end"]][["offset"]] ## Perform Y setup infoY <- getStartEndRunAndOffset(Y, 1L + SHIFT, rep.int(N - OFFSET, length(SHIFT))) runStartY <- infoY[["start"]][["run"]] offsetStartY <- infoY[["start"]][["offset"]] runEndY <- infoY[["end"]][["run"]] offsetEndY <- infoY[["end"]][["offset"]] ## Performance Optimization ## Use a stripped down loop with empty Rle object newX <- new("Rle") newY <- new("Rle") if (verbose) { maxI <- length(SHIFT) ans <- sapply(seq_len(length(SHIFT)), function(i) { cat("\r", i, "/", maxI) FUN(.Call2("Rle_window", X, runStartX[i], runEndX[i], offsetStartX[i], offsetEndX[i], newX, PACKAGE = "IRanges"), .Call2("Rle_window", Y, runStartY[i], runEndY[i], offsetStartY[i], offsetEndY[i], newY, PACKAGE = "IRanges"), ...) }, simplify = simplify) cat("\n") } else { ans <- sapply(seq_len(length(SHIFT)), function(i) FUN(.Call2("Rle_window", X, runStartX[i], runEndX[i], offsetStartX[i], offsetEndX[i], newX, PACKAGE = "IRanges"), .Call2("Rle_window", Y, runStartY[i], runEndY[i], offsetStartY[i], offsetEndY[i], newY, PACKAGE = "IRanges"), ...), simplify = simplify) } ans }) setMethod("order", "Rle", function(..., na.last=TRUE, decreasing=FALSE) { args <- lapply(unname(list(...)), function(x) {if (is(x, "Rle")) decodeRle(x) else x}) do.call(order, c(args, list(na.last=na.last, decreasing=decreasing))) } ) ### S3/S4 combo for sort.Rle .sort.Rle <- function(x, decreasing=FALSE, na.last=NA, ...) { if (is.na(na.last)) { if (anyMissing(runValue(x))) x <- x[!is.na(x)] } if (is.integer(runValue(x)) || is.factor(runValue(x))) ord <- orderInteger(runValue(x), decreasing=decreasing, na.last=na.last) else ord <- order(runValue(x), decreasing=decreasing, na.last=na.last) Rle(values=runValue(x)[ord], lengths=runLength(x)[ord], check=FALSE) } sort.Rle <- function(x, decreasing=FALSE, ...) .sort.Rle(x, decreasing=decreasing, ...) setMethod("sort", "Rle", sort.Rle) setGeneric("splitRanges", signature = "x", function(x) standardGeneric("splitRanges")) setMethod("splitRanges", "Rle", function(x) { split(IRanges(start = start(x), width = runLength(x)), runValue(x)) }) setMethod("splitRanges", "vectorORfactor", function(x) { callGeneric(Rle(x)) }) ### S3/S4 combo for summary.Rle summary.Rle <- function(object, ..., digits=max(3, getOption("digits") - 3)) { value <- if (is.logical(runValue(object))) c(ValueMode = "logical", { tb <- table(object, exclude = NULL) if (!is.null(n <- dimnames(tb)[[1L]]) && any(iN <- is.na(n))) dimnames(tb)[[1L]][iN] <- "NA's" tb }) else if (is.numeric(runValue(object))) { nas <- is.na(object) object <- object[!nas] qq <- quantile(object) qq <- signif(c(qq[1L:3L], mean(object), qq[4L:5L]), digits) names(qq) <- c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.") if (any(nas)) c(qq, `NA's` = sum(nas)) else qq } else c(Length = length(object), Class = class(object), ValueMode = mode(runValue(object))) class(value) <- c("summaryDefault", "table") value } setMethod("summary", "Rle", summary.Rle) setMethod("table", "Rle", function(...) { ## Currently only 1 Rle is supported. An approach for multiple ## Rle's could be disjoin(), findRun() to find matches, then ## xtabs(length ~ value ...). x <- sort(list(...)[[1L]]) if (is.factor(runValue(x))) { dn <- levels(x) tab <- integer(length(dn)) tab[dn %in% runValue(x)] <- runLength(x) dims <- length(dn) } else { dn <- as.character(runValue(x)) tab <- runLength(x) dims <- nrun(x) } ## Adjust 'dn' for consistency with base::table if (length(dn) == 0L) dn <- NULL dn <- list(dn) names(dn) <- .list.names(...) y <- array(tab, dims, dimnames=dn) class(y) <- "table" y } ) .list.names <- function(...) { l <- as.list(substitute(list(...)))[-1L] deparse.level <- 1 nm <- names(l) fixup <- if (is.null(nm)) seq_along(l) else nm == "" dep <- vapply(l[fixup], function(x) switch(deparse.level + 1, "", if (is.symbol(x)) as.character(x) else "", deparse(x, nlines = 1)[1L]), "") if (is.null(nm)) dep else { nm[fixup] <- dep nm } } ### S3/S4 combo for duplicated.Rle .duplicated.Rle <- function(x, incomparables=FALSE, fromLast=FALSE) stop("no \"duplicated\" method for Rle objects yet, sorry") duplicated.Rle <- function(x, incomparables=FALSE, ...) .duplicated.Rle(x, incomparables=incomparables, ...) setMethod("duplicated", "Rle", duplicated.Rle) ### S3/S4 combo for unique.Rle unique.Rle <- function(x, incomparables=FALSE, ...) unique(runValue(x), incomparables=incomparables, ...) setMethod("unique", "Rle", unique.Rle) ### S3/S4 combo for window.Rle window.Rle <- function(x, start=NA, end=NA, width=NA, frequency=NULL, delta=NULL, ...) { solved_SEW <- solveUserSEWForSingleSeq(length(x), start, end, width) if (is.null(frequency) && is.null(delta)) { info <- getStartEndRunAndOffset(x, start(solved_SEW), end(solved_SEW)) runStart <- info[["start"]][["run"]] offsetStart <- info[["start"]][["offset"]] runEnd <- info[["end"]][["run"]] offsetEnd <- info[["end"]][["offset"]] ans <- .Call2("Rle_window", x, runStart, runEnd, offsetStart, offsetEnd, new("Rle"), PACKAGE = "IRanges") if (is.factor(runValue(x))) attributes(runValue(ans)) <- list(levels = levels(x), class = "factor") ans } else { idx <- stats:::window.default(seq_len(length(x)), start = start(solved_SEW), end = end(solved_SEW), frequency = frequency, deltat = delta, ...) attributes(idx) <- NULL x[idx] } } setMethod("window", "Rle", window.Rle) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Other logical data methods ### setMethod("!", "Rle", function(x) Rle(values = !runValue(x), lengths = runLength(x), check = FALSE)) setMethod("which", "Rle", function(x, arr.ind = FALSE) { if (!is.logical(runValue(x))) stop("argument to 'which' is not logical") ok <- runValue(x) ok[is.na(ok)] <- FALSE from <- start(x)[ok] to <- end(x)[ok] if (length(from) == 0) integer(0) else mseq(from, to) }) setMethod("which.max", "Rle", function(x) { start(x)[which.max(runValue(x))] }) ## base::ifelse works fine for S4 'test', but not for S4 yes/no setMethod("ifelse", c(yes = "Rle"), function(test, yes, no) { yes <- as.vector(yes) as(callGeneric(), "Rle") }) setMethod("ifelse", c(no = "Rle"), function(test, yes, no) { no <- as.vector(no) as(callGeneric(), "Rle") }) setMethod("ifelse", c(yes = "Rle", no = "Rle"), function(test, yes, no) { yes <- as.vector(yes) no <- as.vector(no) as(callGeneric(), "Rle") }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Other numerical data methods ### ### S3/S4 combo for diff.Rle .diff.Rle <- function(x, lag = 1, differences = 1) { if (!isSingleNumber(lag) || lag < 1L || !isSingleNumber(differences) || differences < 1L) stop("'lag' and 'differences' must be integers >= 1") lag <- as.integer(lag) differences <- as.integer(differences) if (lag * differences >= length(x)) return(Rle(vector(class(runValue(x))))) for (i in seq_len(differences)) { n <- length(x) x <- window(x, 1L + lag, n) - window(x, 1L, n - lag) } x } diff.Rle <- function(x, ...) .diff.Rle(x, ...) setMethod("diff", "Rle", .diff.Rle) .psummary.Rle <- function(FUN, ..., MoreArgs = NULL) { rlist <- RleList(..., compress = FALSE) ends <- end(rlist[[1L]]) if (length(rlist) > 1) { for (i in 2:length(rlist)) ends <- sortedMerge(ends, end(rlist[[i]])) } Rle(values = do.call(FUN, c(lapply(rlist, function(x) { runs <- findIntervalAndStartFromWidth(ends, runLength(x))[["interval"]] runValue(x)[runs] }), MoreArgs)), lengths = diffWithInitialZero(ends), check = FALSE) } setMethod("pmax", "Rle", function(..., na.rm = FALSE) .psummary.Rle(pmax, ..., MoreArgs = list(na.rm = na.rm))) setMethod("pmin", "Rle", function(..., na.rm = FALSE) .psummary.Rle(pmin, ..., MoreArgs = list(na.rm = na.rm))) setMethod("pmax.int", "Rle", function(..., na.rm = FALSE) .psummary.Rle(pmax.int, ..., MoreArgs = list(na.rm = na.rm))) setMethod("pmin.int", "Rle", function(..., na.rm = FALSE) .psummary.Rle(pmin.int, ..., MoreArgs = list(na.rm = na.rm))) ### S3/S4 combo for mean.Rle .mean.Rle <- function(x, na.rm = FALSE) { if (is.integer(runValue(x))) runValue(x) <- as.double(runValue(x)) if (na.rm) n <- length(x) - sum(runLength(x)[is.na(runValue(x))]) else n <- length(x) sum(x, na.rm = na.rm) / n } mean.Rle <- function(x, ...) .mean.Rle(x, ...) setMethod("mean", "Rle", .mean.Rle) setMethod("var", signature = c(x = "Rle", y = "missing"), function(x, y = NULL, na.rm = FALSE, use) { if (na.rm) n <- length(x) - sum(runLength(x)[is.na(runValue(x))]) else n <- length(x) centeredValues <- runValue(x) - mean(x, na.rm = na.rm) sum(runLength(x) * centeredValues * centeredValues, na.rm = na.rm) / (n - 1) }) setMethod("var", signature = c(x = "Rle", y = "Rle"), function(x, y = NULL, na.rm = FALSE, use) { # Direct change to slots for fast computation x@values <- runValue(x) - mean(x, na.rm = na.rm) y@values <- runValue(y) - mean(y, na.rm = na.rm) z <- x * y if (na.rm) n <- length(z) - sum(runLength(z)[is.na(runValue(z))]) else n <- length(z) sum(z, na.rm = na.rm) / (n - 1) }) setMethod("cov", signature = c(x = "Rle", y = "Rle"), function(x, y = NULL, use = "everything", method = c("pearson", "kendall", "spearman")) { use <- match.arg(use, c("all.obs", "complete.obs", "pairwise.complete.obs", "everything", "na.or.complete")) method <- match.arg(method) if (method != "pearson") stop("only 'pearson' method is supported for Rle objects") na.rm <- use %in% c("complete.obs", "pairwise.complete.obs", "na.or.complete") if (use == "all.obs" && (anyMissing(x) || anyMissing(y))) stop("missing observations in cov/cor") var(x, y, na.rm = na.rm) }) setMethod("cor", signature = c(x = "Rle", y = "Rle"), function(x, y = NULL, use = "everything", method = c("pearson", "kendall", "spearman")) { use <- match.arg(use, c("all.obs", "complete.obs", "pairwise.complete.obs", "everything", "na.or.complete")) method <- match.arg(method) if (method != "pearson") stop("only 'pearson' method is supported for Rle objects") na.rm <- use %in% c("complete.obs", "pairwise.complete.obs", "na.or.complete") isMissing <- is.na(x) | is.na(y) if (any(isMissing)) { if (use == "all.obs") { stop("missing observations in cov/cor") } else if (na.rm) { x <- x[!isMissing] y <- y[!isMissing] } } # Direct change to slots for fast computation x@values <- runValue(x) - mean(x, na.rm = na.rm) y@values <- runValue(y) - mean(y, na.rm = na.rm) .sumprodRle(x, y, na.rm = na.rm) / (sqrt(sum(runLength(x) * runValue(x) * runValue(x), na.rm = na.rm)) * sqrt(sum(runLength(y) * runValue(y) * runValue(y), na.rm = na.rm))) }) setMethod("sd", signature = c(x = "Rle"), function(x, na.rm = FALSE) sqrt(var(x, na.rm = na.rm))) ### S3/S4 combo for median.Rle ### FIXME: code duplication needed for S3 / S4 dispatch ### drop NA's here, so dropRle==TRUE allows x[FALSE][NA] in median.default median.Rle <- function(x, na.rm = FALSE) { if (na.rm) x <- x[!is.na(x)] oldOption <- getOption("dropRle") options("dropRle" = TRUE) on.exit(options("dropRle" = oldOption)) NextMethod("median", na.rm=FALSE) } setMethod("median", "Rle", function(x, na.rm = FALSE) { if (na.rm) x <- x[!is.na(x)] oldOption <- getOption("dropRle") options("dropRle" = TRUE) on.exit(options("dropRle" = oldOption)) callNextMethod(x=x, na.rm=FALSE) }) ### S3/S4 combo for quantile.Rle ### FIXME: code duplication needed for S3 / S4 dispatch quantile.Rle <- function(x, probs = seq(0, 1, 0.25), na.rm = FALSE, names = TRUE, type = 7, ...) { if (na.rm) x <- x[!is.na(x)] oldOption <- getOption("dropRle") options("dropRle" = TRUE) on.exit(options("dropRle" = oldOption)) NextMethod("quantile", na.rm=FALSE) } setMethod("quantile", "Rle", function(x, probs = seq(0, 1, 0.25), na.rm = FALSE, names = TRUE, type = 7, ...) { if (na.rm) x <- x[!is.na(x)] oldOption <- getOption("dropRle") options("dropRle" = TRUE) on.exit(options("dropRle" = oldOption)) callNextMethod(x=x, probs=probs, na.rm=FALSE, names=names, type=type, ...) }) setMethod("mad", "Rle", function(x, center = median(x), constant = 1.4826, na.rm = FALSE, low = FALSE, high = FALSE) { if (na.rm) x <- x[!is.na(x)] oldOption <- getOption("dropRle") options("dropRle" = TRUE) on.exit(options("dropRle" = oldOption)) callNextMethod(x=x, center=center, constant=constant, na.rm=FALSE, low=FALSE, high=FALSE) }) setMethod("IQR", "Rle", function(x, na.rm = FALSE) diff(quantile(x, c(0.25, 0.75), na.rm = na.rm, names = FALSE))) setMethod("smoothEnds", "Rle", function(y, k = 3) { oldOption <- getOption("dropRle") options("dropRle" = TRUE) on.exit(options("dropRle" = oldOption)) callNextMethod(y = y, k = k) }) setMethod("runmean", "Rle", function(x, k, endrule = c("drop", "constant"), na.rm = FALSE) { sums <- runsum(x, k, endrule, na.rm) if (na.rm) { d <- Rle(rep(1L, length(x))) d[is.na(x)] <- 0L sums / runsum(d, k, endrule, na.rm) } else { sums / k } }) setMethod("runmed", "Rle", function(x, k, endrule = c("median", "keep", "drop", "constant"), algorithm = NULL, print.level = 0) { if (!all(is.finite(as.vector(x)))) stop("NA/NaN/Inf not supported in runmed,Rle-method") endrule <- match.arg(endrule) n <- length(x) k <- normargRunK(k = k, n = n, endrule = endrule) i <- (k + 1L) %/% 2L ans <- runq(x, k = k, i = i) if (endrule == "constant") { runLength(ans)[1L] <- runLength(ans)[1L] + (i - 1L) runLength(ans)[nrun(ans)] <- runLength(ans)[nrun(ans)] + (i - 1L) } else if (endrule != "drop") { ans <- c(head(x, i - 1L), ans, tail(x, i - 1L)) if (endrule == "median") { ans <- smoothEnds(ans, k = k) } } ans }) setMethod("runsum", "Rle", function(x, k, endrule = c("drop", "constant"), na.rm = FALSE) { endrule <- match.arg(endrule) n <- length(x) k <- normargRunK(k = k, n = n, endrule = endrule) ans <- .Call2("Rle_runsum", x, as.integer(k), as.logical(na.rm), PACKAGE="IRanges") if (endrule == "constant") { j <- (k + 1L) %/% 2L runLength(ans)[1L] <- runLength(ans)[1L] + (j - 1L) runLength(ans)[nrun(ans)] <- runLength(ans)[nrun(ans)] + (j - 1L) } ans }) setMethod("runwtsum", "Rle", function(x, k, wt, endrule = c("drop", "constant"), na.rm = FALSE) { endrule <- match.arg(endrule) n <- length(x) k <- normargRunK(k = k, n = n, endrule = endrule) ans <- .Call2("Rle_runwtsum", x, as.integer(k), as.numeric(wt), as.logical(na.rm), PACKAGE="IRanges") if (endrule == "constant") { j <- (k + 1L) %/% 2L runLength(ans)[1L] <- runLength(ans)[1L] + (j - 1L) runLength(ans)[nrun(ans)] <- runLength(ans)[nrun(ans)] + (j - 1L) } ans }) setMethod("runq", "Rle", function(x, k, i, endrule = c("drop", "constant"), na.rm = FALSE) { endrule <- match.arg(endrule) n <- length(x) k <- normargRunK(k = k, n = n, endrule = endrule) ans <- .Call2("Rle_runq", x, as.integer(k), as.integer(i), as.logical(na.rm), PACKAGE="IRanges") if (endrule == "constant") { j <- (k + 1L) %/% 2L runLength(ans)[1L] <- runLength(ans)[1L] + (j - 1L) runLength(ans)[nrun(ans)] <- runLength(ans)[nrun(ans)] + (j - 1L) } ans }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Other character data methods ### setMethod("nchar", "Rle", function(x, type = "chars", allowNA = FALSE) Rle(values = nchar(runValue(x), type = type, allowNA = allowNA), lengths = runLength(x), check = FALSE)) setMethod("substr", "Rle", function(x, start, stop) { if (is.factor(runValue(x))) { levels(x) <- substr(levels(x), start = start, stop = stop) } else { runValue(x) <- substr(runValue(x), start = start, stop = stop) } x }) setMethod("substring", "Rle", function(text, first, last = 1000000L) { if (is.factor(runValue(text))) { levels(text) <- substring(levels(text), first = first, last = last) } else { runValue(text) <- substring(runValue(text), first = first, last = last) } text }) setMethod("chartr", c(old = "ANY", new = "ANY", x = "Rle"), function(old, new, x) { if (is.factor(runValue(x))) { levels(x) <- chartr(old = old, new = new, levels(x)) } else { runValue(x) <- chartr(old = old, new = new, runValue(x)) } x }) setMethod("tolower", "Rle", function(x) { if (is.factor(runValue(x))) { levels(x) <- tolower(levels(x)) } else { runValue(x) <- tolower(runValue(x)) } x }) setMethod("toupper", "Rle", function(x) { if (is.factor(runValue(x))) { levels(x) <- toupper(levels(x)) } else { runValue(x) <- toupper(runValue(x)) } x }) setMethod("sub", signature = c(pattern = "ANY", replacement = "ANY", x = "Rle"), function(pattern, replacement, x, ignore.case = FALSE, perl = FALSE, fixed = FALSE, useBytes = FALSE) { if (is.factor(runValue(x))) { levels(x) <- sub(pattern = pattern, replacement = replacement, x = levels(x), ignore.case = ignore.case, perl = perl, fixed = fixed, useBytes = useBytes) } else { runValue(x) <- sub(pattern = pattern, replacement = replacement, x = runValue(x), ignore.case = ignore.case, perl = perl, fixed = fixed, useBytes = useBytes) } x }) setMethod("gsub", signature = c(pattern = "ANY", replacement = "ANY", x = "Rle"), function(pattern, replacement, x, ignore.case = FALSE, perl = FALSE, fixed = FALSE, useBytes = FALSE) { if (is.factor(runValue(x))) { levels(x) <- gsub(pattern = pattern, replacement = replacement, x = levels(x), ignore.case = ignore.case, perl = perl, fixed = fixed, useBytes = useBytes) } else { runValue(x) <- gsub(pattern = pattern, replacement = replacement, x = runValue(x), ignore.case = ignore.case, perl = perl, fixed = fixed, useBytes = useBytes) } x }) .pasteTwoRles <- function(e1, e2, sep = " ", collapse = NULL) { n1 <- length(e1) n2 <- length(e2) if (n1 == 0 || n2 == 0) { ends <- integer(0) which1 <- integer(0) which2 <- integer(0) } else { n <- max(n1, n2) if (max(n1, n2) %% min(n1, n2) != 0) warning("longer object length is not a multiple of shorter object length") if (n1 < n) e1 <- rep(e1, length.out = n) if (n2 < n) e2 <- rep(e2, length.out = n) # ends <- sort(unique(c(end(e1), end(e2)))) ends <- sortedMerge(end(e1), end(e2)) which1 <- findIntervalAndStartFromWidth(ends, runLength(e1))[["interval"]] which2 <- findIntervalAndStartFromWidth(ends, runLength(e2))[["interval"]] } if (is.null(collapse) && is.factor(runValue(e1)) && is.factor(runValue(e2))) { levelsTable <- expand.grid(levels(e2), levels(e1), KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE) values <- structure((as.integer(runValue(e1)[which1]) - 1L) * nlevels(e2) + as.integer(runValue(e2)[which2]), levels = paste(levelsTable[[2L]], levelsTable[[1L]], sep = sep), class = "factor") } else { values <- paste(runValue(e1)[which1], runValue(e2)[which2], sep = sep, collapse = collapse) } Rle(values = values, lengths = diffWithInitialZero(ends), check = FALSE) } setMethod("paste", "Rle", function(..., sep = " ", collapse = NULL) { rleList <- RleList(..., compress = FALSE) ans <- rleList[[1L]] if (length(rleList) > 1) { for (i in 2:length(rleList)) { ans <- .pasteTwoRles(ans, rleList[[i]], sep = sep, collapse = collapse) } } ans }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Other factor data methods ### ### S3/S4 combo for levels.Rle levels.Rle <- function(x) levels(runValue(x)) setMethod("levels", "Rle", levels.Rle) setReplaceMethod("levels", "Rle", function(x, value) { levels(x@values) <- value if (anyDuplicated(value)) { x <- Rle(values = runValue(x), lengths = runLength(x), check = FALSE) } x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method ### setMethod("show", "Rle", function(object) { lo <- length(object) nr <- nrun(object) halfWidth <- getOption("width") %/% 2L cat(classNameForDisplay(runValue(object)), "-Rle of length ", lo, " with ", nr, ifelse(nr == 1, " run\n", " runs\n"), sep = "") first <- max(1L, halfWidth) showMatrix <- rbind(as.character(head(runLength(object), first)), as.character(head(runValue(object), first))) if (nr > first) { last <- min(nr - first, halfWidth) showMatrix <- cbind(showMatrix, rbind(as.character(tail(runLength(object), last)), as.character(tail(runValue(object), last)))) } if (is.character(runValue(object))) { showMatrix[2L,] <- paste("\"", showMatrix[2L,], "\"", sep = "") } showMatrix <- format(showMatrix, justify = "right") cat(BiocGenerics:::labeledLine(" Lengths", showMatrix[1L,], count = FALSE)) cat(BiocGenerics:::labeledLine(" Values ", showMatrix[2L,], count = FALSE)) if (is.factor(runValue(object))) cat(BiocGenerics:::labeledLine("Levels", levels(object))) }) setMethod("showAsCell", "Rle", function(object) as.vector(object)) IRanges/R/RleViews-class.R0000644000126300012640000001043612227064470016664 0ustar00biocbuildphs_compbio### ========================================================================= ### RleViews objects ### ------------------------------------------------------------------------- ### ### The RleViews class is the basic container for storing a set of views ### (start/end locations) on the same Rle object, called the "subject" ### vector. setClass("RleViews", contains=c("Views", "RleList"), representation( subject="Rle" ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### User-friendly constructor. ### setMethod("Views", "Rle", function(subject, start=NULL, end=NULL, width=NULL, names=NULL) newViews(subject, start=start, end=end, width=width, names=names, Class="RleViews") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setAs("AtomicList", "RleViews", function(from) { to <- Views(as(unlist(from, use.names = FALSE), "Rle"), PartitioningByWidth(elementLengths(from))) names(to) <- names(from) to }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "show" method. ### ### The 2 helper functions below convert a given view on an Rle object ### into a character-string. ### Both assume that 'start' <= 'end' (so they don't check it) and ### padd the result with spaces to produce the "margin effect" ### if 'start' or 'end' are out of limits. RleViews.show_vframe_header <- function(iW, startW, endW, widthW) { cat(format("", width=iW+1), format("start", width=startW, justify="right"), " ", format("end", width=endW, justify="right"), " ", format("width", width=widthW, justify="right"), "\n", sep="") } RleViews.show_vframe_line <- function(x, i, iW, startW, endW, widthW) { lsx <- length(subject(x)) start <- start(x)[i] end <- end(x)[i] width <- end - start + 1 snippetWidth <- getOption("width") - 10 - iW - startW - endW - widthW if (width > 0 && lsx > 0 && start <= lsx && end >= 1) { snippetStart <- max(min(start,lsx),1) snippetEnd <- max(min(end,lsx,start + snippetWidth),1) snippet <- format(as.vector(extractROWS(subject(x), IRanges(snippetStart, snippetEnd)))) snippet <- snippet[cumsum(nchar(snippet) + 1L) < snippetWidth] if (length(snippet) < width) { snippet <- c(snippet, "...") } snippet <- paste(snippet, collapse = " ") } else { snippet <- " " } cat(format(paste("[", i,"]", sep=""), width=iW, justify="right"), " ", format(start, width=startW, justify="right"), " ", format(end, width=endW, justify="right"), " ", format(width, width=widthW, justify="right"), " ", "[", snippet, "]\n", sep="") } ### 'half_nrow' must be >= 1 RleViews.show_vframe <- function(x, half_nrow=9L) { cat("\nviews:") lx <- length(x) if (lx == 0) cat(" NONE\n") else { cat("\n") iW <- nchar(as.character(lx)) + 2 # 2 for the brackets startMax <- max(start(x)) startW <- max(nchar(startMax), nchar("start")) endMax <- max(end(x)) endW <- max(nchar(endMax), nchar("end")) widthMax <- max(width(x)) widthW <- max(nchar(widthMax), nchar("width")) RleViews.show_vframe_header(iW, startW, endW, widthW) if (lx <= 2*half_nrow+1) { for (i in seq_len(lx)) RleViews.show_vframe_line(x, i, iW, startW, endW, widthW) } else { for (i in 1:half_nrow) RleViews.show_vframe_line(x, i, iW, startW, endW, widthW) cat(format("...", width=iW, justify="right"), " ", format("...", width=startW, justify="right"), " ", format("...", width=endW, justify="right"), " ", format("...", width=widthW, justify="right"), " ...\n", sep="") for (i in (lx-half_nrow+1L):lx) RleViews.show_vframe_line(x, i, iW, startW, endW, widthW) } } } setMethod("show", "RleViews", function(object) { cat("Views on a ", length(subject(object)), "-length Rle subject\n", sep="") RleViews.show_vframe(object) } ) IRanges/R/RleViews-utils.R0000644000126300012640000000416212227064470016716 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "viewApply", "viewMins", "viewMaxs", and "viewSums" generics and ### methods. ### setMethod("viewApply", "RleViews", function(X, FUN, ..., simplify = TRUE) { X <- trim(X) ans <- aggregate(subject(X), start = structure(start(X), names = names(X)), end = end(X), FUN = FUN, ..., simplify = simplify) if (!simplify) { ans <- newList("SimpleList", ans, metadata=metadata(X), mcols=mcols(X)) } ans }) setMethod("viewMins", "RleViews", function(x, na.rm = FALSE) .Call2("RleViews_viewMins", trim(x), na.rm, PACKAGE="IRanges")) setMethod("viewMaxs", "RleViews", function(x, na.rm = FALSE) .Call2("RleViews_viewMaxs", trim(x), na.rm, PACKAGE="IRanges")) setMethod("viewSums", "RleViews", function(x, na.rm = FALSE) .Call2("RleViews_viewSums", trim(x), na.rm, PACKAGE="IRanges")) setMethod("viewMeans", "RleViews", function(x, na.rm = FALSE) .Call2("RleViews_viewMeans", trim(x), na.rm, PACKAGE="IRanges")) setMethod("viewWhichMins", "RleViews", function(x, na.rm = FALSE) .Call2("RleViews_viewWhichMins", trim(x), na.rm, PACKAGE="IRanges")) setMethod("viewWhichMaxs", "RleViews", function(x, na.rm = FALSE) .Call2("RleViews_viewWhichMaxs", trim(x), na.rm, PACKAGE="IRanges")) setMethod("viewRangeMaxs", "RleViews", function(x, na.rm = FALSE) { maxs <- viewWhichMaxs(trim(x), na.rm = na.rm) if (anyMissing(maxs)) stop("missing values present, set 'na.rm = TRUE'") findRange(maxs, subject(x)) }) setMethod("viewRangeMins", "RleViews", function(x, na.rm = FALSE) { mins <- viewWhichMins(trim(x), na.rm = na.rm) if (anyMissing(mins)) stop("missing values present, set 'na.rm = TRUE'") findRange(mins, subject(x)) }) IRanges/R/RleViewsList-class.R0000644000126300012640000000516112227064470017517 0ustar00biocbuildphs_compbio### ========================================================================= ### RleViewsList objects ### ------------------------------------------------------------------------- setClass("RleViewsList", representation("VIRTUAL"), prototype = prototype(elementType = "RleViews"), contains = "ViewsList") setClass("SimpleRleViewsList", prototype = prototype(elementType = "RleViews"), contains = c("RleViewsList", "SimpleViewsList")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor. ### setMethod("subject", "SimpleRleViewsList", function(x) newList("SimpleRleList", lapply(x, slot, "subject"))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### setMethod("Views", "RleList", function(subject, start=NULL, end=NULL, width=NULL, names=NULL) RleViewsList(rleList = subject, rangesList = start)) RleViewsList <- function(..., rleList, rangesList, universe = NULL) { if (!is.null(universe) && !isSingleString(universe)) stop("'universe' must be a single string or NULL") views <- list(...) if (!missing(rleList) && !missing(rangesList)) { if (length(views) > 0) stop("'...' must be empty when 'rleList' and 'rangesList' are specified") if (!is(rleList, "RleList")) stop("'rleList' must be a RleList object") if (!is(rangesList, "RangesList")) { rangesList <- try(IRangesList(rangesList), silent = TRUE) if (inherits(rangesList, "try-error")) stop("'rangesList' must be a RangesList object") } views <- Map(Views, rleList, rangesList) } else if ((length(views) > 0) && (!missing(rleList) || !missing(rangesList))) { stop("cannot specify 'rleList' or 'rangesList' when specifying '...'") } else { if (length(views) == 1 && is.list(views[[1L]])) views <- views[[1L]] if (!all(sapply(views, is, "RleViews"))) stop("all elements in '...' must be RleViews objects") } ans <- newList("SimpleRleViewsList", views) universe(ans) <- universe ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setAs("RleViewsList", "IRangesList", function(from) IRangesList(lapply(from, as, "IRanges"))) setAs("RleViewsList", "CompressedIRangesList", function(from) IRangesList(lapply(from, as, "IRanges"), compress=TRUE)) setAs("RleViewsList", "SimpleIRangesList", function(from) IRangesList(lapply(from, as, "IRanges"), compress=FALSE)) IRanges/R/RleViewsList-utils.R0000644000126300012640000000705112227064470017552 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "viewApply", "viewMins", "viewMaxs", and "viewSums" generics and ### methods. ### setMethod("viewApply", "RleViewsList", function(X, FUN, ..., simplify = TRUE) newList("SimpleList", lapply(structure(seq_len(length(X)), names = names(X)), function(i) { ans <- aggregate(subject(X[[i]]), start = structure(start(X[[i]]), names = names(start(X[[i]]))), end = end(X[[i]]), FUN = FUN, ..., simplify = simplify) if (!simplify) { ans <- newList("SimpleList", ans, metadata = metadata(X[[i]]), mcols = mcols(X[[i]])) } ans }), metadata = metadata(X), mcols = mcols(X))) .summaryRleViewsList <- function(x, FUN, na.rm = FALSE, outputListType = NULL) { FUN <- match.fun(FUN) if (length(x) == 0) { outputListType <- "SimpleList" listData <- list() } else { if (is.null(outputListType)) { valuesClass <- class(runValue(subject(x[[1L]]))) if (valuesClass == "integer") outputListType <- "SimpleIntegerList" else if (valuesClass == "numeric") outputListType <- "SimpleNumericList" else stop("cannot compute numeric summary over a non-numeric Rle") } listData <- lapply(structure(seq_len(length(x)), names = names(x)), function(i) FUN(x[[i]], na.rm = na.rm)) } newList(outputListType, listData, metadata = metadata(x), mcols = mcols(x)) } setMethod("viewMins", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewMins, na.rm = na.rm)) setMethod("viewMaxs", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewMaxs, na.rm = na.rm)) setMethod("viewSums", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewSums, na.rm = na.rm)) setMethod("viewMeans", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewMeans, na.rm = na.rm, outputListType = "SimpleNumericList")) setMethod("viewWhichMins", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewWhichMins, na.rm = na.rm, outputListType = "SimpleIntegerList")) setMethod("viewWhichMaxs", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewWhichMaxs, na.rm = na.rm, outputListType = "SimpleIntegerList")) setMethod("viewRangeMaxs", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewRangeMaxs, na.rm = na.rm, outputListType = "SimpleIRangesList")) setMethod("viewRangeMins", "RleViewsList", function(x, na.rm = FALSE) .summaryRleViewsList(x, FUN = viewRangeMins, na.rm = na.rm, outputListType = "SimpleIRangesList")) IRanges/R/S4-utils.R0000644000126300012640000000373612227064470015452 0ustar00biocbuildphs_compbio### ### Utility functions for reducing redundant testing of object validity. ### .validity_options <- new.env(hash=TRUE, parent=emptyenv()) assign("debug", FALSE, envir=.validity_options) assign("disabled", FALSE, envir=.validity_options) debugValidity <- function(debug) { if (missing(debug)) return(get("debug", envir=.validity_options)) debug <- isTRUE(debug) assign("debug", debug, envir=.validity_options) debug } disableValidity <- function(disabled) { if (missing(disabled)) return(get("disabled", envir=.validity_options)) disabled <- isTRUE(disabled) assign("disabled", disabled, envir=.validity_options) disabled } setValidity2 <- function(Class, valid.func, where=topenv(parent.frame())) { setValidity(Class, function(object) { if (disableValidity()) return(TRUE) if (debugValidity()) { whoami <- paste("validity method for", Class, "object") cat("[debugValidity] Entering ", whoami, "\n", sep="") on.exit(cat("[debugValidity] Leaving ", whoami, "\n", sep="")) } problems <- valid.func(object) if (isTRUE(problems) || length(problems) == 0L) return(TRUE) problems }, where=where ) } new2 <- function(..., check=TRUE) { if (!isTRUEorFALSE(check)) stop("'check' must be TRUE or FALSE") old_val <- disableValidity() on.exit(disableValidity(old_val)) disableValidity(!check) new(...) } stopIfProblems <- function(problems) if (!is.null(problems)) stop(paste(problems, collapse="\n ")) ### 'signatures' must be a list of character vectors. To use when many methods ### share the same implementation. setMethods <- function(f, signatures=list(), definition, where=topenv(parent.frame()), ...) { for (signature in signatures) setMethod(f, signature=signature, definition, where=where, ...) } IRanges/R/SimpleList-class.R0000644000126300012640000001455012227064470017212 0ustar00biocbuildphs_compbio### ========================================================================= ### SimpleList objects ### ------------------------------------------------------------------------- setClass("SimpleList", contains="List", representation( listData="list" ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("length", "SimpleList", function(x) length(as.list(x))) setMethod("names", "SimpleList", function(x) names(as.list(x))) setReplaceMethod("names", "SimpleList", function(x, value) { names(x@listData) <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Constructor. ### SimpleList <- function(...) { list <- list(...) if (length(list) == 1 && is.list(list[[1L]])) list <- list[[1L]] new("SimpleList", listData = list) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.SimpleList.listData <- function(x) { elementTypeX <- elementType(x) if (!all(sapply(as.list(x), function(xi) extends(class(xi), elementTypeX)))) return(paste("the 'listData' slot must be a list containing", elementTypeX, "objects")) NULL } .valid.SimpleList <- function(x) { c(.valid.SimpleList.listData(x)) } setValidity2("SimpleList", .valid.SimpleList) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("extractROWS", "SimpleList", function(x, i) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) initialize(x, listData=extractROWS(x@listData, i), elementMetadata=extractROWS(x@elementMetadata, i)) } ) setMethod("replaceROWS", "SimpleList", function(x, i, value) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) initialize(x, listData=replaceROWS(x@listData, i, value@listData)) } ) setMethod("getListElement", "SimpleList", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=FALSE) x@listData[[i]] } ) setMethod("setListElement", "SimpleList", function(x, i, value) { x@listData[[i]] <- value x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining and splitting. ### ## NOTE: while the 'c' function does not have an 'x', the generic does ## c() is a primitive, so 'x' can be missing; dispatch is by position, ## although sometimes this does not work so well, so it's best to keep ## names off the parameters whenever feasible. setMethod("c", "SimpleList", function(x, ..., recursive = FALSE) { slot(x, "listData") <- do.call(c, lapply(unname(list(x, ...)), as.list)) .c.Vector(x, ...) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Looping. ### setMethod("lapply", "SimpleList", function(X, FUN, ...) lapply(as.list(X), FUN = FUN, ...)) setMethod("aggregate", "SimpleList", function(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE) { if (!missing(by) && is(by, "RangesList")) { if (length(x) != length(by)) stop("for Ranges 'by', 'length(x) != length(by)'") result <- lapply(structure(seq_len(length(x)), names = names(x)), function(i) aggregate(x[[i]], by = by[[i]], FUN = FUN, frequency = frequency, delta = delta, ..., simplify = simplify)) ans <- try(SimpleAtomicList(result), silent = TRUE) if (inherits(ans, "try-error")) ans <- newList("SimpleList", result) } else { ans <- callNextMethod() } ans }) setMethod("endoapply", "SimpleList", function(X, FUN, ...) { listData <- lapply(X, FUN = FUN, ...) elementTypeX <- elementType(X) if (!all(sapply(listData, function(Xi) extends(class(Xi), elementTypeX)))) stop("all results must be of class '", elementTypeX, "'") slot(X, "listData", check=FALSE) <- listData X }) setMethod("mendoapply", "SimpleList", function(FUN, ..., MoreArgs = NULL) { X <- list(...)[[1L]] elementTypeX <- elementType(X) listData <- mapply(FUN = FUN, ..., MoreArgs = MoreArgs, SIMPLIFY = FALSE) if (!all(sapply(listData, function(Xi) extends(class(Xi), elementTypeX)))) stop("all results must be of class '", elementTypeX, "'") slot(X, "listData", check=FALSE) <- listData X }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### .as.list.SimpleList <- function(x, use.names=TRUE) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") ans <- x@listData if (!use.names) names(ans) <- NULL ans } ### S3/S4 combo for as.list.SimpleList as.list.SimpleList <- function(x, ...) .as.list.SimpleList(x, ...) setMethod("as.list", "SimpleList", as.list.SimpleList) setAs("ANY", "SimpleList", function(from) { coerceToSimpleList(from) }) coerceToSimpleList <- function(from, element.type, ...) { if (missing(element.type)) { if (is(from, "List")) element.type <- from@elementType else if (is.list(from)) element.type <- NULL else element.type <- class(from) } SimpleListClass <- listClassName("Simple", element.type) if (!is(from, SimpleListClass)) { listData <- as.list(from) if (!is.null(element.type)) listData <- lapply(listData, coercerToClass(element.type), ...) newList(SimpleListClass, listData) } else { from } } IRanges/R/Vector-class.R0000644000126300012640000007770212227064470016377 0ustar00biocbuildphs_compbio### ========================================================================= ### Vector objects ### ------------------------------------------------------------------------- ### ### The Vector virtual class is a general container for storing a finite ### sequence i.e. an ordered finite collection of elements. ### ### Is it the right place for this? setClassUnion("vectorORfactor", c("vector", "factor")) ### Need to be defined before the Vector class. See DataTable-API.R for the ### implementation of the DataTable API. setClass("DataTable", representation("VIRTUAL")) setClassUnion("DataTableORNULL", c("DataTable", "NULL")) setClass("Vector", contains="Annotated", representation( "VIRTUAL", elementMetadata="DataTableORNULL" ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Internal utility. ### setGeneric("showAsCell", # not exported function(object) standardGeneric("showAsCell") ) setMethod("showAsCell", "ANY", function(object) { if (length(dim(object)) > 2) dim(object) <- c(nrow(object), prod(tail(dim(object), -1))) if (NCOL(object) > 1) { df <- as.data.frame(object[, head(seq_len(ncol(object)), 3), drop = FALSE]) attempt <- do.call(paste, df) if (ncol(object) > 3) attempt <- paste(attempt, "...") attempt } else if (NCOL(object) == 0L) { rep.int("", NROW(object)) } else { attempt <- try(as.vector(object), silent=TRUE) if (is(attempt, "try-error")) rep.int("########", length(object)) else attempt } }) setMethod("showAsCell", "list", function(object) rep.int("########", length(object))) setMethod("showAsCell", "Vector", function(object) rep.int("########", length(object))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("NROW", "Vector", function(x) length(x)) ### 3 accessors for the same slot: elementMetadata(), mcols(), and values(). ### mcols() is the recommended one, use of elementMetadata() or values() is ### discouraged. setGeneric("elementMetadata", function(x, use.names=FALSE, ...) standardGeneric("elementMetadata") ) setMethod("elementMetadata", "Vector", function(x, use.names=FALSE, ...) { if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") ans <- x@elementMetadata if (use.names && !is.null(ans)) rownames(ans) <- names(x) ans } ) setGeneric("mcols", function(x, use.names=FALSE, ...) standardGeneric("mcols") ) setMethod("mcols", "Vector", function(x, use.names=FALSE, ...) elementMetadata(x, use.names=use.names, ...) ) setGeneric("values", function(x, ...) standardGeneric("values")) setMethod("values", "Vector", function(x, ...) elementMetadata(x, ...)) setGeneric("elementMetadata<-", function(x, ..., value) standardGeneric("elementMetadata<-")) setReplaceMethod("elementMetadata", "Vector", function(x, ..., value) { if (!is(value, "DataTableORNULL")) stop("replacement 'elementMetadata' value must be a DataTable object or NULL") if ("elementMetadata" %in% names(attributes(x))) { if (!is.null(value) && length(x) != nrow(value)) stop("the number of rows in elementMetadata 'value' ", "(if non-NULL) must match the length of 'x'") if (!is.null(value)) rownames(value) <- NULL x@elementMetadata <- value } x }) setGeneric("mcols<-", function(x, ..., value) standardGeneric("mcols<-")) setReplaceMethod("mcols", "Vector", function(x, ..., value) `elementMetadata<-`(x, ..., value=value) ) setGeneric("values<-", function(x, ..., value) standardGeneric("values<-")) setReplaceMethod("values", "Vector", function(x, value) { elementMetadata(x) <- value x }) setGeneric("rename", function(x, value, ...) standardGeneric("rename")) .renameVector <- function(x, value, ...) { if (missing(value)) newNames <- c(...) else newNames <- c(value, ...) badOldNames <- setdiff(names(newNames), names(x)) if (length(badOldNames)) stop("Some 'from' names in value not found on 'x': ", paste(badOldNames, collapse = ", ")) names(x)[match(names(newNames), names(x))] <- newNames x } setMethod("rename", "vector", .renameVector) setMethod("rename", "Vector", .renameVector) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.Vector.length <- function(x) { x_len <- length(x) if (!isSingleInteger(x_len) || x_len < 0L) return("'length(x)' must be a single non-negative integer") if (!is.null(names(x_len))) return("'length(x)' must be an unnamed number") NULL } .valid.Vector.names <- function(x) { x_names <- names(x) if (is.null(x_names)) return(NULL) if (!is.character(x_names) || !is.null(names(x_names))) return("'names(x)' must be NULL or an unnamed character vector") if (length(x_names) != length(x)) return("when not NULL, 'names(x)' must have the length of 'x'") NULL } .valid.Vector.mcols <- function(x) { x_mcols <- mcols(x) if (!is(x_mcols, "DataTableORNULL")) return("'mcols(x)' must be a DataTable object or NULL") if (is.null(x_mcols)) return(NULL) ## 'x_mcols' is a DataTable object. if (nrow(x_mcols) != length(x)) { msg <- c("number of rows in DataTable 'mcols(x)' ", "must match length of 'x'") return(paste(msg, collapse="")) } if (!is.null(rownames(x_mcols)) && !identical(rownames(x_mcols), names(x))) { msg <- c("the rownames of DataTable 'mcols(x)' ", "must match the names of 'x'") return(paste(msg, collapse="")) } NULL } .valid.Vector <- function(x) { c(.valid.Vector.length(x), .valid.Vector.names(x), .valid.Vector.mcols(x)) } setValidity2("Vector", .valid.Vector) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Subsetting. ### setMethod("extractROWS", "NULL", function(x, i) NULL) .extractROWSFromArray <- function(x, i) { if (is(i, "Ranges")) i <- extractROWS(seq_len(nrow(x)), i) ## dynamically call [i,,,..,drop=FALSE] with as many "," as length(dim)-1 i <- normalizeSingleBracketSubscript(i, x, byrow=TRUE) ndim <- max(length(dim(x)), 1L) args <- rep(alist(foo=), ndim) names(args) <- NULL args[[1]] <- i args <- c(list(x), args, list(drop = FALSE)) do.call(`[`, args) } setMethod("extractROWS", "matrix", function(x, i) { if (missing(i)) return(x) return(.extractROWSFromArray(x, i)) }) setMethod("extractROWS", "vectorORfactor", function(x, i) { if (missing(i)) return(x) if (!is(i, "Ranges")) { i <- normalizeSingleBracketSubscript(i, x) return(x[i]) } ## Which one is faster, vector_seqselect or vector_subsetByRanges? ans <- .Call2("vector_seqselect", x, start(i), width(i), PACKAGE="IRanges") #ans <- .Call2("vector_subsetByRanges", x, start(i), width(i), # PACKAGE="IRanges") if (is.factor(x)) attributes(ans) <- list(levels=levels(x), class="factor") ans } ) setMethod("[", "Vector", function(x, i, j, ..., drop=TRUE) { if (!missing(j) || length(list(...)) > 0L) stop("invalid subsetting") extractROWS(x, i) } ) setMethod("replaceROWS", "vectorORfactor", function(x, i, value) { i <- extractROWS(setNames(seq_along(x), names(x)), i) x[i] <- value x } ) ### Works on any Vector object for which c() and [ work. Assumes 'value' is ### compatible with 'x'. setMethod("replaceROWS", "Vector", function(x, i, value) { idx <- seq_along(x) i <- extractROWS(setNames(idx, names(x)), i) ## Assuming that objects of class 'class(x)' can be combined with c(). ans <- c(x, value) idx[i] <- length(x) + seq_len(length(value)) ## Assuming that [ works on objects of class 'class(x)'. ans <- ans[idx] ## Restore the original decoration. metadata(ans) <- metadata(x) names(ans) <- names(x) mcols(ans) <- mcols(x) ans } ) setReplaceMethod("[", "Vector", function(x, i, j, ..., value) { if (!missing(j) || length(list(...)) > 0L) stop("invalid subsetting") if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) if (is(i, "Ranges")) li <- sum(width(i)) else li <- length(i) if (li == 0L) { ## Surprisingly, in that case, `[<-` on standard vectors does not ## even look at 'value'. So neither do we... return(x) } lv <- NROW(value) if (lv == 0L) stop("replacement has length zero") value <- normalizeSingleBracketReplacementValue(value, x) if (li != lv) { if (li %% lv != 0L) warning("number of values supplied is not a sub-multiple ", "of the number of values to be replaced") value <- extractROWS(value, rep(seq_len(lv), length.out=li)) } replaceROWS(x, i, value) } ) ### Old stuff. setGeneric("seqselect", signature="x", function(x, start=NULL, end=NULL, width=NULL) standardGeneric("seqselect") ) setMethod("seqselect", "ANY", function(x, start=NULL, end=NULL, width=NULL) { .Deprecated(msg="seqselect() is deprecated.") if (!is.null(end) || !is.null(width)) start <- IRanges(start=start, end=end, width=width) extractROWS(x, start) } ) setGeneric("seqselect<-", signature="x", function(x, start=NULL, end=NULL, width=NULL, value) standardGeneric("seqselect<-") ) setReplaceMethod("seqselect", "ANY", function(x, start=NULL, end=NULL, width=NULL, value) { .Deprecated(msg="seqselect() is deprecated.") if (!is.null(end) || !is.null(width)) start <- IRanges(start=start, end=end, width=width) replaceROWS(x, start, value) } ) subsetByRanges <- function(x, i) { .Deprecated("extractROWS") if (!is(i, "Ranges")) stop("'i' must be a Ranges object") extractROWS(x, i) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Simple helper functions for some common subsetting operations. ### ### S3/S4 combo for head.Vector head.Vector <- function(x, n=6L, ...) { if (!isSingleNumber(n)) stop("'n' must be a single integer") if (!is.integer(n)) n <- as.integer(n) x_NROW <- NROW(x) if (n >= 0L) { n <- min(n, x_NROW) } else { n <- max(x_NROW + n, 0L) } extractROWS(x, IRanges(start=1L, width=n)) } setMethod("head", "Vector", head.Vector) ## S3/S4 combo for tail.Vector tail.Vector <- function(x, n=6L, ...) { if (!isSingleNumber(n)) stop("'n' must be a single integer") if (!is.integer(n)) n <- as.integer(n) x_NROW <- NROW(x) if (n >= 0L) { n <- min(n, x_NROW) } else { n <- max(x_NROW + n, 0L) } extractROWS(x, IRanges(end=x_NROW, width=n)) } setMethod("tail", "Vector", tail.Vector) ### S3/S4 combo for window.Vector window.Vector <- function(x, start=NA, end=NA, width=NA, frequency=NULL, delta=NULL, ...) { i <- solveUserSEWForSingleSeq(NROW(x), start, end, width) if (!is.null(frequency) || !is.null(delta)) { i <- stats:::window.default(seq_len(NROW(x)), start=start(i), end=end(i), frequency=frequency, deltat=delta, ...) attributes(i) <- NULL } extractROWS(x, i) } setMethod("window", "Vector", window.Vector) ### S3/S4 combo for window.vector ### FIXME: This method alters the semantic of stats::window() on ordinary ### vectors (the result has no 'tsp' attribute). Not really acceptable. window.vector <- window.Vector setMethod("window", "vector", window.vector) ### S3/S4 combo for window.factor ### FIXME: This method alters the semantic of stats::window() on factors ### (the result has no 'tsp' attribute). Not really acceptable. window.factor <- window.Vector setMethod("window", "factor", window.factor) ### S3/S4 combo for window.NULL window.NULL <- window.Vector setMethod("window", "NULL", window.NULL) ### S3/S4 combo for window<-.Vector `window<-.Vector` <- function(x, start=NA, end=NA, width=NA, ..., value) { i <- solveUserSEWForSingleSeq(NROW(x), start, end, width) li <- width(i) if (li == 0L) { ## Surprisingly, in that case, `[<-` on standard vectors does not ## even look at 'value'. So neither do we... return(x) } lv <- NROW(value) if (lv == 0L) stop("replacement has length zero") value <- normalizeSingleBracketReplacementValue(value, x) if (li != lv) { if (li %% lv != 0L) warning("number of values supplied is not a sub-multiple ", "of the number of values to be replaced") value <- extractROWS(value, rep(seq_len(lv), length.out=li)) } c(window(x, end=start(i)-1L), value, window(x, start=end(i)+1L)) } setReplaceMethod("window", "Vector", `window<-.Vector`) ### S3/S4 combo for window<-.vector `window<-.vector` <- `window<-.Vector` setReplaceMethod("window", "vector", `window<-.vector`) ### S3/S4 combo for window<-.factor `window<-.factor` <- function(x, start=NA, end=NA, width=NA, ..., value) { levels <- levels(x) x <- as.character(x) value <- as.character(value) factor(callGeneric(), levels=levels) } setReplaceMethod("window", "factor", `window<-.factor`) setMethod("rev", "Vector", function(x) { if (length(x) == 0L) return(x) x[length(x):1] } ) setMethod("rep", "Vector", function(x, ...) x[rep(seq_len(length(x)), ...)]) setMethod("rep.int", "Vector", function(x, times) x[rep.int(seq_len(length(x)), times)] ) setMethod("subset", "Vector", function(x, subset, select, drop = FALSE, ...) { if (missing(subset)) i <- TRUE else { i <- eval(substitute(subset), mcols(x), parent.frame(2)) i <- try(as.logical(i), silent = TRUE) if (inherits(i, "try-error")) stop("'subset' must be coercible to logical") i <- i & !is.na(i) } if (!missing(select)) { nl <- as.list(seq_len(ncol(mcols(x)))) names(nl) <- colnames(mcols(x)) j <- eval(substitute(select), nl, parent.frame(2)) mcols(x) <- mcols(x)[,j,drop=FALSE] } x[i, drop = drop] }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### setMethod("as.logical", "Vector", function(x) as.vector(x, mode="logical") ) setMethod("as.integer", "Vector", function(x) as.vector(x, mode="integer") ) setMethod("as.numeric", "Vector", function(x) as.vector(x, mode="numeric") ) setMethod("as.double", "Vector", function(x) as.vector(x, mode="double") ) setMethod("as.complex", "Vector", function(x) as.vector(x, mode="complex") ) setMethod("as.character", "Vector", function(x) as.vector(x, mode="character") ) setMethod("as.raw", "Vector", function(x) as.vector(x, mode="raw") ) setAs("Vector", "vector", function(from) as.vector(from)) setAs("Vector", "logical", function(from) as.logical(from)) setAs("Vector", "integer", function(from) as.integer(from)) setAs("Vector", "numeric", function(from) as.numeric(from)) setAs("Vector", "double", function(from) as.double(from)) setAs("Vector", "complex", function(from) as.complex(from)) setAs("Vector", "character", function(from) as.character(from)) setAs("Vector", "raw", function(from) as.raw(from)) setAs("Vector", "data.frame", function(from) as.data.frame(from)) ### S3/S4 combo for as.data.frame.Vector as.data.frame.Vector <- function(x, row.names=NULL, optional=FALSE, ...) { x <- as.vector(x) as.data.frame(x, row.names=NULL, optional=optional, ...) } setMethod("as.data.frame", "Vector", as.data.frame.Vector) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining. ### rbindRowOfNAsToMetadatacols <- function(x) { x_mcols <- mcols(x) if (!is.null(x_mcols)) mcols(x)[nrow(x_mcols)+1L,] <- NA x } rbind.mcols <- function(x, ...) { l <- list(x, ...) l_mcols <- lapply(l, mcols) no_mcols <- sapply(l_mcols, is.null) if (all(no_mcols)) return(NULL) newDf <- function(nr) new("DataFrame", nrows = nr) l_mcols[no_mcols] <- lapply(elementLengths(l[no_mcols]), newDf) allCols <- unique(do.call(c, lapply(l_mcols, colnames))) fillCols <- function(df) { if (nrow(df)) df[setdiff(allCols, colnames(df))] <- DataFrame(NA) df } do.call(rbind, lapply(l_mcols, fillCols)) } .c.Vector <- function(x, ..., recursive = FALSE) { if (!is.null(mcols(x))) mcols(x) <- rbind.mcols(x, ...) x } setMethod("c", "Vector", function(x, ..., recursive = FALSE) stop("missing 'c' method for Vector class ", class(x))) ### FIXME: This method doesn't work properly on DataTable objects if 'after' ### is >= 1 and < length(x). setMethod("append", c("Vector", "Vector"), function(x, values, after=length(x)) { if (!isSingleNumber(after)) stop("'after' must be a single number") x_len <- length(x) if (after == 0L) c(values, x) else if (after >= x_len) c(x, values) else c(head(x, n=after), values, tail(x, n=-after)) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Splitting / relisting. ### setGeneric("splitAsListReturnedClass", function(x) standardGeneric("splitAsListReturnedClass") ) setMethod("splitAsListReturnedClass", "ANY", function(x) listClassName("Compressed", class(x)) ) setMethod("relist", c("ANY", "PartitioningByEnd"), function(flesh, skeleton) { ans_class <- splitAsListReturnedClass(flesh) skeleton_len <- length(skeleton) if (skeleton_len == 0L) { flesh_len2 <- 0L } else { flesh_len2 <- end(skeleton)[skeleton_len] } if (NROW(flesh) != flesh_len2) stop("shape of 'skeleton' is not compatible with 'NROW(flesh)'") if (extends(ans_class, "CompressedList")) return(newCompressedList0(ans_class, flesh, skeleton)) if (!extends(ans_class, "SimpleList")) stop("don't know how to split or relist a ", class(flesh), " object as a ", ans_class, " object") listData <- lapply(skeleton, function(i) extractROWS(flesh, i)) ## TODO: Once "window" methods have been revisited/tested and ## 'window(flesh, start=start, end=end)' is guaranteed to do the ## right thing for any 'flesh' object (in particular it subsets a ## data.frame-like object along the rows), then replace the line above ## by the code below (which should be more efficient): #skeleton_start <- start(skeleton) #skeleton_end <- end(skeleton) #FUN <- function(start, end) window(flesh, start=start, end=end) #names(skeleton_start) <- names(skeleton) #listData <- mapply(FUN, skeleton_start, skeleton_end) ## or, if we don't trust mapply(): #skeleton_start <- start(skeleton) #skeleton_end <- end(skeleton) #X <- seq_len(skeleton_len) #names(X) <- names(skeleton) #listData <- lapply(X, function(i) window(flesh, # start=skeleton_start[i], # end=skeleton_end[i])) newList(ans_class, listData) } ) setMethod("relist", c("ANY", "List"), function(flesh, skeleton) { relist(flesh, PartitioningByEnd(skeleton)) } ) setMethod("relist", c("Vector", "list"), function(flesh, skeleton) { relist(flesh, PartitioningByEnd(skeleton)) } ) .splitAsList_by_listlike <- function(x, f, drop) { if (!identical(drop, FALSE)) warning("'drop' is ignored when 'f' is a list-like object") if (!is(f, "PartitioningByEnd")) f <- PartitioningByEnd(f) relist(x, f) } .splitAsList_by_integer <- function(x, f, drop) { if (length(f) > NROW(x)) stop("'f' cannot be longer than 'NROW(x)' when it's an integer vector") idx <- orderInteger(f) tmp <- Rle(f[idx]) f <- cumsum(runLength(tmp)) names(f) <- as.character(runValue(tmp)) if (!identical(drop, FALSE)) warning("'drop' is ignored when 'f' is an integer vector") x <- extractROWS(x, idx) f <- PartitioningByEnd(f) relist(x, f) } .splitAsList_by_factor <- function(x, f, drop) { x_NROW <- NROW(x) f_len <- length(f) f_levels <- levels(f) f <- as.integer(f) if (f_len > x_NROW) f <- head(f, n=x_NROW) idx <- orderInteger(f) f <- tabulate(f, nbins=length(f_levels)) names(f) <- f_levels if (drop) f <- f[f != 0L] f <- cumsum(f) x <- extractROWS(x, idx) f <- PartitioningByEnd(f) relist(x, f) } .splitAsList_by_integer_Rle <- function(x, f, drop) { if (length(f) > NROW(x)) stop("'f' cannot be longer than data when it's an integer-Rle") f_vals <- runValue(f) f_lens <- runLength(f) idx <- orderInteger(f_vals) xranges <- successiveIRanges(f_lens)[idx] tmp <- Rle(f_vals[idx], f_lens[idx]) f <- cumsum(runLength(tmp)) names(f) <- as.character(runValue(tmp)) if (!identical(drop, FALSE)) warning("'drop' is ignored when 'f' is an integer-Rle") x <- extractROWS(x, xranges) f <- PartitioningByEnd(f) relist(x, f) } .splitAsList_by_Rle <- function(x, f, drop) { x_NROW <- NROW(x) f_len <- length(f) f_vals <- runValue(f) if (!is.factor(f_vals)) { f_vals <- as.factor(f_vals) if (f_len > x_NROW) { runValue(f) <- f_vals f <- head(f, n=x_NROW) f_vals <- runValue(f) } } else if (f_len > x_NROW) { f <- head(f, n=x_NROW) f_vals <- runValue(f) } f_lens <- runLength(f) f_levels <- levels(f_vals) f_vals <- as.integer(f_vals) idx <- orderInteger(f_vals) xranges <- successiveIRanges(f_lens)[idx] ## Using tabulate2() is 5x faster than doing: ## f <- integer(length(f_levels)) ## tmp <- Rle(f_vals[idx], f_lens[idx]) ## f[runValue(tmp)] <- runLength(tmp) f <- tabulate2(f_vals, nbins=length(f_levels), weight=f_lens) names(f) <- f_levels if (drop) f <- f[f != 0L] f <- cumsum(f) x <- extractROWS(x, xranges) f <- PartitioningByEnd(f) relist(x, f) } splitAsList <- function(x, f, drop=FALSE) { if (!isTRUEorFALSE(drop)) stop("'drop' must be TRUE or FALSE") if (is.list(f) || is(f, "List")) return(.splitAsList_by_listlike(x, f, drop)) x_NROW <- NROW(x) f_len <- length(f) if (f_len < x_NROW) { if (f_len == 0L) stop("'length(f)' is 0 but 'NROW(x)' is > 0") if (x_NROW %% f_len != 0L) warning("'NROW(x)' is not a multiple of 'length(f)'") f <- rep(f, length.out=x_NROW) } if (is.integer(f)) return(.splitAsList_by_integer(x, f, drop)) if (is.atomic(f) && is.vector(f)) f <- as.factor(f) if (is.factor(f)) return(.splitAsList_by_factor(x, f, drop)) if (!is(f, "Rle")) stop("'f' must be an atomic vector or a factor (possibly ", "in Rle form), or a list-like object") f_vals <- runValue(f) if (!(is.atomic(f_vals) && is.vector(f_vals)) && !is.factor(f_vals)) stop("'f' must be an atomic vector or a factor (possibly ", "in Rle form), or a list-like object") if (is.integer(f_vals)) return(.splitAsList_by_integer_Rle(x, f, drop)) return(.splitAsList_by_Rle(x, f, drop)) } setMethod("split", c("Vector", "ANY"), function(x, f, drop=FALSE, ...) splitAsList(x, f, drop=drop) ) setMethod("split", c("ANY", "Vector"), function(x, f, drop=FALSE, ...) splitAsList(x, f, drop=drop) ) setMethod("split", c("list", "Vector"), function(x, f, drop=FALSE, ...) split(x, as.vector(f), drop=drop) ) setMethod("split", c("Vector", "Vector"), function(x, f, drop=FALSE, ...) splitAsList(x, f, drop=drop) ) `seqsplit<-` <- function(x, f, drop = FALSE, ..., value) { if (!isTRUEorFALSE(drop)) stop("'drop' must be TRUE or FALSE") if (length(x) != length(f)) stop("Length of 'f' must equal the length of 'x'") ind <- seqsplit(seq_len(length(x)), f, drop = drop) if (length(ind) != length(value)) stop("Length of 'value' must equal the length of a split on 'f'") x[unlist(ind, use.names=FALSE)] <- unlist(value, use.names = FALSE) x } setReplaceMethod("split", "Vector", function(x, f, drop = FALSE, ..., value) { seqsplit(x, f, drop = drop, ...) <- value x }) multisplit <- function(x, f) { if (!is.list(f) && !is(f, "List")) stop("'f' must be a list") if (length(x) != length(f)) stop("Length of 'f' must equal length of 'x'") seqsplit(rep(x, elementLengths(f)), unlist(f, use.names = FALSE)) } setGeneric("mstack", function(..., .index.var = "name") standardGeneric("mstack"), signature = "...") setMethod("mstack", "Vector", function(..., .index.var = "name") { if (!isSingleString(.index.var)) stop("'.index.var' must be a single, non-NA string") args <- list(...) combined <- do.call(c, unname(args)) df <- .stack.ind(args, .index.var) if (!is.null(mcols(combined))) df <- cbind(mcols(combined), df) mcols(combined) <- df combined }) setMethod("mstack", "vector", function(..., .index.var = "name") { if (!isSingleString(.index.var)) stop("'.index.var' must be a single, non-NA string") args <- list(...) combined <- do.call(c, unname(args)) df <- DataFrame(combined, .stack.ind(args, .index.var)) colnames(df)[1] <- "value" df }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Looping methods. ### #.tapplyDefault <- base::tapply #environment(.tapplyDefault) <- topenv() .tapplyDefault <- function(X, INDEX, FUN = NULL, ..., simplify = TRUE) { if (!is.null(FUN)) FUN <- match.fun(FUN) if (missing(INDEX)) stop("'INDEX' is missing") if (!is(INDEX, "RleList")) { if (!is.list(INDEX) && !is(INDEX, "Rle")) INDEX <- Rle(INDEX) INDEX <- RleList(INDEX) } nI <- length(INDEX) namelist <- vector("list", nI) names(namelist) <- names(INDEX) extent <- integer(nI) nx <- length(X) one <- 1L group <- Rle(one, nx) ngroup <- one for (i in seq_len(nI)) { index <- INDEX[[i]] if (!is.factor(runValue(index))) runValue(index) <- factor(runValue(index)) offset <- index runValue(offset) <- ngroup * (as.integer(runValue(index)) - one) if (length(index) != nx) stop("arguments must have same length") namelist[[i]] <- levels(index) extent[i] <- nlevels(index) group <- group + offset ngroup <- ngroup * nlevels(index) } if (is.null(FUN)) return(as.vector(group)) groupRanges <- splitRanges(group) ans <- lapply(groupRanges, function(i) FUN(extractROWS(X, i), ...)) index <- as.integer(names(ans)) if (simplify && all(unlist(lapply(ans, length), use.names=FALSE) == 1L)) { ansmat <- array(dim = extent, dimnames = namelist) ans <- unlist(ans, recursive = FALSE) } else { ansmat <- array(vector("list", prod(extent)), dim = extent, dimnames = namelist) } if (length(index) > 0) { names(ans) <- NULL ansmat[index] <- ans } ansmat } setMethod("tapply", c("Vector", "ANY"), .tapplyDefault) setMethod("tapply", c("ANY", "Vector"), .tapplyDefault) setMethod("tapply", c("Vector", "Vector"), .tapplyDefault) .shiftApplyInternal <- function(SHIFT, X, Y, FUN, ..., OFFSET = 0L, simplify = TRUE, verbose = FALSE) { FUN <- match.fun(FUN) N <- length(X) if (N != length(Y)) stop("'X' and 'Y' must be of equal length") if (!is.integer(SHIFT)) SHIFT <- as.integer(SHIFT) if (length(SHIFT) == 0 || anyMissingOrOutside(SHIFT, 0L)) stop("all 'SHIFT' values must be non-negative") if (!is.integer(OFFSET)) OFFSET <- as.integer(OFFSET) if (length(OFFSET) == 0 || anyMissingOrOutside(OFFSET, 0L)) stop("'OFFSET' must be non-negative") ## Perform X setup shiftedStartX <- rep.int(1L + OFFSET, length(SHIFT)) shiftedEndX <- N - SHIFT ## Perform Y setup shiftedStartY <- 1L + SHIFT shiftedEndY <- rep.int(N - OFFSET, length(SHIFT)) if (verbose) { maxI <- length(SHIFT) ans <- sapply(seq_len(length(SHIFT)), function(i) { cat("\r", i, "/", maxI) FUN(window(X, start = shiftedStartX[i], end = shiftedEndX[i]), window(Y, start = shiftedStartY[i], end = shiftedEndY[i]), ...) }, simplify = simplify) cat("\n") } else { ans <- sapply(seq_len(length(SHIFT)), function(i) FUN(window(X, start = shiftedStartX[i], end = shiftedEndX[i]), window(Y, start = shiftedStartY[i], end = shiftedEndY[i]), ...), simplify = simplify) } ans } setGeneric("shiftApply", signature = c("X", "Y"), function(SHIFT, X, Y, FUN, ..., OFFSET = 0L, simplify = TRUE, verbose = FALSE) standardGeneric("shiftApply")) setMethod("shiftApply", signature(X = "Vector", Y = "Vector"), .shiftApplyInternal) setMethod("shiftApply", signature(X = "vector", Y = "vector"), .shiftApplyInternal) .aggregateInternal <- function(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE) { FUN <- match.fun(FUN) if (!missing(by)) { if (is.list(by)) { return(callGeneric(x = as.data.frame(x), by = by, FUN = FUN, ...)) } start <- start(by) end <- end(by) } else { if (!is.null(width)) { if (is.null(start)) start <- end - width + 1L else if (is.null(end)) end <- start + width - 1L } start <- as(start, "integer") end <- as(end, "integer") } if (length(start) != length(end)) stop("'start', 'end', and 'width' arguments have unequal length") n <- length(start) if (!is.null(names(start))) indices <- structure(seq_len(n), names = names(start)) else indices <- structure(seq_len(n), names = names(end)) if (is.null(frequency) && is.null(delta)) { sapply(indices, function(i) FUN(window(x, start = start[i], end = end[i]), ...), simplify = simplify) } else { frequency <- rep(frequency, length.out = n) delta <- rep(delta, length.out = n) sapply(indices, function(i) FUN(window(x, start = start[i], end = end[i], frequency = frequency[i], delta = delta[i]), ...), simplify = simplify) } } setMethod("aggregate", "Vector", .aggregateInternal) setMethod("aggregate", "vector", .aggregateInternal) setMethod("aggregate", "matrix", stats:::aggregate.default) setMethod("aggregate", "data.frame", stats:::aggregate.data.frame) setMethod("aggregate", "ts", stats:::aggregate.ts) IRanges/R/Vector-comparison.R0000644000126300012640000002061112227064470017427 0ustar00biocbuildphs_compbio### ========================================================================= ### Comparing and ordering vector-like objects ### ------------------------------------------------------------------------- ### ### Method signatures for binary comparison operators. .BIN_COMP_OP_SIGNATURES <- list( c("Vector", "Vector"), c("Vector", "ANY"), c("ANY", "Vector") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Element-wise (aka "parallel") comparison of 2 Vector objects. ### setGeneric("compare", function(x, y) standardGeneric("compare")) ### The methods below are implemented on top of compare(). setMethods("==", .BIN_COMP_OP_SIGNATURES, function(e1, e2) { compare(e1, e2) == 0L } ) setMethods("<=", .BIN_COMP_OP_SIGNATURES, function(e1, e2) { compare(e1, e2) <= 0L } ) ### The methods below are implemented on top of == and <=. setMethods("!=", .BIN_COMP_OP_SIGNATURES, function(e1, e2) { !(e1 == e2) }) setMethods(">=", .BIN_COMP_OP_SIGNATURES, function(e1, e2) { e2 <= e1 }) setMethods("<", .BIN_COMP_OP_SIGNATURES, function(e1, e2) { !(e2 <= e1) }) setMethods(">", .BIN_COMP_OP_SIGNATURES, function(e1, e2) { !(e1 <= e2) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### selfmatch() ### ### The default "selfmatch" method below is implemented on top of match(). ### setGeneric("selfmatch", function(x, ...) standardGeneric("selfmatch") ) ### Default "selfmatch" method. Args in ... are propagated to match(). setMethod("selfmatch", "ANY", function(x, ...) match(x, x, ...)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### duplicated() & unique() ### ### The "duplicated" method below is implemented on top of selfmatch(). ### The "unique" method below is implemented on top of duplicated(). ### ### S3/S4 combo for duplicated.Vector duplicated.Vector <- function(x, incomparables=FALSE, ...) { if (!identical(incomparables, FALSE)) stop("the \"duplicated\" method for Vector objects ", "only accepts 'incomparables=FALSE'") args <- list(...) if ("fromLast" %in% names(args)) { fromLast <- args$fromLast if (!isTRUEorFALSE(fromLast)) stop("'fromLast' must be TRUE or FALSE") args$fromLast <- NULL if (fromLast) x <- rev(x) } else { fromLast <- FALSE } xx <- do.call(selfmatch, c(list(x), args)) ans <- xx != seq_along(xx) if (fromLast) ans <- rev(ans) ans } setMethod("duplicated", "Vector", duplicated.Vector) ### S3/S4 combo for unique.Vector unique.Vector <- function(x, incomparables=FALSE, ...) { i <- !duplicated(x, incomparables=incomparables, ...) if (length(dim(x)) < 2L) return(x[i]) x[i, , drop=FALSE] } setMethod("unique", "Vector", unique.Vector) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### %in% ### ### The method below is implemented on top of match(). ### setMethods("%in%", .BIN_COMP_OP_SIGNATURES, function(x, table) { !is.na(match(x, table)) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### findMatches() & countMatches() ### ### The default "findMatches" and "countMatches" methods below are ### implemented on top of match(). ### setGeneric("findMatches", signature=c("x", "table"), function(x, table, select=c("all", "first", "last"), ...) standardGeneric("findMatches") ) ### Equivalent to 'countQueryHits(findMatches(x, table))' but the default ### "countMatches" method below has a more efficient implementation. setGeneric("countMatches", signature=c("x", "table"), function(x, table, ...) standardGeneric("countMatches") ) ### Problem: using transpose=TRUE generates an invalid Hits object (hits are ### not ordered): ### > IRanges:::.findAllMatchesInSmallTable(1:6, c(7:5, 4:5), transpose=TRUE) ### Hits of length 4 ### queryLength: 5 ### subjectLength: 6 ### queryHits subjectHits ### ### 1 4 4 ### 2 3 5 ### 3 5 5 ### 4 2 6 ### and the cost of ordering them would probably defeat the purpose of the ### "put the smallest object on the right" optimization trick. .findAllMatchesInSmallTable <- function(x, table, ..., transpose=FALSE) { x2 <- match(x, table, ...) table2 <- selfmatch(table, ...) table_low2high <- makeLow2highFromHigh2low(table2) hits_per_x <- table_low2high[x2] x_hits <- rep.int(seq_along(hits_per_x), elementLengths(hits_per_x)) if (length(x_hits) == 0L) { table_hits <- integer(0) } else { table_hits <- unlist(hits_per_x, use.names=FALSE) } if (transpose) { new2("Hits", queryHits=table_hits, subjectHits=x_hits, queryLength=length(table), subjectLength=length(x), check=FALSE) } else { new2("Hits", queryHits=x_hits, subjectHits=table_hits, queryLength=length(x), subjectLength=length(table), check=FALSE) } } ### Default "findMatches" method. Args in ... are propagated to match() and ### selfmatch(). setMethod("findMatches", c("ANY", "ANY"), function(x, table, select=c("all", "first", "last"), ...) { select <- match.arg(select) if (select != "all") stop("'select' is not supported yet. Note that you can use ", "match() if you want to do 'select=\"first\"'. Otherwise ", "you're welcome to request this on the Bioconductor ", "mailing list.") ## "put the smallest object on the right" optimization trick #if (length(x) < length(table)) # return(.findAllMatchesInSmallTable(table, x, ..., transpose=TRUE)) .findAllMatchesInSmallTable(x, table, ...) } ) ### Default "countMatches" method. Args in ... are propagated to match() and ### selfmatch(). .countMatches.default <- function(x, table, ...) { x_len <- length(x) table_len <- length(table) if (x_len <= table_len) { table2 <- match(table, x, ...) # can contain NAs nbins <- x_len x2 <- selfmatch(x, ...) # no NAs } else { table2 <- selfmatch(table, ...) # no NAs nbins <- table_len + 1L x2 <- match(x, table, nomatch=nbins, ...) } tabulate(table2, nbins=nbins)[x2] } setMethod("countMatches", c("ANY", "ANY"), .countMatches.default) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### sort() ### ### The method below is implemented on top of order(). ### ### S3/S4 combo for sort.Vector .sort.Vector <- function(x, decreasing=FALSE, na.last=NA) { i <- order(x, na.last=na.last, decreasing=decreasing) if (length(dim(x)) < 2L) return(x[i]) x[i, , drop=FALSE] } sort.Vector <- function(x, decreasing=FALSE, ...) .sort.Vector(x, decreasing=decreasing, ...) setMethod("sort", "Vector", sort.Vector) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### table() ### ### The method below is implemented on top of selfmatch(), order(), and ### as.character(). ### ### This is a copy/paste of the list.names() function locally defined inside ### base::table(). .list.names <- function(...) { deparse.level <- 1 l <- as.list(substitute(list(...)))[-1L] nm <- names(l) fixup <- if (is.null(nm)) seq_along(l) else nm == "" dep <- vapply(l[fixup], function(x) switch(deparse.level + 1, "", if (is.symbol(x)) as.character(x) else "", deparse(x, nlines = 1)[1L]), "") if (is.null(nm)) dep else { nm[fixup] <- dep nm } } .compute_table <- function(x) { xx <- selfmatch(x) t <- tabulate(xx, nbins=length(xx)) keep_idx <- which(t != 0L) x2 <- x[keep_idx] t2 <- t[keep_idx] oo <- order(x2) x2 <- x2[oo] t2 <- t2[oo] ans <- array(t2) dimnames(ans) <- list(as.character(x2)) ans } setMethod("table", "Vector", function(...) { args <- list(...) if (length(args) > 1L) stop("the \"table\" method for Vector objects currently ", "only supports one argument") x <- args[[1L]] ## Compute the table as an array. ans <- .compute_table(x) ## Some cosmetic adjustments. names(dimnames(ans)) <- .list.names(...) class(ans) <- "table" ans } ) IRanges/R/Views-class.R0000644000126300012640000002661712227064470016231 0ustar00biocbuildphs_compbio### ========================================================================= ### Views objects ### ------------------------------------------------------------------------- ### ### The Views virtual class is a general container for storing a set of views ### on an arbitrary Vector object, called the "subject". ### setClass("Views", contains="List", representation( "VIRTUAL", subject="Vector", ranges="IRanges" ) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setGeneric("subject", function(x) standardGeneric("subject")) setMethod("subject", "Views", function(x) x@subject) setGeneric("ranges", function(x, ...) standardGeneric("ranges")) setMethod("ranges", "Views", function(x) x@ranges) setGeneric("ranges<-", function(x, ..., value) standardGeneric("ranges<-")) setReplaceMethod("ranges", "Views", function(x, ..., value) { stop("ranges setter for Views objects not ready yet") } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Methods derived from the IRanges interface. ### setMethod("length", "Views", function(x) length(ranges(x))) setMethod("start", "Views", function(x, ...) start(ranges(x))) setMethod("end", "Views", function(x, ...) end(ranges(x))) setMethod("width", "Views", function(x) width(ranges(x))) setMethod("names", "Views", function(x) names(ranges(x))) setReplaceMethod("start", "Views", function(x, check=TRUE, value) { x@ranges <- `start<-`(ranges(x), check=check, value) x } ) setReplaceMethod("end", "Views", function(x, check=TRUE, value) { x@ranges <- `end<-`(ranges(x), check=check, value) x } ) setReplaceMethod("width", "Views", function(x, check=TRUE, value) { x@ranges <- `width<-`(ranges(x), check=check, value) x } ) setReplaceMethod("names", "Views", function(x, value) { x@ranges <- `names<-`(ranges(x), value) x } ) setMethod("extractROWS", "Views", function(x, i) { if (missing(i) || !is(i, "Ranges")) i <- normalizeSingleBracketSubscript(i, x) x@ranges <- extractROWS(ranges(x), i) mcols(x) <- extractROWS(mcols(x), i) x } ) setMethod("elementLengths", "Views", function(x) width(x)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Validity. ### .valid.Views.width <- function(x) { if (length(width(x)) != 0L && min(width(x)) <= 0L) return("null widths are not allowed") NULL } setValidity2("Views", .valid.Views.width) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The low-level "Views" constructor. ### ### TODO: - add a 'check.limits' arg (default to TRUE) for raising an error if ### some views are "out of limits". ### newViews <- function(subject, start=NULL, end=NULL, width=NULL, names=NULL, Class=NULL) { if (is(start, "Ranges")) { if (!is.null(end) || !is.null(width)) stop("'end' and 'width' must be NULLs when 'start' is a Ranges object") ranges <- start if (class(ranges) != "IRanges") ranges <- as(ranges, "IRanges") ## Keep the names that are already in 'ranges' unless the 'names' arg ## was specified. if (!is.null(names)) names(ranges) <- names } else { ranges <- IRanges(start=start, end=end, width=width, names=names) } if (is.null(Class)) Class <- paste(class(subject), "Views", sep="") new2(Class, subject=subject, ranges=ranges, check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The user-friendly "Views" constructor. ### ### TODO: Same as for the newViews() function above. ### setGeneric("Views", signature="subject", function(subject, start=NULL, end=NULL, width=NULL, names=NULL) standardGeneric("Views") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion. ### ### Returns a single view covering the entire sequence. setAs("Vector", "Views", function(from) Views(from, start=1L, width=length(from)) ) setAs("Views", "Ranges", function(from) ranges(from)) setAs("Views", "IRanges", function(from) ranges(from)) ### Unfortunately, even if we've already defined the IRanges->NormalIRanges ### "coerce" method to override the silly implicit one, we still need to ### define the ->NormalIRanges ones for every that contains ### IRanges. Otherwise, again, 'as(x, "NormalIRanges")' would call another ### silly implicit method when 'x' is a instance. ### Yes, this is another S4 "feature": ### https://stat.ethz.ch/pipermail/r-devel/2008-April/049027.html setAs("Views", "NormalIRanges", function(from) asNormalIRanges(ranges(from), force=TRUE) ) setMethod("as.matrix", "Views", function(x, rev = FALSE, max.width = NA) { ## TODO: Supress this warning in BioC 2.12. msg <- c("as.matrix() on a Views object 'x' has changed ", "behavior: now each view is converted into a row of the\n", " returned matrix. To achieve the old behavior, ", "do 'as.matrix(ranges(x))'.\n To supress this warning, do ", "'suppressWarnings(as.matrix(x))'.\n This warning will be ", "removed in BioC 2.12.") warning(msg) x_ranges <- restrict(ranges(x), start = 1L) if (is.na(max.width)) { max.width <- max(width(x_ranges)) } rev <- recycleVector(rev, length(x)) part <- PartitioningByWidth(x_ranges) ord <- mseq(ifelse(rev, end(part), start(part)), ifelse(rev, start(part), end(part))) v <- extractROWS(subject(x), x_ranges)[ord] v_fill <- rep.int(NA, max.width * length(x)) part <- PartitioningByWidth(rep(max.width, length(x))) i <- as.integer(IRanges(start(part), width = width(x_ranges))) v_fill[i] <- as.vector(v) matrix(v_fill, ncol = max.width, byrow = TRUE, dimnames = list(names(x), NULL)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Extracting a view. ### setMethod("getListElement", "Views", function(x, i, exact=TRUE) { i <- normalizeDoubleBracketSubscript(i, x, exact=exact, error.if.nomatch=TRUE) start <- start(x)[i] end <- end(x)[i] if (start < 1L || end > length(subject(x))) stop("view is out of limits") extractROWS(subject(x), IRanges(start, end)) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Combining Views objects. ### setMethod("c", "Views", function(x, ..., ignore.mcols=FALSE, recursive=FALSE) { if (!identical(recursive, FALSE)) stop("\"c\" method for Views objects ", "does not support the 'recursive' argument") if (!isTRUEorFALSE(ignore.mcols)) stop("'ignore.mcols' must be TRUE or FALSE") if (missing(x)) { args <- unname(list(...)) x <- args[[1L]] } else { args <- unname(list(x, ...)) } if (length(args) == 1L) return(x) arg_is_null <- sapply(args, is.null) if (any(arg_is_null)) args[arg_is_null] <- NULL # remove NULL elements by setting them to NULL! if (!all(sapply(args, is, class(x)))) stop("all arguments in '...' must be ", class(x), " objects (or NULLs)") ok <- sapply(args, function(arg) isTRUE(all.equal(subject(arg), subject(x)))) if (!all(ok)) stop("all Views objects to combine must have the same subject") x@ranges <- do.call(c, lapply(args, ranges)) if (ignore.mcols) { mcols(x) <- NULL } else { mcols(x) <- do.call(rbind.mcols, args) } validObject(x) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "trim" function. ### setGeneric("trim", signature="x", function(x, use.names=TRUE, ...) standardGeneric("trim") ) setMethod("trim", "Views", function(x, use.names=TRUE) { x@ranges <- restrict(ranges(x), start=1L, end=length(subject(x)), keep.all.ranges=TRUE, use.names=use.names) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "subviews" function. ### ### TODO: - add a 'check.limits' arg (default to TRUE) for raising an error if ### some views are "out of limits" setGeneric("subviews", signature="x", function(x, start=NA, end=NA, width=NA, use.names=TRUE) standardGeneric("subviews") ) setMethod("subviews", "Views", function(x, start=NA, end=NA, width=NA, use.names=TRUE) trim(narrow(x, start=start, end=end, width=width, use.names=use.names)) ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "successiveViews" function. ### successiveViews <- function(subject, width, gapwidth=0, from=1) { ranges <- successiveIRanges(width, gapwidth=gapwidth, from=from) Views(subject, ranges) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "viewApply" function. ### setGeneric("viewApply", signature="X", function(X, FUN, ..., simplify = TRUE) standardGeneric("viewApply") ) setMethod("viewApply", "Views", function(X, FUN, ..., simplify = TRUE) { X <- trim(X) Xsubject <- subject(X) Xstart <- start(X) Xwidth <- width(X) ans <- sapply(structure(seq_len(length(X)), names=names(X)), function(i) FUN(extractROWS(Xsubject, IRanges(start=Xstart[i], width=Xwidth[i])), ...), simplify = simplify) if (!simplify) { ans <- newList("SimpleList", ans, metadata = metadata(X), mcols = mcols(X)) } ans } ) setGeneric("viewMins", signature="x", function(x, na.rm = FALSE) standardGeneric("viewMins")) setGeneric("viewMaxs", signature="x", function(x, na.rm = FALSE) standardGeneric("viewMaxs")) setGeneric("viewSums", signature="x", function(x, na.rm = FALSE) standardGeneric("viewSums")) setGeneric("viewMeans", signature="x", function(x, na.rm = FALSE) standardGeneric("viewMeans")) setGeneric("viewWhichMins", signature="x", function(x, na.rm = FALSE) standardGeneric("viewWhichMins")) setGeneric("viewWhichMaxs", signature="x", function(x, na.rm = FALSE) standardGeneric("viewWhichMaxs")) setGeneric("viewRangeMaxs", function(x, na.rm = FALSE) standardGeneric("viewRangeMaxs")) setGeneric("viewRangeMins", function(x, na.rm = FALSE) standardGeneric("viewRangeMins")) setMethod("Summary", "Views", function(x, ..., na.rm = FALSE) { viewSummaryFunMap <- list(min = viewMins, max = viewMaxs, sum = viewSums) viewSummaryFun <- viewSummaryFunMap[[.Generic]] if (!is.null(viewSummaryFun)) { if (length(list(...))) stop("Passing multiple arguments to '", .Generic, "' is not supported.") viewSummaryFun(x, na.rm = na.rm) } else { Summary(ranges(x), ..., na.rm = na.rm) } }) setMethod("mean", "Views", viewMeans) setMethod("which.max", "Views", function(x) { viewWhichMaxs(x, na.rm = TRUE) }) setMethod("which.min", "Views", function(x) { viewWhichMins(x, na.rm = TRUE) }) IRanges/R/ViewsList-class.R0000644000126300012640000000511612227064470017054 0ustar00biocbuildphs_compbio### ========================================================================= ### ViewsList objects ### ------------------------------------------------------------------------- setClass("ViewsList", contains="List", representation("VIRTUAL"), prototype(elementType="Views") ) setClass("SimpleViewsList", contains=c("ViewsList", "SimpleList"), representation("VIRTUAL"), prototype(elementType="Views") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Accessor methods. ### setMethod("ranges", "SimpleViewsList", function(x, ...) newList("SimpleIRangesList", lapply(x, ranges)) ) setMethod("start", "SimpleViewsList", function(x, ...) start(ranges(x))) setMethod("end", "SimpleViewsList", function(x, ...) end(ranges(x))) setMethod("width", "SimpleViewsList", function(x) width(ranges(x))) ### TODO: Why not define this at the List level? Or even at the Vector level? setMethod("universe", "ViewsList", function(x) { ### FIXME: for compatibility with older versions, eventually emit warning if (is.null(metadata(x)) || is.character(metadata(x))) metadata(x) else metadata(x)$universe }) ### TODO: Why not define this at the List level? Or even at the Vector level? setReplaceMethod("universe", "ViewsList", function(x, value) { if (!is.null(value) && !isSingleString(value)) stop("'value' must be a single string or NULL") metadata(x)$universe <- value x }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Coercion ### setMethod("as.matrix", "ViewsList", function(x, rev = FALSE, use.names = FALSE) { if (!isTRUEorFALSE(use.names)) stop("use.names must be TRUE or FALSE") rev <- normargAtomicList1(rev, LogicalList, length(x)) max_width <- max(max(width(restrict(ranges(x), start = 1L)))) m <- do.call(rbind, mapply(as.matrix, x, rev, IntegerList(max_width), SIMPLIFY = FALSE)) nms <- names(x) if (!is.null(nms) && use.names) { nms <- rep(nms, elementLengths(x)) rownms <- rownames(m) if (is.null(rownms)) rownms <- as.integer(IRanges(1L, width = elementLengths(x))) rownames(m) <- paste(nms, rownms, sep = ".") } m }) IRanges/R/classNameForDisplay-methods.R0000644000126300012640000000202412227064470021357 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### classNameForDisplay() ### setGeneric("classNameForDisplay", function(x) standardGeneric("classNameForDisplay")) setMethod("classNameForDisplay", "ANY", function(x) { ## Selecting the 1st element guarantees that we return a single string ## (e.g. on an ordered factor, class(x) returns a character vector of ## length 2). class(x)[1L] } ) .classNameForDisplay_shorten <- function(x) { sub("^(Compressed|Simple)", "", class(x)) } setMethod("classNameForDisplay", "CompressedList", .classNameForDisplay_shorten) setMethod("classNameForDisplay", "CompressedNormalIRangesList", .classNameForDisplay_shorten) setMethod("classNameForDisplay", "SimpleList", .classNameForDisplay_shorten) setMethod("classNameForDisplay", "SimpleNormalIRangesList", .classNameForDisplay_shorten) setMethod("classNameForDisplay", "AsIs", function(x) { class(x) <- setdiff(class(x), "AsIs") classNameForDisplay(x) }) IRanges/R/compact_bitvector.R0000644000126300012640000000171412227064470017527 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Basic manipulation of a "compact bit vector" i.e. a bit vector stored in ### a standard raw vector. ### logicalAsCompactBitvector <- function(x) { if (!is.logical(x)) stop("'x' must be a logical vector") .Call2("logical_as_compact_bitvector", x, PACKAGE="IRanges") } compactBitvectorAsLogical <- function(x, length.out) { if (!is.raw(x)) stop("'x' must be a raw vector") if (!isSingleNumber(length.out)) stop("'length.out' must be a single number") if (!is.integer(length.out)) length.out <- as.integer(length.out) .Call2("compact_bitvector_as_logical", x, length.out, PACKAGE="IRanges") } subsetCompactBitvector <- function(x, i) { if (!is.raw(x)) stop("'x' must be a raw vector") if (!is.integer(i)) stop("'i' must be an integer vector") .Call2("subset_compact_bitvector", x, i, PACKAGE="IRanges") } IRanges/R/coverage-methods.R0000644000126300012640000002474012233570550017256 0ustar00biocbuildphs_compbio### ========================================================================= ### coverage() ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### .IRanges.coverage() and .CompressedIRangesList.coverage() ### ### These 2 internal helpers are the workhorses behind most "coverage" ### methods. All the hard work is almost entirely performed at the C level. ### Only some argument checking/normalization plus the "folding" of the ### result are performed in R. ### .fold_and_truncate_coverage <- function(cvg, circle.length, width) { cvg <- fold(cvg, circle.length) if (is.na(width)) return(cvg) head(cvg, n=width) } ### Returns an Rle object. .IRanges.coverage <- function(x, shift=0L, width=NULL, weight=1L, circle.length=NA, method=c("auto", "sort", "hash")) { ## Check 'x'. if (!is(x, "IRanges")) stop("'x' must be an IRanges object") ## 'shift' will be checked at the C level. ## Check 'width'. if (is.null(width)) { width <- NA_integer_ } else if (!isSingleNumberOrNA(width)) { stop("'width' must be NULL or a single integer") } else if (!is.integer(width)) { width <- as.integer(width) } ## 'weight' will be checked at the C level. ## Check 'circle.length'. if (!isSingleNumberOrNA(circle.length)) stop("'circle.length' must be a single integer") if (!is.integer(circle.length)) circle.length <- as.integer(circle.length) ## Check 'method'. method <- match.arg(method) ## Ready to go... ans <- .Call2("IRanges_coverage", x, shift, width, weight, circle.length, method, PACKAGE="IRanges") if (is.na(circle.length)) return(ans) .fold_and_truncate_coverage(ans, circle.length, width) } .check_arg_names <- function(arg, arg.label, x_names, x_names.label) { arg_names <- names(arg) if (!(is.null(arg_names) || identical(arg_names, x_names))) stop("when '", arg.label, "' has names, ", "they must be identical to ", x_names.label) } ## Some packages like easyRNASeq or TEQC pass 'width' as a named list-like ## object where each list element is a single number, an NA, or a NULL, when ## calling coverage() on a RangesList or RangedData object. They do so because, ## for whatever reason, we've been supporting this for a while, and also ## because, in the case of the method for RangedData objects, the arg default ## for 'width' used to be such a list (a named list of NULLs in that case). ## However, it never really made sense to support a named list-like object for ## 'width', and it makes even less sense now that the signature of the method ## for RangedData objects has been modified (as of BioC 2.13) to use the same ## arg defaults as the coverage() generic and all other methods. ## TODO: Deprecate support for this. Preferred 'width' form: NULL or an integer ## vector. An that's it. .unlist_width <- function(width, x_names, x_names.label) { if (!identical(names(width), x_names)) stop("when 'width' is a list-like object, it must be named ", "and its names must be identical to ", x_names.label) width_eltlens <- elementLengths(width) if (!all(width_eltlens <= 1L)) stop("when 'width' is a list-like object, each list element ", "should contain at most 1 element or be NULL") width[width_eltlens == 0L] <- NA_integer_ setNames(unlist(width, use.names=FALSE), x_names) } ### Returns a SimpleRleList object of the length of 'x'. .CompressedIRangesList.coverage <- function(x, shift=0L, width=NULL, weight=1L, circle.length=NA, method=c("auto", "sort", "hash"), x_names.label="'x' names") { ## Check 'x'. if (!is(x, "CompressedIRangesList")) stop("'x' must be a CompressedIRangesList object") x_names <- names(x) ## Check and normalize 'shift'. if (!is.list(shift)) { if (!(is.numeric(shift) || is(shift, "List"))) stop("'shift' must be a numeric vector or list-like object") shift <- as.list(shift) } .check_arg_names(shift, "shift", x_names, x_names.label) ## Check and normalize 'width'. if (is.null(width)) { width <- NA_integer_ } else { if (is.numeric(width)) { .check_arg_names(width, "width", x_names, x_names.label) } else if (is.list(width) || is(width, "List")) { width <- .unlist_width(width, x_names, x_names.label) } else { ## We purposedly omit to mention that 'width' can also be a named ## list-like object because this will be deprecated soon (this is ## why it's not documented in man/coverage-methods.Rd either). stop("'width' must be NULL or an integer vector") } if (!is.integer(width)) width <- setNames(as.integer(width), names(width)) } ## Check and normalize 'weight'. if (!is.list(weight)) { if (!(is.numeric(weight) || is(weight, "List"))) stop("'weight' must be a numeric vector or list-like object") weight <- as.list(weight) } .check_arg_names(weight, "weight", x_names, x_names.label) ## Check and normalize 'circle.length'. if (identical(circle.length, NA)) { circle.length <- NA_integer_ } else if (!is.numeric(circle.length)) { stop("'circle.length' must be an integer vector") } else if (!is.integer(circle.length)) { circle.length <- setNames(as.integer(circle.length), names(circle.length)) } .check_arg_names(circle.length, "circle.length", x_names, x_names.label) ## Check and normalize 'method'. method <- match.arg(method) ## Ready to go... ans_listData <- .Call2("CompressedIRangesList_coverage", x, shift, width, weight, circle.length, method, PACKAGE="IRanges") ## "Fold" the coverage vectors in 'ans_listData' associated with a ## circular sequence. ## Note that the C code should have raised an error or warning already if ## the length of 'circle.length' or 'width' didn't allow proprer recycling ## to the length of 'x'. So using silent 'rep( , length.out=length(x))' is ## safe. circle.length <- rep(circle.length, length.out=length(x)) fold_idx <- which(!is.na(circle.length)) if (length(fold_idx) != 0L) { width <- rep(width, length.out=length(x)) ## Because we "fold" the coverage vectors in an lapply() loop, it will ## be inefficient if 'x' has a lot of list elements associated with a ## circular sequence. ans_listData[fold_idx] <- lapply(fold_idx, function(i) .fold_and_truncate_coverage(ans_listData[[i]], circle.length[i], width[i])) } names(ans_listData) <- names(x) newList("SimpleRleList", ans_listData, metadata=metadata(x), mcols=mcols(x)) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### coverage() generic and methods. ### setGeneric("coverage", signature="x", function(x, shift=0L, width=NULL, weight=1L, ...) standardGeneric("coverage") ) setMethod("coverage", "Ranges", function(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash")) { if (isSingleString(weight)) { x_mcols <- mcols(x) if (!is(x_mcols, "DataTable") || sum(colnames(x_mcols) == weight) != 1L) stop("'mcols(x)' has 0 or more than 1 \"", weight, "\" columns") weight <- x_mcols[[weight]] } .IRanges.coverage(as(x, "IRanges"), shift=shift, width=width, weight=weight, method=method) } ) setMethod("coverage", "Views", function(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash")) { if (is.null(width)) width <- length(subject(x)) coverage(as(x, "IRanges"), shift=shift, width=width, weight=weight, method=method) } ) setMethod("coverage", "RangesList", function(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash")) { x_mcols <- mcols(x) x_mcolnames <- colnames(x_mcols) if (isSingleString(shift)) { if (!(shift %in% x_mcolnames)) stop("the string supplied for 'shift' (\"", shift, "\")", "is not a valid metadata column name of 'x'") shift <- x_mcols[[shift]] } if (isSingleString(width)) { if (!(width %in% x_mcolnames)) stop("the string supplied for 'width' (\"", width, "\")", "is not a valid metadata column name of 'x'") width <- x_mcols[[width]] } if (isSingleString(weight)) { if (!(weight %in% x_mcolnames)) stop("the string supplied for 'weight' (\"", weight, "\")", "is not a valid metadata column name of 'x'") weight <- x_mcols[[weight]] } .CompressedIRangesList.coverage(as(x, "CompressedIRangesList"), shift=shift, width=width, weight=weight, method=method) } ) setMethod("coverage", "RangedData", function(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash")) { x_ranges <- ranges(x) if (length(metadata(x)) > 0) metadata(x_ranges) <- metadata(x) varnames <- colnames(x) if (isSingleString(shift) && (shift %in% varnames)) shift <- values(x)[, shift] if (isSingleString(weight) && (weight %in% varnames)) weight <- values(x)[, weight] coverage(x_ranges, shift=shift, width=width, weight=weight, method=method) } ) IRanges/R/debug.R0000644000126300012640000000062112227064470015102 0ustar00biocbuildphs_compbio### debug_AEbufs <- function() invisible(.Call2("debug_AEbufs", PACKAGE="IRanges")) debug_IRanges_class <- function() invisible(.Call2("debug_IRanges_class", PACKAGE="IRanges")) debug_Grouping_class <- function() invisible(.Call2("debug_Grouping_class", PACKAGE="IRanges")) debug_inter_range_methods <- function() invisible(.Call2("debug_inter_range_methods", PACKAGE="IRanges")) IRanges/R/encodeOverlaps-methods.R0000644000126300012640000002016212227064470020430 0ustar00biocbuildphs_compbio### ========================================================================= ### encodeOverlaps() ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### encodeOverlaps1() - A low-level utility. ### ### > query <- IRanges(start=c(7, 15, 22), end=c(9, 19, 23)) ### > subject <- IRanges(start=c(1, 4, 15, 22, 1, 30, 25), ### end=c(2, 9, 19, 25, 10, 38, 25)) ### > encodeOverlaps1(query, subject, as.matrix=TRUE) ### [,1] [,2] [,3] [,4] [,5] [,6] [,7] ### [1,] "m" "j" "a" "a" "i" "a" "a" ### [2,] "m" "m" "g" "a" "m" "a" "a" ### [3,] "m" "m" "m" "f" "m" "a" "a" ### > encodeOverlaps1(query, subject) ### $Loffset ### [1] 1 ### ### $Roffset ### [1] 2 ### ### $encoding ### [1] "3:jmm:agm:aaf:imm:" ### ### > query.space <- c(0, 1, 0) ### > encodeOverlaps1(query, subject, query.space=query.space)$encoding ### [1] "3:mXm:jXm:aXm:aXf:iXm:aXa:aXa:" ### > query.space <- rep(-1, length(query)) ### > subject.space <- rep(-1, length(subject)) ### > encodeOverlaps1(rev(query), rev(subject), ### query.space=query.space, subject.space=subject.space) ### $Loffset ### [1] 2 ### ### $Roffset ### [1] 1 ### ### $encoding ### [1] "3:aai:jmm:agm:aaf:" ### ### > encodeOverlaps1(query, subject, query.break=2)$encoding ### [1] "2--1:jm--m:ag--m:aa--f:im--m:" ### > encodeOverlaps1(rev(query), rev(subject), ### query.space=query.space, subject.space=subject.space, ### query.break=1)$encoding ### [1] "1--2:a--ai:j--mm:a--gm:a--af:" ### 'query.space' must be either an integer vector of the same length as ### 'query', or NULL. If NULL, then it's interpreted as ### 'integer(length(query))' i.e. all the ranges in 'query' are considered to ### be on space 0. encodeOverlaps1 <- function(query, subject, query.space=NULL, subject.space=NULL, query.break=0L, flip.query=FALSE, as.matrix=FALSE, as.raw=FALSE) { if (!is(query, "Ranges")) stop("'query' must be a Ranges object") if (!is(subject, "Ranges")) stop("'subject' must be a Ranges object") if (is.numeric(query.space) && !is.integer(query.space)) query.space <- as.integer(query.space) if (is.numeric(subject.space) && !is.integer(subject.space)) subject.space <- as.integer(subject.space) if (!isSingleNumber(query.break)) stop("'query.break' must be a single integer value") if (!is.integer(query.break)) query.break <- as.integer(query.break) if (!isTRUEorFALSE(flip.query)) stop("'flip.query' must be TRUE or FALSE") if (!isTRUEorFALSE(as.matrix)) stop("'as.matrix' must be TRUE or FALSE") if (!isTRUEorFALSE(as.raw)) stop("'as.raw' must be TRUE or FALSE") .Call2("encode_overlaps1", start(query), width(query), query.space, query.break, flip.query, start(subject), width(subject), subject.space, as.matrix, as.raw, PACKAGE="IRanges") } ### TODO: Put this in the (upcoming) man page for encodeOverlaps(). ### A simple (but inefficient) implementation of the "findOverlaps" method for ### Ranges objects. Complexity and memory usage is M x N where M and N are the ### lengths of 'query' and 'subject', respectively. findRangesOverlaps <- function(query, subject) { ovenc <- encodeOverlaps1(query, subject, as.matrix=TRUE, as.raw=TRUE) offsets <- which(charToRaw("c") <= ovenc & ovenc <= charToRaw("k")) - 1L q_hits <- offsets %% nrow(ovenc) + 1L s_hits <- offsets %/% nrow(ovenc) + 1L cbind(queryHits=q_hits, subjectHits=s_hits) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The RangesList_encodeOverlaps() helper. ### ### This is the power horse behind all the "encodeOverlaps" methods. ### .RangesList_encodeOverlaps <- function(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces) { .Call2("RangesList_encode_overlaps", query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, PACKAGE="IRanges") } .Hits_encode_overlaps <- function(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, hits, flip.query) { if (queryLength(hits) != length(query.starts) || subjectLength(hits) != length(subject.starts)) stop("'hits' is not compatible with 'query' and 'subject'") .Call2("Hits_encode_overlaps", query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, queryHits(hits), subjectHits(hits), flip.query, PACKAGE="IRanges") } RangesList_encodeOverlaps <- function(query.starts, query.widths, subject.starts, subject.widths, hits, flip.query=NULL, query.spaces=NULL, subject.spaces=NULL, query.breaks=NULL) { if (is.null(hits)) { C_ans <- .RangesList_encodeOverlaps(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces) flip.query <- logical(length(encoding)) } else { if (!is(hits, "Hits")) stop("'hits' must be a Hits object") if (is.null(flip.query)) { flip.query <- logical(length(hits)) } else { if (!is.logical(flip.query)) stop("'flip.query' must be a logical vector") if (length(flip.query) != length(hits)) stop("'flip.query' must have the same length as 'hits'") } C_ans <- .Hits_encode_overlaps(query.starts, query.widths, query.spaces, query.breaks, subject.starts, subject.widths, subject.spaces, hits, flip.query) } encoding <- factor(C_ans$encoding) new2("OverlapEncodings", Loffset=C_ans$Loffset, Roffset=C_ans$Roffset, encoding=encoding, flippedQuery=flip.query, check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### encodeOverlaps() ### setGeneric("encodeOverlaps", signature=c("query", "subject"), function(query, subject, hits=NULL, ...) standardGeneric("encodeOverlaps") ) setMethod("encodeOverlaps", c("RangesList", "RangesList"), function(query, subject, hits=NULL, ...) { RangesList_encodeOverlaps(as.list(start(query)), as.list(width(query)), as.list(start(subject)), as.list(width(subject)), hits) } ) setMethod("encodeOverlaps", c("RangesList", "Ranges"), function(query, subject, hits=NULL, ...) { RangesList_encodeOverlaps(as.list(start(query)), as.list(width(query)), as.list(start(subject)), as.list(width(subject)), hits) } ) setMethod("encodeOverlaps", c("Ranges", "RangesList"), function(query, subject, hits=NULL, ...) { RangesList_encodeOverlaps(as.list(start(query)), as.list(width(query)), as.list(start(subject)), as.list(width(subject)), hits) } ) IRanges/R/endoapply.R0000644000126300012640000000215112227064470016007 0ustar00biocbuildphs_compbio### ========================================================================= ### endoapply() ### ------------------------------------------------------------------------- ### setGeneric("endoapply", signature = "X", function(X, FUN, ...) standardGeneric("endoapply")) setMethod("endoapply", "list", function(X, FUN, ...) lapply(X = X, FUN = FUN, ...)) setMethod("endoapply", "data.frame", function(X, FUN, ...) as.data.frame(lapply(X = X, FUN = FUN, ...))) ### ========================================================================= ### mendoapply() ### ------------------------------------------------------------------------- ### setGeneric("mendoapply", signature = "...", function(FUN, ..., MoreArgs = NULL) standardGeneric("mendoapply")) setMethod("mendoapply", "list", function(FUN, ..., MoreArgs = NULL) mapply(FUN = FUN, ..., MoreArgs = MoreArgs, SIMPLIFY = FALSE)) setMethod("mendoapply", "data.frame", function(FUN, ..., MoreArgs = NULL) as.data.frame(mapply(FUN = FUN, ..., MoreArgs = MoreArgs, SIMPLIFY = FALSE))) IRanges/R/expand-methods.R0000644000126300012640000000325712227064470016744 0ustar00biocbuildphs_compbio### ========================================================================= ### expand methods ### ------------------------------------------------------------------------- ### setGeneric("expand", signature="x", function(x, ...) standardGeneric("expand") ) ## A helper function to do the work .expandOneCol <- function(x, colname, keepEmptyRows) { if(keepEmptyRows==TRUE){ x[[colname]][elementLengths(x[[colname]])==0] <- NA } if (!is(x, "DataFrame")) stop("'x' must be a DataFrame object") if (!isSingleString(colname) && !isSingleNumber(colname)) stop("'x' must be a single string or number") col <- x[[colname]] if (is.null(col)) stop("'colname' must be a valid colname name or index") idx <- rep.int(seq_len(nrow(x)), elementLengths(col)) ans <- x[idx, ] ans[[colname]] <- unlist(col, use.names=FALSE) ans } ## A better helper .expand <- function(x, colnames, keepEmptyRows){ for(i in seq_len(length(colnames))){ x <- .expandOneCol(x, colnames[i], keepEmptyRows) } x } setMethod("expand", "DataFrame", function(x, colnames, keepEmptyRows, ...){ .expand(x, colnames, keepEmptyRows) } ) ## Assume that the named columns have the same geometry and expand ## them simultaneously; this is different from the cartesian product ## expansion above. .expandByColumnSet <- function(x, colnames, keepEmptyRows) { if (length(colnames) == 0L) return(x) if(keepEmptyRows) { emptyRows <- elementLengths(col) == 0L x[emptyRows, colnames] <- rep(NA, sum(emptyRows)) } ans <- x[togroup(x[[colnames[1L]]]),] ans[colnames] <- lapply(x[colnames], unlist, use.names = FALSE) ans } IRanges/R/findOverlaps-methods.R0000644000126300012640000010550412227064470020117 0ustar00biocbuildphs_compbio### ========================================================================= ### findOverlaps (and related) methods ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### findOverlaps() ### ### Find objects in the query that overlap those in the subject. ### setGeneric("findOverlaps", signature = c("query", "subject"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary"), ...) standardGeneric("findOverlaps") ) ### ### The next two functions are pre/post processing functions shared ### by the IntervalTree and IntervalForest versions of findOverlaps ### ### pre-process query (sort and adjust) and partition (if not NULL) .preProcess_findOverlaps_query <- function(query, maxgap, minoverlap, partitioning=NULL) { res <- list() query <- as(query, "IRanges") query_ord <- NULL res$origQuery <- query adjust <- (maxgap - minoverlap + 1L) * (width(query) > 0L) if (sum(adjust) > 0L) query <- resize(query, width(query) + 2L * adjust, fix = "center") res$unsortedQuery <- query if (is.null(partitioning)) { if (isNotSorted(start(query))) { ## query must be sorted query_ord <- sort.list(start(query), method = "quick", na.last = NA) query <- query[query_ord] } else { query_ord <- seq_len(length(query)) } } else { if(!is(partitioning, "PartitioningByEnd")) stop("invalid partitioning") # query be sorted within partition spaces query_ord <- seq_len(length(query)) isSorted <- TRUE for (i in seq(len=length(partitioning))) { curStart <- start(partitioning)[i] curEnd <- end(partitioning)[i] cur <- IRanges(curStart, curEnd) qStarts <- extractROWS(start(query), cur) if (isNotSorted(qStarts)) { isSorted <- FALSE ind <- extractROWS(query_ord, cur) query_ord <- replaceROWS(query_ord, cur, ind[sort.list(qStarts, method="quick", na.last=NA)]) } } if (!isSorted) { query <- query[query_ord] } } res$query <- query res$query_ord <- query_ord res } ### post-process result based on overlap type and select .postProcess_findOverlaps_result <- function(result, unsortedQuery, origQuery, subject, type, minoverlap, maxgap, origSelect) { if (type != "any" || minoverlap > 1L) { if (!is(subject,"Ranges")) subject <- as(subject, "IRanges") m <- as.matrix(result) if (minoverlap > 1L) { r <- ranges(result, unsortedQuery, subject) m <- m[width(r) >= minoverlap, , drop=FALSE] ## unname() required because in case 'm' has only 1 row ## 'm[ , 1L]' and 'm[ , 2L]' will return a named atomic vector result@queryHits <- unname(m[ , 1L]) result@subjectHits <- unname(m[ , 2L]) } query <- origQuery filterMatrix <- function(fun) m[abs(fun(query)[m[,1L]] - fun(subject)[m[,2L]]) <= maxgap, , drop=FALSE] if (type == "within") { r <- ranges(result, query, subject) m <- m[width(query)[m[,1L]] - width(r) <= maxgap, , drop=FALSE] } else if (type == "start") { m <- filterMatrix(start) } else if (type == "end") { m <- filterMatrix(end) } else if (type == "equal") { m <- filterMatrix(start) m <- filterMatrix(end) } if (origSelect != "all") { m <- m[!duplicated(m[,1L]), , drop=FALSE] result <- rep.int(NA_integer_, length(query)) ## unname() required because in case 'm' has only 1 row ## 'm[,2L]' will return a named atomic vector result[m[,1L]] <- unname(m[,2L]) } else { ## unname() required because in case 'm' has only 1 row ## 'm[ , 1L]' and 'm[ , 2L]' will return a named atomic vector result@queryHits <- unname(m[ , 1L]) result@subjectHits <- unname(m[ , 2L]) } } result } ### findOverlaps method for IntervalTree setMethod("findOverlaps", c("Ranges", "IntervalTree"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary")) { # verify inputs if (!isSingleNumber(maxgap) || maxgap < 0L) stop("'maxgap' must be a single, non-negative integer") if (!isSingleNumber(minoverlap) || minoverlap < 1L) stop("'minoverlap' must be a single, positive integer") type <- match.arg(type) select <- match.arg(select) origSelect <- select if (type != "any" || minoverlap > 1L) select <- "all" # preprocess query preprocRes <- .preProcess_findOverlaps_query(query, maxgap, minoverlap) origQuery <- preprocRes$origQuery unsortedQuery <- preprocRes$origQuery query <- preprocRes$query query_ord <- preprocRes$query_ord validObject(query) # make initial findOverlaps call fun <- paste("overlap_", select, sep = "") result <- IntervalTreeCall(subject, fun, query, query_ord) # postprocess results .postProcess_findOverlaps_result(result, unsortedQuery, origQuery, subject, type, minoverlap, maxgap, origSelect) }) setMethod("findOverlaps", c("Ranges", "Ranges"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary")) { findOverlaps(query, IntervalTree(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select)) }) setMethod("findOverlaps", c("Vector", "missing"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary"), ignoreSelf = FALSE, ignoreRedundant = FALSE) { select <- match.arg(select) result <- findOverlaps(query, query, maxgap = maxgap, minoverlap = minoverlap, type = type, select = "all") processSelfMatching(result, select, ignoreSelf, ignoreRedundant) }) setMethod("findOverlaps", c("integer", "Ranges"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary")) { findOverlaps(IRanges(query, query), subject, maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select)) }) setMethod("findOverlaps", c("Views", "Views"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), select=c("all", "first", "last", "arbitrary")) { findOverlaps(ranges(query), ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, select=select) } ) setMethod("findOverlaps", c("Views", "Vector"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), select=c("all", "first", "last", "arbitrary")) { findOverlaps(ranges(query), subject, maxgap=maxgap, minoverlap=minoverlap, type=type, select=select) } ) setMethod("findOverlaps", c("Vector", "Views"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), select=c("all", "first", "last", "arbitrary")) { findOverlaps(query, ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, select=select) } ) ### findOverlaps method for IntervalForest setMethod("findOverlaps", c("RangesList", "IntervalForest"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary"), drop=FALSE) { # verify inputs if (!isSingleNumber(maxgap) || maxgap < 0L) stop("'maxgap' must be a single, non-negative integer") if (!isSingleNumber(minoverlap) || minoverlap < 1L) stop("'minoverlap' must be a single, positive integer") type <- match.arg(type) select <- match.arg(select) origSelect <- select if (type != "any" || minoverlap > 1L) select <- "all" if (!is(query, "CompressedIRangesList")) query <- as(query, "CompressedIRangesList") validObject(query) queryList <- query query <- queryList@unlistData partitioning <- queryList@partitioning # preprocess query preprocRes <- .preProcess_findOverlaps_query(query, maxgap, minoverlap, partitioning) origQuery <- preprocRes$origQuery unsortedQuery <- preprocRes$unsortedQuery query <- preprocRes$query query_ord <- preprocRes$query_ord validObject(query) # match query partition to subject partition partitionIndices <- match(names(partitioning), names(subject)) # make initial findOverlaps call fun <- paste("overlap_", select, sep = "") result <- .IntervalForestCall(subject, fun, query, partitionIndices, elementLengths(partitioning), query_ord) # postprocess findOverlaps result res <- .postProcess_findOverlaps_result(result, unsortedQuery, origQuery, subject, type, minoverlap, maxgap, origSelect) # turn it into compressed list if (origSelect == "all") return(CompressedHitsList(res, queryList)) if (!drop) { return(newCompressedList0("CompressedIntegerList", unlistData=res, partitioning=partitioning)) } res }) # might consider making this the following: # setMethod("findOverlaps", c("RangesList", "RangesList"), # function(query, subject, maxgap = 0L, minoverlap = 1L, # type = c("any", "start", "end", "within", "equal"), # select = c("all", "first", "last", "arbitrary"), # drop = FALSE) # { # findOverlaps(query, as(query, "IntervalForest"), # maxgap = maxgap, minoverlap = minoverlap, # type = match.arg(type), select = match.arg(select), drop = drop) # } # ) setMethod("findOverlaps", c("RangesList", "RangesList"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary"), drop = FALSE) { type <- match.arg(type) select <- match.arg(select) query <- as.list(query) subject <- as.list(subject) origSubject <- subject if (!is.null(names(subject)) && !is.null(names(query))) { subject <- subject[names(query)] names(subject) <- names(query) # get rid of NA's in names } else { subject <- subject[seq_along(query)] } ## NULL's are introduced where they do not match ## We replace those with empty IRanges subject[sapply(subject, is.null)] <- IRanges() ans <- lapply(seq_len(length(subject)), function(i) { findOverlaps(query[[i]], subject[[i]], maxgap = maxgap, minoverlap = minoverlap, type = type, select = select) }) names(ans) <- names(subject) if (select == "all") { ans <- HitsList(ans, origSubject) } else if (drop) { off <- head(c(0L, cumsum(sapply(origSubject, length))), -1) names(off) <- names(origSubject) if (is.null(names(ans))) off <- off[seq_along(ans)] else off <- off[names(ans)] ans <- unlist(ans, use.names=FALSE) + rep.int(unname(off), sapply(ans, length)) } else { ans <- IntegerList(ans) } ans }) setMethod("findOverlaps", c("ViewsList", "ViewsList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), select=c("all", "first", "last", "arbitrary"), drop=FALSE) { findOverlaps(ranges(query), ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, select=select, drop=drop) } ) setMethod("findOverlaps", c("ViewsList", "Vector"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), select=c("all", "first", "last", "arbitrary"), drop=FALSE) { findOverlaps(ranges(query), subject, maxgap=maxgap, minoverlap=minoverlap, type=type, select=select, drop=drop) } ) setMethod("findOverlaps", c("Vector", "ViewsList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), select=c("all", "first", "last", "arbitrary"), drop=FALSE) { findOverlaps(query, ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, select=select, drop=drop) } ) setMethod("findOverlaps", c("RangedData", "RangedData"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary"), drop = FALSE) { findOverlaps(ranges(query), ranges(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), drop = drop) }) setMethod("findOverlaps", c("RangedData", "RangesList"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary"), drop = FALSE) { findOverlaps(ranges(query), subject, maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), drop = drop) }) setMethod("findOverlaps", c("RangesList", "RangedData"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), select = c("all", "first", "last", "arbitrary"), drop = FALSE) { findOverlaps(query, ranges(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = match.arg(select), drop = drop) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### countOverlaps() ### setGeneric("countOverlaps", signature = c("query", "subject"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), ...) standardGeneric("countOverlaps") ) setMethod("countOverlaps", c("ANY", "Vector"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), ...) { counts <- queryHits(findOverlaps(query, subject, maxgap = maxgap, minoverlap = minoverlap, type = type, ...)) structure(tabulate(counts, length(query)), names=names(query)) } ) setMethod("countOverlaps", c("ANY", "missing"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { countOverlaps(query, query, maxgap = maxgap, minoverlap = minoverlap, type = type) } ) setMethod("countOverlaps", c("RangesList", "IntervalForest"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), drop = FALSE, ...) { if (!is(query, "CompressedIRangesList")) query <- as("CompressedIRangesList", query) hits <- findOverlaps(query, subject, maxgap = maxgap, minoverlap = minoverlap, type = type, ...) res <- tabulate(queryHits(hits), queryLength(hits)) new2("CompressedIntegerList", unlistData=res, partitioning = query@partitioning) }) setMethod("countOverlaps", c("RangesList", "RangesList"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { IntegerList(mapply(countOverlaps, query, subject, MoreArgs = list(maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type)), SIMPLIFY = FALSE)) }) setMethod("countOverlaps", c("ViewsList", "ViewsList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal")) { countOverlaps(ranges(query), ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type) } ) setMethod("countOverlaps", c("ViewsList", "Vector"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal")) { countOverlaps(ranges(query), subject, maxgap=maxgap, minoverlap=minoverlap, type=type) } ) setMethod("countOverlaps", c("Vector", "ViewsList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal")) { countOverlaps(query, ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type) } ) setMethod("countOverlaps", c("RangedData", "RangedData"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { countOverlaps(ranges(query), ranges(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type)) }) setMethod("countOverlaps", c("RangedData", "RangesList"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { countOverlaps(ranges(query), subject, maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type)) }) setMethod("countOverlaps", c("RangesList", "RangedData"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { countOverlaps(query, ranges(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### match() is defunct ### setMethod("match", c("Views", "Views"), function(x, table, nomatch=NA_integer_, incomparables=NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on Views objects is defunct.\n", "Please use '", "findOverlaps(ranges(x), ranges(table), select=\"first\")", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("Views", "Vector"), function(x, table, nomatch=NA_integer_, incomparables=NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on a Views query is defunct.\n", "Please use '", "findOverlaps(ranges(x), table, select=\"first\")", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("Vector", "Views"), function(x, table, nomatch=NA_integer_, incomparables=NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on a Views subject is defunct.\n", "Please use '", "findOverlaps(x, ranges(table), select=\"first\")", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("RangesList", "RangesList"), function(x, table, nomatch = NA_integer_, incomparables = NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on RangesList objects is defunct.\n", "Please use '", "findOverlaps(x, table, select=\"first\", drop=TRUE)", "' instead.") .Defunct(msg=msg) }) setMethod("match", c("ViewsList", "ViewsList"), function(x, table, nomatch=NA_integer_, incomparables=NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on ViewsList objects is defunct.\n", "Please use '", "findOverlaps(ranges(x), ranges(table), select=\"first\", ", "drop=TRUE)", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("ViewsList", "Vector"), function(x, table, nomatch=NA_integer_, incomparables=NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on a ViewsList query is defunct.\n", "Please use '", "findOverlaps(ranges(x), table, select=\"first\", ", "drop=TRUE)", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("Vector", "ViewsList"), function(x, table, nomatch=NA_integer_, incomparables=NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on a ViewsList subject is defunct.\n", "Please use '", "findOverlaps(x, ranges(table), select=\"first\", ", "drop=TRUE)", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("RangedData", "RangedData"), function(x, table, nomatch = NA_integer_, incomparables = NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on RangedData objects is defunct.\n", "Please use '", "findOverlaps(ranges(x), ranges(table), select=\"first\", ", "drop=TRUE)", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("RangedData", "RangesList"), function(x, table, nomatch = NA_integer_, incomparables = NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on a RangedData query is defunct.\n", "Please use '", "findOverlaps(ranges(x), table, select=\"first\", ", "drop=TRUE)", "' instead.") .Defunct(msg=msg) } ) setMethod("match", c("RangesList", "RangedData"), function(x, table, nomatch = NA_integer_, incomparables = NULL) { if (!identical(nomatch, NA_integer_)) stop("'nomatch' arg is not supported") msg <- c("match() on a RangedData subject is defunct.\n", "Please use '", "findOverlaps(x, ranges(table), select=\"first\", ", "drop=TRUE)", "' instead.") .Defunct(msg=msg) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### overlapsAny() ### ### %in% is defunct. Replacing it with %over%. ### ### Same args and signature as countOverlaps() and subsetByOverlaps(). setGeneric("overlapsAny", signature=c("query", "subject"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) standardGeneric("overlapsAny") ) setMethod("overlapsAny", c("Ranges", "Ranges"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { !is.na(findOverlaps(query, subject, maxgap=maxgap, minoverlap=minoverlap, type=type, select="arbitrary", ...)) } ) setMethod("overlapsAny", c("Views", "Views"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(ranges(query), ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("Views", "Vector"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(ranges(query), subject, maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("Vector", "Views"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(query, ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("RangesList", "RangesList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { query <- as.list(query) subject <- as.list(subject) if (!is.null(names(query)) && !is.null(names(subject))) { subject <- subject[names(query)] names(subject) <- names(query) # get rid of NA's in names } else { subject <- subject[seq_along(query)] } ## NULL's are introduced where they do not match ## We replace those with empty IRanges subject[sapply(subject, is.null)] <- IRanges() LogicalList(lapply(structure(seq_len(length(query)), names = names(query)), function(i) overlapsAny(query[[i]], subject[[i]], maxgap=maxgap, minoverlap=minoverlap, type=type, ...))) } ) setMethod("overlapsAny", c("RangesList", "IntervalForest"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { if (!is(query, "CompressedIRangesList")) query <- as(query, "CompressedIRangesList") !is.na(findOverlaps(query, subject, maxgap=maxgap, minoverlap=minoverlap, type=type, select="arbitrary", ...)) } ) setMethod("overlapsAny", c("ViewsList", "ViewsList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(ranges(query), ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("ViewsList", "Vector"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(ranges(query), subject, maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("Vector", "ViewsList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(query, ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("RangedData", "RangedData"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(ranges(query), ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("RangedData", "RangesList"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(ranges(query), subject, maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) setMethod("overlapsAny", c("RangesList", "RangedData"), function(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) { overlapsAny(query, ranges(subject), maxgap=maxgap, minoverlap=minoverlap, type=type, ...) } ) ### Convenience wrappers for the 2 most common use cases. `%over%` <- function(query, subject) overlapsAny(query, subject) `%within%` <- function(query, subject) overlapsAny(query, subject, type="within") `%outside%` <- function(query, subject) !overlapsAny(query, subject) `.%in%.definition` <- function(x, table) { msg <- c("%in% between a ", class(x), " and a ", class(table), " object ", "is defunct.\nPlease use 'query %over% subject' instead.") .Defunct(msg=msg) } .signatures <- list( c("Views", "Views"), c("Views", "Vector"), c("Vector", "Views"), c("RangesList", "RangesList"), c("ViewsList", "ViewsList"), c("ViewsList", "Vector"), c("Vector", "ViewsList"), c("RangedData", "RangedData"), c("RangedData", "RangesList"), c("RangesList", "RangedData") ) setMethods("%in%", .signatures, `.%in%.definition`) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### subsetByOverlaps() ### setGeneric("subsetByOverlaps", signature = c("query", "subject"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), ...) standardGeneric("subsetByOverlaps") ) setMethod("subsetByOverlaps", c("Vector", "Vector"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal"), ...) { type <- match.arg(type) query[!is.na(findOverlaps(query, subject, maxgap = maxgap, minoverlap = minoverlap, type = type, select = "arbitrary", ...))] } ) setMethod("subsetByOverlaps", c("RangedData", "RangedData"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { query[unlist(!is.na(findOverlaps(ranges(query), ranges(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = "arbitrary")), use.names=FALSE),] }) setMethod("subsetByOverlaps", c("RangedData", "RangesList"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { query[unlist(!is.na(findOverlaps(ranges(query), subject, maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = "arbitrary")), use.names=FALSE),] }) setMethod("subsetByOverlaps", c("RangesList", "RangedData"), function(query, subject, maxgap = 0L, minoverlap = 1L, type = c("any", "start", "end", "within", "equal")) { query[!is.na(findOverlaps(query, ranges(subject), maxgap = maxgap, minoverlap = minoverlap, type = match.arg(type), select = "arbitrary"))] }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### "ranges" method for Hits objects ### ### Extracts the actual regions of intersection between the overlapping ranges. ### Not much value. Could be replaced by 1-liner: ### pintersect(query[queryHits(x)], subject[subjectHits(x)]) ### setMethod("ranges", "Hits", function(x, query, subject) { if (!is(query, "Ranges") || length(query) != queryLength(x)) stop("'query' must be a Ranges of length equal to number of queries") if (!is(subject, "Ranges") || length(subject) != subjectLength(x)) stop("'subject' must be a Ranges of length equal to number of subjects") m <- as.matrix(x) qstart <- start(query)[m[,1L]] qend <- end(query)[m[,1L]] sstart <- start(subject)[m[,2L]] send <- end(subject)[m[,2L]] IRanges(pmax.int(qstart, sstart), pmin.int(send, qend)) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The only reason for defining the methods below is to prevent the default ### "findMatches" or "countMatches" methods to be called and return something ### wrong (and the reason they would return something wrong is because they ### are based on match() which does overlaps instead of equality). ### TODO: Remove these methods in BioC 2.14 when the "match" methods for all ### the signatures in '.signatures' are gone. setMethods("findMatches", .signatures, function(x, table, select=c("all", "first", "last"), ...) { msg <- c("findMatches() between a ", class(x), " and a ", class(table), " object is not supported") stop(msg) } ) setMethods("countMatches", .signatures, function(x, table, ...) { msg <- c("countMatches() between a ", class(x), " and a ", class(table), " object is not supported") stop(msg) } ) IRanges/R/funprog-methods.R0000644000126300012640000000606712227064470017147 0ustar00biocbuildphs_compbio### ========================================================================= ### Functional programming methods ### ------------------------------------------------------------------------- ### #.ReduceDefault <- base::Reduce #environment(.ReduceDefault) <- topenv() .ReduceDefault <- function(f, x, init, right = FALSE, accumulate = FALSE) { mis <- missing(init) len <- length(x) if (len == 0L) return(if (mis) NULL else init) f <- match.fun(f) # if (!is.vector(x) || is.object(x)) # x <- as.list(x) ind <- seq_len(len) if (mis) { if (right) { init <- x[[len]] ind <- ind[-len] } else { init <- x[[1L]] ind <- ind[-1L] } } if (!accumulate) { if (right) { for (i in rev(ind)) init <- f(x[[i]], init) } else { for (i in ind) init <- f(init, x[[i]]) } init } else { len <- length(ind) + 1L out <- vector("list", len) if (mis) { if (right) { out[[len]] <- init for (i in rev(ind)) { init <- f(x[[i]], init) out[[i]] <- init } } else { out[[1L]] <- init for (i in ind) { init <- f(init, x[[i]]) out[[i]] <- init } } } else { if (right) { out[[len]] <- init for (i in rev(ind)) { init <- f(x[[i]], init) out[[i]] <- init } } else { for (i in ind) { out[[i]] <- init init <- f(init, x[[i]]) } out[[len]] <- init } } if (all(sapply(out, length) == 1L)) out <- unlist(out, recursive = FALSE) out } } setMethod("Reduce", "List", .ReduceDefault) .FilterDefault <- base::Filter environment(.FilterDefault) <- topenv() setMethod("Filter", "List", .FilterDefault) .FindDefault <- base::Find environment(.FindDefault) <- topenv() setMethod("Find", "List", .FindDefault) .MapDefault <- base::Map environment(.MapDefault) <- topenv() setMethod("Map", "List", .MapDefault) setMethod("Position", "List", function(f, x, right = FALSE, nomatch = NA_integer_) { ## In R-2.12, base::Position() was modified to use seq_along() ## internally. The problem is that seq_along() was a primitive ## that would let the user define methods for it (otherwise it ## would have been worth defining a "seq_along" method for Vector ## objects). So we need to redefine seq_along() locally in order ## to make base_Position() work. seq_along <- function(along.with) seq_len(length(along.with)) base_Position <- base::Position environment(base_Position) <- environment() base_Position(f, x, right = right, nomatch = nomatch) } ) IRanges/R/int-utils.R0000644000126300012640000004572212227064470015757 0ustar00biocbuildphs_compbio### ========================================================================= ### Some low-level (not exported) utility functions to operate on integer ### vectors ### ------------------------------------------------------------------------- anyMissingOrOutside <- function(x, lower = -.Machine$integer.max, upper = .Machine$integer.max) { if (!is.integer(x)) stop("'x' must be an integer vector") if (!is.integer(lower)) lower <- as.integer(lower) if (!is.integer(upper)) upper <- as.integer(upper) .Call2("Integer_any_missing_or_outside", x, lower, upper, PACKAGE="IRanges") } ### Returns 'sum(x)', or an error if 'x' contains NAs or negative values or if ### an integer overflow occurs while summing. sumNonNegInts <- function(x) .Call2("Integer_sum_non_neg_vals", x, PACKAGE="IRanges") ### Equivalent to (but much faster than): ### ### diff(c(0L, x)) ### ### except that NAs are not supported. diffWithInitialZero <- function(x) { if (!is.integer(x)) stop("'x' must be an integer vector") .Call2("Integer_diff_with_0", x, PACKAGE="IRanges") } ### Equivalent to (but much faster than): ### ### diff(c(x, last)) ### ### except that NAs are not supported. diffWithLast <- function(x, last) { if (!is.integer(x)) stop("'x' must be an integer vector") if (!isSingleInteger(last)) stop("'last' must be a single, non-NA integer") .Call2("Integer_diff_with_last", x, last, PACKAGE="IRanges") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Fast ordering of an integer vector. ### ### We want this ordering to be "stable". orderInteger <- function(x, decreasing=FALSE, na.last=NA) { if (is.factor(x)) { input_is_factor <- TRUE x_delta <- length(levels(x)) - 1L x <- as.integer(x) } else { if (!is.integer(x)) stop("'x' must be an integer vector or a factor") input_is_factor <- FALSE } x_min <- suppressWarnings(min(x, na.rm=TRUE)) if (x_min == Inf) { if (is.na(na.last)) return(integer(0)) else return(seq_len(length(x))) } ## At this point 'x' is guaranteed to contain at least one non NA value. if (!input_is_factor) x_delta <- max(x, na.rm=TRUE) - x_min if (x_delta < 100000L) { ## "radix" method is stable. return(sort.list(x, decreasing=decreasing, na.last=na.last, method="radix")) } has_NAs <- anyMissing(x) if (!has_NAs || is.na(na.last)) { if (has_NAs) x <- x[!is.na(x)] ## Uses _get_order_of_int_array() at the C level which is stable. return(.Call2("Integer_order", x, decreasing, PACKAGE="IRanges")) } ## At this point 'x' has NAs and we must keep them ('na.last' is not NA). ## We can't use sort.list() with method="quick" or method="shell" here ## because they are not stable algorithms (and in addition method="quick" ## is only supported when 'na.last' is NA). So we use order() with an ## extra vector to break ties, which is a trick to make it stable. ## Unfortunately this is very inefficient (about twice slower than ## using sort.list() with method="shell"). ## TODO: Modify .Call entry point Integer_order to support 'na.last' arg. if (decreasing) y <- length(x):1L else y <- seq_len(length(x)) order(x, y, decreasing=decreasing, na.last=na.last) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Fast ordering/comparing of integer pairs. ### .normargIntegerOrFactor <- function(arg, argname) { if (is.factor(arg)) arg <- as.integer(arg) else if (!is.integer(arg)) stop("'", argname, "' must be an integer vector or factor") arg } .normargMethod <- function(method=c("auto", "quick", "hash"), a_len) { method <- match.arg(method) if (method == "auto") { if (a_len <= 2^29) method <- "hash" else method <- "quick" } method } ### For 'a' and 'b' integer vectors of equal length with no NAs, ### 'orderIntegerPairs(a, b)' is equivalent to (but faster than): ### ### order(a, b) ### ### Benchmarking: ### ### # Generating random pairs (representing ranges). ### library(IRanges) ### N <- 20000000L # nb of ranges ### W <- 40L # average width of the ranges ### max_end <- 55000000L ### set.seed(777) ### a <- sample(max_end - W - 2L, N, replace=TRUE) ### b <- W + sample(-3:3, N, replace=TRUE) ### ## Takes < 10 sec.: ### oo <- IRanges:::orderIntegerPairs(a, b) ### ## Takes about 1 min.: ### oo2 <- order(a, b) ### identical(oo, oo2) # TRUE ### ### For efficiency reasons, we don't support (and don't even check) for NAs. orderIntegerPairs <- function(a, b, decreasing=FALSE) { a <- .normargIntegerOrFactor(a, "a") b <- .normargIntegerOrFactor(b, "b") .Call2("Integer_order2", a, b, decreasing, PACKAGE="IRanges") } .matchIntegerPairs_quick <- function(a1, b1, a2, b2, nomatch=NA_integer_) { .Call2("Integer_match2_quick", a1, b1, a2, b2, nomatch, PACKAGE="IRanges") } .matchIntegerPairs_hash <- function(a1, b1, a2, b2, nomatch=NA_integer_) { .Call2("Integer_match2_hash", a1, b1, a2, b2, nomatch, PACKAGE="IRanges") } matchIntegerPairs <- function(a1, b1, a2, b2, nomatch=NA_integer_, method=c("auto", "quick", "hash")) { a1 <- .normargIntegerOrFactor(a1, "a1") b1 <- .normargIntegerOrFactor(b1, "b1") if (length(a1) != length(b1)) stop("'a1' and 'b1' must have the same length") a2 <- .normargIntegerOrFactor(a2, "a2") b2 <- .normargIntegerOrFactor(b2, "b2") if (length(a2) != length(b2)) stop("'a2' and 'b2' must have the same length") if (!isSingleNumberOrNA(nomatch)) stop("'nomatch' must be a single number or NA") if (!is.integer(nomatch)) nomatch <- as.integer(nomatch) method <- .normargMethod(method, length(a2)) if (method == "quick") { ans <- .matchIntegerPairs_quick(a1, b1, a2, b2, nomatch=nomatch) } else { ans <- .matchIntegerPairs_hash(a1, b1, a2, b2, nomatch=nomatch) } ans } .selfmatchIntegerPairs_quick <- function(a, b) { .Call2("Integer_selfmatch2_quick", a, b, PACKAGE="IRanges") } ### Author: Martin Morgan .selfmatchIntegerPairs_hash <- function(a, b) { .Call2("Integer_selfmatch2_hash", a, b, PACKAGE="IRanges") } selfmatchIntegerPairs <- function(a, b, method=c("auto", "quick", "hash")) { a <- .normargIntegerOrFactor(a, "a") b <- .normargIntegerOrFactor(b, "b") if (length(a) != length(b)) stop("'a' and 'b' must have the same length") method <- .normargMethod(method, length(a)) if (method == "quick") { ans <- .selfmatchIntegerPairs_quick(a, b) } else { ans <- .selfmatchIntegerPairs_hash(a, b) } ans } ### For 'a' and 'b' integer vectors of equal length with no NAs, ### 'duplicatedIntegerPairs(a, b)' is equivalent to (but much faster than): ### ### duplicated(cbind(a, b)) ### ### For efficiency reasons, we don't support (and don't even check) for NAs. duplicatedIntegerPairs <- function(a, b, fromLast=FALSE, method=c("auto", "quick", "hash")) { a <- .normargIntegerOrFactor(a, "a") b <- .normargIntegerOrFactor(b, "b") if (length(a) != length(b)) stop("'a' and 'b' must have the same length") if (!isTRUEorFALSE(fromLast)) stop("'fromLast' must be TRUE or FALSE") if (length(a) == 0L) return(logical(0L)) if (length(a) == 1L) return(FALSE) ## This is a temporary (and inefficient) workaround until "quick" ## and "hash" methods can natively support fromLast=TRUE. ## TODO: Add support for fromLast=TRUE to "quick" and "hash" methods. if (fromLast) return(rev(duplicatedIntegerPairs(rev(a), rev(b), method=method))) sm <- selfmatchIntegerPairs(a, b, method=method) sm != seq_len(length(sm)) } ### For 'a' and 'b' integer vectors of equal length with no NAs, ### 'runEndsOfIntegerPairs(a, b)' finds the runs of identical rows in ### 'cbind(a, b)' and returns the indices of the last row in each run. ### In other words, it's equivalent to (but much faster than): ### ### cumsum(runLength(Rle(paste(a, b, sep="|")))) ### ### Note that, if the rows in 'cbind(a, b)' are already sorted, then ### 'runEndsOfIntegerPairs(a, b)' returns the indices of the unique rows. ### In other words, 'runEndsOfIntegerPairs()' could be used to efficiently ### extract the unique pairs of integers from a presorted set of pairs. ### However, at the moment (April 2011) using 'duplicatedIntegerPairs()' ### is still faster than using 'runEndsOfIntegerPairs()' for finding the ### duplicated or unique pairs of integers in a presorted set of pairs. ### But this only because 'runEndsOfIntegerPairs()' is not as fast as it ### could/should be (an all-in-C implementation would probably solve this). ### ### For efficiency reasons, we don't support (and don't even check) for NAs. ### TODO: What happens if 'a' and 'b' don't have the same length? Shouldn't ### we check for that? runEndsOfIntegerPairs <- function(a, b) { not_same_as_prev <- diffWithInitialZero(a) != 0L | diffWithInitialZero(b) != 0L if (length(not_same_as_prev) == 0L) return(integer()) which(c(not_same_as_prev[-1L], TRUE)) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Fast ordering/comparing of integer quadruplets. ### ### For 'a', 'b', 'c' and 'd' integer vectors of equal length with no NAs, ### 'orderIntegerQuads(a, b, c, d)' is equivalent to (but faster than): ### ### order(a, b, c, d) ### ### For efficiency reasons, we don't support (and don't even check) for NAs. orderIntegerQuads <- function(a, b, c, d, decreasing=FALSE) { a <- .normargIntegerOrFactor(a, "a") b <- .normargIntegerOrFactor(b, "b") c <- .normargIntegerOrFactor(c, "c") d <- .normargIntegerOrFactor(d, "d") .Call2("Integer_order4", a, b, c, d, decreasing, PACKAGE="IRanges") } .matchIntegerQuads_quick <- function(a1, b1, c1, d1, a2, b2, c2, d2, nomatch=NA_integer_) { .Call2("Integer_match4_quick", a1, b1, c1, d1, a2, b2, c2, d2, nomatch, PACKAGE="IRanges") } .matchIntegerQuads_hash <- function(a1, b1, c1, d1, a2, b2, c2, d2, nomatch=NA_integer_) { .Call2("Integer_match4_hash", a1, b1, c1, d1, a2, b2, c2, d2, nomatch, PACKAGE="IRanges") } matchIntegerQuads <- function(a1, b1, c1, d1, a2, b2, c2, d2, nomatch=NA_integer_, method=c("auto", "quick", "hash")) { a1 <- .normargIntegerOrFactor(a1, "a1") b1 <- .normargIntegerOrFactor(b1, "b1") c1 <- .normargIntegerOrFactor(c1, "c1") d1 <- .normargIntegerOrFactor(d1, "d1") if (length(a1) != length(b1) || length(b1) != length(c1) || length(c1) != length(d1)) stop("'a1', 'b1', 'c1' and 'd1' must have the same length") a2 <- .normargIntegerOrFactor(a2, "a2") b2 <- .normargIntegerOrFactor(b2, "b2") c2 <- .normargIntegerOrFactor(c2, "c2") d2 <- .normargIntegerOrFactor(d2, "d2") if (length(a2) != length(b2) || length(b2) != length(c2) || length(c2) != length(d2)) stop("'a2', 'b2', 'c2' and 'd2' must have the same length") if (!isSingleNumberOrNA(nomatch)) stop("'nomatch' must be a single number or NA") if (!is.integer(nomatch)) nomatch <- as.integer(nomatch) method <- .normargMethod(method, length(a2)) if (method == "quick") { ans <- .matchIntegerQuads_quick(a1, b1, c1, d1, a2, b2, c2, d2, nomatch=nomatch) } else { ans <- .matchIntegerQuads_hash(a1, b1, c1, d1, a2, b2, c2, d2, nomatch=nomatch) } ans } .selfmatchIntegerQuads_quick <- function(a, b, c, d) { .Call2("Integer_selfmatch4_quick", a, b, c, d, PACKAGE="IRanges") } .selfmatchIntegerQuads_hash <- function(a, b, c, d) { .Call2("Integer_selfmatch4_hash", a, b, c, d, PACKAGE="IRanges") } selfmatchIntegerQuads <- function(a, b, c, d, method=c("auto", "quick", "hash")) { a <- .normargIntegerOrFactor(a, "a") b <- .normargIntegerOrFactor(b, "b") c <- .normargIntegerOrFactor(c, "c") d <- .normargIntegerOrFactor(d, "d") if (length(a) != length(b) || length(b) != length(c) || length(c) != length(d)) stop("'a', 'b', 'c' and 'd' must have the same length") method <- .normargMethod(method, length(a)) if (method == "quick") { ans <- .selfmatchIntegerQuads_quick(a, b, c, d) } else { ans <- .selfmatchIntegerQuads_hash(a, b, c, d) } ans } duplicatedIntegerQuads <- function(a, b, c, d, fromLast=FALSE, method=c("auto", "quick", "hash")) { a <- .normargIntegerOrFactor(a, "a") b <- .normargIntegerOrFactor(b, "b") c <- .normargIntegerOrFactor(c, "c") d <- .normargIntegerOrFactor(d, "d") if (length(a) != length(b) || length(b) != length(c) || length(c) != length(d)) stop("'a', 'b', 'c' and 'd' must have the same length") if (!isTRUEorFALSE(fromLast)) stop("'fromLast' must be TRUE or FALSE") if (length(a) == 0L) return(logical(0L)) if (length(a) == 1L) return(FALSE) ## This is a temporary (and inefficient) workaround until "quick" ## and "hash" methods can natively support fromLast=TRUE. ## TODO: Add support for fromLast=TRUE to "quick" and "hash" methods. if (fromLast) return(rev(duplicatedIntegerQuads(rev(a), rev(b), rev(c), rev(d), method=method))) sm <- selfmatchIntegerQuads(a, b, c, d, method=method) sm != seq_len(length(sm)) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### tabulate2() ### ### An enhanced version of base::tabulate() that: (1) handles integer weights ### (NA and negative weights are OK), and (2) throws an error if 'strict' is ### TRUE and if 'x' contains NAs or values not in the [1, 'nbins'] interval. ### Unlike with base::tabulate(), 'nbins' needs to be specified (no default ### value). Also for now, it only works if 'x' is an integer vector. ### tabulate2 <- function(x, nbins, weight=1L, strict=FALSE) { if (!is.integer(x)) stop("'x' must be an integer vector") if (!isSingleNumber(nbins)) stop("'nbins' must be a single integer") if (!is.integer(nbins)) nbins <- as.integer(nbins) if (!is.integer(weight)) stop("'weight' must be an integer vector") if (!isTRUEorFALSE(strict)) stop("'strict' must be TRUE or FALSE") .Call2("Integer_tabulate2", x, nbins, weight, strict, PACKAGE="IRanges") } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Bitwise operations. ### ### The bitwise operations in this section don't treat the integer NA (aka ### NA_integer_) in any particular way: at the C level an NA_integer_ is ### just a 32-bit pattern like any other int in C. ### makePowersOfTwo <- function(nbit) { if (!isSingleInteger(nbit) || nbit < 0L) stop("'nbit' must be a single non-negative integer") if (nbit == 0L) return(integer(0)) as.integer(cumprod(c(1L, rep.int(2L, nbit-1L)))) } ### Returns an integer matrix with 'length(x)' rows and 'length(bitpos)' cols. explodeIntBits <- function(x, bitpos=1:32) { if (!is.integer(x)) stop("'x' must be an integer vector") if (!is.integer(bitpos)) stop("'bitpos' must be an integer vector") ## Old implementation: not very efficient and also broken on NAs and ## negative integers! #if (length(bitpos) == 0L) # return(matrix(nrow=length(x), ncol=0L)) #nbit <- max(bitpos) #if (is.na(nbit) || min(bitpos) <= 0L) # stop("'bitpos' must contain potive values only") #ans <- matrix(nrow=length(x), ncol=nbit) #for (i in seq_len(ncol(ans))) { # ans[ , i] <- x %% 2L # x <- x %/% 2L #} #ans[ , bitpos, drop=FALSE] .Call2("Integer_explode_bits", x, bitpos, PACKAGE="IRanges") } ### FIXME: Broken if ncol(x) = 32. implodeIntBits <- function(x) { if (!is.matrix(x)) stop("'x' must be a matrix") tx <- t(x) data <- tx * makePowersOfTwo(nrow(tx)) ## In some circumstances (e.g. if 'tx' has 0 col), the "dim" attribute ## gets lost during the above multiplication. if (is.null(dim(data))) dim(data) <- dim(tx) as.integer(colSums(data)) } intbitsNOT <- function(x) { stop("not yet implemented") # fix implodeIntBits() first! xbits <- explodeIntBits(x) implodeIntBits(!xbits) } intbitsAND <- function(x, y) { stop("not yet implemented") # fix implodeIntBits() first! xbits <- explodeIntBits(x) ybits <- explodeIntBits(y) implodeIntBits(xbits & ybits) } intbitsOR <- function(x, y) { stop("not yet implemented") # fix implodeIntBits() first! xbits <- explodeIntBits(x) ybits <- explodeIntBits(y) implodeIntBits(xbits | ybits) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Others. ### sortedMerge <- function(x, y) .Call2("Integer_sorted_merge", x, y, PACKAGE="IRanges") mseq <- function(from, to) { if (!is.integer(from)) from <- as.integer(from) if (!is.integer(to)) to <- as.integer(to) .Call2("Integer_mseq", from, to, PACKAGE="IRanges") } fancy_mseq <- function(lengths, offset=0L, rev=FALSE) { if (!is.integer(lengths)) lengths <- as.integer(lengths) if (!is.integer(offset)) offset <- as.integer(offset) if (!is.logical(rev)) stop("'rev' must be a logical vector") #unlist(lapply(seq_len(length(lengths)), # function(i) { # tmp <- seq_len(lengths[i]) + offset[i] # if (rev[i]) # tmp <- rev(tmp) # tmp # })) .Call2("Integer_fancy_mseq", lengths, offset, rev, PACKAGE="IRanges") } make_XYZxyz_to_XxYyZz_subscript <- function(N) { idx2 <- seq_len(N) * 2L idx1 <- idx2 - 1L ans <- integer(N * 2L) ans[c(idx1, idx2)] <- seq_along(ans) ans } findIntervalAndStartFromWidth <- function(x, width) .Call2("findIntervalAndStartFromWidth", x, width, PACKAGE="IRanges") ### Reverse an injection from 1:M to 1:N. ### The injection is represented by an integer vector of length M (eventually ### with NAs). Fundamental property: ### ### reverseIntegerInjection(reverseIntegerInjection(injection, N), M) ### ### is the identity function. ### Can be used to efficiently reverse the result of a call to 'order()'. reverseIntegerInjection <- function(injection, N) { M <- length(injection) ans <- rep.int(NA_integer_, N) is_not_na <- !is.na(injection) ans[injection[is_not_na]] <- seq_len(M)[is_not_na] ans } IRanges/R/inter-range-methods.R0000644000126300012640000004252412227064470017700 0ustar00biocbuildphs_compbio### ========================================================================= ### Inter-range methods ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### range() ### setMethod("range", "Ranges", function(x, ..., na.rm=FALSE) { if (!identical(na.rm, FALSE)) warning("'na.rm' argument is ignored") args <- unname(list(x, ...)) if (length(args) == 0L) # should never happen return(IRanges()) if (!all(sapply(args, is, "Ranges"))) stop("all arguments in '...' must be Ranges objects") xx <- do.call(c, lapply(args, as, "IRanges")) y <- .Call2("IRanges_range", xx, PACKAGE="IRanges") as(y, class(args[[1L]])) } ) setMethod("range", "RangesList", function(x, ..., na.rm=FALSE) { if (length(list(x, ...)) >= 2L) x <- merge(x, ...) endoapply(x, range) } ) ### Equivalent to, but much faster than, 'endoapply(x, range)'. .CompressedIRangesList.range <- function(x) { ## 'x_start' and 'x_end' are CompressedIntegerList objects with the ## same shape as 'x'. x_start <- start(x) x_end <- end(x) ## TEMPORARY HACK! if (!require(XVector, quietly=TRUE)) stop("the XVector package is required by the \"range\" method ", "for CompressedIRangesList objects") ## 'sv' and 'ev' are XIntegerViews objects (see XVector package). sv <- Views(x_start@unlistData, x_start@partitioning) ev <- Views(x_end@unlistData, x_end@partitioning) is_not_empty_view <- width(sv) != 0L # same as 'width(ev) != 0L' ans_unlistData <- IRanges(viewMins(sv)[is_not_empty_view], viewMaxs(ev)[is_not_empty_view]) ans_partitioning <- new2("PartitioningByEnd", end=cumsum(is_not_empty_view), check=FALSE) ans <- new2("CompressedIRangesList", unlistData=ans_unlistData, partitioning=ans_partitioning, check=FALSE) names(ans) <- names(x) mcols(ans) <- mcols(x) ans } setMethod("range", "CompressedIRangesList", function(x, ..., na.rm=FALSE) { if (length(list(x, ...)) >= 2L) x <- merge(x, ...) .CompressedIRangesList.range(x) } ) setMethod("range", "IntervalForest", function(x, ..., na.rm=FALSE) as(range(as(x, "CompressedIRangesList"), ..., na.rm = na.rm), "IntervalForest")) setMethod("range", "RangedData", function(x, ..., na.rm) { args <- list(x, ...) rangeLists <- lapply(args, ranges) do.call(range, rangeLists) }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### reduce() ### setGeneric("reduce", signature="x", function(x, ...) standardGeneric("reduce") ) setMethod("reduce", "IRanges", function(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) { if (!isTRUEorFALSE(drop.empty.ranges)) stop("'drop.empty.ranges' must be TRUE or FALSE") if (!isSingleNumber(min.gapwidth)) stop("'min.gapwidth' must be a single integer") if (!is.integer(min.gapwidth)) min.gapwidth <- as.integer(min.gapwidth) if (min.gapwidth < 0L) stop("'min.gapwidth' must be non-negative") if (!isTRUEorFALSE(with.mapping)) stop("'with.mapping' must be TRUE or FALSE") if (!isTRUEorFALSE(with.inframe.attrib)) stop("'with.inframe.attrib' must be TRUE or FALSE") C_ans <- .Call2("Ranges_reduce", start(x), width(x), drop.empty.ranges, min.gapwidth, with.mapping, with.inframe.attrib, PACKAGE="IRanges") ans <- unsafe.update(x, start=C_ans$start, width=C_ans$width, names=NULL) if (with.mapping) { mapping <- IntegerList(C_ans$mapping) mcols(ans) <- DataFrame(mapping=mapping) } if (with.inframe.attrib) { inframe <- new2("IRanges", start=C_ans$inframe.start, width=width(x), check=FALSE) attr(ans, "inframe") <- inframe } ans } ) setMethod("reduce", "Ranges", function(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) { ir <- as(x, "IRanges") y <- reduce(ir, drop.empty.ranges=drop.empty.ranges, min.gapwidth=min.gapwidth, with.mapping=with.mapping, with.inframe.attrib=with.inframe.attrib) as(y, class(x)) } ) setMethod("reduce", "Views", function(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) { x@ranges <- reduce(ranges(x), drop.empty.ranges=drop.empty.ranges, min.gapwidth=min.gapwidth, with.mapping=with.mapping, with.inframe.attrib=with.inframe.attrib) x } ) setMethod("reduce", "RangesList", function(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) endoapply(x, reduce, drop.empty.ranges = drop.empty.ranges, min.gapwidth = min.gapwidth, with.mapping=with.mapping, with.inframe.attrib = with.inframe.attrib)) ### 'with.inframe.attrib' is ignored for now. ### TODO: Support 'with.inframe.attrib=TRUE'. setMethod("reduce", "CompressedIRangesList", function(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) { if (!isTRUEorFALSE(drop.empty.ranges)) stop("'drop.empty.ranges' must be TRUE or FALSE") if (!isSingleNumber(min.gapwidth)) stop("'min.gapwidth' must be a single integer") if (!is.integer(min.gapwidth)) min.gapwidth <- as.integer(min.gapwidth) if (min.gapwidth < 0L) stop("'min.gapwidth' must be non-negative") if (!isTRUEorFALSE(with.mapping)) stop("'with.mapping' must be TRUE or FALSE") if (!identical(with.inframe.attrib, FALSE)) stop("'with.inframe.attrib' argument not yet supported ", "when reducing a CompressedIRangesList object") C_ans <- .Call2("CompressedIRangesList_reduce", x, drop.empty.ranges, min.gapwidth, with.mapping, PACKAGE="IRanges") ans_unlistData <- new2("IRanges", start=C_ans$start, width=C_ans$width, check=FALSE) if (with.mapping) { mapping <- IntegerList(C_ans$mapping) mcols(ans_unlistData) <- DataFrame(mapping=mapping) } ans_partitioning <- PartitioningByEnd(C_ans$partitioning_by_end) names(ans_partitioning) <- names(x) relist(ans_unlistData, ans_partitioning) } ) setMethod("reduce", "IntervalForest", function(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) { if (!drop.empty.ranges) stop("'drop.empty.ranges' must be FALSE in ", "'reduce,IntervalForest'") if (with.mapping) stop("'with.mapping' muse be FALSE in 'reduce,IntervalForest'") as(reduce(as(x, "CompressedIRangesList"), drop.empty.ranges = drop.empty.ranges, min.gapwidth = min.gapwidth, with.mapping = with.mapping, with.inframe.attrib = with.inframe.attrib), "IntervalForest") }) setMethod("reduce", "RangedData", function(x, by = character(), drop.empty.ranges=FALSE, min.gapwidth=1L, with.inframe.attrib=FALSE) { if (!isTRUEorFALSE(drop.empty.ranges)) stop("'drop.empty.ranges' must be TRUE or FALSE") if (!isSingleNumber(min.gapwidth)) stop("'min.gapwidth' must be a single integer") if (!is.integer(min.gapwidth)) min.gapwidth <- as.integer(min.gapwidth) if (min.gapwidth < 0L) stop("'min.gapwidth' must be non-negative") FUN <- function(y) { name <- names(y) ranges <- ranges(y)[[1L]] values <- values(y)[[1L]] inds <- unname(split(seq_len(nrow(values)), lapply(values, as.vector))) rlist <- lapply(inds, function(i) { rngs <- reduce(ranges[i], drop.empty.ranges=drop.empty.ranges, min.gapwidth=min.gapwidth, with.inframe.attrib=with.inframe.attrib) list(ranges = rngs, values = values[rep(i, length.out = length(rngs)), , drop=FALSE]) }) ranges <- IRangesList(do.call(c, lapply(rlist, "[[", "ranges"))) names(ranges) <- name values <- SplitDataFrameList(do.call(rbind, lapply(rlist, "[[", "values"))) names(values) <- name new2(class(y), ranges = ranges, values = values, check = FALSE) } if (ncol(x) == 0 || length(by) == 0) { ranges <- reduce(ranges(x), drop.empty.ranges = drop.empty.ranges, min.gapwidth = min.gapwidth, with.inframe.attrib = with.inframe.attrib) listData <- new2("DataFrame", nrows=sum(elementLengths(ranges)), check=FALSE) end <- cumsum(elementLengths(ranges)) names(end) <- names(ranges) partitioning <- PartitioningByEnd(end) initialize(x, ranges = ranges, values = relist(listData, partitioning)) } else { endoapply(x[,by], FUN) } }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### gaps() ### setGeneric("gaps", signature="x", function(x, start=NA, end=NA) standardGeneric("gaps") ) setMethod("gaps", "IRanges", function(x, start=NA, end=NA) { start <- normargSingleStartOrNA(start) end <- normargSingleEndOrNA(end) C_ans <- .Call2("IRanges_gaps", start(x), width(x), start, end, PACKAGE="IRanges") initialize(x, start=C_ans$start, width=C_ans$width, NAMES=NULL, elementMetadata=NULL) } ) setMethod("gaps", "Ranges", function(x, start=NA, end=NA) { ir <- as(x, "IRanges") y <- gaps(ir, start=start, end=end) as(y, class(x)) } ) setMethod("gaps", "Views", function(x, start=NA, end=NA) { if (!isSingleNumberOrNA(start)) stop("'start' must be a single integer") if (!is.integer(start)) start <- as.integer(start) if (!isSingleNumberOrNA(end)) stop("'end' must be a single integer") if (!is.integer(end)) end <- as.integer(end) if (is.na(start)) start <- 1L if (is.na(end)) end <- length(subject(x)) x@ranges <- gaps(ranges(x), start=start, end=end) x } ) setMethod("gaps", "RangesList", function(x, start = NA, end = NA) { lx <- length(x) if (!isNumericOrNAs(start)) stop("'start' must be an integer vector or NA") if (!is.integer(start)) start <- as.integer(start) if (!isNumericOrNAs(end)) stop("'end' must be an integer vector or NA") if (!is.integer(end)) end <- as.integer(end) start <- IntegerList(as.list(recycleVector(start, lx))) end <- IntegerList(as.list(recycleVector(end, lx))) mendoapply(gaps, x, start = start, end = end) }) setMethod("gaps", "CompressedIRangesList", function(x, start = NA, end = NA) { lx <- length(x) if (!isNumericOrNAs(start)) stop("'start' must be an integer vector or NA") if (!is.integer(start)) start <- as.integer(start) if (!isNumericOrNAs(end)) stop("'end' must be an integer vector or NA") if (!is.integer(end)) end <- as.integer(end) if ((length(start) != 1) || (length(end) != 1)) { start <- recycleVector(start, lx) end <- recycleVector(end, lx) } .Call2("CompressedIRangesList_gaps", x, start, end, PACKAGE="IRanges") }) setMethod("gaps", "IntervalForest", function(x, start = NA, end = NA) as(gaps(as(x, "CompressedIRangesList"), start = start, end = end), "IntervalForest")) ### 'start' and 'end' are ignored. setMethod("gaps", "MaskCollection", function(x, start=NA, end=NA) { start <- 1L end <- width(x) x@nir_list <- lapply(nir_list(x), function(nir) gaps(nir, start=start, end=end) ) x@NAMES <- as.character(NA) x@desc <- as.character(NA) x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### disjoin() ### setGeneric("disjoin", function(x, ...) standardGeneric("disjoin")) setMethod("disjoin", "Ranges", function(x) { ## starts: original starts and end+1 when inside another interval ## ends: original ends and start-1 when inside another interval starts <- unique(start(x)) ends <- unique(end(x)) adj_start <- sort(unique(c(starts, ends + 1L))) adj_end <- sort(unique(c(ends, starts - 1L))) adj <- update(x, start=head(adj_start, -1L), end=tail(adj_end, -1L), names=NULL, check=FALSE) subsetByOverlaps(adj, x) } ) setMethod("disjoin", "RangesList", function(x) endoapply(x, disjoin)) setMethod("disjoin", "CompressedIRangesList", function(x, ...) { .wunlist <- function(x) ## unlist CompressedIntegerList, with integer(0) as 0 { w <- integer(length(x)) w[elementLengths(x) != 0L] <- unlist(x, use.names=FALSE) w } rng <- range(x) if (sum(.wunlist(width(rng) + 1)) > .Machine$integer.max) return(endoapply(x, disjoin, ...)) ## localize coordinates off0 <- head(.wunlist(width(rng) + 1L), -1L) offset <- c(1L, cumsum(off0)) - .wunlist(start(rng)) local <- unlist(shift(x, offset), use.names=FALSE) ## disjoin lvls <- names(x) if (is.null(lvls)) lvls <- seq_along(x) d <- disjoin(local, ...) vec <- unlist(start(shift(rng, offset)), use.names=FALSE) lvls0 <- lvls[elementLengths(rng) != 0] f <- lvls0[findInterval(start(d), vec)] d <- split(d, factor(f, levels=lvls)) if (is.null(names(x))) names(d) <- NULL ## globalize coordinates shift(d, -offset) }) setMethod("disjoin", "IntervalForest", function(x, ...) as(disjoin(as(x, "CompressedIRangesList"), ...), "IntervalForest")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### isDisjoint() ### setGeneric("isDisjoint", function(x, ...) standardGeneric("isDisjoint")) setMethod("isDisjoint", "Ranges", function(x) { x_len <- length(x) if (x_len < 2L) return(TRUE) x_start <- start(x) x_end <- end(x) oo <- order(x) start2 <- x_start[oo] end2 <- x_end[oo] all(start2[-1L] > end2[-x_len]) } ) setMethod("isDisjoint", "RangesList", function(x) unlist(lapply(x, isDisjoint))) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### disjointBins() ### ## make intervals disjoint by segregating them into separate Ranges setGeneric("disjointBins", function(x, ...) standardGeneric("disjointBins")) setMethod("disjointBins", "Ranges", function(x) { x_ord <- NULL if (isNotSorted(start(x))) { # minimize work for sorted ranges (common) x_ord <- order(x) x <- x[x_ord] } bins <- .Call2("Ranges_disjointBins", start(x), width(x), PACKAGE="IRanges") if (!is.null(x_ord)) { rev_ord <- integer(length(x_ord)) rev_ord[x_ord] <- seq_along(rev_ord) bins <- bins[rev_ord] } names(bins) <- names(x) bins } ) setMethod("disjointBins", "RangesList", function(x) seqapply(x, disjointBins)) IRanges/R/intra-range-methods.R0000644000126300012640000005715612227064470017703 0ustar00biocbuildphs_compbio### ========================================================================= ### Intra-range methods ### ------------------------------------------------------------------------- ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### shift() ### setGeneric("shift", signature="x", function(x, shift=0L, use.names=TRUE) standardGeneric("shift") ) setMethod("shift", "Ranges", function(x, shift=0L, use.names=TRUE) { if (is(x, "NormalIRanges") && !isSingleNumber(shift)) stop("'shift' must be a single number when shifting ", "a NormalIRanges object") shift <- recycleIntegerArg(shift, "shift", length(x)) ## Note that we won't do anything with 'new_end', we just want to ## fail in case of integer overflow. errorIfWarning(new_start <- start(x) + shift) errorIfWarning(new_end <- new_start + width(x) - 1L) if (is(x, "IRanges")) { x@start <- new_start } else { x <- update(x, start=new_start, width=width(x), check=FALSE) } if (!normargUseNames(use.names)) names(x) <- NULL x } ) setMethod("shift", "Views", function(x, shift=0L, use.names=TRUE) { x@ranges <- shift(ranges(x), shift=shift, use.names=use.names) x } ) setMethod("shift", "RangesList", function(x, shift=0L, use.names = TRUE) { lx <- length(x) shift <- normargAtomicList1(shift, IntegerList, lx) mendoapply("shift", x = x, shift = shift, MoreArgs = list(use.names = use.names)) }) setMethod("shift", "CompressedIRangesList", function(x, shift=0L, use.names = TRUE) { lx <- length(x) eln <- elementLengths(x) shift <- normargAtomicList2(shift, IntegerList, lx, eln) slot(x, "unlistData", check=FALSE) <- shift(x@unlistData, shift = shift, use.names = use.names) x }) setMethod("shift", "IntervalForest", function(x, shift=0L, use.names = TRUE) as(shift(as(x, "CompressedIRangesList"), shift = shift, use.names = use.names), "IntervalForest")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### narrow() ### setGeneric("narrow", signature="x", function(x, start=NA, end=NA, width=NA, use.names=TRUE) standardGeneric("narrow") ) setMethod("narrow", "Ranges", function(x, start=NA, end=NA, width=NA, use.names=TRUE) { if (is(x, "NormalIRanges")) stop("narrowing a NormalIRanges object is not supported") solved_SEW <- solveUserSEW(width(x), start=start, end=end, width=width) ans_start <- start(x) + start(solved_SEW) - 1L ans_width <- width(solved_SEW) x <- update(x, start=ans_start, width=ans_width, check=FALSE) if (!normargUseNames(use.names)) names(x) <- NULL x } ) setMethod("narrow", "Views", function(x, start=NA, end=NA, width=NA, use.names=TRUE) { x@ranges <- narrow(ranges(x), start=start, end=end, width=width, use.names=use.names) x } ) setMethod("narrow", "RangesList", function(x, start = NA, end = NA, width = NA, use.names = TRUE) { lx <- length(x) start <- normargAtomicList1(start, IntegerList, lx) end <- normargAtomicList1(end, IntegerList, lx) width <- normargAtomicList1(width, IntegerList, lx) mendoapply(narrow, x = x, start = start, end = end, width = width, MoreArgs = list(use.names = use.names)) }) setMethod("narrow", "CompressedIRangesList", function(x, start = NA, end = NA, width = NA, use.names = TRUE) { lx <- length(x) eln <- elementLengths(x) start <- normargAtomicList2(start, IntegerList, lx, eln) end <- normargAtomicList2(end, IntegerList, lx, eln) width <- normargAtomicList2(width, IntegerList, lx, eln) slot(x, "unlistData", check=FALSE) <- narrow(x@unlistData, start = start, end = end, width = width, use.names = use.names) x }) setMethod("narrow", "IntervalForest", function(x, start = NA, end = NA, width = NA, use.names = TRUE) as(narrow(as(x, "CompressedIRangesList"), start = start, end = end, width = width, use.names = use.names), "IntervalForest")) ### FIXME: This is a quick and dirty implementation that is TOTALLY ### inefficient. It needs to be improved a lot! ### FIXME: It's also broken because it can return a GappedRanges object with ### empty elements (not allowed). #setMethod("narrow", "GappedRanges", # function(x, start=NA, end=NA, width=NA, use.names=TRUE) # { # solved_SEW <- solveUserSEW(width(x), start=start, end=end, width=width) # start2 <- start(x) + start(solved_SEW) - 1L # end2 <- start2 + width(solved_SEW) - 1L # for (i in seq_len(length(x))) { # x@cnirl[[i]] <- restrict(x[[i]], start=start2[i], end=end2[i]) # } # if (!normargUseNames(use.names)) # names(x) <- NULL # x # } #) setMethod("narrow", "MaskCollection", function(x, start=NA, end=NA, width=NA, use.names=TRUE) { solved_SEW <- solveUserSEWForSingleSeq(width(x), start, end, width) solved_start <- start(solved_SEW) solved_end <- end(solved_SEW) solved_width <- width(solved_SEW) x@nir_list <- lapply(nir_list(x), function(nir) shift(restrict(nir, start=solved_start, end=solved_end), 1L - solved_start) ) x@width <- solved_width if (!normargUseNames(use.names)) names(x) <- NULL x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### flank() ### setGeneric("flank", signature="x", function(x, width, start=TRUE, both=FALSE, use.names=TRUE, ...) standardGeneric("flank") ) setMethod("flank", "Ranges", function(x, width, start=TRUE, both=FALSE, use.names=TRUE) { if (is(x, "NormalIRanges")) stop("flanking a NormalIRanges object is not supported") width <- recycleIntegerArg(width, "width", length(x)) if (!is.logical(start) || anyMissing(start)) stop("'start' must be logical without NA's") start <- recycleVector(start, length(x)) if (!isTRUEorFALSE(both)) stop("'both' must be TRUE or FALSE") if (both) { ans_start <- ifelse(start, start(x) - abs(width), end(x) - abs(width) + 1L) ans_width <- 2L * abs(width) } else { ans_start <- ifelse(start, ifelse(width < 0L, start(x), start(x) - width), ifelse(width < 0L, end(x) + width + 1L, end(x) + 1L)) ans_width <- abs(width) } x <- update(x, start=ans_start, width=ans_width, check=FALSE) if (!normargUseNames(use.names)) names(x) <- NULL x } ) setMethod("flank", "RangesList", function(x, width, start = TRUE, both = FALSE, use.names = TRUE) { lx <- length(x) width <- normargAtomicList1(width, IntegerList, lx) start <- normargAtomicList1(start, LogicalList, lx) mendoapply(flank, x = x, width = width, start = start, MoreArgs = list(both = both, use.names = use.names)) }) setMethod("flank", "CompressedIRangesList", function(x, width, start = TRUE, both = FALSE, use.names = TRUE) { lx <- length(x) eln <- elementLengths(x) width <- normargAtomicList2(width, IntegerList, lx, eln) start <- normargAtomicList2(start, LogicalList, lx, eln) slot(x, "unlistData", check=FALSE) <- flank(x@unlistData, width = width, start = start, both = both, use.names = use.names) x }) setMethod("flank", "IntervalForest", function(x, width, start = TRUE, both = FALSE, use.names = TRUE) as(flank(as(x, "CompressedIRangesList"), width = width, start = start, both = both, use.names = use.names), "IntervalForest")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### promoters() ### setGeneric("promoters", signature="x", function(x, upstream=2000, downstream=200, ...) standardGeneric("promoters") ) setMethod("promoters", "Ranges", function(x, upstream=2000, downstream=200, ...) { if (is(x, "NormalIRanges")) stop("promoters on a NormalIRanges object is not supported") if (!isSingleNumber(upstream)) stop("'upstream' must be a single integer") if (!is.integer(upstream)) upstream <- as.numeric(upstream) if (!isSingleNumber(downstream)) stop("'downstream' must be a single integer") if (!is.integer(downstream)) downstream <- as.numeric(downstream) if (upstream < 0 | downstream < 0) stop("'upstream' and 'downstream' must be integers >= 0") st <- start(x) start(x) <- st - upstream end(x) <- st + downstream - 1L x } ) setMethod("promoters", "Views", function(x, upstream=2000, downstream=200, ...) { x@ranges <- promoters(ranges(x), upstream, downstream) x } ) setMethod("promoters", "RangesList", function(x, upstream=2000, downstream=200, ...) { endoapply(x, promoters, upstream = upstream, downstream = downstream) } ) setMethod("promoters", "CompressedIRangesList", function(x, upstream=2000, downstream=200, ...) { slot(x, "unlistData", check=FALSE) <- promoters(x@unlistData, upstream = upstream, downstream = downstream, ...) x } ) setMethod("promoters", "IntervalForest", function(x, upstream=2000, downstream=200, ...) as(promoters(as(x, "CompressedIRangesList"), upstream = upstream, downstream = downstream), "IntervalForest")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### reflect() ### setGeneric("reflect", signature="x", function(x, bounds, use.names=TRUE) standardGeneric("reflect") ) setMethod("reflect", "Ranges", function(x, bounds, use.names=TRUE) { if (is(x, "NormalIRanges")) stop("reflecting a NormalIRanges object is not supported") if (!is(bounds, "Ranges")) stop("'bounds' must be a Ranges object") if (length(x) > 1 && length(bounds) == 0) stop("'bounds' is an empty Ranges object") if (length(x) < length(bounds)) bounds <- head(bounds, length(x)) ans_start <- (2L * start(bounds) + width(bounds) - 1L) - end(x) x <- update(x, start=ans_start, width=width(x), check=FALSE) if (!normargUseNames(use.names)) names(x) <- NULL x } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### resize() ### setGeneric("resize", signature="x", function(x, width, fix="start", use.names=TRUE, ...) standardGeneric("resize") ) setMethod("resize", "Ranges", function(x, width, fix="start", use.names=TRUE) { if (is(x, "NormalIRanges")) stop("resizing a NormalIRanges object is not supported") lx <- length(x) if (!is.numeric(width) || anyMissing(width)) stop("'width' must be a numeric vector without NA's") if (!is.integer(width)) width <- as.integer(width) if (anyMissingOrOutside(width, 0L)) stop("'width' values must be non-negative") if (!(is.character(fix) || (is(fix, "Rle") && is.character(runValue(fix)))) || (length(fix) == 0L && length(x) > 0L) || (length(setdiff(unique(fix), c("start", "end", "center"))) > 0)) { stop("'fix' must be a character vector or character Rle ", "with values in \"start\", \"end\", and \"center\"") } if (!is(fix, "Rle")) fix <- Rle(fix) if (length(fix) != lx) fix <- rep(fix, length.out = lx) ans_width <- recycleVector(width, lx) ans_start <- start(x) if (!identical(runValue(fix), "start")) { fixEnd <- as(fix == "end", "IRanges") if (length(fixEnd) > 0) { value <- extractROWS(ans_start, fixEnd) + (extractROWS(width(x), fixEnd) - extractROWS(ans_width, fixEnd)) ans_start <- replaceROWS(ans_start, fixEnd, value) } fixCenter <- as(fix == "center", "IRanges") if (length(fixCenter) > 0) { value <- extractROWS(ans_start, fixCenter) + (extractROWS(width(x), fixCenter) - extractROWS(ans_width, fixCenter)) %/% 2L ans_start <- replaceROWS(ans_start, fixCenter, value) } } x <- update(x, start=ans_start, width=ans_width, check=FALSE) if (!normargUseNames(use.names)) names(x) <- NULL x } ) setMethod("resize", "RangesList", function(x, width, fix = "start", use.names = TRUE) { lx <- length(x) width <- normargAtomicList1(width, IntegerList, lx) fix <- normargAtomicList1(fix, CharacterList, lx) mendoapply(resize, x = x, width = width, fix = fix, MoreArgs = list(use.names = use.names)) }) setMethod("resize", "CompressedIRangesList", function(x, width, fix = "start", use.names = TRUE) { lx <- length(x) eln <- elementLengths(x) width <- normargAtomicList2(width, IntegerList, lx, eln) fix <- normargAtomicList2(fix, CharacterList, lx, eln) slot(x, "unlistData", check=FALSE) <- resize(x@unlistData, width = width, fix = fix, use.names = use.names) x }) setMethod("resize", "IntervalForest", function(x, width, fix = "start", use.names = TRUE) as(resize(as(x, "CompressedIRangesList"), width = width, fix = fix, use.names = use.names), "IntervalForest")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "restrict" method. ### setGeneric("restrict", signature="x", function(x, start=NA, end=NA, keep.all.ranges=FALSE, use.names=TRUE) standardGeneric("restrict") ) ### We distinguish 4 exclusive types of relationship between a range in 'x' ### and its corresponding restriction interval (specified by 'start' and ### 'end'): ### - Type 1: They have a non-empty intersection. ### - Type 2: The restriction interval is empty but its bounds are within ### the range in 'x'. ### - Type 3: The restriction interval is not empty and is adjacent to the ### range in 'x' i.e. the range in 'x' ends at start - 1 or starts ### at end - 1. ### drop.ranges.mode: ### 0L: Ranges in 'x' that are empty after restriction are dropped. ### 1L: Ranges in 'x' that are not overlapping and not even adjacent ### with the region of restriction are dropped. ### "Not overlapping and not adjacent" means that they end strictly ### before start - 1 or start strictly after end + 1. ### Those that are not overlapping but are however adjacent are kept ### (and are empty after restriction). ### 2L: All ranges in 'x' are kept after restriction. ### Ranges ### Note that the only mode compatible with a NormalIRanges object is 0L. Ranges.restrict <- function(x, start, end, drop.ranges.mode, use.names) { if (!isNumericOrNAs(start)) stop("'start' must be a vector of integers") if (!is.integer(start)) start <- as.integer(start) if (!isNumericOrNAs(end)) stop("'end' must be a vector of integers") if (!is.integer(end)) end <- as.integer(end) if (length(x) != 0L) { if (length(start) == 0L || length(start) > length(x)) stop("invalid 'start' length") if (length(end) == 0L || length(end) > length(x)) stop("invalid 'end' length") } start <- recycleVector(start, length(x)) end <- recycleVector(end, length(x)) use.names <- normargUseNames(use.names) ans_start <- start(x) ans_end <- end(x) if (use.names) ans_names <- names(x) else ans_names <- NULL ## Compare ranges in 'x' with 'start'. if (drop.ranges.mode == 0L) far_too_left <- !is.na(start) & (ans_end < start) else far_too_left <- !is.na(start) & (ans_end < start - 1L) if (drop.ranges.mode == 2L) { ans_end[far_too_left] <- start[far_too_left] - 1L } else { ## Drop the ranges that are far too left with respect to the ## region of restriction. keep_it <- !far_too_left ans_start <- ans_start[keep_it] ans_end <- ans_end[keep_it] if (!is.null(ans_names)) ans_names <- ans_names[keep_it] start <- start[keep_it] end <- end[keep_it] } ## Fix 'ans_start'. too_left <- !is.na(start) & (ans_start < start) ans_start[too_left] <- start[too_left] ## Compare ranges in 'x' with 'end'. if (drop.ranges.mode == 0L) far_too_right <- !is.na(end) & (ans_start > end) else far_too_right <- !is.na(end) & (ans_start > end + 1L) if (drop.ranges.mode == 2L) { ans_start[far_too_right] <- end[far_too_right] + 1L } else { ## Drop the ranges that are far too right with respect to the ## region of restriction. keep_it <- !far_too_right ans_start <- ans_start[keep_it] ans_end <- ans_end[keep_it] if (!is.null(ans_names)) ans_names <- ans_names[keep_it] start <- start[keep_it] end <- end[keep_it] } ## Fix 'ans_end'. too_right <- !is.na(end) & (ans_end > end) ans_end[too_right] <- end[too_right] ans_width <- ans_end - ans_start + 1L unsafe.update(x, start=ans_start, width=ans_width, names=ans_names) } setMethod("restrict", "Ranges", function(x, start=NA, end=NA, keep.all.ranges=FALSE, use.names=TRUE) { if (!isTRUEorFALSE(keep.all.ranges)) stop("'keep.all.ranges' must be TRUE or FALSE") use.names <- normargUseNames(use.names) if (is(x, "NormalIRanges")) { if (keep.all.ranges) stop("'keep.all.ranges=TRUE' is not supported ", "when 'x' is a NormalIRanges object") drop.ranges.mode <- 0L } else { if (keep.all.ranges) drop.ranges.mode <- 2L else drop.ranges.mode <- 1L } Ranges.restrict(x, start, end, drop.ranges.mode, use.names) } ) setMethod("restrict", "RangesList", function(x, start = NA, end = NA, keep.all.ranges = FALSE, use.names = TRUE) { lx <- length(x) start <- normargAtomicList1(start, IntegerList, lx) end <- normargAtomicList1(end, IntegerList, lx) mendoapply(restrict, x, start = start, end = end, MoreArgs = list(keep.all.ranges = keep.all.ranges, use.names = use.names)) }) setMethod("restrict", "CompressedIRangesList", function(x, start = NA, end = NA, keep.all.ranges = FALSE, use.names = TRUE) { if (!isTRUEorFALSE(keep.all.ranges)) stop("'keep.all.ranges' must be TRUE or FALSE") if (keep.all.ranges) { lx <- length(x) eln <- elementLengths(x) start <- normargAtomicList2(start, IntegerList, lx, eln) end <- normargAtomicList2(end, IntegerList, lx, eln) slot(x, "unlistData", check=FALSE) <- restrict(x@unlistData, start = start, end = end, keep.all.ranges = keep.all.ranges, use.names = use.names) } else x <- callNextMethod() x }) setMethod("restrict", "IntervalForest", function(x, start = NA, end = NA, keep.all.ranges = FALSE, use.names = TRUE) { if (keep.all.ranges) stop("'keep.all.ranges' must be FALSE in ", "'restrict,IntervalForest'") as(restrict(as(x, "CompressedIRangesList"), start = start, end = end, keep.all.ranges = keep.all.ranges, use.names = use.names), "IntervalForest") }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "threebands" method. ### setGeneric("threebands", signature="x", function(x, start=NA, end=NA, width=NA) standardGeneric("threebands") ) ### Method for IRanges only! setMethod("threebands", "IRanges", function(x, start=NA, end=NA, width=NA) { middle <- narrow(x, start=start, end=end, width=width, use.names=FALSE) left <- right <- middle left@start <- start(x) left@width <- start(middle) - start(x) right@start <- end(middle) + 1L right@width <- end(x) - end(middle) list(left=left, middle=middle, right=right) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Zooming (symmetrically scales the width). ### ### TODO: Implement a zoom() generic and methods and make the "Ops" method ### below a simple convenience wrapper for zoom(). Recommend the use of zoom() ### over "Ops" methods in packages and scripts. Reserve "Ops" methods as a ### convenience when working interactively. ### setMethod("Ops", c("Ranges", "numeric"), function(e1, e2) { if (anyMissing(e2)) stop("NA not allowed as zoom factor") if ((length(e1) < length(e2) && length(e1)) || (length(e1) && !length(e2)) || (length(e1) %% length(e2) != 0)) stop("zoom factor length not a multiple of number of ranges") if (.Generic == "*") { e2 <- ifelse(e2 < 0, abs(1/e2), e2) r <- e1 mid <- (start(r)+end(r))/2 w <- width(r)/e2 update(r, start = ceiling(mid - w/2), width = floor(w), check = FALSE) } else { if (.Generic == "-") { e2 <- -e2 .Generic <- "+" } if (.Generic == "+") { if (any(-e2*2 > width(e1))) stop("adjustment would result in ranges with negative widths") update(e1, start = start(e1) - e2, end = end(e1) + e2, check = FALSE) } } } ) setMethod("Ops", c("RangesList", "ANY"), function(e1, e2) { for (i in seq_len(length(e1))) e1[[i]] <- callGeneric(e1[[i]], e2) e1 }) setMethod("Ops", c("CompressedIRangesList", "ANY"), function(e1, e2) { relist(callGeneric(unlist(e1, use.names = FALSE), e2), e1) }) IRanges/R/isConstant.R0000644000126300012640000000766712227064470016162 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### isConstant() ### setGeneric("isConstant", function(x) standardGeneric("isConstant")) ### There are many ways to implement the "isConstant" method for integer ### vectors: ### isConstant1 <- function(x) {length(x) <= 1L || all(x == x[1L])} ### isConstant2 <- function(x) {length(unique(x)) <= 1L} ### isConstant3 <- function(x) {length(x) <= 1L || all(duplicated(x)[-1L])} ### isConstant4 <- function(x) {length(x) <= 1L || ### sum(duplicated(x)) == length(x) - 1L} ### isConstant5 <- function(x) {length(x) <= 1L || min(x) == max(x)} ### isConstant6 <- function(x) {length(x) <= 1L || ### {rx <- range(x); rx[1L] == rx[2L]}} ### Which one is faster is hard to guess. It happens to be isConstant5(): ### it's 2.7x faster than isConstant1(), 6x faster than isConstant2(), 11x ### faster than isConstant3(), 5.2x faster than isConstant4() and 1.6x faster ### than isConstant6(). ### Results obtained on 'x0 <- rep.int(112L, 999999L)' with R-2.13 Under ### development (unstable) (2011-01-08 r53945). ### For this method we use a modified version of isConstant5() above that ### handles NAs. setMethod("isConstant", "integer", function(x) { if (length(x) <= 1L) return(TRUE) x_min <- min(x, na.rm=FALSE) if (!is.na(x_min)) # success means 'x' contains no NAs return(x_min == max(x, na.rm=FALSE)) ## From here 'x' is guaranteed to have a length >= 2 and to contain ## at least an NA. ## 'min(x, na.rm=TRUE)' issues a warning if 'x' contains only NAs. ## In that case, and in that case only, it returns Inf. x_min <- suppressWarnings(min(x, na.rm=TRUE)) if (x_min == Inf) return(NA) ## From here 'x' is guaranteed to contain a mix of NAs and non-NAs. x_max <- max(x, na.rm=TRUE) if (x_min == x_max) return(NA) FALSE } ) ### Like the method for integer vectors this method also uses a comparison ### between min(x) and max(x). In addition it needs to handle rounding errors ### and special values: NA, NaN, Inf and -Inf. ### Using all.equal() ensures that TRUE is returned on c(11/3, 2/3+4/3+5/3). setMethod("isConstant", "numeric", function(x) { if (length(x) <= 1L) return(TRUE) x_min <- min(x, na.rm=FALSE) if (!is.na(x_min)) { # success means 'x' contains no NAs and no NaNs x_max <- max(x, na.rm=FALSE) if (is.finite(x_min) && is.finite(x_max)) return(isTRUE(all.equal(x_min, x_max))) if (x_min == x_max) # both are Inf or both are -Inf return(NA) return(FALSE) } ## From here 'x' is guaranteed to have a length >= 2 and to contain ## at least an NA or NaN. ## 'min(x, na.rm=TRUE)' issues a warning if 'x' contains only NAs ## and NaNs. x_min <- suppressWarnings(min(x, na.rm=TRUE)) if (x_min == Inf) { ## Only possible values in 'x' are NAs, NaNs or Infs. is_in_x <- c(NA, NaN, Inf) %in% x if (is_in_x[2L] && is_in_x[3L]) return(FALSE) return(NA) } ## From here 'x' is guaranteed to contain at least one value that is ## not NA or NaN or Inf. x_max <- max(x, na.rm=TRUE) if (x_max == -Inf) { ## Only possible values in 'x' are NAs, NaNs or -Infs. is_in_x <- c(NA, NaN, -Inf) %in% x if (is_in_x[2L] && is_in_x[3L]) return(FALSE) return(NA) } if (is.infinite(x_min) || is.infinite(x_max)) return(FALSE) if (!isTRUE(all.equal(x_min, x_max))) return(FALSE) if (NaN %in% x) return(FALSE) return(NA) } ) setMethod("isConstant", "array", function(x) isConstant(as.vector(x))) IRanges/R/nearest-methods.R0000644000126300012640000001551112227064470017122 0ustar00biocbuildphs_compbio### ========================================================================= ### nearest (and related) methods ### ------------------------------------------------------------------------- ### setClassUnion("RangesORmissing", c("Ranges", "missing")) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### precede() and follow() ### setGeneric("precede", function(x, subject = x, ...) standardGeneric("precede")) setMethod("precede", c("Ranges", "RangesORmissing"), function(x, subject, select = c("first", "all")) { select <- match.arg(select) s <- start(subject) ord <- NULL if (isNotSorted(s)) { ord <- orderInteger(s) s <- s[ord] } if (select == "all") { srle <- Rle(s) s <- runValue(srle) } i <- findInterval(end(x), s) + 1L i[i > length(s)] <- NA if (select == "all") { .vectorToHits(i, srle, ord) } else { if (!is.null(ord)) i <- ord[i] i } } ) setGeneric("follow", function(x, subject = x, ...) standardGeneric("follow")) setMethod("follow", c("Ranges", "RangesORmissing"), function(x, subject, select = c("last", "all")) { select <- match.arg(select) e <- end(subject) ord <- NULL if (isNotSorted(e)) { ord <- orderInteger(e) e <- e[ord] } if (select == "all") { srle <- Rle(e) e <- runValue(srle) } i <- findInterval(start(x) - 1L, e) i[i == 0] <- NA if (select == "all") { .vectorToHits(i, srle, ord) } else { if (!is.null(ord)) i <- ord[i] i } } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### nearest() ### .hitsMatrixToVector <- function(hitsMatrix, queryLength) { hitsMatrix <- hitsMatrix[diffWithInitialZero(hitsMatrix[,1L,drop=TRUE]) != 0L,, drop=FALSE] ans <- rep.int(NA_integer_, queryLength) ans[hitsMatrix[,1L,drop=TRUE]] <- hitsMatrix[,2L,drop=TRUE] ans } .vectorToHits <- function(i, srle, ord) { lx <- length(i) v <- !is.na(i) i <- i[v] w <- width(srle)[i] subj <- as.integer(IRanges(start(srle)[i], width=w)) m <- cbind(queryHits = rep(seq(lx)[v], w), subjectHits = if (!is.null(ord)) ord[subj] else subj) if (!is.null(ord)) m <- m[orderIntegerPairs(m[,1L], m[,2L]),,drop=FALSE] ## unname() required because in case 'm' has only 1 row ## 'm[ , 1L]' and 'm[ , 2L]' will return a named atomic vector new("Hits", queryHits = unname(m[ , 1L]), subjectHits = unname(m[ , 2L]), queryLength = lx, subjectLength = length(srle)) } setGeneric("nearest", function(x, subject, ...) standardGeneric("nearest")) setMethod("nearest", c("Ranges", "RangesORmissing"), function(x, subject, select = c("arbitrary", "all")) { select <- match.arg(select) if (!missing(subject)) { ol <- findOverlaps(x, subject, select = select) } else { subject <- x ol <- findOverlaps(x, select = select, ignoreSelf = TRUE) } if (select == "all") { m <- as.matrix(ol) olv <- .hitsMatrixToVector(m, length(x)) } else olv <- ol x <- x[is.na(olv)] before <- precede(x, subject, if (select == "all") "all" else "first") after <- follow(x, subject, if (select == "all") "all" else "last") if (select == "all") { before_m <- as.matrix(before) before <- .hitsMatrixToVector(before_m, length(x)) after_m <- as.matrix(after) after <- .hitsMatrixToVector(after_m, length(x)) } leftdist <- (start(subject)[before] - end(x)) rightdist <- (start(x) - end(subject)[after]) left <- leftdist < rightdist left[is.na(left)] <- is.na(after)[is.na(left)] if (select == "all") { filterMatchMatrix <- function(m, i) { qrle <- Rle(m[,1L]) qstart <- qend <- integer(length(i)) qstart[runValue(qrle)] <- start(qrle) qend[runValue(qrle)] <- end(qrle) rows <- as.integer(IRanges(qstart[i], qend[i])) m <- m[rows,,drop=FALSE] m[,1L] <- map[m[,1L]] m } map <- which(is.na(olv)) right <- !left left[leftdist == rightdist] <- TRUE m <- rbind(m, filterMatchMatrix(before_m, left), filterMatchMatrix(after_m, right)) m <- m[orderIntegerPairs(m[,1L], m[,2L]),, drop=FALSE] ## unname() required because in case 'm' has only 1 row ## 'm[ , 1L]' and 'm[ , 2L]' will return a named atomic vector ol@queryHits <- unname(m[ , 1L]) ol@subjectHits <- unname(m[ , 2L]) } else { olv[is.na(olv)] <- ifelse(left, before, after) ol <- olv } ol }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### distance() ### setGeneric("distance", function(x, y, ...) standardGeneric("distance")) setMethod("distance", c("Ranges", "Ranges"), function(x, y) { warning("The behavior of distance() has changed in ", "Bioconductor 2.12. See ?distance for details.") max_start <- pmax.int(start(x), start(y)) min_end <- pmin.int(end(x), end(y)) pmax.int(max_start - min_end - 1L, 0L) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### distanceToNearest() ### setGeneric("distanceToNearest", function(x, subject = x, ...) standardGeneric("distanceToNearest")) setMethod("distanceToNearest", c("Ranges", "RangesORmissing"), function(x, subject, select = c("arbitrary", "all")) { select <- match.arg(select) if (missing(subject)) { subject <- x x_nearest <- nearest(x, select = select) } else { x_nearest <- nearest(x, subject, select = select) } if (select == "arbitrary") { x_nearest <- cbind(queryHits = seq_len(length(x)), subjectHits = x_nearest) } else { x_nearest <- as.matrix(x_nearest) } distance = distance(x[x_nearest[,1]], subject[x_nearest[,2]]) new("Hits", queryHits=x_nearest[,1], subjectHits=x_nearest[,2], queryLength=length(x), subjectLength=length(subject), elementMetadata=DataFrame(distance=distance)) }) IRanges/R/normarg-utils.R0000644000126300012640000002415512227064470016627 0ustar00biocbuildphs_compbio### ========================================================================= ### Utility functions for checking/fixing user-supplied arguments ### ------------------------------------------------------------------------- ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### For checking only. ### isTRUEorFALSE <- function(x) { is.logical(x) && length(x) == 1L && !is.na(x) } isSingleInteger <- function(x) { is.integer(x) && length(x) == 1L && !is.na(x) } isSingleNumber <- function(x) { is.numeric(x) && length(x) == 1L && !is.na(x) } isSingleString <- function(x) { is.character(x) && length(x) == 1L && !is.na(x) } ### We want these functions to return TRUE when passed an NA of whatever type. isSingleNumberOrNA <- function(x) { is.atomic(x) && length(x) == 1L && (is.numeric(x) || is.na(x)) } isSingleStringOrNA <- function(x) { is.atomic(x) && length(x) == 1L && (is.character(x) || is.na(x)) } ### NOT exported. anyMissing <- function(x) .Call2("anyMissing", x, PACKAGE="IRanges") ### NOT exported. isNumericOrNAs <- function(x) { is.numeric(x) || (is.atomic(x) && is.vector(x) && all(is.na(x))) } ### NOT exported. ### isNotStrictlySorted() takes for granted that 'x' contains no NAs (behaviour ### is undefined if this is not the case). This allows isNotStrictlySorted() to ### be MUCH faster than is.unsorted() in some situations: ### > x <- c(99L, 1:1000000) ### > system.time(for (i in 1:1000) isNotStrictlySorted(x)) ### user system elapsed ### 0.004 0.000 0.003 ### > system.time(for (i in 1:1000) is.unsorted(x, strictly=TRUE)) ### user system elapsed ### 6.925 1.756 8.690 ### So let's keep it for now! Until someone has enough time and energy to ### convince the R core team to fix is.unsorted()... ### Note that is.unsorted() does not only have a performance problem: ### a) It also has a semantic problem: is.unsorted(NA) returns NA despite the ### man page stating that all objects of length 0 or 1 are sorted (sounds ### like a fair statement). ### b) The sort()/is.unsorted() APIs and semantics are inconsistent. ### c) Why did they choose to have is.unsorted() instead of is.sorted() in the ### first place? Having is.unsorted( , strictly=TRUE) being a "looser test" ### (or a "weaker condition") than is.unsorted( , strictly=FALSE) is really ### counterintuitive! ### > is.unsorted(c(5L, 5:8), strictly=FALSE) ### [1] FALSE ### > is.unsorted(c(5L, 5:8), strictly=TRUE) ### [1] TRUE ### Common sense would expect to have less objects that are "strictly ### something" than objects that are "just something". isNotSorted <- function(x) .Internal(is.unsorted(x, FALSE)) isNotStrictlySorted <- function(x) .Internal(is.unsorted(x, TRUE)) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### For checking AND fixing (aka normalizing). ### ### NOT exported. numeric2integer <- function(x) { if (is.numeric(x) && !is.integer(x)) as.integer(x) else x } ### NOT exported. ### recycleVector() vs rep(x, length.out=length): ### - The former seems a little bit faster (1.5x - 2x). ### - The former will issue a warning that "number of items to replace is not ### a multiple of replacement length". The latter will always remain silent. recycleVector <- function(x, length.out) { if (length(x) == length.out) { x } else { ans <- vector(storage.mode(x), length.out) ans[] <- x ans } } ### NOT exported. ### Must always drop the names of 'arg'. recycleArg <- function(arg, argname, length.out) { if (length.out == 0L) { if (length(arg) > 1L) stop("invalid length for '", argname, "'") if (length(arg) == 1L && is.na(arg)) stop("'", argname, "' contains NAs") return(recycleVector(arg, length.out)) # drops the names } if (length(arg) == 0L) stop("'", argname, "' has no elements") if (length(arg) > length.out) stop("'", argname, "' is longer than 'x'") if (anyMissing(arg)) stop("'", argname, "' contains NAs") if (length(arg) < length.out) arg <- recycleVector(arg, length.out) # drops the names else arg <- unname(arg) arg } recycleIntegerArg <- function(arg, argname, length.out) { if (!is.numeric(arg)) stop("'", argname, "' must be a vector of integers") if (!is.integer(arg)) arg <- as.integer(arg) recycleArg(arg, argname, length.out) } recycleNumericArg <- function(arg, argname, length.out) { if (!is.numeric(arg)) stop("'", argname, "' must be a numeric vector") recycleArg(arg, argname, length.out) } ### We use a signature in the style of successiveIRanges() or ### successiveViews(). ### The current implementation should be fast enough if length(x)/circle.length ### is small (i.e. < 10 or 20). This will actually be the case for the typical ### usecase which is the calculation of "circular coverage vectors", that is, ### we use fold() on the "linear coverage vector" to turn it into a "circular ### coverage vector" of length 'circle.length' where 'circle.length' is the ### length of the circular sequence. fold <- function(x, circle.length, from=1) { if (typeof(x) != "S4" && !is.numeric(x) && !is.complex(x)) stop("'x' must be a vector-like object with elements that can be added") if (!isSingleNumber(circle.length)) stop("'circle.length' must be a single integer") if (!is.integer(circle.length)) circle.length <- as.integer(circle.length) if (circle.length <= 0L) stop("'circle.length' must be positive") if (!isSingleNumber(from)) stop("'from' must be a single integer") if (!is.integer(from)) from <- as.integer(from) from <- 1L + (from - 1L) %% circle.length if (typeof(x) == "S4") { ans <- as(rep.int(0L, circle.length), class(x)) if (length(ans) != circle.length) stop("don't know how to handle 'x' of class ", class(x)) } else { ans <- vector(typeof(x), length=circle.length) } if (from > length(x)) { ## Nothing to fold jj <- seq_len(length(x)) + circle.length - from + 1L ans[jj] <- x return(ans) } if (from > 1L) { ii <- seq_len(from - 1L) jj <- ii + circle.length - from + 1L ans[jj] <- x[ii] } max_from <- length(x) - circle.length + 1L while (from <= max_from) { ii <- from:(from+circle.length-1L) ans[] <- ans[] + x[ii] from <- from + circle.length } if (from > length(x)) return(ans) ii <- from:length(x) jj <- ii - from + 1L ans[jj] <- ans[jj] + x[ii] ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Other non exported normarg* functions. ### normargSingleStartOrNA <- function(start) { if (!isSingleNumberOrNA(start)) stop("'start' must be a single integer or NA") if (!is.integer(start)) start <- as.integer(start) start } normargSingleEndOrNA <- function(end) { if (!isSingleNumberOrNA(end)) stop("'end' must be a single integer or NA") if (!is.integer(end)) end <- as.integer(end) end } normargUseNames <- function(use.names) { if (is.null(use.names)) return(TRUE) if (!isTRUEorFALSE(use.names)) stop("'use.names' must be TRUE or FALSE") use.names } normargAtomicList1 <- function(arg, List, lx, argname = deparse(substitute(arg))) { if (is.vector(arg)) arg <- List(as.list(recycleVector(arg, lx))) else if (!is(arg, "AtomicList")) stop("'", argname,"' must be a vector or AtomicList object") arg } normargAtomicList2 <- function(arg, List, lx, eln, argname = deparse(substitute(arg))) { if (!(is.vector(arg) && length(arg) == 1L)) { if (is.vector(arg)) arg <- as(rep(recycleVector(arg, lx), eln), class(unlist(List()))) else { if (!is(arg, "AtomicList")) stop("'arg' must be a vector or AtomicList object") if (!isTRUE(all.equal(elementLengths(arg), eln, check.attributes=FALSE))) arg <- mapply(recycleVector, arg, List(as.list(eln))) arg <- unlist(arg, use.names=FALSE) } } else if (is.list(arg)){ arg <- unlist(arg, use.names=FALSE) } arg } normargRunK <- function(k, n, endrule) { if (!is.numeric(k)) stop("'k' must be a numeric vector") if (k < 0) stop("'k' must be positive") if ((endrule != "drop") && (k %% 2 == 0)) { k <- 1L + 2L * (k %/% 2L) warning(paste("'k' must be odd when 'endrule != \"drop\"'!", "Changing 'k' to ", k)) } if (k > n) { k <- 1L + 2L * ((n - 1L) %/% 2L) warning("'k' is bigger than 'n'! Changing 'k' to ", k) } as.integer(k) } normargSubset2_iOnly <- function(x, i, j, ..., .conditionPrefix=character()) { if (!missing(j) || length(list(...)) > 0) warning(.conditionPrefix, "arguments beyond 'i' ignored") if (missing(i)) stop(.conditionPrefix, "subscript 'i' is missing") if (!is.character(i) && !is.numeric(i)) stop(.conditionPrefix, "invalid subscript 'i' type") if (length(i) < 1L) stop(.conditionPrefix, "attempt to select less than one element") if (length(i) > 1L) stop(.conditionPrefix, "attempt to select more than one element") if (is.numeric(i) && (i < 1L || i > length(x)+1)) stop(.conditionPrefix, "subscript 'i' out of bounds") if (is.character(i)) { i <- match(i, names(x)) if (is.na(i)) i <- length(x) + 1L } i } extraArgsAsList <- function(.valid.argnames, ...) { args <- list(...) argnames <- names(args) if (length(args) != 0L && (is.null(argnames) || any(argnames %in% c("", NA)))) stop("all extra arguments must be named") if (!is.null(.valid.argnames) && !all(argnames %in% .valid.argnames)) stop("valid extra argument names are ", paste("'", .valid.argnames, "'", sep="", collapse=", ")) if (anyDuplicated(argnames)) stop("argument names must be unique") args } IRanges/R/read.Mask.R0000644000126300012640000003365612227064470015637 0ustar00biocbuildphs_compbio### ========================================================================= ### Read a mask from a file ### ----------------------- ### ### From an NCBI "agp" file (for chrY in hs b36v3): ### library(BSgenome.Hsapiens.NCBI.b36v3) ### file1 <- system.file("extdata", "hs_b36v3_chrY.agp", package="IRanges") ### mask1 <- read.agpMask(file1, seqname="chrY", mask.width=length(Hsapiens$chrY)) ### ### From an UCSC "gap" file (for chrY in hg18): ### library(BSgenome.Hsapiens.UCSC.hg18) ### file2 <- system.file("extdata", "chrY_gap.txt", package="IRanges") ### mask2 <- read.gapMask(file2, seqname="chrY", mask.width=length(Hsapiens$chrY)) ### ### From an UCSC "lift" file (for hg18): ### file3 <- system.file("extdata", "hg18liftAll.lft", package="IRanges") ### mask3 <- read.liftMask(file3, seqname="chr1") ### ### From a RepeatMasker .out file (for chrM in ce2): ### library(BSgenome.Celegans.UCSC.ce2) ### file4 <- system.file("extdata", "ce2chrM.fa.out", package="IRanges") ### mask4 <- read.rmMask(file4, seqname="chrM", mask.width=length(Celegans$chrM)) ### ### From a Tandem Repeats Finder .bed file (for chrM in ce2): ### file5 <- system.file("extdata", "ce2chrM.bed", package="IRanges") ### mask5 <- read.trfMask(file5, seqname="chrM", mask.width=length(Celegans$chrM)) ### ### ------------------------------------------------------------------------- .showDistinctSeqnamesAndStop <- function(seqnames) { distinct_seqnames <- paste("\"", unique(seqnames), "\"", sep="") distinct_seqnames <- paste(distinct_seqnames, collapse=", ") stop(length(distinct_seqnames), " distinct seqnames found in this file: ", distinct_seqnames) } .newEmptyMask <- function(seqname, mask.width, mask.name, mask.desc, nofound_what="information") { msg <- paste("No ", nofound_what, " found for sequence \"", seqname, "\" in this file. ", sep="") if (is.na(mask.width)) stop(msg, "Please use the\n", " 'mask.width' argument to specify the width of the empty mask to\n", " return (i.e. the length of the sequence this mask will be put on).") warning(msg, "returning empty mask") ans <- Mask(mask.width) # empty mask names(ans) <- mask.name desc(ans) <- paste(mask.desc, "(empty)") ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### read.agpMask() and read.gapMask() extract the AGAPS mask from an NCBI ### "agp" file or a UCSC "gap" file, respectively. ### .guessGapFileCOL2CLASS <- function(file) { ## UCSC "gap" files generally have the 9 columns below except for some ## organisms like Rhesus that have only 8 columns (no 'bin' column). COL2CLASS <- c( `bin`="integer", `chrom`="character", `chr_start`="integer", `chr_stop`="integer", `part_no`="integer", `part_type`="character", `gap_len`="integer", `gap_type`="character", `bridge`="character" ) line1 <- try(read.table(file, sep="\t", col.names=names(COL2CLASS), colClasses=COL2CLASS, nrows=1L, check.names=FALSE), silent=TRUE) if (!inherits(line1, "try-error")) return(COL2CLASS) COL2CLASS <- COL2CLASS[-1L] line1 <- try(read.table(file, sep="\t", col.names=names(COL2CLASS), colClasses=COL2CLASS, nrows=1L, check.names=FALSE), silent=TRUE) if (!inherits(line1, "try-error")) return(COL2CLASS) stop("unable to guess the column names in \"gap\" file '", file, "', sorry") } .read.agpORgapFile <- function(agp_or_gap, file) { if (agp_or_gap == "agp") { COL2CLASS <- c( `chrom`="character", `chr_start`="integer", `chr_stop`="integer", `part_no`="integer", `part_type`="character", `gap_len`="character", `gap_type`="character", `linkage`="character", `empty`="character" ) } else if (agp_or_gap == "gap") { COL2CLASS <- .guessGapFileCOL2CLASS(file) } else { stop("read.Mask internal error: please report") } COLS <- c( "chrom", "chr_start", "chr_stop", "part_type", "gap_len", "gap_type" ) COL2CLASS[!(names(COL2CLASS) %in% COLS)] <- "NULL" data <- read.table(file, sep="\t", col.names=names(COL2CLASS), colClasses=COL2CLASS, check.names=FALSE, fill=TRUE) } .read.agpORgapMask <- function(agp_or_gap, file, seqname, mask.width, gap.types, use.gap.types) { if (!isSingleString(seqname)) stop("'seqname' must be a single string") if (!isSingleNumberOrNA(mask.width)) stop("'mask.width' must be a single integer or 'NA'") if (!is.integer(mask.width)) mask.width <- as.integer(mask.width) if (!is.null(gap.types) && (!is.character(gap.types) || anyMissing(gap.types) || anyDuplicated(gap.types))) stop("'gap.types' must be 'NULL' or a character vector ", "with no NAs and no duplicated") if (!isTRUEorFALSE(use.gap.types)) stop("'use.gap.types' must be TRUE or FALSE") data <- .read.agpORgapFile(agp_or_gap, file) if (seqname == "?") .showDistinctSeqnamesAndStop(data$chrom) data <- data[data$chrom == seqname, ] ii <- data$part_type == "N" if (agp_or_gap == "agp") { data <- data[ii, ] } else if (!all(ii)) { warning("gap file contains gaps with a part_type that is not N") } if (length(gap.types) == 1 && gap.types == "?") { found_types <- paste("\"", unique(data$gap_type), "\"", sep="") found_types <- paste(found_types, collapse=", ") stop("gap types found in this file for sequence \"", seqname, "\": ", found_types) } mask.name <- "AGAPS" mask.desc <- "assembly gaps" if (!is.null(gap.types)) { data <- data[data$gap_type %in% gap.types, ] mask.desc <- paste(mask.desc, " [type=", paste(gap.types, collapse="|"), "]", sep="") } if (nrow(data) == 0) return(.newEmptyMask(seqname, mask.width, mask.name, mask.desc, mask.desc)) if (agp_or_gap == "agp") ranges_start <- data$chr_start else ranges_start <- data$chr_start + 1L ranges <- IRanges(start=ranges_start, width=as.integer(data$gap_len)) ## Sanity check if (!identical(end(ranges), data$chr_stop)) stop("broken \"", agp_or_gap, "\" file: contains inconsistent ", "chr_start/chr_stop/gap_len values ", "for assembly gaps in sequence \"", seqname, "\"") if (use.gap.types) { names(ranges) <- data$gap_type if (isNotStrictlySorted(start(ranges))) ranges <- ranges[orderInteger(start(ranges))] if (!isNormal(ranges)) stop("cannot use the gap types when some gaps are adjacent or overlap") nir1 <- asNormalIRanges(ranges, force=FALSE) } else { nir1 <- asNormalIRanges(ranges, force=TRUE) } ## Don't use new2(): the validity of the new mask needs to be checked! new2("MaskCollection", nir_list=list(nir1), width=mask.width, active=TRUE, NAMES=mask.name, desc=mask.desc, check=FALSE) } read.agpMask <- function(file, seqname="?", mask.width=NA, gap.types=NULL, use.gap.types=FALSE) .read.agpORgapMask("agp", file, seqname, mask.width, gap.types, use.gap.types) read.gapMask <- function(file, seqname="?", mask.width=NA, gap.types=NULL, use.gap.types=FALSE) .read.agpORgapMask("gap", file, seqname, mask.width, gap.types, use.gap.types) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### read.liftMask() extracts the AGAPS mask from a UCSC "lift" file. ### .read.liftFile <- function(file) { COL2CLASS <- c( `offset`="integer", `xxxx`="NULL", # not sure how to call this `width`="integer", `seqname`="character", `seqlen`="integer" ) read.table(file, col.names=names(COL2CLASS), colClasses=COL2CLASS, check.names=FALSE) } read.liftMask <- function(file, seqname="?", mask.width=NA) { if (!isSingleString(seqname)) stop("'seqname' must be a single string") if (!isSingleNumberOrNA(mask.width)) stop("'mask.width' must be a single integer or 'NA'") if (!is.integer(mask.width)) mask.width <- as.integer(mask.width) data <- .read.liftFile(file) if (seqname == "?") .showDistinctSeqnamesAndStop(data$seqname) data <- data[data$seqname == seqname, ] if (nrow(data) == 0) return(.newEmptyMask(seqname, mask.width, "AGAPS", "assembly gaps")) ## Sanity checks seqlen0 <- unique(data$seqlen) if (length(seqlen0) != 1) stop("broken \"lift\" file: contains different lengths ", "for sequence \"", seqname, "\"") if (!is.na(mask.width) && mask.width != seqlen0) stop("when supplied, 'mask.width' must match the length found ", "in the file for sequence \"", seqname, "\"") contigs0 <- IRanges(start=data$offset+1, width=data$width) contigs1 <- asNormalIRanges(contigs0, force=TRUE) if (length(contigs1) != length(contigs0)) warning("some contigs are adjacent or overlapping") contigs <- Mask(seqlen0, start=start(contigs1), width=width(contigs1)) ans <- gaps(contigs) names(ans) <- "AGAPS" desc(ans) <- "assembly gaps" ans } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### read.rmMask() extracts the RM mask from a RepeatMasker .out file. ### ### See http://www.repeatmasker.org/webrepeatmaskerhelp.html for a ### description of the RepeatMasker output format. ### .read.rmFile <- function(file) { COL2CLASS <- c( `SW_score`="integer", `perc_div`="numeric", `perc_del`="numeric", `perc_ins`="numeric", `query_sequence`="character", `begin_in_query`="integer", `end_in_query`="integer", `left_in_query`="character", `C`="character", `matching_repeat`="character", `repeat_class_or_family`="character", `begin_in_repeat`="integer", `end_in_repeat`="integer", `left_in_repeat`="character", `ID`="character" ) COLS <- c("query_sequence", "begin_in_query", "end_in_query", "ID") COL2CLASS[!(names(COL2CLASS) %in% COLS)] <- "NULL" read.table(file, col.names=names(COL2CLASS), colClasses=COL2CLASS, skip=3, check.names=FALSE) } read.rmMask <- function(file, seqname="?", mask.width=NA, use.IDs=FALSE) { if (!isSingleString(seqname)) stop("'seqname' must be a single string") if (!isSingleNumberOrNA(mask.width)) stop("'mask.width' must be a single integer or 'NA'") if (!is.integer(mask.width)) mask.width <- as.integer(mask.width) if (!isTRUEorFALSE(use.IDs)) stop("'use.IDs' must be TRUE or FALSE") data <- .read.rmFile(file) if (seqname == "?") .showDistinctSeqnamesAndStop(data$query_sequence) data <- data[data$query_sequence == seqname, ] if (nrow(data) == 0) return(.newEmptyMask(seqname, mask.width, "RM", "RepeatMasker")) ranges <- IRanges(start=data$begin_in_query, end=data$end_in_query) if (use.IDs) { names(ranges) <- data$ID if (isNotStrictlySorted(start(ranges))) ranges <- ranges[orderInteger(start(ranges))] if (!isNormal(ranges)) stop("cannot use the repeat IDs when some repeats are adjacent or overlap") nir1 <- asNormalIRanges(ranges, force=FALSE) } else { nir1 <- asNormalIRanges(ranges, force=TRUE) } ## Don't use new2(): the validity of the new mask needs to be checked! new2("MaskCollection", nir_list=list(nir1), width=mask.width, active=TRUE, NAMES="RM", desc="RepeatMasker", check=FALSE) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### read.trfMask() extracts the TRF mask from a Tandem Repeats Finder .bed ### file. ### .read.trfFile <- function(file) { COL2CLASS <- c( `chrom`="character", `chromStart`="integer", `chromEnd`="integer", `name`="character", `period`="integer", `copyNum`="numeric", `consensusSize`="integer", `perMatch`="integer", `perIndel`="integer", `score`="integer", `A`="integer", `C`="integer", `G`="integer", `T`="integer", `entropy`="numeric", `sequence`="character" ) COLS <- c("chrom", "chromStart", "chromEnd") COL2CLASS[!(names(COL2CLASS) %in% COLS)] <- "NULL" read.table(file, col.names=names(COL2CLASS), colClasses=COL2CLASS, check.names=FALSE) } read.trfMask <- function(file, seqname="?", mask.width=NA) { if (!isSingleString(seqname)) stop("'seqname' must be a single string") if (!isSingleNumberOrNA(mask.width)) stop("'mask.width' must be a single integer or 'NA'") if (!is.integer(mask.width)) mask.width <- as.integer(mask.width) data <- .read.trfFile(file) if (seqname == "?") .showDistinctSeqnamesAndStop(data$chrom) data <- data[data$chrom == seqname, ] if (nrow(data) == 0) return(.newEmptyMask(seqname, mask.width, "TRF", "Tandem Repeats Finder")) ranges <- IRanges(start=data$chromStart+1, end=data$chromEnd) nir1 <- asNormalIRanges(ranges, force=TRUE) ## Don't use new2(): the validity of the new mask needs to be checked! new2("MaskCollection", nir_list=list(nir1), width=mask.width, active=TRUE, NAMES="TRF", desc="Tandem Repeats Finder", check=FALSE) } IRanges/R/reverse-methods.R0000644000126300012640000000525212227064470017135 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "reverse" generic and methods. ### setGeneric("reverse", function(x, ...) standardGeneric("reverse")) setMethod("reverse", "character", function(x, ...) { if (length(x) == 0) return(x) sapply(strsplit(x, NULL, fixed=TRUE), function(xx) paste(rev(xx), collapse="")) } ) ### This method does NOT preserve normality. .IRanges.reverse <- function(x, ...) { if (length(x) == 0L) return(x) args <- extraArgsAsList(NULL, ...) argnames <- names(args) n2p <- match(c("start", "end", "use.names"), argnames) if (is.na(n2p[1L])) { start <- min(start(x)) } else { start <- args[[n2p[1L]]] if (!is.numeric(start)) stop("'start' must be a vector of integers") if (!is.integer(start)) start <- as.integer(start) if (anyMissing(start)) stop("'start' contains NAs") } if (is.na(n2p[2L])) { end <- max(end(x)) } else { end <- args[[n2p[2L]]] if (!is.numeric(end)) stop("'end' must be a vector of integers") if (!is.integer(end)) end <- as.integer(end) if (anyMissing(end)) stop("'end' contains NAs") } if (!is.na(n2p[3L]) && !normargUseNames(args[[n2p[3L]]])) unsafe.names(x) <- NULL ## WARNING: -end(x) *must* appear first in this expression if we want ## the supplied 'start' and 'end' to be recycled properly. ## Remember that in R, because of the recycling, addition of numeric ## vectors of different lengths is not associative i.e. in general ## '(x + y) + z' is not the same as 'x + (y + z)'. For example: ## (integer(6) + 1:2) + 1:3 and integer(6) + (1:2 + 1:3) ## are not the same. x@start[] <- -end(x) + start + end x } setMethod("reverse", "IRanges", .IRanges.reverse) setMethod("reverse", "NormalIRanges", function(x, ...) { ## callNextMethod() temporarily breaks 'x' as a NormalIRanges object ## because the returned ranges are ordered from right to left. x <- callNextMethod() unsafe.update(x, start=rev(start(x)), width=rev(width(x)), names=rev(names(x))) } ) setMethod("reverse", "Views", function(x, ...) { x@subject <- rev(subject(x)) x@ranges <- reverse(ranges(x), start=1L, end=length(subject(x))) x } ) setMethod("reverse", "MaskCollection", function(x, ...) { start <- 1L end <- width(x) x@nir_list <- lapply(nir_list(x), function(nir) reverse(nir, start=start, end=end) ) x } ) IRanges/R/runstat.R0000644000126300012640000000131212227064470015512 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### The "runsum", "runwtsum", and "runq" generics. ### setGeneric("runsum", signature="x", function(x, k, endrule = c("drop", "constant"), ...) standardGeneric("runsum")) setGeneric("runmean", signature="x", function(x, k, endrule = c("drop", "constant"), ...) standardGeneric("runmean")) setGeneric("runwtsum", signature="x", function(x, k, wt, endrule = c("drop", "constant"), ...) standardGeneric("runwtsum")) setGeneric("runq", signature="x", function(x, k, i, endrule = c("drop", "constant"), ...) standardGeneric("runq")) IRanges/R/setops-methods.R0000644000126300012640000002445612227064470017006 0ustar00biocbuildphs_compbio### ========================================================================= ### Set operations ### ------------------------------------------------------------------------- ### ### I. Vector-wise set operations: union, intersect, setdiff ### ### All the functions in that group are implemented to behave like ### endomorphisms with respect to their first argument 'x'. ### ### On IRanges objects, the functions in that group interpret each supplied ### object ('x' or 'y') as a set of integer values. Therefore, if 2 IRanges ### objects 'x1' and 'x2' represent the same set of integers, then each of ### these functions will return the same result when 'x1' is replaced by 'x2' ### in the input. The returned IRanges object is guaranteed to be normal ### (note that if 'x' is an IRanges *instance* then the returned object is ### still an IRanges *instance*, that is, it is *not* promoted to ### NormalIRanges). ### ### II. Element-wise (aka "parallel") set operations: punion, pintersect, ### psetdiff, pgap ### ### The functions in that group take 2 *objects* of the same length and ### return an object of the same class and length as the first argument. ### ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### union() ### setMethod("union", c("IRanges", "IRanges"), function(x, y, ...) { ## We need to downgrade 'x' to an IRanges instance 'x0' so 'c(x0, y)' ## is guaranteed to work (even e.g. if 'x' is a NormalIRanges object). x0 <- as(x, "IRanges") # downgrade x to IRanges x0 <- reduce(c(x0, y), drop.empty.ranges=TRUE) ## Maybe the call to update() below could be replaced by ## 'as(x, "IRanges") <- x0' but I was not lucky with my first ## attempt to use this construct: ## > v <- Views(XInteger(18), 2:5, 13:10) ## > as(v, "IRanges") <- IRanges(3, 8) ## Error: evaluation nested too deeply: infinite recursion / options(expressions=)? initialize(x, start=start(x0), width=width(x0), NAMES=names(x0), elementMetadata=NULL) } ) setMethod("union", c("RangesList", "RangesList"), function(x, y) mendoapply(union, x, y)) setMethod("union", c("CompressedIRangesList", "CompressedIRangesList"), function(x, y) { len <- max(length(x), length(y)) if (length(x) != len) x <- x[recycleVector(seq_len(length(x)), len)] if (length(y) != len) y <- y[recycleVector(seq_len(length(y)), len)] xy <- c(unlist(x, use.names = FALSE), unlist(y, use.names = FALSE)) xy_list <- split(xy, factor(c(togroup(x), togroup(y)), seq_len(length(x)))) names(xy_list) <- names(x) reduce(xy_list, drop.empty.ranges=TRUE) }) setMethod("union", c("Hits", "Hits"), function(x, y) { m <- match(y, x) y <- y[is.na(m)] q_hits <- c(queryHits(x), queryHits(y)) s_hits <- c(subjectHits(x), subjectHits(y)) oo <- orderIntegerPairs(q_hits, s_hits) q_hits <- q_hits[oo] s_hits <- s_hits[oo] new2("Hits", queryHits=q_hits, subjectHits=s_hits, queryLength=queryLength(x), subjectLength=subjectLength(x), check=FALSE) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### intersect() ### setMethod("intersect", c("IRanges", "IRanges"), function(x, y, ...) { if (length(x) == 0L) return(x) start <- min(c(start(x), start(y))) end <- max(c(end(x), end(y))) setdiff(x, gaps(y, start=start, end=end)) } ) setMethod("intersect", c("RangesList", "RangesList"), function(x, y) mendoapply(intersect, x, y)) setMethod("intersect", c("CompressedIRangesList", "CompressedIRangesList"), function(x, y) { nonempty <- elementLengths(x) != 0L rx <- unlist(range(x), use.names = FALSE) startx <- integer() startx[nonempty] <- start(rx) endx <- integer() endx[nonempty] <- end(rx) setdiff(x, gaps(y, start = startx, end = endx)) }) setMethod("intersect", c("Hits", "Hits"), function(x, y) { if (!compatibleHits(x, y)) stop("'x' and 'y' are incompatible by subject and query length") x[x %in% y] }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### setdiff() ### setMethod("setdiff", c("IRanges", "IRanges"), function(x, y, ...) { if (length(x) == 0L) return(x) start <- min(c(start(x), start(y))) end <- max(c(end(x), end(y))) gaps(union(gaps(x, start=start, end=end), y), start=start, end=end) } ) setMethod("setdiff", c("RangesList", "RangesList"), function(x, y) mendoapply(setdiff, x, y)) setMethod("setdiff", c("CompressedIRangesList", "CompressedIRangesList"), function(x, y) { nonempty <- elementLengths(x) != 0L rx <- unlist(range(x), use.names = FALSE) startx <- integer() startx[nonempty] <- start(rx) endx <- integer() endx[nonempty] <- end(rx) gaps(union(gaps(x), y), start = startx, end = endx) }) setMethod("setdiff", c("Hits", "Hits"), function(x, y) { if (!compatibleHits(x, y)) stop("'x' and 'y' are incompatible by subject and query length") x[!(x %in% y)] }) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### punion() ### setGeneric("punion", signature=c("x", "y"), function(x, y, ...) standardGeneric("punion") ) setMethod("punion", c("IRanges", "IRanges"), function(x, y, fill.gap=FALSE, ...) { if (length(x) != length(y)) stop("'x' and 'y' must have the same length") if (!isTRUEorFALSE(fill.gap)) stop("'fill.gap' must be TRUE or FALSE") if (!fill.gap) { gap <- pmax.int(start(x), start(y)) - pmin.int(end(x), end(y)) - 1L if (any(gap > 0L)) stop("some pair of ranges have a gap within ", "the 2 members of the pair.\n", " Use 'fill.gap=TRUE' to enforce their ", "union by filling the gap.") } ans_start <- pmin.int(start(x), start(y)) ans_end <- pmax.int(end(x), end(y)) ans_names <- names(x) if (is.null(ans_names)) ans_names <- names(y) IRanges(start=ans_start, end=ans_end, names=ans_names) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### pintersect() ### setGeneric("pintersect", signature=c("x", "y"), function(x, y, ...) standardGeneric("pintersect") ) setMethod("pintersect", c("IRanges", "IRanges"), function(x, y, resolve.empty=c("none", "max.start", "start.x"), ...) { if (length(x) != length(y)) stop("'x' and 'y' must have the same length") ans_start <- pmax.int(start(x), start(y)) ans_end <- pmin.int(end(x), end(y)) ans_width <- ans_end - ans_start + 1L keep_empty_x <- width(x) == 0L if (any(keep_empty_x)) { keep_empty_x <- keep_empty_x & ((start(x) >= start(y) & start(x) <= end(y)) | (start(x) == start(y) & width(y) == 0L)) } if (any(keep_empty_x)) { ans_start[keep_empty_x] <- start(x)[keep_empty_x] ans_width[keep_empty_x] <- 0L } keep_empty_y <- width(y) == 0L if (any(keep_empty_y)) { keep_empty_y <- keep_empty_y & start(y) >= start(x) & start(y) <= end(x) } if (any(keep_empty_y)) { ans_start[keep_empty_y] <- start(y)[keep_empty_y] ans_width[keep_empty_y] <- 0L } check_empty <- ans_width < 0L check_empty[keep_empty_x | keep_empty_y] <- FALSE if (any(check_empty)) { resolve.empty <- match.arg(resolve.empty) if (resolve.empty == "none") { stop("some intersections produce ambiguous empty ranges.\n", " Use argument 'resolve.empty' to resolve them.") } else { ans_width[check_empty] <- 0L if (resolve.empty == "start.x") ans_start[check_empty] <- start(x)[check_empty] } } ans_names <- names(x) if (is.null(ans_names)) ans_names <- names(y) IRanges(start=ans_start, width=ans_width, names=ans_names) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### psetdiff() ### setGeneric("psetdiff", signature=c("x", "y"), function(x, y, ...) standardGeneric("psetdiff") ) setMethod("psetdiff", c("IRanges", "IRanges"), function(x, y, ...) { if (length(x) != length(y)) stop("'x' and 'y' must have the same length") ans_start <- start(x) ans_end <- end(x) if (any((start(y) > ans_start) & (end(y) < ans_end))) stop("some ranges in 'y' have their end points strictly inside\n", " the range in 'x' that they need to be subtracted from.\n", " Cannot subtract them.") start2 <- pmax.int(ans_start, start(y)) end2 <- pmin.int(ans_end, end(y)) ii <- start2 <= end2 jj <- end2 == ans_end kk <- ii & jj ans_end[kk] <- start2[kk] - 1L kk <- ii & (!jj) ans_start[kk] <- end2[kk] + 1L ans_names <- names(x) if (is.null(ans_names)) ans_names <- names(y) IRanges(start=ans_start, end=ans_end, names=ans_names) } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### pgap() ### setGeneric("pgap", signature=c("x", "y"), function(x, y, ...) standardGeneric("pgap") ) setMethod("pgap", c("IRanges", "IRanges"), function(x, y, ...) { if (length(x) != length(y)) stop("'x' and 'y' must have the same length") ans_end_plus1 <- pmax.int(start(x), start(y)) ans_start <- pmin.int(end(x), end(y)) + 1L ans_width <- ans_end_plus1 - ans_start ans_width[ans_width < 0L] <- 0L ans_names <- names(x) if (is.null(ans_names)) ans_names <- names(y) IRanges(start=ans_start, width=ans_width, names=ans_names) } ) IRanges/R/slice-methods.R0000644000126300012640000000643012227064470016560 0ustar00biocbuildphs_compbio### ========================================================================= ### Slice the bread ### ------------------------------------------------------------------------- setGeneric("slice", signature="x", function(x, lower=-Inf, upper=Inf, ...) standardGeneric("slice")) setMethod("slice", "Rle", function(x, lower = -Inf, upper = Inf, includeLower = TRUE, includeUpper = TRUE, rangesOnly = FALSE) { if (!isSingleNumber(lower)) { stop("'lower' must be a single number") } if (!isSingleNumber(upper)) { stop("'upper' must be a single number") } if (!isTRUEorFALSE(includeLower)) { stop("'includeLower' must be TRUE or FALSE") } if (!isTRUEorFALSE(includeUpper)) { stop("'includeUpper' must be TRUE or FALSE") } if (!isTRUEorFALSE(rangesOnly)) { stop("'rangesOnly' must be TRUE or FALSE") } if (lower == -Inf) { ranges <- Rle(TRUE, length(x)) } else if (includeLower) { ranges <- (x >= lower) } else { ranges <- (x > lower) } if (upper < Inf) { if (includeUpper) { ranges <- ranges & (x <= upper) } else { ranges <- ranges & (x < upper) } } if (rangesOnly) { as(ranges, "IRanges") } else { Views(x, ranges) } }) setMethod("slice", "RleList", function(x, lower = -Inf, upper = Inf, includeLower = TRUE, includeUpper = TRUE, rangesOnly = FALSE) { if (!isSingleNumber(lower)) stop("'lower' must be a single number") if (!isSingleNumber(upper)) stop("'upper' must be a single number") if (!isTRUEorFALSE(includeLower)) stop("'includeLower' must be TRUE or FALSE") if (!isTRUEorFALSE(includeUpper)) stop("'includeUpper' must be TRUE or FALSE") if (!isTRUEorFALSE(rangesOnly)) stop("'rangesOnly' must be TRUE or FALSE") if (lower == -Inf) { ranges <- RleList(lapply(elementLengths(x), function(len) Rle(TRUE, len)), compress=FALSE) } else if (includeLower) { ranges <- (x >= lower) } else { ranges <- (x > lower) } if (upper < Inf) { if (includeUpper) { ranges <- ranges & (x <= upper) } else { ranges <- ranges & (x < upper) } } if (rangesOnly) { as(ranges, "CompressedIRangesList") } else { RleViewsList(rleList = x, rangesList = as(ranges, "SimpleIRangesList")) } }) IRanges/R/str-utils.R0000644000126300012640000000402512227064470015764 0ustar00biocbuildphs_compbiocapitalize <- function(x) { substring(x, 1L, 1L) <- toupper(substring(x, 1L, 1L)) x } ### Safe alternative to 'strsplit(x, NULL, fixed=TRUE)[[1L]]'. safeExplode <- function(x) { if (!isSingleString(x)) stop("'x' must be a single string") .Call2("safe_strexplode", x, PACKAGE="IRanges") } ### strsplitAsListOfIntegerVectors(x) is an alternative to: ### lapply(strsplit(x, ",", fixed=TRUE), as.integer) ### except that: ### - strsplit() accepts NAs, we don't (raise an error); ### - as.integer() introduces NAs by coercion (with a warning), we don't ### (raise an error); ### - as.integer() supports "inaccurate integer conversion in coercion" ### when the value to coerce is > INT_MAX (then it's coerced to INT_MAX), ### we don't (raise an error); ### - as.integer() will coerce non-integer values (e.g. 10.3) to an int ### by truncating them, we don't (raise an error). ### When it fails, strsplit_as_list_of_ints() will print a detailed parse ### error message. ### It's also faster and uses much less memory. E.g. it's 8x faster and uses ### < 1 Mb versus > 60 Mb on the character vector 'biginput' created with: ### library(rtracklayer) ### session <- browserSession() ### genome(session) <- "hg18" ### query <- ucscTableQuery(session, "UCSC Genes") ### tx <- getTable(query) ### biginput <- c(tx$exonStarts, tx$exonEnds) # 133606 elements strsplitAsListOfIntegerVectors <- function(x, sep=",") { if (!is.character(x)) stop("'x' must be a character vector") if (!isSingleString(sep) || nchar(sep) != 1L) stop("'sep' must be a string containing just one single-byte character") ans <- .Call2("strsplit_as_list_of_ints", x, sep, PACKAGE="IRanges") names(ans) <- names(x) ans } ### svn.time() returns the time in Subversion format, e.g.: ### "2007-12-07 10:03:15 -0800 (Fri, 07 Dec 2007)" ### The -0800 part will be adjusted if daylight saving time is in effect. ### TODO: Find a better home for this function. svn.time <- function() .Call2("svn_time", PACKAGE="IRanges") IRanges/R/subsetting-utils.R0000644000126300012640000001672712227064470017357 0ustar00biocbuildphs_compbio### ========================================================================= ### Subsetting utility functions ### ------------------------------------------------------------------------- ### Returns an integer vector with values >= 1 and <= N, where N = length(x) ### if 'byrow=FALSE' and N = nrow(x) if 'byrow=TRUE'. normalizeSingleBracketSubscript <- function(i, x, byrow=FALSE, exact=TRUE, allow.append=FALSE) { if (!isTRUEorFALSE(byrow)) stop("'byrow' must be TRUE or FALSE") if (!isTRUEorFALSE(exact)) stop("'exact' must be TRUE or FALSE") if (!isTRUEorFALSE(allow.append)) stop("'allow.append' must be TRUE or FALSE") if (byrow) { N <- nrow(x) } else { N <- length(x) } if (missing(i)) return(seq_len(N)) if (is.null(i)) return(integer(0)) if (is(i, "Rle")) { i <- as.vector(i) } else if (allow.append && is(i, "Ranges")) { i <- as.integer(i) } if (!is.atomic(i)) stop("invalid subscript type") if (is.numeric(i)) { if (!is.integer(i)) i <- as.integer(i) if (allow.append) { if (any(is.na(i))) stop("subscript contains NAs") } else { if (anyMissingOrOutside(i, upper=N)) stop("subscript contains NAs or out of bounds indices") } nonzero_idx <- which(i != 0L) i <- i[nonzero_idx] if (length(i) == 0L) return(i) any_pos <- any(i > 0L) any_neg <- any(i < 0L) if (any_neg && any_pos) stop("cannot mix negative with positive indices") ## From here, indices are guaranteed to be either all positive or ## all negative. if (any_neg) return(seq_len(N)[i]) return(i) } if (is.logical(i)) { if (anyMissing(i)) stop("subscript contains NAs") li <- length(i) if (!allow.append && li > N) { if (any(i[(N+1L):li])) stop("subscript is a logical vector with out of bounds ", "TRUE values") i <- i[seq_len(N)] } if (li < N) i <- rep(i, length.out=N) return(which(i)) } if (is.character(i) || is.factor(i)) { if (byrow) { x_names <- rownames(x) what <- "rownames" } else { x_names <- names(x) what <- "names" } if (is.null(x_names)) { if (!allow.append) stop("cannot subset by character when ", what, " are NULL") return(N + seq_along(i)) } if (exact) { i <- match(i, x_names, incomparables=c(NA_character_, "")) } else { i <- pmatch(i, x_names, duplicates.ok=TRUE) } if (allow.append) { na_idx <- which(is.na(i)) i[na_idx] <- N + seq_along(na_idx) return(i) } if (anyMissing(i)) stop("subscript contains invalid ", what) return(i) } stop("invalid subscript type") } ### Supported types for 'i': single NA, numeric and character vectors only. ### Always returns a single integer. When called with 'error.if.nomatch=FALSE', ### returns an NA_integer_ if no match is found. Otherwise (the default), ### raises an error if no match is found so the returned integer is guaranteed ### to be a non-NA positive integer referring to a valid position in 'x'. normalizeDoubleBracketSubscript <- function(i, x, exact=TRUE, error.if.nomatch=TRUE) { if (!isTRUEorFALSE(exact)) stop("'exact' must be TRUE or FALSE") if (!isTRUEorFALSE(error.if.nomatch)) stop("'error.if.nomatch' must be TRUE or FALSE") if (missing(i)) stop("subscript is missing") if (is.vector(i) && length(i) == 1L && is.na(i)) { if (error.if.nomatch) stop("subsetting by NA returns no match") return(NA_integer_) } if (!is.numeric(i) && !is.character(i)) stop("invalid subscript type '", class(i), "'") if (length(i) < 1L) stop("attempt to extract less than one element") if (length(i) > 1L) stop("attempt to extract more than one element") if (is.numeric(i)) { if (!is.integer(i)) i <- as.integer(i) if (i < 1L || length(x) < i) stop("subscript out of bounds") return(i) } ## 'i' is a character string x_names <- names(x) if (is.null(x_names)) { if (error.if.nomatch) stop("attempt to extract by name when elements have no names") return(NA_integer_) } #if (i == "") # stop("invalid subscript \"\"") if (exact) { ans <- match(i, x_names, incomparables=c(NA_character_, "")) } else { ## Because 'i' has length 1, it doesn't matter whether we use ## 'duplicates.ok=FALSE' (the default) or 'duplicates.ok=TRUE' but ## the latter seems to be just a little bit faster. ans <- pmatch(i, x_names, duplicates.ok=TRUE) } if (is.na(ans) && error.if.nomatch) stop("subscript \"", i, "\" matches no name") ans } ### Dispatch on the 2nd argument! setGeneric("normalizeSingleBracketReplacementValue", signature="x", function(value, x, i) standardGeneric("normalizeSingleBracketReplacementValue") ) ### Default method. setMethod("normalizeSingleBracketReplacementValue", "ANY", function(value, x) { if (is(value, class(x))) return(value) lv <- length(value) value <- try(as(value, class(x)), silent=TRUE) if (inherits(value, "try-error")) stop("'value' must be a ", class(x), " object (or coercible ", "to a ", class(x), " object)") if (length(value) != lv) stop("coercing replacement value to ", class(x), "\n", " changed its length!\n", " Please do the explicit coercion ", "yourself with something like:\n", " x[...] <- as(value, \"", class(x), "\")\n", " but first make sure this coercion does what you want.") value } ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### 2 internal generics to ease implementation of [ and [<- subsetting for ### new Vector subclasses. ### ### Most new Vector subclasses should only need to implement an "extractROWS" ### and a "replaceROWS" method to have "[" and "[<-" work out-of-the-box, ### respectively. ### Must support the following 'i' types: missing, Ranges and anything that ### can be handled by normalizeSingleBracketSubscript(). ### For replaceROWS(), it's OK to assume that 'value' is "compatible" i.e. ### that it has gone thru normalizeSingleBracketReplacementValue(). ### See "extractROWS" and "replaceROWS" methods for IRanges objects for an ### example. ### setGeneric("extractROWS", signature="x", function(x, i) standardGeneric("extractROWS") ) setGeneric("replaceROWS", signature="x", function(x, i, value) standardGeneric("replaceROWS") ) ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### 2 internal generics to ease implementation of [[ and [[<- subsetting for ### new List subclasses. ### setGeneric("getListElement", signature="x", function(x, i, exact=TRUE) standardGeneric("getListElement") ) setGeneric("setListElement", signature="x", function(x, i, value) standardGeneric("setListElement") ) IRanges/R/test_IRanges_package.R0000644000126300012640000000007212227064470020056 0ustar00biocbuildphs_compbio.test <- function() BiocGenerics:::testPackage("IRanges") IRanges/R/updateObject-methods.R0000644000126300012640000003422712227064470020077 0ustar00biocbuildphs_compbio## Functions for updating old TypedList to new infrastructure toSimpleList <- function(object, newclass, newtype, ...) { annotation <- tryCatch(slot(object, "annotation"), error = function(e) list()) if (!is.list(annotation)) { if (is.null(annotation)) annotation <- list() else annotation <- list(annotation) } new(newclass, listData = lapply(structure(slot(object, "elements"), names = slot(object, "NAMES")), updateObject), elementMetadata = updateObject(tryCatch(slot(object, "elementMetadata"), error = function(e) NULL)), elementType = newtype, metadata = annotation, ...) } toCompressedList <- function(object, newclass, newtype, ...) { annotation <- tryCatch(slot(object, "annotation"), error = function(e) list()) if (!is.list(annotation)) { if (is.null(annotation)) annotation <- list() else annotation <- list(annotation) } new(newclass, partitioning = new("PartitioningByEnd", end = cumsum(slot(object, "elementLengths")), NAMES = slot(object, "NAMES")), unlistData = updateObject(slot(object, "elements")[[1L]]), elementMetadata = updateObject(tryCatch(slot(object, "elementMetadata"), error = function(e) NULL)), elementType = newtype, metadata = annotation, ...) } toNewTypeList <- function(object, simpleclass, compressedclass, newtype) { if (slot(object, "compress")) toCompressedList(object, compressedclass, newtype) else toSimpleList(object, simpleclass, newtype) } ### ################################################################### ### Update methods ### ################################################################### ## "AnnotatedList" -> "SimpleList" setClass("AnnotatedList", representation("VIRTUAL")) setMethod("updateObject", signature(object="AnnotatedList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'AnnotatedList')") toSimpleList(asS4(object), "SimpleList", "ANY") }) ## "LogicalList" -> "SimpleLogicalList" or "CompressedLogicalList" setMethod("updateObject", signature(object="LogicalList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'LogicalList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleLogicalList", "CompressedLogicalList", "logical") } object }) ## "IntegerList" -> "SimpleIntegerList" or "CompressedIntegerList" setMethod("updateObject", signature(object="IntegerList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'IntegerList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleIntegerList", "CompressedIntegerList", "integer") } object }) ## "NumericList" -> "SimpleNumericList" or "CompressedNumericList" setMethod("updateObject", signature(object="NumericList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'NumericList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleNumericList", "CompressedNumericList", "numeric") } object }) ## "ComplexList" -> "SimpleComplexList" or "CompressedComplexList" setMethod("updateObject", signature(object="ComplexList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'ComplexList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleComplexList", "CompressedComplexList", "complex") } object }) ## "CharacterList" -> "SimpleCharacterList" or "CompressedCharacterList" setMethod("updateObject", signature(object="CharacterList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'CharacterList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleCharacterList", "CompressedCharacterList", "character") } object }) ## "RawList" -> "SimpleRawList" or "CompressedRawList" setMethod("updateObject", signature(object="RawList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'RawList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleRawList", "CompressedRawList", "raw") } object }) ## "RleList" -> "SimpleRleList" or "CompressedRleList" setMethod("updateObject", signature(object="RleList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'RleList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleRleList", "CompressedRleList", "Rle") } object }) ## "FilterRules" -> "FilterRules" setMethod("updateObject", signature(object="FilterRules"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'FilterRules')") if (!("metadata" %in% names(attributes(object)))) { object <- toSimpleList(asS4(object), "FilterRules", "expressionORfunction", active = slot(object, "active")) } object }) ## "IRanges" -> "IRanges" setMethod("updateObject", signature(object="IRanges"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'IRanges')") if (!("metadata" %in% names(attributes(object)))) { object <- new("IRanges", start = slot(object, "start"), width = slot(object, "width"), NAMES = slot(object, "NAMES")) } object }) ## "NormalIRanges" -> "NormalIRanges" setMethod("updateObject", signature(object="NormalIRanges"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'NormalIRanges')") if (!("metadata" %in% names(attributes(object)))) { object <- new("NormalIRanges", start = slot(object, "start"), width = slot(object, "width"), NAMES = slot(object, "NAMES")) } object }) ## "IntervalTree" -> "IntervalTree" setMethod("updateObject", signature(object="IntervalTree"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'IntervalTree')") if (!("metadata" %in% names(attributes(object)))) { object <- new("IntervalTree", ptr = slot(object, "ptr"), mode = slot(object, "mode")) } object }) ## "MaskCollection" -> "MaskCollection" setMethod("updateObject", signature(object="MaskCollection"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'MaskCollection')") if (!("metadata" %in% names(attributes(object)))) { object <- new("MaskCollection", nir_list = lapply(slot(object, "nir_list"), updateObject), width = slot(object, "width"), active = slot(object, "active"), NAMES = slot(object, "NAMES"), desc = slot(object, "desc")) } object }) ## "RDApplyParams" -> "RDApplyParams" setMethod("updateObject", signature(object="RDApplyParams"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'RDApplyParams')") if (!("metadata" %in% names(attributes(object)))) { object <- new("RDApplyParams", rangedData = updateObject(slot(object, "rangedData")), applyFun = slot(object, "applyFun"), applyParams = slot(object, "applyParams"), filterRules = updateObject(slot(object, "filterRules")), simplify = slot(object, "simplify"), reducerFun = slot(object, "reducerFun"), reducerParams = slot(object, "reducerParams")) } object }) ## "RangedData" -> "RangedData" setMethod("updateObject", signature(object="RangedData"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'RangedData')") if (!("metadata" %in% names(attributes(object)))) { ranges <- updateObject(slot(object, "ranges")) values <- updateObject(slot(object, "values")) if (is.null(names(ranges))) { names(ranges) <- as.character(seq_len(length(ranges))) } if (is.null(names(values))) { names(values) <- as.character(seq_len(length(values))) } object <- new("RangedData", ranges = ranges, values = values) } object }) ## "RangedDataList" -> "RangedDataList" setMethod("updateObject", signature(object="RangedDataList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'RangedDataList')") if (!("metadata" %in% names(attributes(object)))) { object <- toSimpleList(asS4(object), "RangedDataList", "RangedData") } object }) ## "RangesList" -> "SimpleRangesList" setMethod("updateObject", signature(object="RangesList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'RangesListList')") if (!("metadata" %in% names(attributes(object)))) { object <- toSimpleList(asS4(object), "SimpleRangesList", "Ranges") } object }) ## "IRangesList" -> "SimpleIRangesList" or "CompressedIRangesList" setMethod("updateObject", signature(object="IRangesList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'IRangesList')") if (!("metadata" %in% names(attributes(object)))) { object <- toNewTypeList(asS4(object), "SimpleIRangesList", "CompressedIRangesList", "IRanges") } object }) ## "Rle" -> "Rle" setMethod("updateObject", signature(object="Rle"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'Rle')") if (!("metadata" %in% names(attributes(object)))) { object <- new("Rle", values = slot(object, "values"), lengths = slot(object, "lengths")) } object }) ## "RleViews" -> "RleViews" setMethod("updateObject", signature(object="RleViews"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'RleViews')") if (!("metadata" %in% names(attributes(object)))) { object <- new("RleViews", subject = updateObject(slot(object, "subject")), start = slot(object, "start"), width = slot(object, "width"), NAMES = slot(object, "NAMES")) } object }) ## "XDataFrame" -> "DataFrame" setClass("XDataFrame", representation("VIRTUAL")) setMethod("updateObject", signature(object="XDataFrame"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'XDataFrame')") toSimpleList(asS4(object), "DataFrame", "ANY", rownames = slot(object, "rownames"), nrows = slot(object, "nrows")) }) ## "XDataFrameList" -> "SimpleDataFrameList" setClass("XDataFrameList", representation("VIRTUAL")) setMethod("updateObject", signature(object="XDataFrameList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'XDataFrameList')") toSimpleList(asS4(object), "SimpleDataFrameList", "DataFrame") }) ## "SplitXDataFrameList" -> "SimpleSplitDataFrameList" or "CompressedSplitDataFrameList" setClass("SplitXDataFrameList", representation("VIRTUAL")) setMethod("updateObject", signature(object="SplitXDataFrameList"), function(object, ..., verbose=FALSE) { if (verbose) message("updateObject(object = 'SplitXDataFrameList')") toNewTypeList(asS4(object), "SimpleSplitDataFrameList", "CompressedSplitDataFrameList", "DataFrame") }) IRanges/R/utils.R0000644000126300012640000001736612227064470015172 0ustar00biocbuildphs_compbio### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Some low-level helper functions and classes. ### ### Unless stated otherwise, nothing in this section is exported. ### errorIfWarning <- function(expr) { old_options <- options(warn=2) on.exit(options(old_options)) eval(expr) } AEbufs.use.malloc <- function(x) .Call("AEbufs_use_malloc", x, PACKAGE="IRanges") AEbufs.free <- function() .Call("AEbufs_free", PACKAGE="IRanges") ### Exported! .Call2 <- function(.NAME, ..., PACKAGE) { #Turning off malloc-based Auto-Extending buffers again until I find the #time to troubleshoot 'R CMD check' segfault on moscato1 and pitt. #AEbufs.use.malloc(TRUE) #on.exit({AEbufs.free(); AEbufs.use.malloc(FALSE)}) .Call(.NAME, ..., PACKAGE=PACKAGE) } ### Exported! setClassUnion("characterORNULL", c("character", "NULL")) ### Exported! ### We define the coercion method below as a workaround to the following ### bug in R: ### ### setClass("A", representation(stuff="numeric")) ### setMethod("as.vector", "A", function(x, mode="any") x@stuff) ### ### a <- new("A", stuff=3:-5) ### > as.vector(a) ### [1] 3 2 1 0 -1 -2 -3 -4 -5 ### > as(a, "vector") ### Error in as.vector(from) : ### no method for coercing this S4 class to a vector ### > selectMethod("coerce", c("A", "vector")) ### Method Definition: ### ### function (from, to, strict = TRUE) ### { ### value <- as.vector(from) ### if (strict) ### attributes(value) <- NULL ### value ### } ### ### ### Signatures: ### from to ### target "A" "vector" ### defined "ANY" "vector" ### > setAs("ANY", "vector", function(from) as.vector(from)) ### > as(a, "vector") ### [1] 3 2 1 0 -1 -2 -3 -4 -5 setAs("ANY", "vector", function(from) as.vector(from)) coercerToClass <- function(class) { if (extends(class, "vector")) .as <- get(paste0("as.", class)) else .as <- function(from) as(from, class) function(from) { setNames(.as(from), names(from)) } } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Manipulating the prototype of an S4 class. ### ### Gets or sets the default value of the given slot of the given class by ### reading or altering the prototype of the class. setDefaultSlotValue() is ### typically used in the .onLoad() hook of a package when the DLL of the ### package needs to be loaded *before* the default value of a slot can be ### computed. getDefaultSlotValue <- function(classname, slotname, where=.GlobalEnv) { classdef <- getClass(classname, where=where) if (!(slotname %in% names(attributes(classdef@prototype)))) stop("prototype for class \"", classname, "\" ", "has no \"", slotname, "\" attribute") attr(classdef@prototype, slotname, exact=TRUE) } setDefaultSlotValue <- function(classname, slotname, value, where=.GlobalEnv) { classdef <- getClass(classname, where=where) if (!(slotname %in% names(attributes(classdef@prototype)))) stop("prototype for class \"", classname, "\" ", "has no \"", slotname, "\" attribute") attr(classdef@prototype, slotname) <- value assignClassDef(classname, classdef, where=where) ## Re-compute the complete definition of the class. methods::setValidity() ## does that after calling assignClassDef() so we do it too. resetClass(classname, classdef, where=where) } setPrototypeFromObject <- function(classname, object, where=.GlobalEnv) { classdef <- getClass(classname, where=where) if (class(object) != classname) stop("'object' must be a ", classname, " instance") object_attribs <- attributes(object) object_attribs$class <- NULL ## Sanity check. stopifnot(identical(names(object_attribs), names(attributes(classdef@prototype)))) attributes(classdef@prototype) <- object_attribs assignClassDef(classname, classdef, where=where) ## Re-compute the complete definition of the class. methods::setValidity() ## does that after calling assignClassDef() so we do it too. resetClass(classname, classdef, where=where) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### Pretty printing ### ### 'makeNakedMat.FUN' must be a function returning a character matrix. makePrettyMatrixForCompactPrinting <- function(x, makeNakedMat.FUN) { lx <- NROW(x) nhead <- get_showHeadLines() ntail <- get_showTailLines() if (lx < (nhead + ntail + 1L)) { ans <- makeNakedMat.FUN(x) ans_rownames <- .rownames2(names(x), lx) } else { top_idx <- 1:nhead if (nhead == 0) top_idx <- 0 bottom_idx=(lx-ntail+1L):lx if (ntail == 0) bottom_idx <- 0 ans_top <- makeNakedMat.FUN(x[top_idx,,drop=FALSE]) ans_bottom <- makeNakedMat.FUN(x[bottom_idx,,drop=FALSE]) ans <- rbind(ans_top, matrix(rep.int("...", ncol(ans_top)), nrow=1L), ans_bottom) ans_rownames <- .rownames2(names(x), lx, top_idx, bottom_idx) } rownames(ans) <- format(ans_rownames, justify="right") ans } .rownames2 <- function(names=NULL, len=NULL, tindex=NULL, bindex=NULL) { if (is.null(tindex) && is.null(bindex)) { ## all lines if (len == 0L) character(0) else if (is.null(names)) paste0("[", seq_len(len), "]") else names } else { ## head and tail if (!is.null(names)) { c(names[tindex], "...", names[bindex]) } else { s1 <- paste0("[", tindex, "]") s2 <- paste0("[", bindex, "]") if (all(tindex == 0)) s1 <- character(0) if (all(bindex == 0)) s2 <- character(0) c(s1, "...", s2) } } } ### Works as long as length(), "[" and as.numeric() work on 'x'. ### Not exported. toNumSnippet <- function(x, max.width) { if (length(x) <= 2L) return(paste(format(as.numeric(x)), collapse=" ")) if (max.width < 0L) max.width <- 0L ## Elt width and nb of elt to display if they were all 0. elt_width0 <- 1L nelt_to_display0 <- min(length(x), (max.width+1L) %/% (elt_width0+1L)) head_ii0 <- seq_len(nelt_to_display0 %/% 2L) tail_ii0 <- length(x) + head_ii0 - length(head_ii0) ii0 <- c(head_ii0, tail_ii0) ## Effective elt width and nb of elt to display elt_width <- format.info(as.numeric(x[ii0]))[1L] nelt_to_display <- min(length(x), (max.width+1L) %/% (elt_width+1L)) if (nelt_to_display == length(x)) return(paste(format(as.numeric(x), width=elt_width), collapse=" ")) head_ii <- seq_len((nelt_to_display+1L) %/% 2L) tail_ii <- length(x) + seq_len(nelt_to_display %/% 2L) - nelt_to_display %/% 2L ans_head <- format(as.numeric(x[head_ii]), width=elt_width) ans_tail <- format(as.numeric(x[tail_ii]), width=elt_width) ans <- paste(paste(ans_head, collapse=" "), "...", paste(ans_tail, collapse=" ")) if (nchar(ans) <= max.width || length(ans_head) == 0L) return(ans) ans_head <- ans_head[-length(ans_head)] ans <- paste(paste(ans_head, collapse=" "), "...", paste(ans_tail, collapse=" ")) if (nchar(ans) <= max.width || length(ans_tail) == 0L) return(ans) ans_tail <- ans_tail[-length(ans_tail)] paste(paste(ans_head, collapse=" "), "...", paste(ans_tail, collapse=" ")) } ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ### showHeadLines and showTailLines robust to NA, Inf and non-integer ### get_showHeadLines <- function() { .get_showLines(5L, "showHeadLines") } get_showTailLines <- function() { .get_showLines(5L, "showTailLines") } .get_showLines <- function(default, option) { opt <- getOption(option, default=default) if (!is.infinite(opt)) opt <- as.integer(opt) if (is.na(opt)) opt <- default opt } IRanges/R/zzz.R0000644000126300012640000000262112227064470014653 0ustar00biocbuildphs_compbio### .onLoad <- function(libname, pkgname) { ## -- HACK! -- ## Not loading the methods package can cause some strange 'R CMD check' ## WARNINGs. For example, on a BSgenome data package (with R 2.14.0): ## ## * checking whether the namespace can be loaded with stated dependencies ... WARNING ## Error: .onLoad failed in loadNamespace() for ‘BSgenome.Celegans.UCSC.ce2’, details: ## call: length(x) ## error: could not find function "loadMethod" ## Execution halted ## ## A namespace must be able to be loaded with just the base namespace ## loaded: otherwise if the namespace gets loaded by a saved object, the ## session will be unable to start. ## ## Probably some imports need to be declared in the NAMESPACE file. ## ## However, loading the methods package with library(methods) produces the ## following 'R CMD check' NOTE (with R 2.14.0): ## ## * checking R code for possible problems ... NOTE ## File ‘IRanges/R/zzz.R’: ## .onLoad calls: ## library(methods) ## ## Package startup functions should not change the search path. ## See section ‘Good practice’ in ?.onAttach. ## ## So we cheat on codetools to avoid this NOTE. sillyname <- library sillyname(methods) } .onUnload <- function(libpath) { library.dynam.unload("IRanges", libpath) } IRanges/TODO0000644000126300012640000001617212227064501014163 0ustar00biocbuildphs_compbioImmediate TODO list ------------------- - Bug fix: Combining RangedData objects is currently broken (IRanges 1.9.20): library(IRanges) ranges <- IRanges(c(1,2,3),c(4,5,6)) rd1 <- RangedData(ranges) rd2 <- RangedData(shift(ranges, 100)) rd <- c(rd1, rd2) # Seems to work (with some warnings)... validObject(rd) # but returns an invalid object! - Herve: Make the MaskCollection class a derivative of the SimpleIRangesList class. - Herve: Use a different name for "reverse" method for IRanges and MaskCollection objects. Seems like, for IRanges objects, reverse() and reflect() are doing the same thing, so I should just keep (and eventually adapt) the latter. Also, I should add a "reflect" method for SimpleIRangesList objects that would do what the current "reverse" method for MaskCollection objects does. Once this is done, adapt R/reverse.R file in Biostrings to use reflect() instead of reverse() wherever needed. - Herve or Michael: Provide a way to reduce ranges with a min overlap (Michael's suggestion). - Alignment data structure and lift-over functionality. - Clean up endomorphisms. Long term TODO list ------------------- o Ranges: - "match" for exact matching - operator aliases - ranges & ranges (pintersect) - ranges | ranges (punion) - !ranges (gaps) - ranges - ranges (psetdiff) - ranges +/- x (expand both sides) - permute or something to create a random mimic o RangesList: - parallel rbind - binary ops: "nearest", "intersect", "setdiff", "union" - 'y' omitted: become n-ary ops on items in collection - 'y' specified: performed element-wise - unary ops: "coverage" etc are vectorized * as a subset specification for BSGenome objects (get sequences out) - as XStringSet? o DataTable: - group generics (Math, Ops, Summary) o RangedData: - 'merge' for SQL-type join operations based on range overlap - "rangeQuantiles", "rangeMins", "rangeMaxs", "rangeSums" - could support radius for smoothing o SplitDataFrameList: - rbind o FilterRules: - refactor, using ShortRead filter framework (becomes FilterList) - support subsetting DataFrame/RangedData directly o rdapply: - probably need to add 'excludePattern' parameter o IO: - xscan() - read data directly into XVector objects - move chain reading to rtracklayer ------------------------------------- Conceptual framework (by Michael) ------------------------------------- [Herve: This might be slightly out-of-sync. Would be good to revisit/update.] We need to construct a conceptual framework around the current functionality in IRanges, so that we can eliminate redundancies and better plan for the future. Basic problem: We have lots of (long) data series and need a way to efficiently represent and manipulate them. A series is a vector, except that the positions of the elements are meaningful. That is, we often expect strong auto-correlation. We have an abstraction called "Vector" for representing these series. There are currently two optimized means of storing long series: 1) Externally, currently only in memory, in XVector derivatives. The main benefit here is avoiding unnecessary copying, though there is potential for vectors stored in databases and flat files on disk (but this is outside our use case). 2) Run-length encoding (Rle class). This is a classic means of compressing discrete-valued series. It is very efficient, as long as there are long runs of equal value. Rle, so far, is far ahead of XVector in terms of direct usefulness. If XVector were implemented with an environment, rather than an external pointer, adding functionality would be easier. Could carry some things over from externalVector. As the sequence of observations in a series is important, we often want to manipulate specific regions of the series. We can use the window() function to select a particular region from a Vector, and a logical Rle can represent a selection of multiple regions. A slightly more general representation, that supports overlapping regions, is the Ranges class. (Is there a function for converting a logical Rle to a Ranges? Would be a quick way to reimplement slice().) A Ranges object holds any number of start,width pairs that describe closed intervals representing the set of integers that fall within the endpoints. The primary implementation is IRanges, which stores the information as two integer vectors. The IntervalTree class is a tree representation of Ranges. Often the endpoints of the intervals are interesting independent of the underlying sequence. Many utilities are implemented for manipulating and analyzing Ranges. These include: 1) overlap detection, using an interval tree 2) nearest neighbors: precede, follow, nearest 3) set operations: (p)union, (p)intersect, (p)setdiff, gaps 4) coverage, too bio specific? rename to 'table'? 5) resolving overlap: reduce and (soon) collapse 6) transformations: flank, reflect, restrict, narrow... 7) (soon) mapping/alignment There are two ways to explicitly pair a Ranges object with a Vector: 1) Masking, as in MaskedXString, where only the elements outside of the Ranges are considered by an operation. 2) Views, which are essentially lists of subsequences. This relies in the fly-weight pattern for efficiency. Several fast paths, like viewSums and viewMaxs, are implemented. There is an RleViews and an XIntegerViews (is this one currently used at all?). Views are limited to subsequences derived from a single sequence. For more general lists of sequences, we have a separate framework, based on the TypedList class (rename to List?). The TypedList optionally ensures that all of its elements are derived from a specified type, and it also aims to efficiently represent a major use case of lists: splitting a vector by a factor. The indices of the elements with each factor level are stored, but there is no physical split of the vector into separate list elements. It may be that (Typed)List and general derivatives like AnnotatedList, which adds metadata on the elements, belong in the "Vector" package proposed above. A special case that often occurs in data analysis is a list containing a set of variables in the same dataset. This problem is solved by 'data.frame' in base R, and we have an equivalent DataFrame class (rename to DataFrame?) that can hold any type of R object, as long as it has a vector semantic. This probably also belongs in the Vector package. Many of the important data structures have TypedList analogs. These include all atomic types, as well as: * SplitDataFrameList: a list of DataFrames that have the same columns (usually the result of a split), could be in Vector * RangesList: Essentially just a list of Ranges objects, but often used for splitting Ranges by their "space" (e.g. chromosome) Note that MaskCollection (a set of Ranges used to mask the same series) is not a TypedList, but probably should be. When working with series, the records correspond to subseries of some larger series. The RangedData class associates variables with a set of subseries encoded by a RangesList object. Thus, it stores data on intervals across multiple spaces. It can be said that RangedData sits at the top of the IRanges infrastructure. IRanges/build/0000755000126300012640000000000012234075662014573 5ustar00biocbuildphs_compbioIRanges/build/vignette.rds0000644000126300012640000000037112234075662017133 0ustar00biocbuildphs_compbio‹…PË Â0ŒM­/Å›§|AÿAA<(¥¯¡‰Ô¤¤ÑâÍ/·nÛ´ôqð}ÌîÌ9OBÂð %^Aðà- ÜEÈ«}@å•'Ç×/ÁS?©̓;µˆnI¶yë${i´bÏÈ%‰QÄJUÊ@'¡ˆB%#¥Ð¿ã1»ôç`›·ì™¶ƒYÃr®_pJ.jä&>°TÏšo£r4”ôQïytwíB(LÝàÓvgËAår´å1—¬ú¨ñ¿S¥¡ošh•úÕ±ynù!˲o×Qt§I×ù”QCý‹>tßcö·D IRanges/inst/0000755000126300012640000000000012227064501014441 5ustar00biocbuildphs_compbioIRanges/inst/doc/0000755000126300012640000000000012234075662015216 5ustar00biocbuildphs_compbioIRanges/inst/doc/IRangesOverview.R0000644000126300012640000003511512234075661020424 0ustar00biocbuildphs_compbio### R code from vignette source 'IRangesOverview.Rnw' ################################################### ### code chunk number 1: options ################################################### options(width=72) ################################################### ### code chunk number 2: biocLite (eval = FALSE) ################################################### ## source("http://bioconductor.org/biocLite.R") ## biocLite("IRanges") ################################################### ### code chunk number 3: initialize ################################################### library(IRanges) ################################################### ### code chunk number 4: initialize ################################################### set.seed(0) lambda <- c(rep(0.001, 4500), seq(0.001, 10, length = 500), seq(10, 0.001, length = 500)) xVector <- rpois(1e7, lambda) yVector <- rpois(1e7, lambda[c(251:length(lambda), 1:250)]) ################################################### ### code chunk number 5: basic-ops ################################################### length(xVector) xVector[1] zVector <- c(xVector, yVector) ################################################### ### code chunk number 6: seq-extraction ################################################### xSnippet <- window(xVector, start = 4751, end = 4760) xSnippet head(xSnippet) tail(xSnippet) rev(xSnippet) rep(xSnippet, 2) window(xSnippet, delta = 2) subset(xSnippet, xSnippet >= 5L) ################################################### ### code chunk number 7: seq-combine ################################################### c(xSnippet, rev(xSnippet)) append(xSnippet, xSnippet, after = 3) ################################################### ### code chunk number 8: aggregate ################################################### xSnippet aggregate(xSnippet, start = 1:8, width = 3, FUN = median) ################################################### ### code chunk number 9: shiftApply-cor ################################################### cor(xVector, yVector) shifts <- seq(235, 265, by=3) corrs <- shiftApply(shifts, yVector, xVector, FUN = cor) ################################################### ### code chunk number 10: figshiftcorrs ################################################### plot(shifts, corrs) ################################################### ### code chunk number 11: Rle-construction ################################################### xRle <- Rle(xVector) yRle <- Rle(yVector) xRle yRle ################################################### ### code chunk number 12: Rle-vector-compare ################################################### as.vector(object.size(xRle) / object.size(xVector)) identical(as.vector(xRle), xVector) ################################################### ### code chunk number 13: Rle-accessors ################################################### head(runValue(xRle)) head(runLength(xRle)) ################################################### ### code chunk number 14: Rle-ops ################################################### xRle > 0 xRle + yRle xRle > 0 | yRle > 0 ################################################### ### code chunk number 15: Rle-summary ################################################### range(xRle) sum(xRle > 0 | yRle > 0) ################################################### ### code chunk number 16: Rle-math ################################################### log1p(xRle) ################################################### ### code chunk number 17: Rle-cor ################################################### cor(xRle, yRle) shiftApply(249:251, yRle, xRle, FUN = function(x, y) var(x, y) / (sd(x) * sd(y))) ################################################### ### code chunk number 18: list-intro ################################################### getClassDef("RleList") ################################################### ### code chunk number 19: list-construct ################################################### args(IntegerList) cIntList1 <- IntegerList(x = xVector, y = yVector) cIntList1 sIntList2 <- IntegerList(x = xVector, y = yVector, compress = FALSE) sIntList2 ## sparse integer list xExploded <- lapply(xVector[1:5000], function(x) seq_len(x)) cIntList2 <- IntegerList(xExploded) sIntList2 <- IntegerList(xExploded, compress = FALSE) object.size(cIntList2) object.size(sIntList2) ################################################### ### code chunk number 20: list-length ################################################### length(cIntList2) Rle(elementLengths(cIntList2)) ################################################### ### code chunk number 21: list-lapply ################################################### system.time(sapply(xExploded, mean)) system.time(sapply(sIntList2, mean)) system.time(sapply(cIntList2, mean)) identical(sapply(xExploded, mean), sapply(sIntList2, mean)) identical(sapply(xExploded, mean), sapply(cIntList2, mean)) ################################################### ### code chunk number 22: list-groupgenerics ################################################### xRleList <- RleList(xRle, 2L * rev(xRle)) yRleList <- RleList(yRle, 2L * rev(yRle)) xRleList > 0 xRleList + yRleList sum(xRleList > 0 | yRleList > 0) ################################################### ### code chunk number 23: list-endoapply ################################################### safe.max <- function(x) { if(length(x)) max(x) else integer(0) } endoapply(sIntList2, safe.max) endoapply(cIntList2, safe.max) endoapply(sIntList2, safe.max)[[1]] ################################################### ### code chunk number 24: iranges-constructor ################################################### ir1 <- IRanges(start = 1:10, width = 10:1) ir2 <- IRanges(start = 1:10, end = 11) ir3 <- IRanges(end = 11, width = 10:1) identical(ir1, ir2) & identical(ir2, ir3) ir <- IRanges(c(1, 8, 14, 15, 19, 34, 40), width = c(12, 6, 6, 15, 6, 2, 7)) ################################################### ### code chunk number 25: iranges-start ################################################### start(ir) ################################################### ### code chunk number 26: iranges-end ################################################### end(ir) ################################################### ### code chunk number 27: iranges-width ################################################### width(ir) ################################################### ### code chunk number 28: iranges-subset-numeric ################################################### ir[1:4] ################################################### ### code chunk number 29: iranges-subset-logical ################################################### ir[start(ir) <= 15] ################################################### ### code chunk number 30: ranges-extraction ################################################### ir[[1]] ################################################### ### code chunk number 31: plotRanges ################################################### plotRanges <- function(x, xlim = x, main = deparse(substitute(x)), col = "black", sep = 0.5, ...) { height <- 1 if (is(xlim, "Ranges")) xlim <- c(min(start(xlim)), max(end(xlim))) bins <- disjointBins(IRanges(start(x), end(x) + 1)) plot.new() plot.window(xlim, c(0, max(bins)*(height + sep))) ybottom <- bins * (sep + height) - height rect(start(x)-0.5, ybottom, end(x)+0.5, ybottom + height, col = col, ...) title(main) axis(1) } ################################################### ### code chunk number 32: ir-plotRanges ################################################### plotRanges(ir) ################################################### ### code chunk number 33: ranges-reduce ################################################### reduce(ir) plotRanges(reduce(ir)) ################################################### ### code chunk number 34: rangeslist-contructor ################################################### rl <- RangesList(ir, rev(ir)) ################################################### ### code chunk number 35: rangeslist-start ################################################### start(rl) ################################################### ### code chunk number 36: bracket-ranges ################################################### irextract <- IRanges(start = c(4501, 4901) , width = 100) xRle[irextract] ################################################### ### code chunk number 37: overlap-ranges ################################################### ol <- findOverlaps(ir, reduce(ir)) as.matrix(ol) ################################################### ### code chunk number 38: ranges-coverage ################################################### cov <- coverage(ir) plotRanges(ir) cov <- as.vector(cov) mat <- cbind(seq_along(cov)-0.5, cov) d <- diff(cov) != 0 mat <- rbind(cbind(mat[d,1]+1, mat[d,2]), mat) mat <- mat[order(mat[,1]),] lines(mat, col="red", lwd=4) axis(2) ################################################### ### code chunk number 39: ranges-shift ################################################### shift(ir, 10) ################################################### ### code chunk number 40: ranges-plus ################################################### ir + seq_len(length(ir)) ################################################### ### code chunk number 41: ranges-asterisk ################################################### ir * -2 # half the width ################################################### ### code chunk number 42: ranges-narrow ################################################### narrow(ir, start=1:5, width=2) ################################################### ### code chunk number 43: ranges-threebands ################################################### threebands(ir, start=1:5, width=2) ################################################### ### code chunk number 44: ranges-restrict ################################################### restrict(ir, start=2, end=3) ################################################### ### code chunk number 45: ranges-disjoin ################################################### disjoin(ir) plotRanges(disjoin(ir)) ################################################### ### code chunk number 46: ranges-disjointBins ################################################### disjointBins(ir) ################################################### ### code chunk number 47: ranges-reflect ################################################### reflect(ir, IRanges(start(ir), width=width(ir)*2)) ################################################### ### code chunk number 48: ranges-flank ################################################### flank(ir, width = seq_len(length(ir))) ################################################### ### code chunk number 49: ranges-gaps ################################################### gaps(ir, start=1, end=50) plotRanges(gaps(ir, start=1, end=50), c(1,50)) ################################################### ### code chunk number 50: ranges-pgap ################################################### ################################################### ### code chunk number 51: ranges-union ################################################### ################################################### ### code chunk number 52: ranges-punion ################################################### ################################################### ### code chunk number 53: ranges-intersect ################################################### ################################################### ### code chunk number 54: ranges-pintersect ################################################### ################################################### ### code chunk number 55: ranges-setdiff ################################################### ################################################### ### code chunk number 56: ranges-psetdiff ################################################### ################################################### ### code chunk number 57: Views-constructors ################################################### xViews <- Views(xRle, xRle >= 1) xViews <- slice(xRle, 1) xViewsList <- slice(xRleList, 1) ################################################### ### code chunk number 58: views-looping ################################################### head(viewSums(xViews)) viewSums(xViewsList) head(viewMaxs(xViews)) viewMaxs(xViewsList) ################################################### ### code chunk number 59: RangedData-construct ################################################### values <- rnorm(length(ir)) rd <- RangedData(ir, name = letters[seq_len(length(ir))], values) rd ################################################### ### code chunk number 60: RangedData-construct-space ################################################### rd <- RangedData(ir, name = letters[seq_len(length(ir))], values, space = rep(c("chr1", "chr2"), c(3, length(ir) - 3))) rd ################################################### ### code chunk number 61: RangedData-ranges ################################################### ranges(rd) ################################################### ### code chunk number 62: RangedData-values ################################################### values(rd) ################################################### ### code chunk number 63: RangedData-subspace ################################################### rd["chr1"] ################################################### ### code chunk number 64: RangedData-subspace-2 ################################################### all(identical(rd["chr1"], rd[1]), identical(rd[1], rd[c(TRUE, FALSE)])) ################################################### ### code chunk number 65: RangedData-names ################################################### names(rd) ################################################### ### code chunk number 66: RangedData-length ################################################### length(rd) ################################################### ### code chunk number 67: RangedData-lapply ################################################### lapply(rd, names) ################################################### ### code chunk number 68: RangedData-extract ################################################### rd[[2]] ################################################### ### code chunk number 69: RangedData-dollar ################################################### rd$values ################################################### ### code chunk number 70: RangedData-subset-2d ################################################### rd[1:3, "name"] ################################################### ### code chunk number 71: sessionInfo ################################################### toLatex(sessionInfo()) IRanges/inst/doc/IRangesOverview.Rnw0000644000126300012640000010314312227064501020757 0ustar00biocbuildphs_compbio%\VignetteIndexEntry{An Introduction to IRanges} %\VignetteDepends{} %\VignetteKeywords{Ranges} %\VignettePackage{IRanges} \documentclass[10pt]{article} \usepackage{times} \usepackage{hyperref} \textwidth=6.5in \textheight=8.5in %\parskip=.3cm \oddsidemargin=-.1in \evensidemargin=-.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\Rcode}[1]{{\texttt{#1}}} \newcommand{\software}[1]{\textsf{#1}} \newcommand{\R}{\software{R}} \newcommand{\IRanges}{\Rpackage{IRanges}} \title{An Introduction to \IRanges{}} \author{Patrick Aboyoun, Michael Lawrence, Herv\'e Pag\`es} \date{\today} \begin{document} \maketitle <>= options(width=72) @ \section{Introduction} The \IRanges{} package is designed to represent sequences, ranges representing indices along those sequences, and data related to those ranges. In this vignette, we will rely on simple, illustrative example datasets, rather than large, real-world data, so that each data structure and algorithm can be explained in an intuitive, graphical manner. We expect that packages that apply \IRanges{} to a particular problem domain will provide vignettes with relevant, realistic examples. The \IRanges{} package is available at bioconductor.org and can be downloaded via \Rfunction{biocLite}: <>= source("http://bioconductor.org/biocLite.R") biocLite("IRanges") @ <>= library(IRanges) @ \section{Vector objects} In the context of the \IRanges{} package, a sequence is an ordered finite collection of elements. The \IRanges{} packages represents two types of objects as sequences: (1) atomic sequences and (2) lists (or non-atomic sequences). The following subsections describe each in turn. All \IRanges{}-derived sequences inherit from the \Rclass{Vector} virtual class. \subsection{Atomic Vectors} In \R{}, atomic sequences are typically stored in atomic vectors. The \IRanges{} package includes an additional atomic sequence object type, \Rclass{Rle}, which compresses an atomic sequence through run-length encoding. We begin our discussion of atomic sequences using two \R{} \Rclass{integer} vectors. <>= set.seed(0) lambda <- c(rep(0.001, 4500), seq(0.001, 10, length = 500), seq(10, 0.001, length = 500)) xVector <- rpois(1e7, lambda) yVector <- rpois(1e7, lambda[c(251:length(lambda), 1:250)]) @ All atomic sequences in \R{} have three main properties: (1) a notion of length or number of elements, (2) the ability to extract elements to create new atomic sequences, and (3) the ability to be combined with one or more atomic sequences to form larger atomic sequences. The main functions for these three operations are \Rfunction{length}, \Rfunction{[}, and \Rfunction{c}. <>= length(xVector) xVector[1] zVector <- c(xVector, yVector) @ While these three methods may seem trivial, they provide a great deal of power and many atomic sequence manipulations can be constructed using them. \subsubsection{Vector Subsetting} As with ordinary \R{} atomic vectors, it is often necessary to subset one sequence from another. When this subsetting does not duplicate or reorder the elements being extracted, the result is called a \textit{subsequence}. In general, the \Rfunction{[} function can be used to construct a new sequence or extract a subsequence, but its interface is often inconvenient and not amenable to optimization. To compensate for this, the \IRanges{} package supports seven additional functions for sequence extraction: \begin{enumerate} \item \Rfunction{window} - Produces a subsequence over a specified region with or without regular interval subsampling. \item \Rfunction{subset} - Extracts the subsequence specified by a logical vector. \item \Rfunction{head} - Extracts a consecutive subsequence containing the first n elements. \item \Rfunction{tail} - Extracts a consecutive subsequence containing the last n elements. \item \Rfunction{rev} - Creates a new sequence with the elements in the reverse order. \item \Rfunction{rep} - Creates a new sequence by repeating sequence elements. \end{enumerate} The following code illustrates how these functions are used on an ordinary \R{} \Rclass{integer} vector: <>= xSnippet <- window(xVector, start = 4751, end = 4760) xSnippet head(xSnippet) tail(xSnippet) rev(xSnippet) rep(xSnippet, 2) window(xSnippet, delta = 2) subset(xSnippet, xSnippet >= 5L) @ \subsubsection{Combining Vectors} The \IRanges{} package uses two generic functions, \Rfunction{c} and \Rfunction{append}, for combining two \Rclass{Vector} objects. The methods for \Rclass{Vector} objects follow the definition that these two functions are given the the \Rpackage{base} package. <>= c(xSnippet, rev(xSnippet)) append(xSnippet, xSnippet, after = 3) @ \subsubsection{Looping over Vectors and Vector subsets} In \R{}, \Rfunction{for} looping can be an expensive operation. To compensate for this, \IRanges{} uses three generics, \Rfunction{endoapply}, \Rfunction{lapply}, and \Rfunction{sapply}, for looping over sequences and two generics, \Rfunction{aggregate} and \Rfunction{shiftApply}, to perform calculations over subsequences. The \Rfunction{lapply} and \Rfunction{sapply} functions are familiar to many \R{} users since they are the standard functions for looping over the elements of an \R{} \Rclass{list} object. The \Rfunction{endoapply} function performs an endomorphism equivalent to \Rfunction{lapply}, i.e. returns a \Rclass{Vector} object of the same class as the input rather than a \Rclass{list} object. More will be given on these three functions in the Lists subsection. The \Rfunction{aggregate} function combines sequence extraction functionality of the \Rfunction{window} function with looping capabilities of the \Rfunction{sapply} function. For example, here is some code to compute medians across a moving window of width 3 using the function \Rfunction{aggregate}: <>= xSnippet aggregate(xSnippet, start = 1:8, width = 3, FUN = median) @ The \Rfunction{shiftApply} function is a looping operation involving two sequences whose elements are lined up via a positional shift operation. For example, the elements of \Robject{xVector} and \Robject{yVector} were simulated from Poisson distributions with the mean of element i from \Robject{yVector} being equivalent to the mean of element i + 250 from \Robject{xVector}. If we did not know the size of the shift, we could estimate it by finding the shift that maximizes the correlation between \Robject{xVector} and \Robject{yVector}. <>= cor(xVector, yVector) shifts <- seq(235, 265, by=3) corrs <- shiftApply(shifts, yVector, xVector, FUN = cor) @ % <>= plot(shifts, corrs) @ The result is shown in Fig.~\ref{figshiftcorrs}. \begin{figure}[tb] \begin{center} \includegraphics[width=0.5\textwidth]{IRangesOverview-figshiftcorrs} \caption{\label{figshiftcorrs}% Correlation between \Robject{xVector} and \Robject{yVector} for various shifts.} \end{center} \end{figure} \subsubsection{Run Length Encoding} Up until this point we have used \R{} atomic vectors to represent atomic sequences, but there are times when these object become too large to manage in memory. When there are lots of consecutive repeats in the sequence, the data can be compressed and managed in memory through a run-length encoding where a data value is paired with a run length. For example, the sequence \{1, 1, 1, 2, 3, 3\} can be represented as values = \{1, 2, 3\}, run lengths = \{3, 1, 2\}. The \Rclass{Rle} class in \IRanges{} is used to represent a run-length encoded (compressed) sequence of \Rclass{logical}, \Rclass{integer}, \Rclass{numeric}, \Rclass{complex}, \Rclass{character}, or \Rclass{raw} values. One way to construct an \Rclass{Rle} object is through the \Rclass{Rle} constructor function: <>= xRle <- Rle(xVector) yRle <- Rle(yVector) xRle yRle @ When there are lots of consecutive repeats, the memory savings through an RLE can be quite dramatic. For example, the \Robject{xRle} object occupies less than one quarter of the space of the original \Robject{xVector} object, while storing the same information: <>= as.vector(object.size(xRle) / object.size(xVector)) identical(as.vector(xRle), xVector) @ The functions \Rfunction{runValue} and \Rfunction{runLength} extract the run values and run lengths from an \Rclass{Rle} object respectively: <>= head(runValue(xRle)) head(runLength(xRle)) @ The \Rclass{Rle} class supports many of the basic methods associated with \R{} atomic vectors including the Ops, Math, Math2, Summary, and Complex group generics. Here is a example of manipulating \Rclass{Rle} objects using methods from the Ops group: <>= xRle > 0 xRle + yRle xRle > 0 | yRle > 0 @ Here are some from the Summary group: <>= range(xRle) sum(xRle > 0 | yRle > 0) @ And here is one from the Math group: <>= log1p(xRle) @ As with the atomic vectors, the \Rfunction{cor} and \Rfunction{shiftApply} functions operate on \Rclass{Rle} objects: <>= cor(xRle, yRle) shiftApply(249:251, yRle, xRle, FUN = function(x, y) var(x, y) / (sd(x) * sd(y))) @ For more information on the methods supported by the \Rclass{Rle} class, consult the \Rcode{Rle} man page. \subsection{Lists} In many data analysis situation there is a desire to organize and manipulate multiple objects simultaneously. Typically this is done in \R{} through the usage of a list. While a list serves as a generic container, it does not confer any information about the specific class of its elements, provides no infrastructure to ensure type safety, and the S3 and S4 method dispatch mechanisms do not support method selection for lists with homogeneous object types. The \Rclass{List} virtual class defined in the \IRanges{} package addresses these issues. \Rclass{List} is a direct extension of \Rclass{Vector}. \subsubsection{Lists of Atomic Vectors} The first type of lists we consider are those containing atomic sequences such as \Rclass{integer} vectors or \Rclass{Rle} objects. We may wish to define a method that retrieves the length of each atomic sequence element, without special type checking. To enable this, we define collection classes such as \Rclass{IntegerList} and \Rclass{RleList}, which inherit from the \Rclass{List} virtual class, for representing lists of \Rclass{integer} vectors and \Rclass{Rle} objects respectively. <>= getClassDef("RleList") @ As the class definition above shows, the \Rclass{RleList} class is virtual with subclasses \Rclass{SimpleRleList} and \Rclass{CompressedRleList}. A \Rclass{SimpleRleList} class uses a regular \R{} list to store the underlying elements and the \Rclass{CompressedRleList} class stores the elements in an unlisted form and keeps track of where the element breaks are. The former ``simple list" class is useful when the Rle elements are long and the latter ``compressed list" class is useful when the list is long and/or sparse (i.e. a number of the list elements have length 0). In fact, all of the atomic vector types (raw, logical, integer, numeric, complex, and character) have similar list classes that derive from the \Rclass{List} virtual class. For example, there is an \Rclass{IntegerList} virtual class with subclasses \Rclass{SimpleIntegerList} and \Rclass{CompressedIntegerList}. Each of the list classes for atomic sequences, be they stored as vectors or \Rclass{Rle} objects, have a constructor function with a name of the appropriate list virtual class, such as \Rclass{IntegerList}, and an optional argument \Rfunarg{compress} that takes an argument to specify whether or not to create the simple list object type or the compressed list object type. The default is to create the compressed list object type. <>= args(IntegerList) cIntList1 <- IntegerList(x = xVector, y = yVector) cIntList1 sIntList2 <- IntegerList(x = xVector, y = yVector, compress = FALSE) sIntList2 ## sparse integer list xExploded <- lapply(xVector[1:5000], function(x) seq_len(x)) cIntList2 <- IntegerList(xExploded) sIntList2 <- IntegerList(xExploded, compress = FALSE) object.size(cIntList2) object.size(sIntList2) @ The \Rfunction{length} function returns the number of elements in a \Rclass{Vector}-derived object and, for a \Rclass{List}-derived object like ``simple list" or ``compressed list", the \Rfunction{elementLengths} function returns an integer vector containing the lengths of each of the elements: <>= length(cIntList2) Rle(elementLengths(cIntList2)) @ Just as with ordinary \R{} \Rclass{list} objects, \Rclass{List}-derived object support the \Rfunction{[[} for element extraction, \Rfunction{c} for combining, and \Rfunction{lapply}/\Rfunction{sapply} for looping. When looping over sparse lists, the ``compressed list" classes can be much faster during computations since only the non-empty elements are looped over during the \Rfunction{lapply}/\Rfunction{sapply} computation and all the empty elements are assigned the appropriate value based on their status. <>= system.time(sapply(xExploded, mean)) system.time(sapply(sIntList2, mean)) system.time(sapply(cIntList2, mean)) identical(sapply(xExploded, mean), sapply(sIntList2, mean)) identical(sapply(xExploded, mean), sapply(cIntList2, mean)) @ Unlist ordinary \R{} \Rclass{list} objects, \Rclass{AtomicList} objects support the \Rfunction{Ops} (e.g. \Rfunction{+}, \Rfunction{==}, \Rfunction{\&}), \Rfunction{Math} (e.g. \Rfunction{log}, \Rfunction{sqrt}), \Rfunction{Math2} (e.g. \Rfunction{round}, \Rfunction{signif}), \Rfunction{Summary} (e.g. \Rfunction{min}, \Rfunction{max}, \Rfunction{sum}), and \Rfunction{Complex} (e.g. \Rfunction{Re}, \Rfunction{Im}) group generics. <>= xRleList <- RleList(xRle, 2L * rev(xRle)) yRleList <- RleList(yRle, 2L * rev(yRle)) xRleList > 0 xRleList + yRleList sum(xRleList > 0 | yRleList > 0) @ Since these atomic lists inherit from \Rclass{List}, they can also use the looping function \Rfunction{endoapply} to perform endomorphisms. <>= safe.max <- function(x) { if(length(x)) max(x) else integer(0) } endoapply(sIntList2, safe.max) endoapply(cIntList2, safe.max) endoapply(sIntList2, safe.max)[[1]] @ \section{Data Tables} To Do: \Rclass{DataTable}, \Rclass{DataFrame}, \Rclass{DataFrameList}, \Rclass{SplitDataFrameList} \section{Vector Annotations} Often when one has a collection of objects, there is a need to attach metadata that describes the collection in some way. Two kinds of metadata can be attached to a \Rclass{Vector} object: \begin{enumerate} \item Metadata about the object as a whole: this metadata is accessed via the \Rfunction{metadata} accessor and is represented as an ordinary \Rclass{list}; \item Metadata about the individual elements of the object: this metadata is accessed via the \Rfunction{mcols} accessor (\Rfunction{mcols} stands for {\it metadata columns}) and is represented as a \Rclass{DataTable} object (i.e. as an instance of a concrete subclass of \Rclass{DataTable}, e.g. a \Rclass{DataFrame} object). This \Rclass{DataTable} object can be thought of as the result of binding together one or several vector-like objects (the metadata columns) of the same length as the \Rclass{Vector} object. Each row of the \Rclass{DataTable} object annotates the corresponding element of the \Rclass{Vector} object. \end{enumerate} \section{Vector Ranges} When analyzing sequences, we are often interested in particular consecutive subsequences. For example, the \Sexpr{letters} vector could be considered a sequence of lower-case letters, in alphabetical order. We would call the first five letters (\textit{a} to \textit{e}) a consecutive subsequence, while the subsequence containing only the vowels would not be consecutive. It is not uncommon for an analysis task to focus only on the geometry of the regions, while ignoring the underlying sequence values. A list of indices would be a simple way to select a subsequence. However, a sparser representation for consecutive subsequences would be a range, a pairing of a start position and a width, as used when extracting sequences with \Rfunction{window} above. When analyzing subsequences in \IRanges{}, each range is treated as an observation. The virtual \Rclass{Ranges} class represents lists of ranges, or, equivalently and as a derivative \Rclass{IntegerList}, sequences of consecutive integers. The most commonly used implementation of \Rclass{Ranges} is \Rclass{IRanges}, which stores the starts and widths as ordinary integer vectors. To construct an \Rclass{IRanges} instance, we call the \Rfunction{IRanges} constructor. Ranges are normally specified by passing two out of the three parameters: start, end and width (see \Rcode{help(IRanges)} for more information). % <>= ir1 <- IRanges(start = 1:10, width = 10:1) ir2 <- IRanges(start = 1:10, end = 11) ir3 <- IRanges(end = 11, width = 10:1) identical(ir1, ir2) & identical(ir2, ir3) ir <- IRanges(c(1, 8, 14, 15, 19, 34, 40), width = c(12, 6, 6, 15, 6, 2, 7)) @ % All of the above calls construct an \Rclass{IRanges} instance with the same ranges, using different combinations of the \Rfunarg{start}, \Rfunarg{end} and \Rfunarg{width} parameters. Accessing the starts, widths and ends is supported by every \Rclass{Ranges} implementation. <>= start(ir) @ <>= end(ir) @ <>= width(ir) @ For \Rclass{IRanges} and some other \Rclass{Ranges} derivatives, subsetting is also supported, by numeric and logical indices. <>= ir[1:4] @ <>= ir[start(ir) <= 15] @ One may think of each range as a sequence of integer ranges, and \Rclass{Ranges} is, in fact, derived from \Rclass{IntegerList}. <>= ir[[1]] @ In order to illustrate range operations, we'll create a function to plot ranges. <>= plotRanges <- function(x, xlim = x, main = deparse(substitute(x)), col = "black", sep = 0.5, ...) { height <- 1 if (is(xlim, "Ranges")) xlim <- c(min(start(xlim)), max(end(xlim))) bins <- disjointBins(IRanges(start(x), end(x) + 1)) plot.new() plot.window(xlim, c(0, max(bins)*(height + sep))) ybottom <- bins * (sep + height) - height rect(start(x)-0.5, ybottom, end(x)+0.5, ybottom + height, col = col, ...) title(main) axis(1) } @ <>= plotRanges(ir) @ \begin{figure}[tb] \begin{center} \includegraphics[width=0.5\textwidth]{IRangesOverview-ir-plotRanges} \caption{\label{fig-ir-plotRanges}% Plot of original ranges.} \end{center} \end{figure} \subsection{Normality} Sometimes, it is necessary to formally represent a subsequence, where no elements are repeated and order is preserved. Also, it is occasionally useful to think of a \Rclass{Ranges} object as a set, where no elements are repeated and order does not matter. While every \Rclass{Ranges} object, as a \Rclass{Vector} derivative, has an implicit ordering, one can enforce the same ordering for all such objects, so that ordering becomes inconsequential within that context. The \Rclass{NormalIRanges} class formally represents either a subsequence encoding or a set of integers. By definition a Ranges object is said to be \textit{normal} when its ranges are: (a) not empty (i.e. they have a non-null width); (b) not overlapping; (c) ordered from left to right; (d) not even adjacent (i.e. there must be a non empty gap between 2 consecutive ranges). There are three main advantages of using a \textit{normal} \Rclass{Ranges} object: (1) it guarantees a subsequence encoding or set of integers, (2) it is compact in terms of the number of ranges, and (3) it uniquely identifies its information, which simplifies comparisons. The \Rfunction{reduce} function reduces any \Rclass{Ranges} object to a \Rclass{NormalIRanges} by merging redundant ranges. <>= reduce(ir) plotRanges(reduce(ir)) @ \begin{figure}[tb] \begin{center} \includegraphics[width=0.5\textwidth]{IRangesOverview-ranges-reduce} \caption{\label{fig-ranges-reduce}% Plot of reduced ranges.} \end{center} \end{figure} \subsection{Lists of \Rclass{Ranges} objects} It is common to manipulate collections of \Rclass{Ranges} objects during an analysis. Thus, the \IRanges{} package defines some specific classes for working with multiple \Rclass{Ranges} objects. The \Rclass{RangesList} class asserts that each element is a \Rclass{Ranges} object and provides convenience methods, such as \Rfunction{start}, \Rfunction{end} and \Rfunction{width} accessors that return \Rclass{IntegerList} objects, aligning with the \Rclass{RangesList} object. To explicitly construct a \Rclass{RangesList}, use the \Rfunction{RangesList} function. <>= rl <- RangesList(ir, rev(ir)) @ % <>= start(rl) @ \subsection{Vector Extraction} As the elements of a \Rclass{Ranges} object encode consecutive subsequences, they may be used directly in sequence extraction. Note that when a \textit{normal} \Rclass{Ranges} is given as the index, the result is a subsequence, as no elements are repeated or reordered. If the sequence is a \Rclass{Vector} subclass (i.e. not an ordinary \Rclass{vector}), the canonical \Rfunction{[} function accepts a \Rclass{Ranges} instance. % <>= irextract <- IRanges(start = c(4501, 4901) , width = 100) xRle[irextract] @ % \subsection{Finding Overlapping Ranges} The function \Rfunction{findOverlaps} detects overlaps between two \Rclass{Ranges} objects. <>= ol <- findOverlaps(ir, reduce(ir)) as.matrix(ol) @ \subsection{Counting Overlapping Ranges} The function \Rfunction{coverage} counts the number of ranges over each position. <>= cov <- coverage(ir) plotRanges(ir) cov <- as.vector(cov) mat <- cbind(seq_along(cov)-0.5, cov) d <- diff(cov) != 0 mat <- rbind(cbind(mat[d,1]+1, mat[d,2]), mat) mat <- mat[order(mat[,1]),] lines(mat, col="red", lwd=4) axis(2) @ \begin{figure}[tb] \begin{center} \includegraphics[width=0.5\textwidth]{IRangesOverview-ranges-coverage} \caption{\label{fig-ranges-coverage}% Plot of ranges with accumulated coverage.} \end{center} \end{figure} \subsection{Finding Neighboring Ranges} The \Rfunction{nearest} function finds the nearest neighbor ranges (overlapping is zero distance). The \Rfunction{precede} and \Rfunction{follow} functions find the non-overlapping nearest neighbors on a specific side. \subsection{Transforming Ranges} Utilities are available for transforming a \Rclass{Ranges} object in a variety of ways. Some transformations, like \Rfunction{reduce} introduced above, can be dramatic, while others are simple per-range adjustments of the starts, ends or widths. \subsubsection{Adjusting starts, ends and widths} Perhaps the simplest transformation is to adjust the start values by a scalar offset, as performed by the \Rfunction{shift} function. Below, we shift all ranges forward 10 positions. % <>= shift(ir, 10) @ The arithmetic functions \Rfunction{+}, \Rfunction{-} and \Rfunction{*} change both the start and the end/width by symmetrically expanding or contracting each range. Adding or subtracting a numeric (integer) vector to a \Rclass{Ranges} causes each range to be expanded or contracted on each side by the corresponding value in the numeric vector. <>= ir + seq_len(length(ir)) @ % The \Rfunction{*} operator symmetrically magnifies a \Rclass{Ranges} object by a factor, where positive contracts (zooms in) and negative expands (zooms out). % <>= ir * -2 # half the width @ There are several other ways to form subranges, besides symmetric contraction. These include \Rfunction{narrow}, \Rfunction{threebands} and \Rfunction{restrict}. \Rfunction{narrow} supports the adjustment of start, end and width values, which should be relative to each range. Unlike \Rfunction{shift}, these adjustments are vectorized over the ranges. As its name suggests, the ranges can only be narrowed. % <>= narrow(ir, start=1:5, width=2) @ % The \Rfunction{threebands} function extends \Rfunction{narrow} so that the remaining left and right regions adjacent to the narrowed region are also returned in separate \Rclass{Ranges} objects. <>= threebands(ir, start=1:5, width=2) @ The \Rfunction{restrict} function ensures every range falls within a set of bounds. Ranges are contracted as necessary, and the ranges that fall completely outside of but not adjacent to the bounds are dropped, by default. <>= restrict(ir, start=2, end=3) @ \subsubsection{Making ranges disjoint} A more complex type of operation is making a set of ranges disjoint, \textit{i.e.} non-overlapping. For example, \Rfunction{threebands} returns a disjoint set of three ranges for each input range. The \Rfunction{disjoin} function makes a \Rclass{Ranges} object disjoint by fragmenting it into the widest ranges where the set of overlapping ranges is the same. <>= disjoin(ir) plotRanges(disjoin(ir)) @ \begin{figure}[tb] \begin{center} \includegraphics[width=0.5\textwidth]{IRangesOverview-ranges-disjoin} \caption{\label{fig-ranges-disjoin}% Plot of disjoined ranges.} \end{center} \end{figure} A variant of \Rfunction{disjoin} is \Rfunction{disjointBins}, which divides the ranges into bins, such that the ranges in each bin are disjoint. The return value is an integer vector of the bins. <>= disjointBins(ir) @ \subsubsection{Other transformations} Other transformations include \Rfunction{reflect} and \Rfunction{flank}. The former ``flips'' each range within a set of common reference bounds. <>= reflect(ir, IRanges(start(ir), width=width(ir)*2)) @ % The \Rfunction{flank} returns ranges of a specified width that flank, to the left (default) or right, each input range. One use case of this is forming promoter regions for a set of genes. <>= flank(ir, width = seq_len(length(ir))) @ % \subsection{Set Operations} Sometimes, it is useful to consider a \Rclass{Ranges} object as a set of integers, although there is always an implicit ordering. This is formalized by \Rclass{NormalIRanges}, above, and we now present versions of the traditional mathematical set operations \textit{complement}, \textit{union}, \textit{intersect}, and \textit{difference} for \Rclass{Ranges} objects. There are two variants for each operation. The first treats each \Rclass{Ranges} object as a set and returns a \textit{normal} value, while the other has a ``parallel'' semantic like \Rfunction{pmin}/\Rfunction{pmax} and performs the operation for each range pairing separately. The \textit{complement} operation is implemented by the \Rfunction{gaps} and \Rfunction{pgap} functions. By default, \Rfunction{gaps} will return the ranges that fall between the ranges in the (normalized) input. It is possible to specify a set of bounds, so that flanking ranges are included. <>= gaps(ir, start=1, end=50) plotRanges(gaps(ir, start=1, end=50), c(1,50)) @ \begin{figure}[tb] \begin{center} \includegraphics[width=0.5\textwidth]{IRangesOverview-ranges-gaps} \caption{\label{fig-ranges-gap}% Plot of gaps from ranges.} \end{center} \end{figure} \Rfunction{pgap} considers each parallel pairing between two \Rclass{Ranges} objects and finds the range, if any, between them. Note that the function name is singular, suggesting that only one range is returned per range in the input. <>= @ The remaining operations, \textit{union}, \textit{intersect} and \textit{difference} are implemented by the \Rfunction{[p]union}, \Rfunction{[p]intersect} and \Rfunction{[p]setdiff} functions, respectively. These are relatively self-explanatory. <>= @ <>= @ <>= @ <>= @ <>= @ <>= @ % \subsection{Mapping Ranges Between Vectors} % \Rclass{RangesMapping} % \Rfunction{map} \section{Vector Views} The \IRanges{} package provides the virtual \Rclass{Views} class, which stores a sequence together with an \Rclass{IRanges} object defining ranges on the sequence. Each range is said to represent a \textit{view} onto the sequence. Here, we will demonstrate the \Rclass{RleViews} class, where the sequence is of class \Rclass{Rle}. Other \Rclass{Views} implementations exist, such as \Rclass{XStringViews} in the \Rpackage{Biostrings} package. \subsection{Creating Views} There are two basic constructors for creating views: the \Rfunction{Views} function based on indicators and the \Rfunction{slice} based on numeric boundaries. <>= xViews <- Views(xRle, xRle >= 1) xViews <- slice(xRle, 1) xViewsList <- slice(xRleList, 1) @ \subsection{Aggregating Views} While \Rfunction{sapply} can be used to loop over each window, the native functions \Rfunction{viewMaxs}, \Rfunction{viewMins}, \Rfunction{viewSums}, and \Rfunction{viewMeans} provide fast looping to calculate their respective statistical summaries. <>= head(viewSums(xViews)) viewSums(xViewsList) head(viewMaxs(xViews)) viewMaxs(xViewsList) @ \section{Data on Ranges} When analyzing ranges, there are often additional variables of interest, besides the geometry (starts, ends and widths). To formally represent a dataset where the ranges are the observations, \IRanges{} defines the \Rclass{RangedData} class. %\subsection{Manipulating \Rclass{RangedData}} To create a \Rclass{RangedData} instance, one needs to provide a \Rclass{Ranges} object and, optionally, any number of variables on those ranges. The variable objects need not be vectors, but they must satisfy the contract of \Rclass{DataFrame}. <>= values <- rnorm(length(ir)) rd <- RangedData(ir, name = letters[seq_len(length(ir))], values) rd @ One might notice the term ``sequence'' in the above output. This refers to an important feature of \Rclass{RangedData}: the ability to segregate ranges by their sequence (or space). For example, when analyzing genomic data, one is often working with ranges on different chromosomes. In many cases, such as when calculating overlap, one needs to separately treat ranges from different spaces, and \Rclass{RangedData} aims to facilitate this mode of operation. The segregation may be performed at construction time. <>= rd <- RangedData(ir, name = letters[seq_len(length(ir))], values, space = rep(c("chr1", "chr2"), c(3, length(ir) - 3))) rd @ With the knowledge that the data is split into spaces, it should not be surprising that the \Rfunction{ranges} accessor returns a \Rclass{RangesList} and \Rfunction{values} returns a \Rclass{SplitDataFrameList}. <>= ranges(rd) @ <>= values(rd) @ To obtain a \Rclass{RangedData} for a specific set of spaces, one should use the \Rfunction{[} function, which accepts logical, numeric and character indices. <>= rd["chr1"] @ % <>= all(identical(rd["chr1"], rd[1]), identical(rd[1], rd[c(TRUE, FALSE)])) @ The \Rfunction{names} and \Rfunction{length} functions return the names and number of spaces, respectively. <>= names(rd) @ <>= length(rd) @ The \Rfunction{lapply} function operates over the spaces. The object passed to the user function is a subset \Rclass{RangedData}. <>= lapply(rd, names) @ The above would suggest that \Rclass{RangedData} is a sequence of spaces. However, \Rclass{RangedData} also inherits from \Rclass{DataTable}, so it in some ways behaves like a sequence of columns. For example, one can extract a column via \Rfunction{\$} or \Rfunction{[[}. <>= rd[[2]] @ <>= rd$values @ Note that the extracted columns are ``unlisted'' over the spaces, which is usually much more convenient than obtaining them as lists. It is important to note that the elements have been sorted by the space factor and thus may not have the same order as the objects passed to the constructor. The two dimensional matrix-style subsetting is also supported. The rows are indexed globally, independent of space. <>= rd[1:3, "name"] @ % \subsection{Applying Over Spaces} % \Rclass{RDApplyParams} % \Rclass{FilterRules} \section{IRanges in Biological Sequence Analysis} The \IRanges{} packages was primarily designed with biological sequence analysis in mind and Table \ref{table:bioseq} shows how some biological sequence analysis concepts are represented in the \IRanges{} class system. \begin{table}[ht] \begin{center} \begin{tabular}{l|l} \hline Biological Entity & \Rclass{Vector} Subclass \\ \hline Genome browser track(s) & \Rclass{RangedData}/\Rclass{RangedDataList} \\ Coverage across chromosomes/contigs & \Rclass{RleList} \\ Mapped ranges to genome & \Rclass{CompressedIRangesList} \\ Data (sans ranges) across chroms/contigs & \Rclass{SplitDataFrameList} \\ \hline \end{tabular} \end{center} \caption{\Rclass{Vector} subclasses for Biological Sequence Analysis} \label{table:bioseq} \end{table} \pagebreak[4] \section{Session Information} \begin{table*}[tbp] \begin{minipage}{\textwidth} <>= toLatex(sessionInfo()) @ \end{minipage} \caption{\label{tab:sessioninfo}% The output of \Rfunction{sessionInfo} on the build system after running this vignette.} \end{table*} \end{document} IRanges/inst/doc/IRangesOverview.pdf0000644000126300012640000100551112234075661020772 0ustar00biocbuildphs_compbio%PDF-1.4 %ÐÔÅØ 1 0 obj << /S /GoTo /D (section.1) >> endobj 4 0 obj (Introduction) endobj 5 0 obj << /S /GoTo /D (section.2) >> endobj 8 0 obj (Vector objects) endobj 9 0 obj << /S /GoTo /D (subsection.2.1) >> endobj 12 0 obj (Atomic Vectors) endobj 13 0 obj << /S /GoTo /D (subsubsection.2.1.1) >> endobj 16 0 obj (Vector Subsetting) endobj 17 0 obj << /S /GoTo /D (subsubsection.2.1.2) >> endobj 20 0 obj (Combining Vectors) endobj 21 0 obj << /S /GoTo /D (subsubsection.2.1.3) >> endobj 24 0 obj (Looping over Vectors and Vector subsets) endobj 25 0 obj << /S /GoTo /D (subsubsection.2.1.4) >> endobj 28 0 obj (Run Length Encoding) endobj 29 0 obj << /S /GoTo /D (subsection.2.2) >> endobj 32 0 obj (Lists) endobj 33 0 obj << /S /GoTo /D (subsubsection.2.2.1) >> endobj 36 0 obj (Lists of Atomic Vectors) endobj 37 0 obj << /S /GoTo /D (section.3) >> endobj 40 0 obj (Data Tables) endobj 41 0 obj << /S /GoTo /D (section.4) >> endobj 44 0 obj (Vector Annotations) endobj 45 0 obj << /S /GoTo /D (section.5) >> endobj 48 0 obj (Vector Ranges) endobj 49 0 obj << /S /GoTo /D (subsection.5.1) >> endobj 52 0 obj (Normality) endobj 53 0 obj << /S /GoTo /D (subsection.5.2) >> endobj 56 0 obj (Lists of Ranges objects) endobj 57 0 obj << /S /GoTo /D (subsection.5.3) >> endobj 60 0 obj (Vector Extraction) endobj 61 0 obj << /S /GoTo /D (subsection.5.4) >> endobj 64 0 obj (Finding Overlapping Ranges) endobj 65 0 obj << /S /GoTo /D (subsection.5.5) >> endobj 68 0 obj (Counting Overlapping Ranges) endobj 69 0 obj << /S /GoTo /D (subsection.5.6) >> endobj 72 0 obj (Finding Neighboring Ranges) endobj 73 0 obj << /S /GoTo /D (subsection.5.7) >> endobj 76 0 obj (Transforming Ranges) endobj 77 0 obj << /S /GoTo /D (subsubsection.5.7.1) >> endobj 80 0 obj (Adjusting starts, ends and widths) endobj 81 0 obj << /S /GoTo /D (subsubsection.5.7.2) >> endobj 84 0 obj (Making ranges disjoint) endobj 85 0 obj << /S /GoTo /D (subsubsection.5.7.3) >> endobj 88 0 obj (Other transformations) endobj 89 0 obj << /S /GoTo /D (subsection.5.8) >> endobj 92 0 obj (Set Operations) endobj 93 0 obj << /S /GoTo /D (section.6) >> endobj 96 0 obj (Vector Views) endobj 97 0 obj << /S /GoTo /D (subsection.6.1) >> endobj 100 0 obj (Creating Views) endobj 101 0 obj << /S /GoTo /D (subsection.6.2) >> endobj 104 0 obj (Aggregating Views) endobj 105 0 obj << /S /GoTo /D (section.7) >> endobj 108 0 obj (Data on Ranges) endobj 109 0 obj << /S /GoTo /D (section.8) >> endobj 112 0 obj (IRanges in Biological Sequence Analysis) endobj 113 0 obj << /S /GoTo /D (section.9) >> endobj 116 0 obj (Session Information) endobj 117 0 obj << /S /GoTo /D [118 0 R /Fit ] >> endobj 120 0 obj << /Length 2447 /Filter /FlateDecode >> stream xÚ½YIÛȾûW9QH«ÌZ¸38@q0AFÃ9Ø>°E¶Ô3’Ø%÷ô¿Ï[¹H”z:‡$‘µ¼zûû^éo·oÞþ쳙͌³I˜ÝÞÏ\›,ÍfiÈMòÙm5û½ßÍ>Ž£síæ.‹ûf¾pITad ŸÃCCs´ìÐÌ¿ÞþóíÏÁ )[Ÿoí,fšHëã<‰£r·ª[Þà♵¦H‡6MLž³…ËM^8Þ÷+ž_â‘ðÙ?Ðù.~‡£]½¿¾Ò¨Á¡güjŽÄ—npAý eS­áIÕžü…Þaâi£;®–½ÿ¨qø;’ý;?©‹j>÷W,W2ådÊF$Ø,÷¦°äðÆgåø7GfhÓ!†Š›þ9†õ¢P0U0ˆ³~ŠØxçf‹àLžL×ÎÖº ¶ò 'dÌÕ‘N[É|V˜"u)ŒCkòX¬~‹ê©y˜°_çb“ÀÀØ IDê1mŸ›ÌfºçM&ø}ž¤ 8Tcpd™–+¤ÕâÀ íPW8ÌVGa‚ÈFH‰Z¶àÀhà|‘¥ÝR¡nC Mèzý‰==¬;g—ñ:&‘¥Šüh@ Ü sº ·¡›¶>e¨s.a}d‘Æe¬JÀz*éœù"xˆµò@îI/{öZx?ˆrpT”£ë†Žìw¨¼f¾È ò>ìkQÈ–ß¿‹À¬øƒÄFAHãè u"DŸpÙ†>=[øúŒï”ÁãdÇ-|7JýfÐI«!]ª¾)Ðä údû(«ë‘JZe³eUƢĔ•¸W5­krˆ¶ÐÉ †wmJ\¶BÖ\–² ”›|“¼ În*^[)Á’VgQÛœ=ðº”43ØVòÒN\”2èQ=™¨éée^²o½e¢K³HÆ›=«‹t]ª·ÖÂ<¿ëƒ!ñô£Ò›`¬UqÍ©õq­ùx\¸"¶Ä8ˆ+ ZÊFÿ™çž˜ƒ¨Ú?9é‘äoåsÊl£%QHvªòfð¼º@c,0ïù(¼[v* ‰4/‘HõA¨–Âqï~ç'MèMCäN„)å÷¹?åÚ JýÊÁaÞ™ÂIÅr‚á>Í ÈšŒfÐ"`Ëß(M´/â8,ó>íË|ͯèù„–,ø‡›ûÓÕçÁ\$&N^ŸS‹P\fÌD†0NèëÛ(ñ°Æ:<–"ÅiUkñ¬xôKlê¿÷‘YñF­.úСР^KÒîàdËe,ôy9½…Ib÷:•@eô°«ûô¹j–Ù‚1É£B¬¶î̇óÚ.|¢¦g0ð,•Vˆ ”ô ~”$âG¢ ¡SÊÒö¬â’wà~6S_·äдšQ³•²qq¿¡¸–!)×Ó¡¶_"1€¯;Êًщ¸}褠ƒ–¤jOè\tÔÔ=8w¨¦Û£„}Û»Áý–ç+í/–û.G"ƒ®—¡`NÅØj A‡AÞ [ï™ 7Ë¡;O^x‰ñq¬‹J‘Yï*fñ‚½:~×ÃÞsOÍå¶åR€À‚”’ÆÈ×?Í3¬¢‰ë+Æ~Bg\Ò¥…={Õ"O*ÎTï[×.Éî„XÅä™fZX¬-ó{j—Y Âu‘LÂs-Õ¯élksãsÛe[Z’¥·Î¤EWê?žIMpÝ<¦Â$׈RV`dºƒäÅÒ:à3Ç=&‹)ˆå†á1LgYM—-aƒºãä¡Ò†émÅ^Èñv=™ 3&-^]ò,¿Šõ”QhsT€¬ò+ÿ•væ}„²ö>oã.{”ºÑM)šì0Î×Qóv’ªùd™‚ß Ë¤§/C/à,XüÐ_ÌñCœ˜<¸+rQÖˆµþñ]îj‘¶ª„‚Vƺ)ä‹Z‹æQÿ ª¨?ÆáùqCÉDvÍ ÔÒçg©n\2Öáò«Vàé—<ý¿DB{±ƒ½–c. 7`0t&ð ¥¹ÓYËQ£;Dì+wÝ•äIVàë‰"Ú6ŠC³Ó–Ðçñ©˜€…Åʬ¢Nl¿åq¾X]©¼@vTSmܪ~ÁRÁ¼Ü럃Ëq;‡SÝKÁ°¨–ÿRð¼³P‚E8âÇå{¶S ¼~~-mRÚÿQ6×Îa…5Þù/ž“…æ+ë¨~>§çNð&ÞzN\[&&øÁ,§)uÿòN¢™¼ ¿s9ežC+yür¦ç¿'÷xŸ¥h|ãˆéÏ™lM6ð¬Ó\aÝ›¿ß¾ù/íüOú endstream endobj 118 0 obj << /Type /Page /Contents 120 0 R /Resources 119 0 R /MediaBox [0 0 612 792] /Parent 132 0 R >> endobj 121 0 obj << /D [118 0 R /XYZ 63.8 705.06 null] >> endobj 122 0 obj << /D [118 0 R /XYZ 64.8 700.753 null] >> endobj 2 0 obj << /D [118 0 R /XYZ 64.8 569.406 null] >> endobj 6 0 obj << /D [118 0 R /XYZ 64.8 399.213 null] >> endobj 10 0 obj << /D [118 0 R /XYZ 64.8 311.896 null] >> endobj 119 0 obj << /Font << /F37 123 0 R /F42 124 0 R /F20 125 0 R /F47 126 0 R /F8 127 0 R /F54 128 0 R /F56 129 0 R /F58 130 0 R /F64 131 0 R >> /ProcSet [ /PDF /Text ] >> endobj 135 0 obj << /Length 1762 /Filter /FlateDecode >> stream xÚÕXKoÛF¾çWèHÖ–ärùšm‘)z(¡=¸9Ð"% •DE¤ì8¿¾óZrIÑ–£z ´\ÎÎÎ~ó̓üyþê‡_M:ÉT‡ñd¾œÄ‘J'qæ«$ &óbrí½ÎL¨½/ÓÀû®®\ \\¸®á àú4ý4ÿ ÆŽB2 }Å¢­%­¾¬H_!û}tzü# g<ħûƇ¿§Œ¾bé‡'D@KÀºö‘Ê¢¨oä_ }»†Ÿ ©š…kºÅÛz0‡ªKšð½miÅ*˜H¼¢–ù| w|S—hݶSqÀ­îàÂÿ|ç MÆúQø…÷r’ µÑ‚¢3&ç¿Ù“7¼WQ²JzT-yrO¶‘’{ü)xR²ƒqÁãí”î;ÃsBs»&lI¤Æ¥Ÿá:â`· kâÉÌÂ*3†aÝ’v\¾? ¸¤r]á<@¥uè-@ˆ7de)³,ÒGòmɶâó#ze2+œÐt[Å>‡46*6,9…bù…⊠7ÞZN² °±Ëyu.©Ú¥XäC¡hT»L/§&ôZÏq¬ÃLyJCã«4̬ð[d"ïýŽ™@™$ë§…1Ül“Ÿöµs¾Ó2d´2Q ×§V¤*HìcäÖ‘Èf„œ…™ #cñß-ƒ ¾†Û5ÕÁi‚Ç“-$‹œ%è4÷<Mô‰ƒ‹:/ç›®*&.å™N … IòØ­¡(®»1¥îÆB»$•òX‚%Tè¾;ª¥„A¦œv|l®;˜GpnݦÚ„5ÀYð*4³jxœom¼ç7¶¤Â´E55^µwâ’²Ö׼󲶘Oa‘, {¶{©`Cm«‰(_À²K›#°°fmu8 m Ð7°Ôyr¦Y²’ÃÖ§dÓÀ¶(´kö4BòÏÔÄ^¾ƒÈ—û=ÑŒEÓ%-iÐ6pq‡Ñ–’˜…¤+›XÜñÙòh¹Ñá&%uÉI*|„X.ñþK?×H Þk²1Uú¤@Ä&&a‹Æ½“k )¥÷#FP(ÛÔ3Cr'Þh4R¶èSzö1ÑŸ“ÙO늟ØN 1D ü˜¦”Ý:ö,ÖÔ®/x)eô•M¸”+÷-ߦ æ”s<6ü”²ñê¸áŠNSë6ëS<Þ96rŒ¶lR¨´¥f·R’8ø ðºH|ܵœG¿v+dëúÐk8à#ÞIÃí¦&)Xº_{ôÓ^@Þ1뢩Íã“øÍêðôÕŠK­°{ؼt°è8XB¶_Ÿ‡åV È‰”'p„‘ ²ì9xˆáÒ¥£ŽNB»›vì0¥÷±Ò^—hquncGšÌ1ôPjèÞd×E5w¥[jj¨8ñÄ*ƒt×ãUtÀFÀãw¤ÿ;€¥µ ]8Þ­&¬3çA;ëîFz÷Teɰ_¨²-k}¤l“Ái}4êz/§§.mG¸ô£Z6)é:رɔÜDÒÜõv:c…? V|9Fûï„‘›}hoÉTmóa)óßZ¦<a!˜ýº9wÜ€ÝV…*6òBÞ]TdP!›­7ÒG÷u8oÊÎy·öÁýÀíuy¶SÈ"à °¤èʶ;×ágßXu˜¨4Н¬½v+SIׯ“†Þ4l³u©UÚ]3¬ ¯G¾@Á;j¬Â$ý…飓"örÉëëàcÔx7óœTµLç2-{¼á?Ìã \F¾«É¢²ÝrL8†Ëw¾oч§¼è¤#ïX Âò©¯}ÿÅügÆ&ÃÞ]Ò“4c®:ÝT¬ï—ìâÊýæ÷ŒÏ˜ìÒ/ýRùßþ¨Þ•«—}–I¦÷—‡I]‰¹ø\WÖ”o?⋃åû‡ÜÉîÐ ™Ú´‰ÏÍaá c´O„ø¹?zî/¨!oaøÆZx¿¿0ÂG=êë^[M™ñ3(ˆ¾Jc¿}ƒÜ«wóWÿ?¡ endstream endobj 134 0 obj << /Type /Page /Contents 135 0 R /Resources 133 0 R /MediaBox [0 0 612 792] /Parent 132 0 R >> endobj 136 0 obj << /D [134 0 R /XYZ 63.8 705.06 null] >> endobj 14 0 obj << /D [134 0 R /XYZ 64.8 601.848 null] >> endobj 138 0 obj << /D [134 0 R /XYZ 64.8 518.879 null] >> endobj 139 0 obj << /D [134 0 R /XYZ 64.8 499.536 null] >> endobj 140 0 obj << /D [134 0 R /XYZ 64.8 480.194 null] >> endobj 141 0 obj << /D [134 0 R /XYZ 64.8 460.851 null] >> endobj 142 0 obj << /D [134 0 R /XYZ 64.8 441.509 null] >> endobj 143 0 obj << /D [134 0 R /XYZ 64.8 422.166 null] >> endobj 133 0 obj << /Font << /F58 130 0 R /F56 129 0 R /F8 127 0 R /F66 137 0 R /F64 131 0 R /F54 128 0 R >> /ProcSet [ /PDF /Text ] >> endobj 148 0 obj << /Length 2464 /Filter /FlateDecode >> stream xÚµZ[së¶~?¿ÂÒô!n™i;ÓvzfN'étR÷¼$y %ÚV#™®(ÛÇùõÝ @"$[Êä" ,€Åb/ß.õ×ëß|*Ë«ZÔ¥*¯®o¯J#ª«².„«åÕõêêÇ™šË™ø—š/¤4Õìo¼lçZÍnàaý~îæ ]©Ù—y]ÎÚå©vpõóŸ¯ÿñͧ*Z¨¸ZÈJèʯr}d-“YÑ))L ÔDõˆ~˜[9kîˆ>;µ®EiuóDÍr®Üì—¹-gÍ];_]Ξp0Ï@ïû¹ªf/H×qÃ]‹;j‘ÿ5\Kn½…Ç'ìXî}G÷ÐÃïGÏ{,LYJQÉ2p²œ²Z [ÚÐßà´«Ì<ªAd@õè/ä?•HA ­)|îKIÜw;ÞÉŸ·¸á›µŸ†îwSyL¥VBëag_æÎ{nMºçE¦i¡ªaLw3_X3ûodÙ‹ùÂÁ£*\-LQ‹ ­µµãøö`Á6át*5â—&ˆà%Öô£¥V©¡V¶:nuÂÏYY ]¨«Œ®eÅcÿ ‚VšŽæ§Âpû ׿#ÕOÆG#v¾éùý#L†ÛÔð¬P¼ýÄ8àg^Ñð­ä›Í5ªäÍ%”Ù›;1Ü$”CcF²SÖ½Xóîã\Q¿“ »õM-Y5ÿ‰oú÷•ü¥ÇqÎâ<‰ AòVTÎeB¨ö!ô;r ]ÌÐý<ì#h‡±õ A‹ÎÄTjöA#v©©GqCäpû·ñç¿§ØH-ÊÑÛÿ0¤F•c¬™ž§Ê…~ò˜y— ‘Nº!h±GEßÅò1œì,úrzáFMªö•4“–ãþ×ì™¶;wä{ q¨*ôìz^¸\·}ä…ÈÇ6¬Ï4ÏRáyïÍ¡ÿ˜ƒ2µ¶¶gƒ™Jn•AKïWó^|×nÀ×ÓfiS Z"^-…'ÛJ"kìð„b_‡ñ:åÏ”¢®ô©£/ÅA6ï›t‚]´®OÀ#+¬DÔŸ±„:X"œ¥Öî˜ò!Ey¯KliºbûŸʤ&˶穚‡?ñj‚1!IUÀ)•2†€wþ AïÎï{ŸÏ0¤•oBMˆÇ¦HdT:¸ñ¿¼-[ À©0‰N@¨/Á1$Wr×Þû@ãfÞ¼p7·Ý޲ h”Úà"Ë'¿Z“"ã2‡ÈøÓM@øt*mÀJ-M¶}=`žDÔ²€gw®Æá\õ.ñŽ ?cî:öž‡ È(÷Á3R6ÛµŸïO$÷-6?  _³Ž<{!Ox~pO•LÝÓñÁ¡ƒ{Ð0>ñ2}0§%¥bÕG_ù=l"éã×~Oü®x3ù°ùö)LgeÜ5¤çådûXr"©!¿ÎûÙ žHž¡ïü溷¡4ÂS > Y88g›ÅQãx¬¤þm( QÀ£-â]* …š¯“é"Æ9cD垀º÷;NþDzÍyD Í†ë!pT¯LHŠ]¸´,‘>+̘&¼.#Gö’ £º~{ë/¡Ht›¸ÚÃ:À»æÖEdsÓMVJÈZž coA°¤RÚÙ'ÊovÌQû•ÜF˜ºÅz!ä@÷-[Ѭ=÷=ùê–·°kpí¸©ÎwR‰ññiPHj¥Ñ8`Ý‹‚VRÔœ®-#9ƒ¼†³í€Ç8( ¾ zWâHÜÁ]¬¢ãÕXƒ !—æ§¼Û±Ôæ+w¹ro æi~ƒyR25Lðm®®özQeK;§‹2'‹,î÷)o[˜:-¯s‹TÁ7~Æ}R}Â}~ W5ž$Ò‘ƒr•'üÿëŸ ÁÖ³° pÛ³x¤ÆUœ,pÙ·KSåÁñLCªµ1é2ǃ‹ŒËó—¦~€÷=íe 8Ÿµ‡Î²D3Ç–cÅ è" Ù •ó0 !A õÝæ9 ~pú]r‰úÈÍË=¹ –ç'Ð?SнCžã6ÑÊíŠûŸHVä«j%¬;óσš€Ÿn\–êú:¢@Éþ°ŽeÏ Sñx„nÞEnHc7ß²:›Â&د–ñ®=Ìö^Z¢+ÍhŽsÂß¹p/Þ†ïAy”k YÓ{ÒæZZõzéü¤CDCQ®©Ð­c}ÁŸvßîø™ö•°Ê¥Gø/R;}=¥ë§T5Tvnžô×3i‚5Tú]&ø“ÆOKA îÙ<zpj"@£Û1ׇç¤b©ÍrÔµp¶¿‘¾…¯…ÄU0(Ÿ¦YŸ¦°¸ï¢¶ü|Ù.ÿÀ§¢„LwPÆT$¨8~\F W¹ 4Vc.7@O°1[ëÙç[®¶{£çÕz,Ì?t{~øÅ{ˆTiþVqÐZÿ:¾w~îAdXÕ\±®M´8;ëž6#méß6Ô¯‘tíó» 3(Âá9|¬\%&ôQ6FÙŠèt\-ôAš¹m¾.ðç×vÌ•2PÚÃŽ\ì&õlc¾ç|È'ib²×f™Õ¢Rò’Ó®ÅO¹'mÝ%fu L9¼gja+yô iø!£üâvy=ArR)|mÄÂåè —œÕôg¾rß'‹ì†r £ç®?Âãb¤ e]¿må—µã6±©L›n³H€k2ùöHßÀ"͈×q“…q‡¬¼’6óû{×ÉDß]ß ÉcÓe攜Âãðg†áù;˜ŸJ+V§w¢R2ü]¨Îóµ§uTSá¿~Íû*LRù„Ïw‚_$Z”,é¯6‹RöÒð¢»>üýúÃÿÿB‹  endstream endobj 147 0 obj << /Type /Page /Contents 148 0 R /Resources 146 0 R /MediaBox [0 0 612 792] /Parent 132 0 R /Annots [ 144 0 R ] >> endobj 144 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [199.054 151 206.028 161.84] /A << /S /GoTo /D (figure.1) >> >> endobj 149 0 obj << /D [147 0 R /XYZ 63.8 705.06 null] >> endobj 18 0 obj << /D [147 0 R /XYZ 64.8 700.753 null] >> endobj 22 0 obj << /D [147 0 R /XYZ 64.8 558.034 null] >> endobj 146 0 obj << /Font << /F66 137 0 R /F8 127 0 R /F54 128 0 R /F56 129 0 R /F58 130 0 R /F64 131 0 R >> /ProcSet [ /PDF /Text ] >> endobj 153 0 obj << /Length 1794 /Filter /FlateDecode >> stream xÚÕËn7ðî¯ÐqDÌòµ í¡m¤PÔp“CÛÃFZY*,­bIqü÷¹O;vÛC C^r8œ7‡3Ô³þôLZ3—e*÷z¶Ü]|ºHUæÓTBwL‹Zö àåÛžýØ\üaiÁ4¢ß_]¼|SÌJUf&›]­gÚ9åR?sð-¬]­f¿%oæ:ÙÂïú| ÿëùÂZ›èWó…s6ù¡A -ÜÀ¿ê$ÈÍžñ>Î&KêÓÜÉÝÜä°P÷ó?®~zùÆg]ÞÖ)_8•¸~¼÷ÄO'Kø!á†XÑÖ®Ô¶TEöU{@ZMÑ/•õy@»&y6®ñ–•û<÷YRÝ•ÏG›ä¸AÈZ¨“̺Â,¬¶Êd9¸Ã¨43LÛºÒø~n¾ÐÚÉå&hÍÂ$ïØxà $¾aàkZ5˜§ ;0gœ‘*)F²…f~¿Pà"aàœà½†ãt# Ò­LäÏfÛîp\K»6N>£Ç†¹Å)™ëœW¥5Á¸—c‘K•—et.¹i·%§if³<±WDÌBÜISlBëäc’ÇúLÎÁÔKÜq|ÁÄ>žÉ«=ëÔñX u»ˆ4wu+Ô݆™ƒŽàïUnñXjUzÏúE’ æÂY—4p~¼Kþ¤0=1LŽÔ’ä<ÑÔjà:Œ(ØuÀhø»£R1Ø'ìH^AÆ;²âý¼p„‹âïÆ-ùtuFXÇ̶9±Ê$ÿš¿Ë¹’ñ—g9Û"ˆ ^"ͪ(Ÿoy“S±\Æ–#Òä7²1§FŸ¥%ïC·¤6Yí ' TµgèG²œ ,›]-¸´PíeM¸b:"#-Õ;ŠÄ{žë[Ê èŠ ã {„Ÿ‘Òâ&kÖ‘–£ì×ÕVŽù5.{8q¤*rW _…,\õÌ$Æë†í´°.g†‡j_1än+¾Úð¼âÏmHI0ÈAãŠî  J“ŽS>¦ójw¸‘”‹®ñºãRBŸÕ¸®“@ÃsO+ÍzÊ.©W…Ž]8h4Ëv9÷OÑÈ2.ËÛhÓ…ºØ+ãúÞ'çœj¤Ì>U ¦ þ1âPä´{TtÈqá1¦™©Ô¸'Ó$Å$Sì— ¢^Ù4Qp3ÜîhSª‘Ðßi0œï¦cò“×9оcÊw“'Æ‘à05â…ÛÏrb¦ÕŽ+Pª<ñîÕ6–€°FQ¸?Ê]F·SˆUM=í¬rþi‡»P܈æ°\Cá‚ÕmõÄ•"èf*Å”ü퓤X8oUs—ÔDRt„£¨Ú“¬Ï¡sh»¶W"Ç k€lWêœÉ~:K7ú%õ ä}ƒÅ ÛrÁ䃉²NxÝ?—×ýsxùGô÷‘ÁE'E‡Z:³Z8-Æb£k‘c?ÇY—°Lüʸl°ËÃ/ì62.y9fòX_hH\ƒŒ÷nR(MYZ~B­’ø`ILZzàÁp#|‹Þ«dQºKJz]%`ß¡èsÞ¢\JÑ,Ÿòá{*|ÙâçxQ¯WB§#õ׿S"~}ûø-ÄÐݸ™Œìÿk´áÏÆù¿mCáì \d݇mÙã®œÚæH‹i6å:âúå­Oñö!ô‹Xžz=ê<]-OF÷zxk õðõðñ™ÇH‰w^ZºPz81¶mÂî5ɆÍOF±ÅÎ÷% ºçUŒõw¯yŒ9>ÀÛ &¡°ÜÆCC`,Ao«]|±\’½¹ €Þ`§±uZwÛÙP¿àZ¹w“wOq^*“ëîÓæàÌ÷jU /*)œNåE`‰BŸ¢\}déÂ9?Ê<Ø­ƒóFj&“qèùæÄÁÀÔ×ý‚Œn:P(€ðšðzM¯¡ïÙÔVygÿÆ[¯KUfËŒ£¹¦…rÈBo>|\» O™7µ¼ÓÆWC ¼k~Ôí¾IÀ”¢s'“ kÚµë¾vcÂBÞÆj8|%ôî™ÊR9|—.^_]ü_úp˜ endstream endobj 152 0 obj << /Type /Page /Contents 153 0 R /Resources 151 0 R /MediaBox [0 0 612 792] /Parent 132 0 R >> endobj 145 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./IRangesOverview-figshiftcorrs.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 156 0 R /BBox [0 0 360 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 157 0 R/F2 158 0 R>> /ExtGState << >>/ColorSpace << /sRGB 159 0 R >>>> /Length 590 /Filter /FlateDecode >> stream xœ¥VMk1½ëW̱=t¢}_šB …Ô =”œÜ†Ä8-± ýû­Ö’lŒËn^üüôæS3k‚; ØÀ«º‡Wp µ…`ÐZà 100t »Ÿð ~©«ý×O×p³RµÖÐ?W7_ä×àà¯úþ~(‚;ùlåðY]êê–ÄÝð˜;h£œÔå‹÷HHë †x·}ÃFØa§>ÿS'B @‘s³ÕDYrÖõçd vŒ.-Kê&HÅ=Z^ —ÜsüCççËYrw|L˜ì¹äî$xg1.ž%wo\ĸ ò,¹¹5!¡¥ùr#¹‡¢æpF-3ñ¶+ïe Â4P/â-a0ÜÂê„.È71³$V¢­ô;^®›çÆØñÉ¢Õ/°ñldâbå'Øñ!`ò/°ñGéÔìŸk?o½?S¼ýZÖÉ-O­aœˆò(8¯#v\@¹9l\nOíëEq^$R®Nmõ µ•bÒ‘zŽïhѤ^íføföy—õê¾ÙK›\¯ö3|=6±WWßåí†(í.ˆet´Û}BS®~A%’àR¥'ØñN#ëÆØñ²ßeÎ+_`ã™lž?ÁŽ·>ÿ^ù;¾¤Sù–]_º®^º2Ê" 2²XÌX:¹Nûsµ¿h€ŒøvÕíÞe If06 v¶¹3y­V ñøL#¯ §|zZhhdòdQl§Ã'ðpx5n×7ïŠ:o5ŠùÏJŽwÿôüøg?#cù*á‘ÄË;`ý{·«îÕ?ú¹Ü° endstream endobj 156 0 obj << /CreationDate (D:20131029202312) /ModDate (D:20131029202312) /Title (R Graphics Output) /Producer (R 3.0.2) /Creator (R) >> endobj 157 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 158 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 160 0 R >> endobj 159 0 obj [/ICCBased 161 0 R] endobj 160 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent/dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron/space] >> endobj 161 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xœ–wTSهϽ7½P’Š”ÐkhRH ½H‘.*1 JÀ"6DTpDQ‘¦2(à€£C‘±"Š…Q±ëDÔqp–Id­ß¼yïÍ›ß÷~kŸ½ÏÝgï}ÖºüƒÂLX € ¡Xáçň‹g` ðlàp³³BøF™|ØŒl™ø½º ùû*Ó?ŒÁÿŸ”¹Y"1P˜ŒçòøÙ\É8=Wœ%·Oɘ¶4MÎ0JÎ"Y‚2V“sò,[|ö™e9ó2„<ËsÎâeðäÜ'ã9¾Œ‘`çø¹2¾&cƒtI†@Æoä±|N6(’Ü.æsSdl-c’(2‚-ãyàHÉ_ðÒ/XÌÏËÅÎÌZ.$§ˆ&\S†“‹áÏÏMç‹ÅÌ07#â1Ø™YárfÏüYym²";Ø8980m-m¾(Ô]ü›’÷v–^„îDøÃöW~™ °¦eµÙú‡mi]ëP»ý‡Í`/в¾u}qº|^RÄâ,g+«ÜÜ\KŸk)/èïúŸC_|ÏR¾Ýïåaxó“8’t1C^7nfz¦DÄÈÎâpù 柇øþuü$¾ˆ/”ED˦L L–µ[Ȉ™B†@øŸšøÃþ¤Ù¹–‰ÚøЖX¥!@~(* {d+Ðï} ÆGù͋љ˜ûÏ‚þ}W¸LþÈ$ŽcGD2¸QÎìšüZ4 E@ê@èÀ¶À¸àA(ˆq`1à‚D €µ ”‚­`'¨u 4ƒ6ptcà48.Ë`ÜR0ž€)ð Ì@„…ÈR‡t CȲ…XäCP”%CBH@ë R¨ª†ê¡fè[è(tº C· Qhúz#0 ¦ÁZ°l³`O8Ž„ÁÉð28.‚·À•p|î„O×àX ?§€:¢‹0ÂFB‘x$ !«¤i@Ú¤¹ŠH‘§È[EE1PL” Ê…⢖¡V¡6£ªQP¨>ÔUÔ(j õMFk¢ÍÑÎèt,:‹.FW ›Ðè³èô8úƒ¡cŒ1ŽL&³³³ÓŽ9…ÆŒa¦±X¬:ÖëŠ År°bl1¶ {{{;Ž}ƒ#âtp¶8_\¡8áú"ãEy‹.,ÖXœ¾øøÅ%œ%Gщ1‰-‰ï9¡œÎôÒ€¥µK§¸lî.îžoo’ïÊ/çO$¹&•'=JvMÞž<™âžR‘òTÀT ž§ú§Ö¥¾N MÛŸö)=&½=—‘˜qTH¦ û2µ3ó2‡³Ì³Š³¤Ëœ—í\6% 5eCÙ‹²»Å4ÙÏÔ€ÄD²^2šã–S“ó&7:÷Hžrž0o`¹ÙòMË'ò}ó¿^ZÁ]Ñ[ [°¶`t¥çÊúUЪ¥«zWë¯.Z=¾Æo͵„µik(´.,/|¹.f]O‘VÑš¢±õ~ë[‹ŠEÅ76¸l¨ÛˆÚ(Ø8¸iMKx%K­K+Jßoæn¾ø•ÍW•_}Ú’´e°Ì¡lÏVÌVáÖëÛÜ·(W.Ï/Û²½scGÉŽ—;—ì¼PaWQ·‹°K²KZ\Ù]ePµµê}uJõHWM{­fí¦Ú×»y»¯ìñØÓV§UWZ÷n¯`ïÍz¿úΣ†Š}˜}9û6F7öÍúº¹I£©´éÃ~á~éˆ}ÍŽÍÍ-š-e­p«¤uò`ÂÁËßxÓÝÆl«o§·—‡$‡›øíõÃA‡{°Ž´}gø]mµ£¤ê\Þ9Õ•Ò%íŽë>x´·Ç¥§ã{Ëï÷Ó=Vs\åx٠‰¢ŸN柜>•uêééäÓc½Kz=s­/¼oðlÐÙóç|Ïé÷ì?yÞõü± ÎŽ^d]ìºäp©sÀ~ ãû:;‡‡º/;]îž7|âŠû•ÓW½¯ž»píÒÈü‘áëQ×oÞH¸!½É»ùèVú­ç·snÏÜYs}·äžÒ½Šûš÷~4ý±]ê =>ê=:ð`Áƒ;cܱ'?eÿô~¼è!ùaÅ„ÎDó#ÛGÇ&}'/?^øxüIÖ“™§Å?+ÿ\ûÌäÙw¿xü20;5þ\ôüÓ¯›_¨¿ØÿÒîeïtØôýW¯f^—¼Qsà-ëmÿ»˜w3¹ï±ï+?˜~èùôñî§ŒOŸ~÷„óû endstream endobj 154 0 obj << /D [152 0 R /XYZ 63.8 705.06 null] >> endobj 150 0 obj << /D [152 0 R /XYZ 187.971 456.788 null] >> endobj 26 0 obj << /D [152 0 R /XYZ 64.8 412.733 null] >> endobj 151 0 obj << /Font << /F8 127 0 R /F56 129 0 R /F66 137 0 R /F64 131 0 R /F14 155 0 R /F54 128 0 R /F58 130 0 R >> /XObject << /Im1 145 0 R >> /ProcSet [ /PDF /Text ] >> endobj 164 0 obj << /Length 1191 /Filter /FlateDecode >> stream xÚÝWKÛ6¾ï¯ÐQF#FEJÊa´HP $n.iܵìu`[†Tov‹þø‡C‰²ä×f‹ =¢¨á<¿ùDþ8½zùVæAÁ •¨`:TÊò@1Ë LgÁ§ðzÉD„zÂÃq£„q ãOŒÆ±ŒéõÆ—=1F*–0þ¢o´åÆ{«n™[»/íã‰:?ö”»Ççé/å%!¢„³‚ç6Ÿ@ÒH¶®ÄdVÀ0󄞉9ùa”SãôŒ<܇KòVS6(˜ Ò?šK¾°6OfåÒtLÉÜï0ÞØÝ~äÉz}rGÙ×Ô/ôã 8ÕOì}|ð£oç¶ÿaãîÙCãqš!åÈeQÒ„…ëŽßònÝÆÉC £Àá>ïÿ¼×ÿ#茙ê0wœ9Eâ$o”nlÏ)ÂÆ$pk ¨Âª¦ÄÑ·54àðѼ%a5·«.³¥}½ÑMKÆvWéÒ_!°gBÝ4H¢fùÖlÑF®œY_—}¾P½€¥b*öÚq(ÌÒ6#¨¸Z{nÙ–j‰¼n¬Q#±1««ki!ÔÅZZÉß¶&¶£@¦u´´Fß¹ˆîàá;í’•ÐÊce½Ö5¶vž†¸ÎÓF‚çáOÀKPÕ»º@ÆÚmé ±^R,M 6yøsYSu@nIɇ©¶äZ½6Á¬P(³•…Okôb¹¥¶ZiGG6#CŠBGž Ã8UH²õјmÐₘò+Ô^ž!LüI:j7ïmÐdµ±óE]!ðO°kŸ†ú$‚K׎ÑN’ÈŠŽ‹‘£K4TlDçvº¥¶–ZâƒE¾’½½]…wKpŽŸ|JÅÃEÀcfXÉÏÿ!®m0›—ïq¤âr¤Y÷9Ò­îÜ#Iã £SëD‘; t»¯¶hÃ0>Ç}Ç~yµñÊ>ÞÂÊkú‹|Àã™õªd{ѽ¸þ#C8GTÄó0ýƒ}<ö¾œÄ÷Ò;š— ÇOß ß’0žµ÷ŽgøÑãA1H¿{án¹E¸è‹¦Ô€b #%÷4ð} ² mLqqy; /¤sßǸ\Í·b÷ºwÂü{ Éÿ]ÞN¨ªý;ôwãm:ÈŽÁ··ÕÃhoý@úÿäìÞEœÉxõÝÁ0º¦IS­i6|œ¸@+½£ç9§ hìJrÝN{X:u<ÜgÙø%+î0¯Î>¡5.ÌCÞ<$žxöûUÒ<ÇùY—¿×îN è\wõtçz(bµ9£þÝÕľÓmÂÿÒÊû„È ='+ï+OpÙ>MT~ÌÉÕ›éÕ?¿–« endstream endobj 163 0 obj << /Type /Page /Contents 164 0 R /Resources 162 0 R /MediaBox [0 0 612 792] /Parent 132 0 R >> endobj 165 0 obj << /D [163 0 R /XYZ 63.8 705.06 null] >> endobj 162 0 obj << /Font << /F58 130 0 R /F56 129 0 R /F8 127 0 R /F54 128 0 R /F64 131 0 R >> /ProcSet [ /PDF /Text ] >> endobj 168 0 obj << /Length 2841 /Filter /FlateDecode >> stream xÚÍÉŽÛØñî¯hø$M¾…‹pfÆ€ÇØ=ÎÁ3¶D©5–D…”Üã|}j{ %Jn'ƒ`l‘o©ªW{Õë¿Þ>yþÊæ7URå*¿¹]Þä&)oò*MŠ*»¹]Ü|œì¦ÙäÏžžž5´äAðœì²ð¸ÝJÞ+žî„RÄ×O¹ýÛM–&ÆÜ̲,©¬åã¼% 7d“ÓYQÚjRÀ{É””UZ‚ŸÀ?¼¬ • žœñ|€‰ZXsœ=Ãy!`å ©€Íé$ÙDË© æ÷RNlå©ä1ô}J@ªž¿*#ášÄ¦À•%i*ìx 4i-ÜVk­<[ž®ñ»Ý²ÜiäóT•t¨9M!ïûgÑކє+3iRš XE¸QƒZÒ¨3J³2© ¿°Fa-ÆV‰¶…[Ö ÍkRAíKxöò (¾œã²6±J9 ¸ñ¸sçBP-ëºÝOg*Ÿ4x\â‰ðÖ0u&\©Äd𻩲bcÇÍ*¿²½‰šÉ¯ž»ý ï™é´p™$- ‘ÀNÞk#Ó¦Ãç!‚†NÉöÎæçÈ…{ÙÄMã$ÞöawË9m@œtÐ=g˜m'ƒL’: €´zãÇ Øå¤0´{`;‚ý!TU#,¥£nÛ±¾!Õ"¯¤Ï½3÷NñÉD z{)$bjïAB 8w% ê7¹•NǺƒ¨86"!è1~‘ Š¢“=‹·fš£ 9ôny¢rOÛkJ-Êpåk¸3*5n»=¤$üOS µrQc!æÑ˜^ …ȹw!¨ ¤öNõ›>£Tç‰É‹Çpqfl–@H z’šœRwRxP€ï¿\ÑLaÒ¥Rà0FèJ³¤´ž¦¨ÅÔ*Λ/”{ Rãå,ÇÍãlf–iìI`Æa“BeƒŒƒSË 3SR…¿–Ìc¦Kß’Ð¥‚RB [ŽŽ´àô"çW1}=cå'¥œOízç…ÉïÞ/ån!;Xð¦QjD™h‘dyHÝÂÇШ. doЇÜ#ž™#ÔÚ788Npõî7´©Gþ‹ŒÊšÆ¹|ÅjçaïG$­ ¨?sè çD½ò­¢s[±`ûÁ ±‡àXÛ ú¶ÁfÊÄ–ÙcòhPw”…ªûyQM~ S 08´» C, Ž>œÝó·Ä%U©¡‹³­8W­Ô˜Ëvûï9\Ð7IôuÔæG?\.°7NP«C 5 t8¥6kpä\Ö¼Í[îˆI–ó g«8N`æy‹½(ø\Ž€Ùd'A‡|´A³)yÞŒI‡)ÁÚ¸>H ²(pHÒCC݇qÝטqœ8ÓýìªS—\j´Ãe†0ËÇzHסyEœÄ/=y¸÷€ŽG9ª‹,¬Ö$_6­CµIùx.=/EøB%…Éà+u=ÀSéä$ÅðÒ5ÈŠö>¬†•ΰâÈÕô.E¯ÄòMÃaÇ\÷Dæ•çØÀOeÅïÑäSv.‹ˆ’~Ç ¦K*GãBìyCÑ‚NºBÒ—s @xß¹Z×e)ð|/óËЇzzÒa{ã„ `ž>ºÛøÁé…ì<úÞ:ÑvN ?-û(¥r-½½Oò¾ wéµ@«£»ƒF =¥®™¸G¥wuò^°·>Ç.e¼N¾ÀîŽå43:8èhn'Àn¥²t^[þH€µd¢µÿOW…=ãkFÜÿ˜& íy^/gõNÙ”ˆæï8øXø{åGáý[iξ¡g–«²¦í̉ ~®é!âÇâT×Ïäuà¥ËT\þ(GÓléí."Õm"ø»ˆÓöÍôWÐÜ8ßúÿýéï#¹.¸húF.~8a…˺ÿ ÇÑÿ…Rìäi#°Nᜣ™ûø{DúWȸô½¸Ù;pjåM°ö1_ëÈÂ`"*˜dVÌ5HE^Ô$9iX@ég}óÞ jÃ"¦l¼€. ½­²¯&Íx-ìW}çjß™$¼Æ$i54ï}‡IÞPû``ñhÎæ*ѹ Œ™µ)ñ8iUþ¿1Áˆ ’Ì+î¥7á›;yÉéñŠîên¤¯_ÀŽêz[?­ü‚A—=/]qŒ{_Ï7aÎÙŒH’£,À]éøt=—<õ¤(íyÊ7pîÅcUAq•ÿ5À&ª2£RqÞÕGƒƒßȱO:í<åz—ÝÐcã&öf͂ɯt<ÉOî„j¦ˆŽ.j[ÒJî-HÕè¯ÏF¨>» mw®$«?DÜÅâk«™plxyå}«qg\d:ù9Ó†ïÆ‚w§¥›“¼^¥é©‹³ÁÅ™`#K¾ž£A>èŽ?~ÞLÞydöR×D@»F‘ÕJ·yÍ=…nÃÅáA:~YUÒaçíÖ‡FîR€AAû”¹ã‹ä‘ü%jöžŸêÓ‡{>K\ןVÎ4·5m8Örºç®*ç{‘ŽQÑ) ×Ò¬m°ûf|ë™4çHWžw¾xíäæ~9ú/I§”]°\ÊeÜ2Þ?h¨á`*ÿ1Á*ªt–Xô üIY2+sœzòÃí“ÿà) endstream endobj 167 0 obj << /Type /Page /Contents 168 0 R /Resources 166 0 R /MediaBox [0 0 612 792] /Parent 132 0 R >> endobj 169 0 obj << /D [167 0 R /XYZ 63.8 705.06 null] >> endobj 30 0 obj << /D [167 0 R /XYZ 64.8 525.148 null] >> endobj 34 0 obj << /D [167 0 R /XYZ 64.8 421.21 null] >> endobj 166 0 obj << /Font << /F56 129 0 R /F8 127 0 R /F54 128 0 R /F58 130 0 R /F47 126 0 R /F64 131 0 R /F66 137 0 R >> /ProcSet [ /PDF /Text ] >> endobj 172 0 obj << /Length 1785 /Filter /FlateDecode >> stream xÚíYKÛ6¾çWÍEbF¤¨m¶È)‚7—4([Þuãµ]É›]÷×w^”(¿³ ÒÍA’3œo†3CjôãðÑÓË¢ç”ËLÖN{¹S¹µ½ÌÅ*wº7œôÞDÏýÉŠhÚ×Ñh¼†ûè( 1‡÷9.§üÄák¸Jlºh„íå Üfc&øÐ7ETŽ¡‡†*Ͻ›6¢²æ¾ßâ4’ ÅöM݉X”º¼šÁ}L¤;8 Î[^•U;Dݷо¡^b•¡1á[õyÚò>Ðnï†2Fù¨Ö¨yè4`ÔLría~À[É5Š"íçÄÜ;ü¹7ÐV90ò@kåÒ”<\õº?HH$†{ÐØE¦ÉøÄ#@&/¦[.X üô2µÁRk›¨B÷b–ÿ‚„“jD:…Ñ*ͧü B+œ ‹BÆITY]ö KKŒÃdÛQkj0³Õi ±b¯AØŒ…¸`ö@Ï­Jã=Ç•_—ýÔDW4 ;Í1•R­r“ž¯µîf}Í‹˜8­2›É*fb|¦$|Êô{pfÿÄfqç—ÈúKªyiþ \C‰„þ—Œ ôÓëxî‡A”‰¸jAOÂôNœÝ(z8ÊóOÕ¦þlÚ @ÔÈÉ»9ªQ§`$uåpÆaXþͺ…À¬­€îßÍØû³'w.‘Ch÷hr.Ú—ç‡9ÓÇ+x®ž³#›ÿ@JRóöˆyÞGO×ZÔu'@*+xsnVÁ²”ÚþosÌDb›Ã|Í~lb—bm‹úM³W7ý(WËfçèê _¾ûÄsÏQ嵎ç¢_Ù|.„/ÞšçH{ –NsöSOâ5ÈÚvCcöì:à qæz0¯’î9R=z6|ô7·– w endstream endobj 171 0 obj << /Type /Page /Contents 172 0 R /Resources 170 0 R /MediaBox [0 0 612 792] /Parent 174 0 R >> endobj 173 0 obj << /D [171 0 R /XYZ 63.8 705.06 null] >> endobj 170 0 obj << /Font << /F8 127 0 R /F54 128 0 R /F56 129 0 R /F58 130 0 R >> /ProcSet [ /PDF /Text ] >> endobj 177 0 obj << /Length 1627 /Filter /FlateDecode >> stream xÚíYÝ“Ó6ç¯Èô¡“”³dI¶™ÒÚ)30t:GûpðàK|!L¾àþûjW+ÙN”œÇ1Lû Ø–׫Ýß~hWùõüÞƒ'ù `…‘fp~5È –)50gY!ç“ÁÅðÙH ·vÔïG‰J۬ÝõãÌN¾·ã­{^m&ö&—åÆþ^Þœ?{ðĨÁ9ËÕ€;Î/…îR°ÌÞÅ8Ö¸’¶e9Eá)W—£D«á»ÊAªú,Â=ÍWÂó„=Ä=c†§ž2Õª é÷a$óa5!µaa=|cä…Ó5@¶Æ‘È̂Ӽr˜Yrд—•†I¡ýº–ì""œ²f’žèjà;Þ V-àg RÒ’Õ'²ˆQ"> Èjy“k&uÐ}¼¿~Á´;Ë[¢A¢´aÜ8‚ZƒÕD¹D×ð.2=³’ÙÙf&)2ÁLÖq„2 *ðùz_°T°TÉDØ*VäAôº'WÍW{pób8_9뮃Zl”˜,þím¼$Bøˆh=SûJp;mgKWk1TWÍç3ƒèÙ]ãG‰ÌõðµH8àjÒl jà„ŽºËã÷ ÐÏËÚ­±€V*ei°¢!+– Š‘ÃKT3é-»Ãï[7sUÖäk¨Ž™PÙ´7jØ»ò²ñÊÚ}X{TÇNK˜[-‘ð¡…<.ñã#`BX±ˆÔ›ÃϨ‹¯ib5`P§$ø¦[·k%¯–O -µŽ…7ïFÆ)^-oÝ«Ëu¢|Ic½%Û9c¬¬ÉS›U)HÝýYâý{î»ã æ¢=ÈS›-=äȽt6]’¯"ãÆ°HîUÙ`¤!è(!±ø0ÒÆ ¶mf.˺ÅÎëlA¢å+›d„éÚ¤êã¦Çí¼kE)XÎé‹_ì ·^‡ …4·ƒÑóŒžaþ5לH÷-^CÒþ®þõ -!È5ÅðÌ-î—ä‹–ƒð—H†×ÌAZ(§Å–ä©àDp•P ¬H/~dB`íbwˆ°œ°¹ŒÜ.¢3æyÝy ×väKX1™­WîÆðú)á žû„JÏòû0‡¹s7™C}esŒïÄúŽ£C’9TOsxz}š9f­4²l™`LBÏï0I5ò-¢o'›_¿q¼Îíí ;^¡š}÷‚ïÞñ׆Wõ…w§Ñ)vóû+XsÞÈ–¤B¹þjâ+±rk> ´-ù±æÓôk=3ÆSqbëilV MÄã‘ÔˆëjáýâX7ª¥í[ôº×s®]»iÀ9V‘æSY¨ÿ ù*ÖngEhLÉk*HASá+S&t€è~D%Ö”´±.T³"4rì*""Az}™üx\†-û\ «yð‹?Èó¨{,¥b\|.L>¸§]ݦÔSWp£¨Rޏ“ä,ÏûhnÛ{dº»Wu!€Ü°¿BÁ”(NAŠ ý†`ØR8O"ü ü¨ÿÆ¿öä´uquS£uÔ# Ä}I¢.h”|¬ç*Xn>•Eh5?Ã9:hx!?}1§:¨ç´e’¦Òö“±ë3²9Ðûœ`ÑÚ¯ª¸Ðˆª8 VÙì!1ž–[:@<=B‡ ‚€LÑÅ·kzª–íãÅqµ]¤žKMƌȣÝ'ÚI=NÝ I~¶·‰»=LÙ©<Úd´ûKüor— |8üíN‰ÎALG…ëÛVáú T¸î©‚>Õ DÉo®•n`´Â$†·óV­9mŽå²Àݹ²¯Ä`DTjv£ýâ5éèy‚8¢ÓËì$ùHëí|UØ‘‘ÌïƒéüFáÎ/)è:ºÎ ”¸¶¨Ïs§ýßûýüÞ¿{: endstream endobj 176 0 obj << /Type /Page /Contents 177 0 R /Resources 175 0 R /MediaBox [0 0 612 792] /Parent 174 0 R >> endobj 178 0 obj << /D [176 0 R /XYZ 63.8 705.06 null] >> endobj 175 0 obj << /Font << /F8 127 0 R /F64 131 0 R /F54 128 0 R /F56 129 0 R /F58 130 0 R >> /ProcSet [ /PDF /Text ] >> endobj 181 0 obj << /Length 910 /Filter /FlateDecode >> stream xÚíXKO1¾ó+rÜHÄØë7B*ŠDÕSõB9lÑòR6¨ ¶ÿ½{ö•ݼ*–¶‡‘½¶ç›ÏÙ¼\JճĪXõ†w=%ˆé)mˆáîû¶w]÷™§ØÑ§›á‡í #V⡱ۘ9Z9JÝã¸t4pôÉÑį dÌ£¹›Þ…éOÎ ÂsSº‘ü‘ïn:nrYGÒ‘F¢~ôÛ Ñ#Ê˼)Œ!ÐÌùت0°è4à7 ¢Lj˜ûeYJË—ÚkÄ*k0ÊÀBÜV 0_CX[ƒ£1 3õeí—`«ê)4í‹ÛHÐhføN†âïÿ½fÇÂ8u]8šJ8Ð91%VÛ`Áy—¡SG_©„{xªEón£ÛV ™QåŸax>€Ï c¨j5sh]ËktãMéª<ž%ÎM¿ˆÍÛ^PõJ˜ ¶¸„}…!XG.Á¸äEÀ¦YH:XK`q>ÃFaìgßYXó0žuYä–߸ƒtžOÑrQÕH1"œ*“§¼º¦òš(Êó“Ç€lJeŸá;ŽFÉ 5³yøx¬˜â9ÒÒw$ÖÑ|ÏîQå<ÑG+Ü™ÏZ<Ç´"Z³\«<ño=pÈ–{nš%)‘Tæ« —Âñ b®îo¾ô i91#œ²zM ÁSvñ‡â4ó©ÕLZ…Jv$(5ÅÄœâÚS8ræk³ŸÞUŠâãaŒæÏêùå£ß3ýÃ¥à™É†Ò¹QE*Û *Eà¬|B¶½8ˆAk¿ÚÞ­ó»Ë PPáª"»^+Â3y¼vtèÕC[ Õ~O«¬=¥-“¿ú¬xõ¾õ–ǧù[â%Qy'¨¢Tù2¨kÞRèª;A5 ÚNPó§ùåËK-î<ð³H´,“s‘Ö cŠ¥%­hEá|ïã€8zµhÿJ ””@õV;)ò?*ê­î*ò5K ýW~²–j³³,xÿ'—BC÷È…ŠÇD+¼qøoÅ"ºÅV‰ë_´ˆ†}+¢äÛ$´’¾bÄP|J†}Ã}çÃyt—xÚÒ-rADÑ©d• ûZ;1…'‚„ Ʋ²olÂ*BËa/vÙw-e2Ý€kÜuª]¸z.ÛÚô*I ÷òy1É;ï]òÚ:lK˜0Î/–ƒ~±pìèýðè7-§_ endstream endobj 180 0 obj << /Type /Page /Contents 181 0 R /Resources 179 0 R /MediaBox [0 0 612 792] /Parent 174 0 R >> endobj 182 0 obj << /D [180 0 R /XYZ 63.8 705.06 null] >> endobj 38 0 obj << /D [180 0 R /XYZ 64.8 126.283 null] >> endobj 179 0 obj << /Font << /F56 129 0 R /F58 130 0 R /F8 127 0 R /F54 128 0 R /F47 126 0 R >> /ProcSet [ /PDF /Text ] >> endobj 185 0 obj << /Length 3141 /Filter /FlateDecode >> stream xÚ½ZYsÜÆ~ׯàS [!aÌ`0œ£J©H»âr•Âr?@» ¹Ñî‚Þƒkù×§¯9ÌR¢œä\ÌÝÝÓÇ× üåöÕWoM}¥L^«¯nﮬɛ+Ûyݪ«ÛÕÕ™YÜ(¥Möâ-³~y\¨lØ/nÊÚd¯w»šÇÿÁß[»Ãâ§Ûo¿zÛ\µykµÅ]‹«­ò¦hxËïaÚ.èq>ìeŠìü€ml”m6ìzîÅÎîÀÏÿ,‡ tâ_¿tç"M²Ïp'¿ï7•ÉþMópÒþ®qLÓ:nO4Ðü5M‰Úá`¿bŠˆmìzŽrl·\è6¢ÙÛÞõ®h‚lBGAm²ÂH5¼ µ…9á!ƒS†ÍF$´ŒxÑ¢4•ÊÛªbi®EˆeI<[ܤÔÙy¡k þ}\4&Ë7Ƙì¦ÐÈÀK>àÞÈêJ}$CØaÛ3C aºãáe·ãqd Î丑Xj–œð`mÇÊQ™H;tUçEQ_ÄÏ‹¤²¨4‰á8¸f*Uê\W­[ãnÛ‹ëk’[× ¬Í˲æÉ EѶÙwHâøÊŒ2YÇl '⇺¼Âp“N«D·Â,TTúÅŸŠ5š”µÿzqc ËÛˆ¢áÄ„Î`÷Úíƒ{/{¼ÔCO7DÝOë0•vìE¦6)AC'Ÿ­¨ŸÂ—ÝùöL¸¦Ê›Ö¸ÅÝrIŠ‹t ém»@sDò.AÞªë'Ù#Þbï8Ù¡†8°Í8ˆ‰.¸nÅÊ DbëcByܬ*´£Ž>g3®T \y‘ü)VÀk­5iˆ-ÅçéË¢ëjª!Øi6‰ì•˜íþbçwžÑ;ëÞ‚Ó7Â.ІÐüüž²aBÁƒ¬ÃÚ„J=2,*…óJa7QØM9IhU ÷ÚÆJEžJüqÂñë&o À¤‰äoŠ&Wª«Ì¿ŠªHŸ7Ö¾ät¸ÒàW$ØÕU††}B©ŒÍm­gƃ2EXƒDÿ4lðF·‚^Ý€‡òäK „ð²[ñÙë@F°PÒF* …•JzQ,j/ë¿’Óînuú*3aêM^¶ú‚%zñ2Ô7 Ãh!»À J6ÈxÙó(3{UÓíñ=[Q˜£K¾ÆÝÒ¹ˆ£BÍíÄqr¹a,À2Ó¥ì<‘B þ¾­^,@=€wd¢<=2|Oa³HJ¼,óª°“³ÞâY{ÔŽn›>¬Ò¹ ‡Í ›EerîíÃB;!À¹1ö n\õÅ×wéfAÊRx€|¹½ûVOèŽî¸´¹.íØ–IUŠ&àxæH€ûlp‹¢fÈQ´Ù{a×;ÏÝ=†¸wêñГ­ÐȰ Ò‡jÒ?¡_%Œ‡N‡¹ÇÁÆaƒà)h@ö˜Fwa€œ’?žºR NgøF¾ŒBl÷¾a„páÈí¶} ÝmƒÄy y’)üŽÂÿD3ÚàÀ>QY{Y/A!+k²7õ{rÀ  gΈ¿Z_&L®«/ÑY«ÔE­6 †£Ãª},"‘4úm‚¬¤ÚÃXÕ`Î<43–¬TnÆ—ã€òEv!þ™ú¿‹ls^1NÛnš Ð à\X,IVu9o{×·}:jN’µ:sC‡ –¼{‡"úøëÈF-c»ŸONcg 7U”sˆ…Á{yù‰»—Í9Žâôìবâ)ôøè€!%H(ÓÓ†»`¸‚»&ë##>= tzOs~xޏ4ÙÛESŠ_Ôö Yê£ÓTan„™¦Üq ”ƒåià ³Ù“ìµâŽSU’î?J¾êçÊÎ,vd€®i)ÚÎÁ—&n‚™Òæ wèú–Neî&J޽@º½Êx¡ã¡›Gá¶s´Â‚µ 1ò´0‹Ñ;mCÁ‚A*|qJœ¯§'öÔö^–ˆ2¸‘‡õS Ë„§…ËF«lãYqr£ôÂÆÐÒŒƒ² éR"%·rNhÞMdzR±?/õ±”W×Ñm÷ËSTÚð*[:•¥9•½æ g6" wq5Ã)•°Tg ðìªó6^¢»$Ó—½Ý-ÁQ9V²M»Ü¸StèwM®µ†ì¼žøÖx´#ÑÌ­™°’ξ!8RS²SB¿œ@Ï'gÃvK¥"è»svÏÝÎý²kCÊ>wÔ>„ÆÀtÝñ#J7&³ƒŒ¨V¹«€•ä}®°ì£ÙwÉÙdø÷R³„î³Ëþ63çcCqè~GÖèn/²Õ£ y’Q¶Y'ómÊIR÷Ó¢²lº'ç6­j³×<ºYKéíÈmâ¯`<ö·<0Q”VEŠÐ2Âjén‚Ž–JÁ‹:ÜEᜠÃfjfSÁ‹æ)oó·±’?y—ÊF 1Siˇ>R€:^ÕVÀÇ£m!ý︆ºãiN;ñùÙHæNŠ {ÌÅ7K{|¬Á†ÐLp™±AÌ 2²v…KÑ"œNµŠ°šó¿½ÔEpc,º/Ç^*Fî¢Bÿœ×’©“¢^KqHŠD§CT^<{xËðñYµï|…Ø)>IÓ"¢3q*Ƽú K“ÛÚC×sdR+©Cœh…Jë2)×›ÜÁK€sµËe¾j»§_c¶êO«.gzqËØ¼ñT~³Þ-(»¿P€‰%IJ¢‰sæ¦ÈzWü¥ãö®pßËùB‡sz}8j)pÔR„öàÚ³Ÿ‰JᜒT-äȲý“ :Hxa%0¹)`{PΜ²Ÿ»È, ÁÀö¤L5*IS?[Æ¡)– ”®R"ËЈp,’zxƒ •xƒ%CçÙú!Gí6þ%Šœ"wó%Z8¡“Ó;nz0všx•Dµ£0y­FJ²;R2ãä†þ=øûyWçuWYÁ$ô‹Åy?ö¸(Ð I 7c«yäÕÐî"X€^RÝTÙv8ùi9`ÅfK§m>rEut4ØAgR¸ÕfÚtmJƒÉT!+ÿ,Å÷Qj¯«— Am^•ö7š¯n«#×ÉW$’4vTì†fìô¹ÝíÃç±+w¯ }­Ë6Q,ÒjVü'tTLîôÞ´šUvQ A*[ƒ¯RîEí–RÄê’Ž±5¹iÚŠ¶Éƒš¯¹:,e"öÆ×\Z;»|E»ÜiÃl^|«Óª\é11¢B.SÔæu(¦… B¡½s~H„³÷ó¦´X‡Ÿ¸BÂÚû­pÁp¶Ð®ÆB³–4y|{(H ž)“?bˆZ`í†VC×WÿÆ—p)­Œêq‚i‰Ôž}… c¤Ý»<_Ÿè6óCÚ{ÍŹÞØ ‹žÏ.w•8è“¢ 9§ä“¦ŠS¡EôÈÅ^\~ù*¥<¹PäMãoT°"¿P©l^4“dj;¸WÝ€rœ”ï¨s;Ž©¾ü̼L CñkÔ?CôÕ¥¸Š›„Ç~üW…NÈŒF¢¥u -í'²~íj‰–ß§—v[°éÞâK2Æ%6˜¾ì6QíÊÚ‹ æ¦ACUåEe^ ÐxžA LÌy 9SîM5&ù¾Û ÄÙWu`Ž«Á@p.¹¾,¨–eÄãßÊc…ÈǽþC°TD÷Üç ?ñ<Ïéü…¾¿õ¸NliãwàÁßÍ¿q××uѬ1…ïªzšò½O}r`<Œ>ø=p¨CK¾Œ˜›¼,}}!ª®ã·XòÖøË6,…yn¶T5ââJïên‡€¤¦Be°G)Øì'_ç¼G¥øÈ£«©/r4àÃ6|§ñ¹iN`ö¸¸·%¸‘¦0 ¤enÛ6 Uæ6 /Žª€LUÉoûáȹEþ7ò½‘ßýÜØÑG§ßJ¹£I‡ÇrF©?š@è·ŸMÿÜ‚žácdW`X…œE^+±E‚{õæöÕïY endstream endobj 184 0 obj << /Type /Page /Contents 185 0 R /Resources 183 0 R /MediaBox [0 0 612 792] /Parent 174 0 R >> endobj 186 0 obj << /D [184 0 R /XYZ 63.8 705.06 null] >> endobj 42 0 obj << /D [184 0 R /XYZ 64.8 700.753 null] >> endobj 187 0 obj << /D [184 0 R /XYZ 64.8 651.551 null] >> endobj 188 0 obj << /D [184 0 R /XYZ 64.8 619.965 null] >> endobj 46 0 obj << /D [184 0 R /XYZ 64.8 529.529 null] >> endobj 183 0 obj << /Font << /F47 126 0 R /F8 127 0 R /F54 128 0 R /F56 129 0 R /F58 130 0 R >> /ProcSet [ /PDF /Text ] >> endobj 192 0 obj << /Length 1185 /Filter /FlateDecode >> stream xÚÝWIoÛF¾ûW¾„ŒÃ gÈáR4=¨ º99P"í¸‘DÕ¤*Eÿ{ßÌ{Ã.¢äÜÚƒÌYÞò½}üqyõþV&‹œå‰HˇE³l‘ä!Ks¾X–‹{ïÞç‡ßg?"ÒKá<ŒS/±_s%W†4õ?/y›9ªxÌò8^‚³œg¨ìÖÏb¯~Fb»ÔKS¹‘îTýîKî»GXVðkÆ¢œÉ(5<ŨJ?ˆEì5õ¶ÂUÝÂé%cJk±PFFiâ9¥’¥¡0,%JæÞüþò¥ôŠ¶Û‰Ì«X½(à£æë•’Z)C‡ú¬ÔÛqÅYã¹Zöðgï"¶„¯$Ñ+¥ërîÔZ©ÚvÀÖ$sGîÙ(Ñú¦Ø(Ï 9‡„KJ´NÃ+íF^t]ìqý„é¢x“`?À/Ö‰†’¾7M0ü‹Î=&Zr Ë\nèÆPa´õU¬ !˲Y „°E#§Äí‘ì.;±ÚQ=ɨ†DÂsXcUP1‰0—´V"Â>š{}a™3‡9¢³äcDŒFCì0çç˜ã³ìŠ™íùdÌ݈MÄ|ìeî} eHn}Æ-GÆa÷Ám3ÿ¯<‘ÿ½i ·Jž˜¹2Q˜±(‘¯› PG¡í¯F bÒ ˆu‹“Còt8eÔ\)-©º¨·ƒH„LÒ~DUÑìÚÊ—¢ª$üúÔÕìuœ2;›§&@€çÆ€Íÿéò–Lˆ~…;CùÚwDô5ù<|Ÿ¤ô5Å’ÛÚ%wß>#ës–ŠÁ;æ"E&1…FïZœØQ„VoèwÐ^Õ™…ù¦)œLÇ{Õ*õŽŠâ¨#ÿ¦­×äßÊ^àGeÇÁÔ@‹òFP÷ú5ÐâyWX'F}0UÐé=«©ÎtfÕî\võ;Å>‹j:£‘ñBÕ/¤GQmñ能!¢-)§²rˆJ‚²w:{Cg¤¬!L+gŒ=Ñ÷@ߪM²îónª•Þ@ ™Jmftp]“ áRT_áwmj:è.£‚Àhh!£#f MŒ…$ýûÄ—)=œÉøGêÎí(„|NÄ“ÂÎôoúÞ³áìL¸>™Aè×áÓêõP›HùÚÂØ:Ïq' N¼`† ‡áïåà‹å³o‡ EÍØ§Ý»r`‹«tÜýe¡VÖ|ìqwîf|™oúŽ8aµ}þÝØ|Êî¤o÷°Ù0R¡T­šsî›stœRÒÝñl¾:©ΦÀjìseð[K1Su7ÃFðÚ|ùFŒÁ-­Çµ1‘Yo{u<èFm¼ì`Žpú31¬ûévY&—A£<펋’—¸WʽÄWNJç„=}m»×^tgÙ¦?Çú3ó¼(“؃†~¦|àÌÝw?#¦ÿ—½Ý„ÈY¯¶ —,ׄW?/¯þK^4 endstream endobj 191 0 obj << /Type /Page /Contents 192 0 R /Resources 190 0 R /MediaBox [0 0 612 792] /Parent 174 0 R >> endobj 193 0 obj << /D [191 0 R /XYZ 63.8 705.06 null] >> endobj 190 0 obj << /Font << /F56 129 0 R /F8 127 0 R /F54 128 0 R /F58 130 0 R >> /ProcSet [ /PDF /Text ] >> endobj 197 0 obj << /Length 2081 /Filter /FlateDecode >> stream xÚ¥X[Û¸~ϯ𣠬ñ*i è¢ ¢X´é }ØÝ,Ï8±¥‰eïtþ}Ï4•‘³›ƒ±(êðð\¿sH½*áO¯t­U½ Úª²´«îøæó›Ry§CEù˜>jY'oßÍêÏã›À_ü´až›ŒéwoÞ¾«Wj‚ «»ÝʘJ™Ð¬|£UYûÕÝvõSñn­‹=ü?\NðÛ¯7ÖÚÂ|¿Þ8g‹¿ÃÔþÇ3Ï;|šb<ÅUû~ÛOãl;<ôð˜Ôú—»¿¾ùË]’tu©‚þŸt¶·t¾ò\P9¨J‡•óµ ùŠÊö7T&Ò-ü\:-küö«VZ«Æ{ƒlt€`cå- à\éõFkãŠGx;‘n‚×V/Ì.צD••­5³ù'ŠyìϢΑ¤øÓUÁl`hi8ñp@’®Ÿp¦EÙ_xYŒ8tŇ,Îáp¥ õŸPRLÈgX›*îÑòcºÀü=²ï?£©ˆŒì%b=ÃøgO½HtݹÇízܹÖuq¡Ûè% 16&}{¦y]l…nEç–váUl0'YœÃ|bIà+QÿŠÛ’“Œÿt • "ÈošÍjêÍŠCPLÑ¡¢í„óãÛI.q“Ý…Œ&Å즮hø(Ž> Û?[ŽïòÀ¶Ã¡…H‘kˆA-F™^‡uÊš´d¼_o¼+>RHˆNíw$¡È‘(iï‹g”°w Ý0òS\—EE²M›‘“©ŸÈX8bnÉ1àQ¯læþ!À«œ8ó*NlÅzÀlâ™AòÖA‰û9   Ñ¿ÑÌ{IñžW!Ë_×"ÓéeÁغv*¸êÛŒí•ošÆ&‹:ëÈà(Ã’‹}P¥‹ þµ®ÀÌkoŠNÔ{¼ÞÔæA±ÊïICïÙâü†‘NBØâ1I1°íö˜„O¡í$èÝ<µ(RÑß±mÙ( °ƒè=Hî– Ž;Ø²Æ ×5Ý•"&AÏDS{¼~ãs†&Û'´N-ZËH Z>òyÀ‘C4!ƒ¥)¦q¾{–5YÈÁžìq¢¼gê`a>¥#Å)á?_®ˆ&’·"äó^ydö4™ ±€XÈX8õÿ‘ÕTxVکƹ9õ[s>4£\?’¢ŒùðóþÆ”µÛÑ]¥aYßùØ ÎEÏ"Oñ á seVGìæˆ$}n•þÄ“-? Õ4YËÆ'TØfq‚߯œ•ŽàÆŸvüd÷EûRY?MŒUÅ/꺄nÂÚ¹­)6.µCQ)àXÚ²–g^!qÓ¤¢ ŸQ€v¿åùX©a^bp ¯ªRU&¹gÈÝ»TB‚6Føá*Ãù*Çé•àŒíØ8 ?—¾láGóâˆÅ8¦¢þtFþð ‹yòÀz íÔ9¶BöØbl0XÍŒ8Ä"»¡è¹H¤–”XKüÜ?”lÛZ$¨.þìª2Šsÿ¬õUÒÇ£È!E‚â£ø)¡àœS7ã4žpQãS˜!§ñÈ/TŒvÒ±Áû=ìë"uÙ“¸EH¶Û.KÚ‹µP,bÒâÞÛ.C!"Ì]ÐsŒ{]_]@У'Y㎹óCü±XsßcÏü–£Á}êèó3™7Jާ~È”®Ý%Ë«ÖÎbS\»€Š!GEéKœoR‚cÒŸÞe‚ò†ÝÌÄ[(¥+™àDû@ý|"'Y+EÌ…r¹‰+r¶^ÌÓ¦ø]@lËp³Í€Ü Mˆ¾Ö2(b¬é໇KËæKÀõiùÁ KpM Ë‘D ËéV7*Ôõ~¿ÄÖP+OŸ ˜ævüÜçA 8–j“41ü²à|NÌš+óSÛÍ¿ü5žèœ#+¢’4NàBI š |âNU"dl[‘­l¾ÄZ‘ŠYšùrH!qa<1¥cêžÁ•¿GÍ¿¸ €Ii¿ ¹¼‚ýÍÎA¶#ôœ~›À§xøØ©^bÇ3áE‹Õˆ÷E©ÜN—±®.ŸVš«8ñé†åkÒ7ÕÉÕhÉ– Ø'êͤ3qQÆ…¯Ô²º0Çëuð4»©êb ì&åÀ;q\ÑßBÀ€ÚXÂñOyÛƒ¥öz°%ÊÔYbá¢Ä[<¯Û¼e¾õº¯º}%µ޽J×ϦL«™X›xyÿ_§‹Ë, endstream endobj 196 0 obj << /Type /Page /Contents 197 0 R /Resources 195 0 R /MediaBox [0 0 612 792] /Parent 174 0 R >> endobj 189 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./IRangesOverview-ir-plotRanges.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 202 0 R /BBox [0 0 432 162] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 203 0 R/F3 204 0 R>> /ExtGState << >>/ColorSpace << /sRGB 205 0 R >>>> /Length 338 /Filter /FlateDecode >> stream xœ¥“OK1Åïù益13ùmQ¡ P»àAÔÃ#4žc’¿…â²7ÊGFä¢%/ð¤C©U1ÏX endstream endobj 202 0 obj << /CreationDate (D:20131029202325) /ModDate (D:20131029202325) /Title (R Graphics Output) /Producer (R 3.0.2) /Creator (R) >> endobj 203 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 206 0 R >> endobj 204 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 206 0 R >> endobj 205 0 obj [/ICCBased 207 0 R] endobj 206 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent/dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron/space] >> endobj 207 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xœ–wTSهϽ7½P’Š”ÐkhRH ½H‘.*1 JÀ"6DTpDQ‘¦2(à€£C‘±"Š…Q±ëDÔqp–Id­ß¼yïÍ›ß÷~kŸ½ÏÝgï}ÖºüƒÂLX € ¡Xáçň‹g` ðlàp³³BøF™|ØŒl™ø½º ùû*Ó?ŒÁÿŸ”¹Y"1P˜ŒçòøÙ\É8=Wœ%·Oɘ¶4MÎ0JÎ"Y‚2V“sò,[|ö™e9ó2„<ËsÎâeðäÜ'ã9¾Œ‘`çø¹2¾&cƒtI†@Æoä±|N6(’Ü.æsSdl-c’(2‚-ãyàHÉ_ðÒ/XÌÏËÅÎÌZ.$§ˆ&\S†“‹áÏÏMç‹ÅÌ07#â1Ø™YárfÏüYym²";Ø8980m-m¾(Ô]ü›’÷v–^„îDøÃöW~™ °¦eµÙú‡mi]ëP»ý‡Í`/в¾u}qº|^RÄâ,g+«ÜÜ\KŸk)/èïúŸC_|ÏR¾Ýïåaxó“8’t1C^7nfz¦DÄÈÎâpù 柇øþuü$¾ˆ/”ED˦L L–µ[Ȉ™B†@øŸšøÃþ¤Ù¹–‰ÚøЖX¥!@~(* {d+Ðï} ÆGù͋љ˜ûÏ‚þ}W¸LþÈ$ŽcGD2¸QÎìšüZ4 E@ê@èÀ¶À¸àA(ˆq`1à‚D €µ ”‚­`'¨u 4ƒ6ptcà48.Ë`ÜR0ž€)ð Ì@„…ÈR‡t CȲ…XäCP”%CBH@ë R¨ª†ê¡fè[è(tº C· Qhúz#0 ¦ÁZ°l³`O8Ž„ÁÉð28.‚·À•p|î„O×àX ?§€:¢‹0ÂFB‘x$ !«¤i@Ú¤¹ŠH‘§È[EE1PL” Ê…⢖¡V¡6£ªQP¨>ÔUÔ(j õMFk¢ÍÑÎèt,:‹.FW ›Ðè³èô8úƒ¡cŒ1ŽL&³³³ÓŽ9…ÆŒa¦±X¬:ÖëŠ År°bl1¶ {{{;Ž}ƒ#âtp¶8_\¡8áú"ãEy‹.,ÖXœ¾øøÅ%œ%Gщ1‰-‰ï9¡œÎôÒ€¥µK§¸lî.îžoo’ïÊ/çO$¹&•'=JvMÞž<™âžR‘òTÀT ž§ú§Ö¥¾N MÛŸö)=&½=—‘˜qTH¦ û2µ3ó2‡³Ì³Š³¤Ëœ—í\6% 5eCÙ‹²»Å4ÙÏÔ€ÄD²^2šã–S“ó&7:÷Hžrž0o`¹ÙòMË'ò}ó¿^ZÁ]Ñ[ [°¶`t¥çÊúUЪ¥«zWë¯.Z=¾Æo͵„µik(´.,/|¹.f]O‘VÑš¢±õ~ë[‹ŠEÅ76¸l¨ÛˆÚ(Ø8¸iMKx%K­K+Jßoæn¾ø•ÍW•_}Ú’´e°Ì¡lÏVÌVáÖëÛÜ·(W.Ï/Û²½scGÉŽ—;—ì¼PaWQ·‹°K²KZ\Ù]ePµµê}uJõHWM{­fí¦Ú×»y»¯ìñØÓV§UWZ÷n¯`ïÍz¿úΣ†Š}˜}9û6F7öÍúº¹I£©´éÃ~á~éˆ}ÍŽÍÍ-š-e­p«¤uò`ÂÁËßxÓÝÆl«o§·—‡$‡›øíõÃA‡{°Ž´}gø]mµ£¤ê\Þ9Õ•Ò%íŽë>x´·Ç¥§ã{Ëï÷Ó=Vs\åx٠‰¢ŸN柜>•uêééäÓc½Kz=s­/¼oðlÐÙóç|Ïé÷ì?yÞõü± ÎŽ^d]ìºäp©sÀ~ ãû:;‡‡º/;]îž7|âŠû•ÓW½¯ž»píÒÈü‘áëQ×oÞH¸!½É»ùèVú­ç·snÏÜYs}·äžÒ½Šûš÷~4ý±]ê =>ê=:ð`Áƒ;cܱ'?eÿô~¼è!ùaÅ„ÎDó#ÛGÇ&}'/?^øxüIÖ“™§Å?+ÿ\ûÌäÙw¿xü20;5þ\ôüÓ¯›_¨¿ØÿÒîeïtØôýW¯f^—¼Qsà-ëmÿ»˜w3¹ï±ï+?˜~èùôñî§ŒOŸ~÷„óû endstream endobj 194 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./IRangesOverview-ranges-reduce.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 208 0 R /BBox [0 0 432 162] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 209 0 R/F3 210 0 R>> /ExtGState << >>/ColorSpace << /sRGB 211 0 R >>>> /Length 316 /Filter /FlateDecode >> stream xœ¥“AO1…ïýï—±3¶»Wˆšh‚lâA<&1büûvw˲£Ûìë·¯3ûÚ2&`¬±5SláK²ŠèHN…¢@Jò‚Ý x7Wû‡Û{cÉZ‹þ¸_ðxö žïÓlôø4OϰXÆ$=kÃõ¸3¡ aŽ‚B¬’·à4ÕÔg-•’1+ñ)UGâ2Õ’\èÓôgfTýÚüKIT/õê´C«¹,ˆ,‘Ô£Ú`°[-?«ùàu7Q­ÍuÕ”ú_ J¡È;°I{(†,ß0;í ¤¥ì<‰íp–G.Ö×[zàYöxl^;ÞÊ#?i§ëîÈÿ²äå,äF&硱>ruÄök½òÏV–‚¼ëyùs™~¿°\`–®Hì™Ýf§I=³væ©ùª¼/ endstream endobj 208 0 obj << /CreationDate (D:20131029202325) /ModDate (D:20131029202325) /Title (R Graphics Output) /Producer (R 3.0.2) /Creator (R) >> endobj 209 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 212 0 R >> endobj 210 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 212 0 R >> endobj 211 0 obj [/ICCBased 213 0 R] endobj 212 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent/dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron/space] >> endobj 213 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xœ–wTSهϽ7½P’Š”ÐkhRH ½H‘.*1 JÀ"6DTpDQ‘¦2(à€£C‘±"Š…Q±ëDÔqp–Id­ß¼yïÍ›ß÷~kŸ½ÏÝgï}ÖºüƒÂLX € ¡Xáçň‹g` ðlàp³³BøF™|ØŒl™ø½º ùû*Ó?ŒÁÿŸ”¹Y"1P˜ŒçòøÙ\É8=Wœ%·Oɘ¶4MÎ0JÎ"Y‚2V“sò,[|ö™e9ó2„<ËsÎâeðäÜ'ã9¾Œ‘`çø¹2¾&cƒtI†@Æoä±|N6(’Ü.æsSdl-c’(2‚-ãyàHÉ_ðÒ/XÌÏËÅÎÌZ.$§ˆ&\S†“‹áÏÏMç‹ÅÌ07#â1Ø™YárfÏüYym²";Ø8980m-m¾(Ô]ü›’÷v–^„îDøÃöW~™ °¦eµÙú‡mi]ëP»ý‡Í`/в¾u}qº|^RÄâ,g+«ÜÜ\KŸk)/èïúŸC_|ÏR¾Ýïåaxó“8’t1C^7nfz¦DÄÈÎâpù 柇øþuü$¾ˆ/”ED˦L L–µ[Ȉ™B†@øŸšøÃþ¤Ù¹–‰ÚøЖX¥!@~(* {d+Ðï} ÆGù͋љ˜ûÏ‚þ}W¸LþÈ$ŽcGD2¸QÎìšüZ4 E@ê@èÀ¶À¸àA(ˆq`1à‚D €µ ”‚­`'¨u 4ƒ6ptcà48.Ë`ÜR0ž€)ð Ì@„…ÈR‡t CȲ…XäCP”%CBH@ë R¨ª†ê¡fè[è(tº C· Qhúz#0 ¦ÁZ°l³`O8Ž„ÁÉð28.‚·À•p|î„O×àX ?§€:¢‹0ÂFB‘x$ !«¤i@Ú¤¹ŠH‘§È[EE1PL” Ê…⢖¡V¡6£ªQP¨>ÔUÔ(j õMFk¢ÍÑÎèt,:‹.FW ›Ðè³èô8úƒ¡cŒ1ŽL&³³³ÓŽ9…ÆŒa¦±X¬:ÖëŠ År°bl1¶ {{{;Ž}ƒ#âtp¶8_\¡8áú"ãEy‹.,ÖXœ¾øøÅ%œ%Gщ1‰-‰ï9¡œÎôÒ€¥µK§¸lî.îžoo’ïÊ/çO$¹&•'=JvMÞž<™âžR‘òTÀT ž§ú§Ö¥¾N MÛŸö)=&½=—‘˜qTH¦ û2µ3ó2‡³Ì³Š³¤Ëœ—í\6% 5eCÙ‹²»Å4ÙÏÔ€ÄD²^2šã–S“ó&7:÷Hžrž0o`¹ÙòMË'ò}ó¿^ZÁ]Ñ[ [°¶`t¥çÊúUЪ¥«zWë¯.Z=¾Æo͵„µik(´.,/|¹.f]O‘VÑš¢±õ~ë[‹ŠEÅ76¸l¨ÛˆÚ(Ø8¸iMKx%K­K+Jßoæn¾ø•ÍW•_}Ú’´e°Ì¡lÏVÌVáÖëÛÜ·(W.Ï/Û²½scGÉŽ—;—ì¼PaWQ·‹°K²KZ\Ù]ePµµê}uJõHWM{­fí¦Ú×»y»¯ìñØÓV§UWZ÷n¯`ïÍz¿úΣ†Š}˜}9û6F7öÍúº¹I£©´éÃ~á~éˆ}ÍŽÍÍ-š-e­p«¤uò`ÂÁËßxÓÝÆl«o§·—‡$‡›øíõÃA‡{°Ž´}gø]mµ£¤ê\Þ9Õ•Ò%íŽë>x´·Ç¥§ã{Ëï÷Ó=Vs\åx٠‰¢ŸN柜>•uêééäÓc½Kz=s­/¼oðlÐÙóç|Ïé÷ì?yÞõü± ÎŽ^d]ìºäp©sÀ~ ãû:;‡‡º/;]îž7|âŠû•ÓW½¯ž»píÒÈü‘áëQ×oÞH¸!½É»ùèVú­ç·snÏÜYs}·äžÒ½Šûš÷~4ý±]ê =>ê=:ð`Áƒ;cܱ'?eÿô~¼è!ùaÅ„ÎDó#ÛGÇ&}'/?^øxüIÖ“™§Å?+ÿ\ûÌäÙw¿xü20;5þ\ôüÓ¯›_¨¿ØÿÒîeïtØôýW¯f^—¼Qsà-ëmÿ»˜w3¹ï±ï+?˜~èùôñî§ŒOŸ~÷„óû endstream endobj 198 0 obj << /D [196 0 R /XYZ 63.8 705.06 null] >> endobj 199 0 obj << /D [196 0 R /XYZ 270.835 603.04 null] >> endobj 200 0 obj << /D [196 0 R /XYZ 270.282 470.648 null] >> endobj 50 0 obj << /D [196 0 R /XYZ 64.8 429.125 null] >> endobj 54 0 obj << /D [196 0 R /XYZ 64.8 130.826 null] >> endobj 195 0 obj << /Font << /F8 127 0 R /F47 126 0 R /F54 128 0 R /F56 129 0 R /F58 130 0 R /F63 201 0 R >> /XObject << /Im2 189 0 R /Im3 194 0 R >> /ProcSet [ /PDF /Text ] >> endobj 217 0 obj << /Length 1937 /Filter /FlateDecode >> stream xÚ½XIoÛF¾çW¨=Q¨Åp†3\‚¦@[4hŠ #7(hJvÈ¢£Åqþ}ß6äJv=H’oÞ¾|Ã_._¼|SÌʸÌt6»¼™åeœ3ËÊ$ÎK5»\ή¢ËOs­æ/ÿxùÆX«8)ì,a²÷s«¢j ´·D¯¢=üÞ­ñÿÀ»}IVǪ,ÝæzTÕž6-ÒÒÂz,v‡î.Q•êÀ÷ø¾ªç:‡§ü`#‚ïVÛ¹."¡[{\V([Äe‘Ÿ2c¤|jc£´ÛÒ\ÏÖDŸ‘¸¡ÄaÉë{4¤AE`µ¦ÀZtªRöÿV[! E½bŠ»¹¬oæ à‚»÷¨Õl¡ g:Ÿ-”ŠKkY¡ýw‹g€=ˆg¾iœ©3b/2*T62Å*i­¾°´q–·1E­Ù #NªˆMáè*¨Ç ¨ Û²ûêùŽSa¬ DR· VuÍno5;N]¤½1Í CÓ4%9˜÷ΤÚY€¾1†§ÙºÄÛ]ù¤:\¨I*ë†~z’a¦ˆu—L,渧­¤ÍЧ~&š$6‰çRcQZ|©1_X®ÅäJç ‹6чy 5J™q‘æ&úíÑÕaEI)9ÊbŽPZÛŸqŠ©$:|’J‚5Ïá;ö? !7ÃáUsÃ×P}—'ÒçÍaÛ¬œœÃ¨ •X77EÅšŠm¿ÂttÈ# 8­Ž×D_ðŽìá‘‚íCΪ•44àzW¡¹rsM2EÞ‘8-ùõX»«ý¦/×[¾RgÈåæ«4ŒYq/­Vmø zʨ2ú³á:‚vRô‡ Üu¦lù>Ø€!Šnni¨Þ!h@i¦0fк·'–AîPŸ 3”wÛÀi°ïk*ŠÓd¤H>rÃÒ¹v çXA2/÷%U|¡××—;Ð%<||ˆùcKbÌmŽK øÈôÃRí\Î嬨=pÊ¢UåZÚ’ßQªŒiȯK×èVK aZDoo˜Üó Þ†¬à7ûëPDu¢AWŽóTÃb¶R`\sÜ[ÐHN$“Á‹075b1Sôß6QfËW6Õ¡j÷-”v) '8”ˆÌbÙ*¹ âÔ¢ë 2±¨dK¯OÊÔ^[5äðxå ôÏq\E-LØ0o g;㚺FwÜ»–8uÔÎùN˜÷êªÅU÷Ž °P*Ãø‡p…ø„äüÞBG‹væz˜§õî|Úùš/uGhhÚáHä™|ÑMÉÒ{L±¥7B0>$ø”lM†Æ«X1ÿQŒq@âÊÃ@Ó.Áq~Ô¬O€šEOê³@³¬çB‰GËâ…÷/wнÞr_ul5 ŠÄ䈖‚×sï=:dS¿ žñ¤mç¯0¸m\×ä‚Dù¯d_2à“ Ì™z¸™UŽ˜ÉÕúéÚR÷Hz»ào!á"@#ðÍzËm÷áŸþ¢ñ íhE]sï¼ïŽZû³¨ðòSw® 6ÃÀ§ƒN”™:Z·ß”¨×ÊFÂw?3,.3B Tn®J÷¬š|“AÐÑ2½—¶ìànЈðNÝÓ&•ÊØÚgƒÙ¼(§¿„†~± šàÁðyŽ=w@\JõÔrÿ„Ãâ¸ÕV"*vhÒk­kiµÂ¸9}z”T¾3¾xõ½#”­¢ß½î¸ïN¬ŒeTôÙ!s!é“óW7'ÈúWí¨¢CÉ•¥Òϳ4Ü‚Ü)Ðß ÏmHÒsÌ`ƒ9·Á6Øs²Á†L6ôÚž—òÁ†\6¤O<ÅZéa¿6ÜZRˆÍù^ÆoÍÿÜÈjÉZ¿Æª¶Œ¿RY8·ðºnxDëÂïZî°ƒ]ŠÎ G*X0_íøµáºãƳ’ÆÖkzôd…_Ñ úŠìù„Òì]ʳ¡aø˜Àù[å¡îÓÙ=ì@§=î!ÓÍÃ}clDÛ3ô‰\§µ÷›ÕàQ4óD7ÝW´Sòº¶òÖõ g{`Ú}œøÇƒ3gþ”* 51ÄvýJ/GÊ.EÑùMI'âïàNpyêg]³›vÍ ¯ùæJ^]x_þ~èŸ8¦ÈÝç»ît9¤þÏ!Štiµô fÂßV39”Lè±ñÜ4(Ÿû =6<}rÑ1þ*_Ë zxô¾ëŠº7ñ{'}€Y‰*fÐØc£™—¢1òâ·Ëÿ‹È† endstream endobj 216 0 obj << /Type /Page /Contents 217 0 R /Resources 215 0 R /MediaBox [0 0 612 792] /Parent 219 0 R >> endobj 218 0 obj << /D [216 0 R /XYZ 63.8 705.06 null] >> endobj 58 0 obj << /D [216 0 R /XYZ 64.8 574.142 null] >> endobj 62 0 obj << /D [216 0 R /XYZ 64.8 421.568 null] >> endobj 66 0 obj << /D [216 0 R /XYZ 64.8 241.54 null] >> endobj 215 0 obj << /Font << /F8 127 0 R /F54 128 0 R /F56 129 0 R /F58 130 0 R /F47 126 0 R >> /ProcSet [ /PDF /Text ] >> endobj 222 0 obj << /Length 1739 /Filter /FlateDecode >> stream xÚÝYsÛDø=¿Â2í¥ƒfè@fÊÅ<•£ÈJ¬â#•Bùõ|×J+[&¥LFÑ®ö»ïµZ¤ð§ªPI±È”IÒÔ,êÝÕÇ«4qVe9„k:T‚'nÞììâ»ÃÕÏðçb¦D_¯®nn‹E™”™Î«{`k“Ò™…+U’n±Z/ÞE·Kµð<ù*Ÿî8i] F_µe\úr€bkzNhɼ4ª„B\£ ˜ Bž ÀÄ(çYšN#¤ÐV ñ̬¡arRå ],Á‘ÏF¯‘ëÖÏ×~KN@ß?6#7î:ÜFéüdÄ€S®J\Ì: T)¿¹Uz?BŽUÂÜ“"ÅÚÄ*OœïNß@ÁÕfÆÊÏ7­dô5Câ\’ò©º`ãvbã7ùVæ:Nß ˆØØÑr+'JFb<Ê)Ëaš- uîÂc06ÁÓYóöÙ÷í,U ÁŒ ¾£œWÑ{°lZ:Zc HmiXëà»&2'AõަЀ€A—©2Ê.!›l€\¾„lO Aö¹KÜ 2 `_âžÈ6ݲ$„<5Z`õ<@vcŒìˆ0#ççªàffí4èV¾dX]Æû– Ÿ&5_LÏ#[¥ebì0Ò¾:—Å%Z£Ìõ —¸4÷ñ9<)tþâTªfÖy°¯æÉ ·‚‹Çf¬,¨·öc°$Z"(ë0dVwÄP‰qHEÝÝÿ$qÁT;> endobj 214 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./IRangesOverview-ranges-coverage.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 225 0 R /BBox [0 0 432 162] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 226 0 R/F3 227 0 R>> /ExtGState << >>/ColorSpace << /sRGB 228 0 R >>>> /Length 651 /Filter /FlateDecode >> stream xœ¥•ÍnT1 …÷y /a‰íün§¤J ÁŒÄ±* QuÚ.x}œÜÜ$½-mG]ôj¾9ãÄõøœ!8‚K¸6Ÿá|Fë :â#gô 7?á+ü1oo¿|ØÁÅ­±h­…ùy{±ÊgûäýÙ'}7zøk¾} ? Á¹þ]*€&$d‚ÑGHC@ËÍ;C´¼0$о„fQ»N©UÞCÀ,­’¬Ç˜f5{$úŒù^©X‹™Û¹äì,:A–õÒŒ&QGiv‡'§õ^tô‡_åì&,…™µ+ýGtGxõûæ5.Í»C½àeÃveË}Ô¯:` ¯`¿‘ÒAò¢’xdÛå†Cç2fîzÃIõe×úvzwCÎh¹–7£­Ń‹e³Ë`í:×ròã¥Ä ½LµtJqVÍó Årݵ^,'‹SHS±³Ó.=Ó÷ºkôà®I¹â c'‹àh¢.KhteRõ\§ê£•r@74²Ú]¨§k—€Ø`u½"×<é(„aR%£ut5$:zÆ$÷p½hÉžŽ-m6¸Öê€s˜¨L}`B;©K4m0s±Â•ZŒ‘ò׳ÍÅ+) Ø,eý;ŠE7©Róf‹í?bçÐ۞Ї SyÑ1x “µ[ÚbtÅOs5ýŠÚ@šÔ,˜bÇ5šïâz²Øˆy,ƒGË[ìµÌ%·f$() l©ûÉÞ"§ #ʤjŒJ©¸m`B7©É£êþå‰ß,^;?6ÃçTv¹DêF%L+ µ9¸©­µ¡Ö…éê²>]]uUÛÚµöÑÕÞÕ A?eÝ›)Õ¥¢òõߤ´V3ɵ¼í‰iþ”#Õ< endstream endobj 225 0 obj << /CreationDate (D:20131029202326) /ModDate (D:20131029202326) /Title (R Graphics Output) /Producer (R 3.0.2) /Creator (R) >> endobj 226 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 229 0 R >> endobj 227 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 229 0 R >> endobj 228 0 obj [/ICCBased 230 0 R] endobj 229 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent/dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron/space] >> endobj 230 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xœ–wTSهϽ7½P’Š”ÐkhRH ½H‘.*1 JÀ"6DTpDQ‘¦2(à€£C‘±"Š…Q±ëDÔqp–Id­ß¼yïÍ›ß÷~kŸ½ÏÝgï}ÖºüƒÂLX € ¡Xáçň‹g` ðlàp³³BøF™|ØŒl™ø½º ùû*Ó?ŒÁÿŸ”¹Y"1P˜ŒçòøÙ\É8=Wœ%·Oɘ¶4MÎ0JÎ"Y‚2V“sò,[|ö™e9ó2„<ËsÎâeðäÜ'ã9¾Œ‘`çø¹2¾&cƒtI†@Æoä±|N6(’Ü.æsSdl-c’(2‚-ãyàHÉ_ðÒ/XÌÏËÅÎÌZ.$§ˆ&\S†“‹áÏÏMç‹ÅÌ07#â1Ø™YárfÏüYym²";Ø8980m-m¾(Ô]ü›’÷v–^„îDøÃöW~™ °¦eµÙú‡mi]ëP»ý‡Í`/в¾u}qº|^RÄâ,g+«ÜÜ\KŸk)/èïúŸC_|ÏR¾Ýïåaxó“8’t1C^7nfz¦DÄÈÎâpù 柇øþuü$¾ˆ/”ED˦L L–µ[Ȉ™B†@øŸšøÃþ¤Ù¹–‰ÚøЖX¥!@~(* {d+Ðï} ÆGù͋љ˜ûÏ‚þ}W¸LþÈ$ŽcGD2¸QÎìšüZ4 E@ê@èÀ¶À¸àA(ˆq`1à‚D €µ ”‚­`'¨u 4ƒ6ptcà48.Ë`ÜR0ž€)ð Ì@„…ÈR‡t CȲ…XäCP”%CBH@ë R¨ª†ê¡fè[è(tº C· Qhúz#0 ¦ÁZ°l³`O8Ž„ÁÉð28.‚·À•p|î„O×àX ?§€:¢‹0ÂFB‘x$ !«¤i@Ú¤¹ŠH‘§È[EE1PL” Ê…⢖¡V¡6£ªQP¨>ÔUÔ(j õMFk¢ÍÑÎèt,:‹.FW ›Ðè³èô8úƒ¡cŒ1ŽL&³³³ÓŽ9…ÆŒa¦±X¬:ÖëŠ År°bl1¶ {{{;Ž}ƒ#âtp¶8_\¡8áú"ãEy‹.,ÖXœ¾øøÅ%œ%Gщ1‰-‰ï9¡œÎôÒ€¥µK§¸lî.îžoo’ïÊ/çO$¹&•'=JvMÞž<™âžR‘òTÀT ž§ú§Ö¥¾N MÛŸö)=&½=—‘˜qTH¦ û2µ3ó2‡³Ì³Š³¤Ëœ—í\6% 5eCÙ‹²»Å4ÙÏÔ€ÄD²^2šã–S“ó&7:÷Hžrž0o`¹ÙòMË'ò}ó¿^ZÁ]Ñ[ [°¶`t¥çÊúUЪ¥«zWë¯.Z=¾Æo͵„µik(´.,/|¹.f]O‘VÑš¢±õ~ë[‹ŠEÅ76¸l¨ÛˆÚ(Ø8¸iMKx%K­K+Jßoæn¾ø•ÍW•_}Ú’´e°Ì¡lÏVÌVáÖëÛÜ·(W.Ï/Û²½scGÉŽ—;—ì¼PaWQ·‹°K²KZ\Ù]ePµµê}uJõHWM{­fí¦Ú×»y»¯ìñØÓV§UWZ÷n¯`ïÍz¿úΣ†Š}˜}9û6F7öÍúº¹I£©´éÃ~á~éˆ}ÍŽÍÍ-š-e­p«¤uò`ÂÁËßxÓÝÆl«o§·—‡$‡›øíõÃA‡{°Ž´}gø]mµ£¤ê\Þ9Õ•Ò%íŽë>x´·Ç¥§ã{Ëï÷Ó=Vs\åx٠‰¢ŸN柜>•uêééäÓc½Kz=s­/¼oðlÐÙóç|Ïé÷ì?yÞõü± ÎŽ^d]ìºäp©sÀ~ ãû:;‡‡º/;]îž7|âŠû•ÓW½¯ž»píÒÈü‘áëQ×oÞH¸!½É»ùèVú­ç·snÏÜYs}·äžÒ½Šûš÷~4ý±]ê =>ê=:ð`Áƒ;cܱ'?eÿô~¼è!ùaÅ„ÎDó#ÛGÇ&}'/?^øxüIÖ“™§Å?+ÿ\ûÌäÙw¿xü20;5þ\ôüÓ¯›_¨¿ØÿÒîeïtØôýW¯f^—¼Qsà-ëmÿ»˜w3¹ï±ï+?˜~èùôñî§ŒOŸ~÷„óû endstream endobj 223 0 obj << /D [221 0 R /XYZ 63.8 705.06 null] >> endobj 224 0 obj << /D [221 0 R /XYZ 228.519 603.04 null] >> endobj 70 0 obj << /D [221 0 R /XYZ 64.8 561.627 null] >> endobj 74 0 obj << /D [221 0 R /XYZ 64.8 505.98 null] >> endobj 78 0 obj << /D [221 0 R /XYZ 64.8 438.259 null] >> endobj 220 0 obj << /Font << /F8 127 0 R /F47 126 0 R /F56 129 0 R /F54 128 0 R /F66 137 0 R /F58 130 0 R >> /XObject << /Im4 214 0 R >> /ProcSet [ /PDF /Text ] >> endobj 233 0 obj << /Length 1435 /Filter /FlateDecode >> stream xÚÝWKoã6¾çWhò"æ’IIZ º@{\¸§Ý=(–â8­@v6›ýõÚ–ó(ú@{°,ŠóæÌ7ßægoß•“JUÁ†Éürœ*'¡Òª¨ÌdÞL>dó«©ÉÚé§ù¯oßùZ£tYM4“½aŠTV¥Lðq¿»ÎlÈÚ¤Õ;xtýt–W!ÛÂûüÖ랸ӯà±@º›Ú:Ÿ­ëåV¸÷Q‡Ä[–P‹q.Ñm|©ÊªˆÚßO=ˆCþ%yƒ¼Göæ^9ƒ/¦3ï²k$^ìØ†‹©-£=5+¿¬bvןOgΘìWÈÖ·LÊ®wÛ•P®>£Ù\t\‘ãƒ,ñì£öV_Q:È(²n-;(jC¡ð=™Ì¬uʇb23FUÞ³är,yNäí’b܃ °…Æ~¹JˆÔ‘ÛA{ª>ww»¨ØdJbŸÆQƒ °ÂÚðÄÑæ¤³ç×7ü7ƒ/–_¿á?Lµ~xì—ü uqÒò^¬o$PW#‰ ú!7+S²þ_€ì½ÞÏ’Ø=꺑HÅ h«  [­ÊÒì‡x+„5ù‡ïÄå4OØ vŽüÛÚOv ‚aòәѮ ï¥|·ðîHŒ>`E@0ÕsfC4'˜óD»!kX€å{^€K´œ'Úñ]ï1‡Gf =$Ú‹—h‰€œÜÙ·­:¸â€9jG—ªD»;ÆãTåÜ~ò1zöœÀy°Y¼oÛ¡ oøs7än÷&û^:öwÒ½ÎOõ|&µÉÜvbt)þÞÑ%ü£ vY|ÁC®íKÆ•*WôsŒù‰aÁȰð$³;`.æê9ætL±É”ÁcÙs8=¢¸dDñÏiNG—Œgnzé}°Ñc“ÉØ½Î½n¥?Û0 eÜÐvþî6”xh\ûÛ/’U”t‰°ýÆW*Wø×v¾ ¬î§ÛŽ’?Ð `á"ÔÒ9ˆhV¯â=s³ä-*.†pZÇ[±!áòJºâ h)NR­OsMS@U4!µ+¶±*‡?¸Ê1Ò±¿Œt áÍ#€Z 7©%Ð Úþt¨ Áº§;aÃd<­C{¡µÞ%™’^²­6Jçùë.ÙNÕ‰;60ŒÁöÌæØ@rAo¿‡Þ/ËÏͥ⾕>Ö¦Áaÿ—o«)äGä>yÍK!¿¦ròB¸w bû×½éùKà^úÃÞøÉKåSpŸê ¸× ÜëÀY@cómœd3äßÿ8ïþšQã`L‡Á^CÏr«L!²ŒG³ŸçgÈm endstream endobj 232 0 obj << /Type /Page /Contents 233 0 R /Resources 231 0 R /MediaBox [0 0 612 792] /Parent 219 0 R >> endobj 234 0 obj << /D [232 0 R /XYZ 63.8 705.06 null] >> endobj 231 0 obj << /Font << /F8 127 0 R /F56 129 0 R /F54 128 0 R /F58 130 0 R >> /ProcSet [ /PDF /Text ] >> endobj 238 0 obj << /Length 1471 /Filter /FlateDecode >> stream xÚ½WKoÛF¾ûWèÐ X›}òqh¨è%Ð-ɲ([Ž-¢äÔÿ¾óØ%—%ÙEÁårÞûÍÌΧÅÕ‡—ÍJQf:›-ֳ̊b–•R䥚-V³/É—T%žoé\ËÒ% ÖY:WÒæ´Îa?Se¢Óo‹¿gr6WJ”ÎõÌvÄ\DÌå$sÖ3»ˆY“%̬IðÍYÄl˜˜ ¾ÀœGÌè‚ò̸ÖcfmDˆ×oðÏž;xîáÙO)ù ~|†§‚gë‰kxÚtî´IX®yùèÿª=‰¥_9IÖR…F¯õ„•·gÏ AΊ?xKWX”7Œ‚¢|PÐy£ŽÎWžŠ¨AEL'ô³y7ŠN@P“‰=ŠÊ“¦Ÿ¡›€¡|+ ³ Ê·ÂÐD0Ì<³Eæ7E”ÇÊŠÒZ— iJ·¸'í é5è,@9Qí:2"–oއŠl&\ϼ¢ÂëvïÙšm:·…cÜ¡Ì)hq×&õKª‹¤Æ­W¦ÃeE@¯yc]!ü91pãǦÃ*¨Ø²  _]ïy«Y3ý£”4‡­‡y+Òy)eòÙ«ñb+vœÖ·`5ØܯțzåUµœ#…NëቡÄú–‡¦T»×8®QeàJÍÁøš?Ùå;ŸûA~˜²ì@ðš§g‘šìzôуßÍÁǦ IíuP0à½Äð‚·_T«ò’kƒÎ¿‚äSc“1¦9k£°z»»Âz…ë-}&b¾ò‘X¢’×)ȓɈ¢êðè]±1ê+ÂO\p1;]•|•Nú-üuÍ\Ç…R%¿ûru=.šü˰05‘Kr˜s?¥È«ã"ï~Q‘‡Â®\Þ×gÍ.g#—µë]ÆZ)r:8j JÙ"ùü¾éü››B'»ª IË;házh¼ÍÛÔ詺ƒq.„)|×ýˆ sÉbnG´!WB`ÿåÝ=föë3OÈÉa­©»jPÀàç&¤'k©¾sõ!gp³b²–Ê4Ð]Tfà3òÝóuæÚcÉF><›‡âŠô¢î3"œ¥.\ Ü’ÝsJ_pè% ^a,*ÊÉî( f®HnÒlÞ±‘. í£w=õ¹1Zh3ª¡T„lÄg¥Õàcœƒrª]%a‰Ùm9öÆ 3¾VþtZ¬\!’\¸/m͹€k<ä˜Uó^ÔlZ¦^cpQW·x4÷L¢õ|èGe[pBY)\ž£qºéJ!KüíüAdйøʔ–ú|ÇÕp[xˆbsmù³šX5´õ9uþ”ú*u¬Ý Ûq4МMjÖOz¦N¿|Ù§õ:ôÖ»§ºK‚ +‚,á.O´ÑñRCÂßQCÂO*q+®$ß°±±ìz¾^  * Ùq‘@SÈ«âd^y„ áµé9€Ÿm…U¥>Õ좖â›ÝiÄ5º_ÚªÂ-ZgBIý3ÛÕ„À¨]e Ø®ÂPš_˜Eˆ© 2Èè.Í!H¤¢ûx<ĨSc„1ÛˆÙN2»ã$0»ˆ¹ˆ's3H`.'Æ'uiá Àp|²—VŒ˜Ýhö:Ë\æÍ·LðÙr4>ɉñ)?“sÅ ç½»ñÈœN—.ÿÞ›¢q¦^æ>bÙÀä`°Øm¸‘q©Å}¨SÇ ï2‘÷—„÷µœRšøÒNˆWÐÑìÄsì>Eß}&Ó"ë…]£WU†{¾Ñ‡Þœ'+Üx 5£6VØ|XŠódpûjXþ2¶É뤙5ÖÄVûi5ƒ¦Ók¢ew«ðÝÆ 3!—~ªÅv橉Og:Üß,±EÔKÆ—'’ÅHy<2]šµlãKŽ[ßÕ»Àˆ].ÌP|?2¾êq[†[qûö±í}HùŸÝ-êܧ襧¾Ì`s"µ.…Tܥȕ?7•!áÕŸ‹«ÿ§,ÌV endstream endobj 237 0 obj << /Type /Page /Contents 238 0 R /Resources 236 0 R /MediaBox [0 0 612 792] /Parent 219 0 R >> endobj 239 0 obj << /D [237 0 R /XYZ 63.8 705.06 null] >> endobj 82 0 obj << /D [237 0 R /XYZ 64.8 399.633 null] >> endobj 236 0 obj << /Font << /F56 129 0 R /F8 127 0 R /F58 130 0 R /F66 137 0 R /F54 128 0 R >> /ProcSet [ /PDF /Text ] >> endobj 242 0 obj << /Length 2040 /Filter /FlateDecode >> stream xÚÍYKã6¾÷¯0r’cŽø©ÙC°;Àìa“Mú– ­îvÆm9–;ɯßzQ¢-yzä4dQ$ëÁbñ«*¶^”ð§:j•¶ª,íbýxóËM©¼ÓU  y›µÐIÇë·~ñ¯îæð—†VÌs•1ýúöæõ›¸¨U]™jq{·0Æ)ëýÂ×Z•Ñ/n7‹Š7K]lá¹:Âo»\Yk ÿåråœ-¾…®<݉û»;|›b#DýÏ8¸Ý#冇K³¿oqT-¼ýÏë7U•)±Ò¾V´XÙ¨¢ ¬…‡é*àN{Åo¡ù]fî{¡êGŠ^4B9à >õÈóYF6Érð|Ï\ÿ<£ÀcÆOzM‡ƒ±Žmp})¤UGv¡f2MšÅÊÐP m3¥ŠQ˦UÌ~j"H|6×ÖÎn3/ø†qu?–—µ§6ÂEé-Þeý†Ø”Sæ‚Ø®¡¿ÒuQ]#¶12*3éþ%b—ÛŒØ]¨îÏT#!Ý aöiéÕ…ô*#B|Õh!#vL@Äžw€ˆÃ5ð5V8 âÌZª?hQÕÖœ!,ú‚ÀQðÚD'¨NØ$=:&ZÄ#üì¨|Ñ®·th´“X†SÇ6âéØAMˆ ô!ØØì?ð165O蘱ÄšºKàuâ19Á›ÔÝ<íFÐLÓù}¤èü°4¦DP;À/Î!˜=àòE·lÙ€õf~#¦lùp90_y±h»^2DÀ¦€å°oÚJ<´6oâB8ˆ:÷Ü{£ß=v§Ê%Mhï9ºöÜ…ˆ S‘"Ó€òŠ}ž\|ÂO½é²O‘ˆº¿âW/ø $½Å)ÃFq÷P3nRµÃÑ –ǘ¨½º,b¸¦$&d *]×l(¸ÑÿOÜè$-! #ó~ÎЦVÁ&;­Ñ®TORxL >Soz ›G#OÙå •cа—šxš’9U…ðÙ¼ÈõN­˜‘ƒ+è~¥0†Š:Œù츫"íøT `[sÉ$v–%„–kxjM ðJ¹Ñë$§™C¨Óã9ÀœGåé À‚¿0”ЬB(SŠ º¶ì ÍQr6­ª|}îR't\rx„ÉX'û h¶œ õ<Æ)Vôœ>FªÞ¡›œÒèot@§ª´ãELÆ™6ìĬÒ9h›LP~A0³A®TeõÇÐÙ«q÷'à j4"Á9†œqqÇVN*ÝuíGugcˆ+Ûa¿ö9~Í©çͿ˂ެvJò c{Ö§œ!ÞÕª y4ò;4ƒØmüq E,U}égU±;7¨)ýŸ…vŸÇß©=Èe5$eÈR‰Œ¹¸ ]ð–ð1 ¡ög\ÇY5øÂ½lóaþt F1Ÿsë©sç¹¾À‘’Ê}BÚñNkc닯i‹È3%ù«MàX”îO-Žîv’à‚Àtýxz•KP‡— ödóT€’;)l(ïÞ0HÝJH#VðŽ,’tM5ÛÍ¿ooþÇd , endstream endobj 241 0 obj << /Type /Page /Contents 242 0 R /Resources 240 0 R /MediaBox [0 0 612 792] /Parent 219 0 R >> endobj 235 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./IRangesOverview-ranges-disjoin.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 245 0 R /BBox [0 0 432 162] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 246 0 R/F3 247 0 R>> /ExtGState << >>/ColorSpace << /sRGB 248 0 R >>>> /Length 366 /Filter /FlateDecode >> stream xœ¥“ËNÃ0E÷þŠY¶›Á3~ÅÛT€T ¤ÒH,(«¤F´¨Í‚ßÇNœG£¨XÄÊÍɵGwÆs (á pãQjp µ¥{4 Ç7x†½¸©žîsXWB¢”†kµnñly/gá«3ð%^^AÂFÌÃS Š?Àƒ°2 xЕDñä\94|¨È‚2È'Ð0f*9JsÂ> endobj 246 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 249 0 R >> endobj 247 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 249 0 R >> endobj 248 0 obj [/ICCBased 250 0 R] endobj 249 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent/dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron/space] >> endobj 250 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xœ–wTSهϽ7½P’Š”ÐkhRH ½H‘.*1 JÀ"6DTpDQ‘¦2(à€£C‘±"Š…Q±ëDÔqp–Id­ß¼yïÍ›ß÷~kŸ½ÏÝgï}ÖºüƒÂLX € ¡Xáçň‹g` ðlàp³³BøF™|ØŒl™ø½º ùû*Ó?ŒÁÿŸ”¹Y"1P˜ŒçòøÙ\É8=Wœ%·Oɘ¶4MÎ0JÎ"Y‚2V“sò,[|ö™e9ó2„<ËsÎâeðäÜ'ã9¾Œ‘`çø¹2¾&cƒtI†@Æoä±|N6(’Ü.æsSdl-c’(2‚-ãyàHÉ_ðÒ/XÌÏËÅÎÌZ.$§ˆ&\S†“‹áÏÏMç‹ÅÌ07#â1Ø™YárfÏüYym²";Ø8980m-m¾(Ô]ü›’÷v–^„îDøÃöW~™ °¦eµÙú‡mi]ëP»ý‡Í`/в¾u}qº|^RÄâ,g+«ÜÜ\KŸk)/èïúŸC_|ÏR¾Ýïåaxó“8’t1C^7nfz¦DÄÈÎâpù 柇øþuü$¾ˆ/”ED˦L L–µ[Ȉ™B†@øŸšøÃþ¤Ù¹–‰ÚøЖX¥!@~(* {d+Ðï} ÆGù͋љ˜ûÏ‚þ}W¸LþÈ$ŽcGD2¸QÎìšüZ4 E@ê@èÀ¶À¸àA(ˆq`1à‚D €µ ”‚­`'¨u 4ƒ6ptcà48.Ë`ÜR0ž€)ð Ì@„…ÈR‡t CȲ…XäCP”%CBH@ë R¨ª†ê¡fè[è(tº C· Qhúz#0 ¦ÁZ°l³`O8Ž„ÁÉð28.‚·À•p|î„O×àX ?§€:¢‹0ÂFB‘x$ !«¤i@Ú¤¹ŠH‘§È[EE1PL” Ê…⢖¡V¡6£ªQP¨>ÔUÔ(j õMFk¢ÍÑÎèt,:‹.FW ›Ðè³èô8úƒ¡cŒ1ŽL&³³³ÓŽ9…ÆŒa¦±X¬:ÖëŠ År°bl1¶ {{{;Ž}ƒ#âtp¶8_\¡8áú"ãEy‹.,ÖXœ¾øøÅ%œ%Gщ1‰-‰ï9¡œÎôÒ€¥µK§¸lî.îžoo’ïÊ/çO$¹&•'=JvMÞž<™âžR‘òTÀT ž§ú§Ö¥¾N MÛŸö)=&½=—‘˜qTH¦ û2µ3ó2‡³Ì³Š³¤Ëœ—í\6% 5eCÙ‹²»Å4ÙÏÔ€ÄD²^2šã–S“ó&7:÷Hžrž0o`¹ÙòMË'ò}ó¿^ZÁ]Ñ[ [°¶`t¥çÊúUЪ¥«zWë¯.Z=¾Æo͵„µik(´.,/|¹.f]O‘VÑš¢±õ~ë[‹ŠEÅ76¸l¨ÛˆÚ(Ø8¸iMKx%K­K+Jßoæn¾ø•ÍW•_}Ú’´e°Ì¡lÏVÌVáÖëÛÜ·(W.Ï/Û²½scGÉŽ—;—ì¼PaWQ·‹°K²KZ\Ù]ePµµê}uJõHWM{­fí¦Ú×»y»¯ìñØÓV§UWZ÷n¯`ïÍz¿úΣ†Š}˜}9û6F7öÍúº¹I£©´éÃ~á~éˆ}ÍŽÍÍ-š-e­p«¤uò`ÂÁËßxÓÝÆl«o§·—‡$‡›øíõÃA‡{°Ž´}gø]mµ£¤ê\Þ9Õ•Ò%íŽë>x´·Ç¥§ã{Ëï÷Ó=Vs\åx٠‰¢ŸN柜>•uêééäÓc½Kz=s­/¼oðlÐÙóç|Ïé÷ì?yÞõü± ÎŽ^d]ìºäp©sÀ~ ãû:;‡‡º/;]îž7|âŠû•ÓW½¯ž»píÒÈü‘áëQ×oÞH¸!½É»ùèVú­ç·snÏÜYs}·äžÒ½Šûš÷~4ý±]ê =>ê=:ð`Áƒ;cܱ'?eÿô~¼è!ùaÅ„ÎDó#ÛGÇ&}'/?^øxüIÖ“™§Å?+ÿ\ûÌäÙw¿xü20;5þ\ôüÓ¯›_¨¿ØÿÒîeïtØôýW¯f^—¼Qsà-ëmÿ»˜w3¹ï±ï+?˜~èùôñî§ŒOŸ~÷„óû endstream endobj 243 0 obj << /D [241 0 R /XYZ 63.8 705.06 null] >> endobj 244 0 obj << /D [241 0 R /XYZ 267.921 603.04 null] >> endobj 86 0 obj << /D [241 0 R /XYZ 64.8 562.211 null] >> endobj 90 0 obj << /D [241 0 R /XYZ 64.8 215.897 null] >> endobj 240 0 obj << /Font << /F8 127 0 R /F66 137 0 R /F56 129 0 R /F58 130 0 R /F47 126 0 R /F54 128 0 R >> /XObject << /Im5 235 0 R >> /ProcSet [ /PDF /Text ] >> endobj 254 0 obj << /Length 2063 /Filter /FlateDecode >> stream xÚ½Y[“Û¶~ß_¡Gj&‚ à¥Ód&iãi:é-Ùq;ãø–¸²ZIÜ”wýï{nA‘»Þø!ã‘ÂåàÜÏw ½JáŸ^éR«r•ëL¥i¶Úžn~½I•³:/hC<¦E-çdâÕ§|õçöæ_ðÏ/m˜æ&"úÝíÍ«×åªRUnòÕíÝÊ£´.W®Ò*-Ýêv·z›¼^ëäŸý¥ƒÿ›õ&˲$ÿÃzcm–ü¦Žðižoïð¯Iöõ=ÌöL\'¿¤.ö¹¯x® ²³“ñ×ðÑã–†ÈÇN–|R&¨…©áaÚªÊZ‘¸`‰ï'üÓ™I´:•:L´yÛ"w½÷ˆ¦c´ \d½Þ®M®gu™Ü׸Z£ éS¦½Z¬M:ýM”4ÃÚ”às@¤aUÐâ8ÛŠP6ªÊU^”žÅŸÖNl5j&UæTnƒT-Üîlò_ܼF‘j ÿ’jt«ón\æx l…_IÚó¾a;Y›’ýï)áÓº´~%.ˆ¿™Ðb…Qp; “påI•R'oL–Ö…¥zïÂŽï.Hw+>‡la%'g«O²í Ùæû`Í6'v|0î A»ãmï9l`¬#›^§µÔ¨Ôæþ𷒉߉‘½½Z\W<ÈíµŽó§tS?uÏô¨uý”Ò!hÐI5õ´‰ö'¢U*Óo|·¿g\ÌÉ?³;SÎpÓåìS]ì« n/.RÆG´eqÊaŠH?"¶:Bo4?zh1ˆƒC]ˆ[SB œ²ððyXb°¾ aº%ôâX³P‡-šïóÐûxkƒLú+2Öøš#Ò *\š:>GS+Ñ9/j=‹rÕË´¾±Y¦\ZM+èU­'7$Eû0½8t´•ê&LGµ¿RŒR#íFbäûŽ Ÿôu£¡>H©“ Ú(0ò»m„&„ûzA_ô|L¼ÞcÈþ U&ƒ6·B<Ü?, Êl  ¡†B –‰fšÛþÒx0ÃT…@C`?$äüLqâ„4HDÔƒÜë“0q÷ P A q¡-zÖõ¡BÙ)äÎðKHÜëÐÙ«—)e *€hÇ®npéäo¢“Ç'ª¶ Ùs-h„{Žº—±ÿ’÷Yê? ¾9½˜wÈd¹SÆ~Q»$\=¿.°à¯¤“«Ÿ¯›ñW‚ºäÌ/¼ìJW°?‚¿[zÂÜ^|o:ŒÔò$åÑzO¾Ï-ô´ûa4c¤8à¹Ô‘ÎOœ¾=ÍÅß2òJå0³”Ç?DÊÛ™çyOÔ9^þgŒbö³g³Ïþ1 µRLŠ?×@«ŸåÒÊé7Þ|{óù?4 endstream endobj 253 0 obj << /Type /Page /Contents 254 0 R /Resources 252 0 R /MediaBox [0 0 612 792] /Parent 219 0 R >> endobj 251 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./IRangesOverview-ranges-gaps.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 257 0 R /BBox [0 0 432 162] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 258 0 R/F3 259 0 R>> /ExtGState << >>/ColorSpace << /sRGB 260 0 R >>>> /Length 353 /Filter /FlateDecode >> stream xœ¥’KK1…÷ùgÙB½æÞ> endobj 258 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 261 0 R >> endobj 259 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 261 0 R >> endobj 260 0 obj [/ICCBased 262 0 R] endobj 261 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi/grave/acute/circumflex/tilde/macron/breve/dotaccent/dieresis/.notdef/ring/cedilla/.notdef/hungarumlaut/ogonek/caron/space] >> endobj 262 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xœ–wTSهϽ7½P’Š”ÐkhRH ½H‘.*1 JÀ"6DTpDQ‘¦2(à€£C‘±"Š…Q±ëDÔqp–Id­ß¼yïÍ›ß÷~kŸ½ÏÝgï}ÖºüƒÂLX € ¡Xáçň‹g` ðlàp³³BøF™|ØŒl™ø½º ùû*Ó?ŒÁÿŸ”¹Y"1P˜ŒçòøÙ\É8=Wœ%·Oɘ¶4MÎ0JÎ"Y‚2V“sò,[|ö™e9ó2„<ËsÎâeðäÜ'ã9¾Œ‘`çø¹2¾&cƒtI†@Æoä±|N6(’Ü.æsSdl-c’(2‚-ãyàHÉ_ðÒ/XÌÏËÅÎÌZ.$§ˆ&\S†“‹áÏÏMç‹ÅÌ07#â1Ø™YárfÏüYym²";Ø8980m-m¾(Ô]ü›’÷v–^„îDøÃöW~™ °¦eµÙú‡mi]ëP»ý‡Í`/в¾u}qº|^RÄâ,g+«ÜÜ\KŸk)/èïúŸC_|ÏR¾Ýïåaxó“8’t1C^7nfz¦DÄÈÎâpù 柇øþuü$¾ˆ/”ED˦L L–µ[Ȉ™B†@øŸšøÃþ¤Ù¹–‰ÚøЖX¥!@~(* {d+Ðï} ÆGù͋љ˜ûÏ‚þ}W¸LþÈ$ŽcGD2¸QÎìšüZ4 E@ê@èÀ¶À¸àA(ˆq`1à‚D €µ ”‚­`'¨u 4ƒ6ptcà48.Ë`ÜR0ž€)ð Ì@„…ÈR‡t CȲ…XäCP”%CBH@ë R¨ª†ê¡fè[è(tº C· Qhúz#0 ¦ÁZ°l³`O8Ž„ÁÉð28.‚·À•p|î„O×àX ?§€:¢‹0ÂFB‘x$ !«¤i@Ú¤¹ŠH‘§È[EE1PL” Ê…⢖¡V¡6£ªQP¨>ÔUÔ(j õMFk¢ÍÑÎèt,:‹.FW ›Ðè³èô8úƒ¡cŒ1ŽL&³³³ÓŽ9…ÆŒa¦±X¬:ÖëŠ År°bl1¶ {{{;Ž}ƒ#âtp¶8_\¡8áú"ãEy‹.,ÖXœ¾øøÅ%œ%Gщ1‰-‰ï9¡œÎôÒ€¥µK§¸lî.îžoo’ïÊ/çO$¹&•'=JvMÞž<™âžR‘òTÀT ž§ú§Ö¥¾N MÛŸö)=&½=—‘˜qTH¦ û2µ3ó2‡³Ì³Š³¤Ëœ—í\6% 5eCÙ‹²»Å4ÙÏÔ€ÄD²^2šã–S“ó&7:÷Hžrž0o`¹ÙòMË'ò}ó¿^ZÁ]Ñ[ [°¶`t¥çÊúUЪ¥«zWë¯.Z=¾Æo͵„µik(´.,/|¹.f]O‘VÑš¢±õ~ë[‹ŠEÅ76¸l¨ÛˆÚ(Ø8¸iMKx%K­K+Jßoæn¾ø•ÍW•_}Ú’´e°Ì¡lÏVÌVáÖëÛÜ·(W.Ï/Û²½scGÉŽ—;—ì¼PaWQ·‹°K²KZ\Ù]ePµµê}uJõHWM{­fí¦Ú×»y»¯ìñØÓV§UWZ÷n¯`ïÍz¿úΣ†Š}˜}9û6F7öÍúº¹I£©´éÃ~á~éˆ}ÍŽÍÍ-š-e­p«¤uò`ÂÁËßxÓÝÆl«o§·—‡$‡›øíõÃA‡{°Ž´}gø]mµ£¤ê\Þ9Õ•Ò%íŽë>x´·Ç¥§ã{Ëï÷Ó=Vs\åx٠‰¢ŸN柜>•uêééäÓc½Kz=s­/¼oðlÐÙóç|Ïé÷ì?yÞõü± ÎŽ^d]ìºäp©sÀ~ ãû:;‡‡º/;]îž7|âŠû•ÓW½¯ž»píÒÈü‘áëQ×oÞH¸!½É»ùèVú­ç·snÏÜYs}·äžÒ½Šûš÷~4ý±]ê =>ê=:ð`Áƒ;cܱ'?eÿô~¼è!ùaÅ„ÎDó#ÛGÇ&}'/?^øxüIÖ“™§Å?+ÿ\ûÌäÙw¿xü20;5þ\ôüÓ¯›_¨¿ØÿÒîeïtØôýW¯f^—¼Qsà-ëmÿ»˜w3¹ï±ï+?˜~èùôñî§ŒOŸ~÷„óû endstream endobj 255 0 obj << /D [253 0 R /XYZ 63.8 705.06 null] >> endobj 256 0 obj << /D [253 0 R /XYZ 265.684 603.04 null] >> endobj 94 0 obj << /D [253 0 R /XYZ 64.8 370.702 null] >> endobj 98 0 obj << /D [253 0 R /XYZ 64.8 281.452 null] >> endobj 102 0 obj << /D [253 0 R /XYZ 64.8 177.975 null] >> endobj 252 0 obj << /Font << /F8 127 0 R /F58 130 0 R /F56 129 0 R /F54 128 0 R /F47 126 0 R >> /XObject << /Im6 251 0 R >> /ProcSet [ /PDF /Text ] >> endobj 265 0 obj << /Length 2118 /Filter /FlateDecode >> stream xÚíËŽÛÈñî¯|¢Ã~ðl|$à ’ƒ½8¥Q2µ"µ³^øãSO¾g<ÞEröÐÃVuu½ºªºªç·¯~û.ÎVy˜'6YÝîV‰³U’Gaš›Õívõ!x³ÞÄÖ?¬Mp€QÁx„ñ7WG ŒQÁçGŸ âòŸ†ó–ÑÍú»Û?ûdÀ>Zm¬ Ÿ1ïoó$;Ú^¾—E’±†éާ‚y’]Háž—,òENÆ„9p'N`‡ñ Â5_þØg€nLF¿dÍó'ž<Ç(DÑMö‹O³2f"dã%á¦À¡9â±9ìØv¢r'Ç“ ÙLÛOšôPÙ’ÂÔ϶M dè.è?^[N?ì”ÙÓN)q/VÀØö0“¿Ê/‹Š‹—†Gï°/wÖ—ª÷ õøÊxÏÿgñÿWâ}qÍ~9%L¼ÚÔŽ~%#`6Ú`¿œŠ~q´?Q~’àÌ$ Í8æ£Ùb4"0±ŠFŽçBúåáîÓ•ñ¡ó‰§t6Ì$ éc}ð½¿-Ö—zò¼Nãà=ÂOûŠ\“¨Íƒ+‹„Ø?Ð-+Ýœúkñð þþ„þÍî»qYD>OËû ]þ ¹ú5øú…ž‰\dRï4v”üV’Ó¡•è©™!/ÿ°ŽØðâþP5-úHX›v1IŒ›VEŠ‚»õÆ&:/¥Ð‰Êú…ê#þm‘Æ'Æ’<¢y¢¸´òK&cmÕ¸SÏ%m×o¢àQ ÆšLÁ‡8¥Ûu†§ˆ˜2@áX<ˆÖŸ˜évF%é8«^÷ÀœŒµ-HRäPÉÊã}gÆiù ;ªÝI¤XÂ2õ]£gËgÓvgÖÜHúôïr™¯£tÙóý:Ffš8<Òå¡ËcÝCö12UåC©æ,7ÞBqèâñ90[ âÛ`ûÕ†€™I'¡…ÛF$(Ô˜MHG üCù18?Ì÷GAIÖ+Zñ-€ ‚ÆÂÖ)—¯ÐÛÎDžJÜ΃CD<¡ªb7%â’¸& ªÑôNÝ>#¶ñ.Ìòt,÷ip.©‡i¢[jHí_ˆ\¶Â‰âD¥>‹2Í`cÁ 6£%í@x.öa"ñ~á5Èth.raÇãªZ ²š$˜½š¾š&ê¦bÀ0\ðH“àVóHŠFŒc¡Ùå-YR͹lå0ΧÙB×-ÏE¥ ú‰Ý$G4h ð®\w E®(‡%l–kÓ#4äY("Îv‚¦‘Ž%ǵäUR™Î ÐØ¢·˜ä=qÝwk²8sq$ Í\Ãgažv®.”AÙ˜ý~\Q¶ƒzô"wÓù"ì{ÿœ¨úóµçìæ9ó/Ø)Y°Ó»‡—Ž(>Š´ƒª:íyÕ]ÝO ¥¹UZs]\Êþ‡ÁsÂiL«3Õ¢}3*hrÚ¥ÆÀÊ&¡‰ìØ‹æ˜å1ßÄÂã3^†¹™z‰MLþÄáP.4q˜$î߬¹ðPîí `ÞôNÍwø’@Ú织*4‡ ˆW=qù”ðO+ëúAö¼Ù£ÐOî^#V0BéC_·ß ëû®qøLYO7DRÏc‘ï1ŒœšCÝ~¼äÌv™k6æêæ\ï&\S.®©H²˜jÜŒ+÷ˆ~Ì6Ÿ³-'l­(h:% ­ÅKlýlãž­]f»°Í;S1PD¢,°Ÿ`›Ùú9ÛJv˜¶fÀÚvÇ»À6Y`ëÆFV7™°ÝMتv^а^4rºÀÖ mYì Û=ÿ܈‚ª°*™ÉÜ©Wï`h-sŒ©áKÇ_¹Þ†Ë×G Áý=\-C¤@à”D…À®QyÅw-TaYðÑ8ßTßk*Âý%øk\Ö&nF¥ÀâÊ&®M½Àë«ä³N Ër¨ÃpóAº„Œ³µSYèµô%Âôp¤ÜKÌ.]%­Ufƒ]¥ÓõÒk¼X mÔœ?¿ÿ°aîŒÖD¿ƒÑÇÃnÕ;ÏuåAÒ;_} -¶‰Îu´©ö}¬*ÚŠ\ÁîµrwRMënâÄ÷¿ÁJbxv–B¡V,º¾è`¥X€sI}¼£îV°*|“+Žg-@Àµ=¸Èã½< NÑþŸ~ÁrtˆuFæÝ“Tõ‘ï h6ÁH¬G‚Õ9¬¿Fxª"ôüÿ=xë@ÔÇAqáíÌ€HLhÐcô«®{9iÜP5îµ^8ÖMM7¶©‰ƒo…ȱënhSAÖoD•æJJ!Z/D„Çþíf!¹”dM ×ëCWý³YÙBƒ ùç̉ǧV è=7áÚIzqÌZDõ3õ>ÜýêÓ…÷]}1&6„í;jD¼¼=WésG°JµRQr»&B:}mYx‡HÓÐåOõ¬Ï#ìLº^»@©Ž¨TË{ô·i…(ƒë;OÇ¥¦„û~€É䎅$üÁyUåŸÏŽ_ž´ÅXl¯äw=È«¶¡=ÎÝ.?æcg~mœ–§›¥ÈýÍz“{g–úƒVšåϽe?}=(Æ/R%¼îå™.[YÉoú^Hè¹ú5¶*¥« ÆzQ{ýÿÞ6Ú§ÚFíÞF­còkëøÒÖqœÖ­ÉÂ8ÍÀuò0Ó¥˜_ýñöÕÌ€52 endstream endobj 264 0 obj << /Type /Page /Contents 265 0 R /Resources 263 0 R /MediaBox [0 0 612 792] /Parent 267 0 R >> endobj 266 0 obj << /D [264 0 R /XYZ 63.8 705.06 null] >> endobj 106 0 obj << /D [264 0 R /XYZ 64.8 518.955 null] >> endobj 263 0 obj << /Font << /F58 130 0 R /F56 129 0 R /F47 126 0 R /F8 127 0 R /F54 128 0 R >> /ProcSet [ /PDF /Text ] >> endobj 270 0 obj << /Length 1195 /Filter /FlateDecode >> stream xÚ½WKoã6¾çWE2°æŠOIÀ¢‡b EN»zHsP$ÙkÔ±?šK|‡Ã¡DJr½q“hSäÌð›'9?/n>Þj“”¬4Â$‹eb+Sf,/y²h’û”ÏæÂð2­g<ýcÖx¦òô~6×BÂ'O?ôSãÁ}þ ¹‘iE l1 †„¡a”0 Œ¿¿%Y2眕Z;â2‚"F Çrš‚œPñqä¿"àx¦Š!”cõ‚ Åy§<ǽI#¨ bA÷Ä4„f¡8s2\†°& èï€PÆÔBK<°`ˆ.& ˜ dìb˯µ"rI0&‘_€ HAP¤ÎÂÊ}ÎIqo¯|Asé#òãmd)W¬T*™ δ$\¿éÆqFí¦­›ÿ ó-ŒÝLäéËfm?«6 …QãoÚn*»P¹{ÊÁMÏ0·ÂÖȧpok8âY=QU·– ¬"ò‚€"ÇÁ³;Y!£G˜´ûhé=Šlœ¬½­À½ƒG[úU»"^R­9Y(Æ9Ï¢åö¨š3Ï u¶‚GF—¦Æ3Uµ €Ö8ìö(s$™àqí°Ò[ ådAoí¤´5Ñ!SÁJ0“—þŒ/3MÈzX<½CÅc€¢!ïnÑ¢cíyɤÎ=Ù_¤ü†žS^1£Bƒ]©Ò×çÓÏnÕí,ÏA¢iõDçß­#…fŠw²R@´P\P2ÈRGø“K¶i?óôLg”ÈûäfËâtû(¿œxG*:-ðìL—nº!JÏE ëJæDÁùöã‹g‚è<œW/Q²ÈXQðXü+Â@Zy9û|!½›N,¦E$²ÂßTMyP’í}Ÿ•šæÊÞ÷ d.fU›sŒô6èNPs9dó|Ú âÝÜ Æn0oí=vƒ7ˆ&ƒ2H¿~Áž° ¨×¸CîpW·c>*`v÷®cv—®cÎ'ª„ÏeÕ‡éRxe}øJ×Ô&¸–?ÓÞ…·$ÕλÚ÷ÿ׎˰¢°Š FWX-È—>Ò«8$…û«‰Ð[ø‰¨ðÂI”ae!clÛzúì••Ì¥aZ D| lPªÕ¤KKkŸÓ)pÊžT¯‘ Oâ³/°0;yßìXA×ö:¾] e|_·¢»nÅ÷¡Œ‹íÆk‹Ýõq£Þ/nÌtÜØJð~qƒEçŠÀÑqàü§îL¼E%ߢCRo×ãȸP/f…-‡sÉEº{ĸs ®L½>µd’ËøAÝ_Ìðèlè:ñœ6,SÝ›wiCpï‚?‰%ú™úpñï®ÐÝHw€G2L€qI –£rû¤Óݶí÷¾íNŸ[<\üÚùÙvFdRŽ÷ÏfóP‘“5A}¤àÜm]»*¹I_l´¯ë™(l®¢²®Ñy¦¨?¸ÕÍnåãºÚ »Ë#Û5¬á íôÔ僵ŽÁÛÆMjÛ/b–aŠ!®vïöÖ¾ài˜±lúB?óà·7¶}*ü0º ÝÚÃØ\B”,Qs™±œûôÊ,áÍ/‹›{9- endstream endobj 269 0 obj << /Type /Page /Contents 270 0 R /Resources 268 0 R /MediaBox [0 0 612 792] /Parent 267 0 R >> endobj 271 0 obj << /D [269 0 R /XYZ 63.8 705.06 null] >> endobj 268 0 obj << /Font << /F56 129 0 R /F8 127 0 R /F54 128 0 R /F58 130 0 R >> /ProcSet [ /PDF /Text ] >> endobj 275 0 obj << /Length 1766 /Filter /FlateDecode >> stream xÚí]oÛ6ð½¿Â(ò c5'~ˆ’†¡À†µX‡a÷”õA±•Ä]le’Ó&@üŽwGвä$-ša{ %‘÷ÅûâýãòÙ·¯3;+Ei•-ÏgÖˆbfËT䥜-׳Óäí\&ŒŒ 5Œ5ŒŸx~ÏE¦tò^7=>0Õ+7È §WŒï§·ŒÑr žM×/Iz¸™k¦½Bºï–¿Ì”2U³…”¢Ì2Úïr¡Ò2CÚ‡z`Ÿæ #KZªX:6ÞCsÌ2Özî–¸Ëç÷=ïÈqIÜÈo' `ŸzèÚƒ Ûâõ˜ø.R²_Þ0ÊK=Æ õŠVV–™Ã‚9™š<9õ¶É‹þUÁx× ›[í)…ÃÀÐ02% #Ço'E:@=,@1@8 ³˜9 ³PrJ}¯Yš¡åX‚ÕPÅÛ–aë×P¼E¼Nž\Ø‚åyÙÇ?Ó,ek®Ùº;voájÚ2¨ÛÀóÈ—Z–é9î l*—¼”Èò:û†uö…ÉãÜW=Æ’£å¯zè×ðúŒ_aüÎK,k$6>H×vB׆öÑ ƒ¤‡ûC-/}F:`¢ ̬p¦N#Cª‰G;Táâ'K~Æ}âÞêœ[_JŸ¥¢ÌÍPú¾Î}Xúi*§Ã®!ñ6œ/±ªõ WãÊñT ïâµm¶*#´ ©‰…YÎs4«äT<’Í@wU†xƒÀ0Ú tÀœ;'xÕÉÆeiPÓͶ¦Ô]å~î8YŸ‘nSUïHa\q’ù‹´ŽsSÐM;ºçª ÖŽh‹*&8H›–`ê[·ë­üš·Ó옖n;Ó xËún«•ß©•oK¡´* žó®—ÚT #“Bšà±'cż‚OÀ&J"%d<î‹ÈqH»¶çþ|Y(¡ÕdºŒ‹ÓÓÐþ¸ñ9‡1v÷GC¸ãmÌîx³1„+&c8Íp–ádDOF°*È8„óø†á4ÃfDzqÞgãÓ÷ü<‚ßµ?1UCy#`Ž:Òº1Vö¿±¾¢±Šãáð[³çc4Íãc¾m\¹eÌ<{ñ±Ú‡,\Å{%´/Þ(uD¢‚†b! ¨O¤6Îò;ŸI;Ä_SÅ. uP^Nð?¨0]Ç"Uòñ2ô·€I˜þ¤M¹jt?ÕU(¬£›•cÈXÛ¦í¹­ ž„%hÇQï Ø6v ˜ÎÝ 96!6˞ˮóÇøïcP< ûš7r«PóG6D®›0˜kÑ3Ð[»p‘~ÛjÝ@Þ.È×Ð:¾ÊB:‡Ýß Q͈ÁuT†Ùuì˜èΑó /r.Yxº]vU¬§Óò † ^_ÝÆŽ¤“‹+ ª(Š¡€r9À؉ÛW'ì‚ïW'ô¸„r¸ѱKŠ#ÝýÕˆËÈßqö}Ñ÷8‡ÛóÇ+ÿÒò þ0xèÏuìÏß%<éÿÅ?žø¶ÿé®ñŸð~~|ëªJh‹íBYÍûÀ:æÙ«å³B endstream endobj 274 0 obj << /Type /Page /Contents 275 0 R /Resources 273 0 R /MediaBox [0 0 612 792] /Parent 267 0 R >> endobj 276 0 obj << /D [274 0 R /XYZ 63.8 705.06 null] >> endobj 273 0 obj << /Font << /F56 129 0 R /F58 130 0 R /F8 127 0 R /F54 128 0 R >> /ProcSet [ /PDF /Text ] >> endobj 279 0 obj << /Length 937 /Filter /FlateDecode >> stream xÚ­VË’Ó:Ýç+´´Ñèm‰ Å]Ü›`áIBBÇ!6LÍßßî–”8$“â‘…]²ÕÝ:}ú¨¥ÛéèæÎTL®Slú™9Ã=sAð*H6³…/ÇR*S¼)eñ_ ¯ÍrÑ•c]™â ~áз8náYãk‰_³zÍ&‹oðù}±™-â猳†ç±ƒwå§éÛ›;ÏN9„"ØXIî…8¦+0[D3kvJp ˜“Á,­,êÍ’ÎÆÖžW¶Ê>[0ªg¥ªŠ¯¥uE4®x(•/êô±Ý%¬MG”Bœãb”ÍrƒÃ9þ¶Åšõð¬¢Ù}òl×m$ —^Ç9ôNT!±3‚O3õ†Ì)ÐÅà™°hâXóGOK¯‹ú>áM!eZsEuƒÔˆ&6¶k+k#A#ðÒºèÚ&E‚J©ÅÐí îZ=•¸¤|Ž@3hÔFS¬JßÅPÄxrÞåÉ—b#¶>•{Í29àÝ?%-*®‚þmí8e³Ï ³¨»C]®ái8½šŽ¾$ø&™ÔŠ;`¯)Â5£Ÿ›ÃÜ[&¸ž=eÃÍäÞ"‹ÂŠ$Ê ÌKÏV×a~ˆ?é›4IJ0‰ûú´ RnÎì ×٠Ʀ#âçØï¾ìwÅÉ*ce7P´£žó‚øü ]‰ËÜ&:à>4žôGÃå^Oæ Ç%·ê:â²Ás)’¸^ÐÊÔ›Q ‹”l·WÃÙ ´ÄCíWhqq¥(+|ŬóÆ"ew‡ƒ"ÓD»-%$Ÿ¶ž9 ´UU²¡ChØ(/)ÇzÀ箣ë—65ÉÉvûtÚEweU!µEs¤¨þéNˆð´ó× ]àJ< =\'x§× àR>;wÌn;KüIïテÕO½Ÿî[´èg¬×.–÷èðÛß®`b‚l½> endobj 272 0 obj << /Type /Annot /Subtype /Link /Border[0 0 1]/H/I/C[1 0 0] /Rect [498.088 666.054 505.062 676.893] /A << /S /GoTo /D (table.1) >> >> endobj 280 0 obj << /D [278 0 R /XYZ 63.8 705.06 null] >> endobj 110 0 obj << /D [278 0 R /XYZ 64.8 700.753 null] >> endobj 281 0 obj << /D [278 0 R /XYZ 208.753 566.288 null] >> endobj 277 0 obj << /Font << /F47 126 0 R /F8 127 0 R /F54 128 0 R >> /ProcSet [ /PDF /Text ] >> endobj 284 0 obj << /Length 918 /Filter /FlateDecode >> stream xÚµWÛnÛ0 }ïWøÑjÕºX–l@Ú¥[†ÞºÃ: ns+–K']÷÷#%*q“tk“îCÓä!E‰'‡ÅÞÁqj‚œåZè èZ1è\2#ó èßÂQœ Î"N@N@JüÝy¹NÒ–ŠTÉ}2iÑÚ#} ÷Ë÷âËÁq&k`¸b¹JƒXp–óÌÁ¹D„Ý)‚±Hƨ¡dð#a‘p£>EJ ö]˜T× ÃR™ùH˜¼Ñ ?hU èjNÿ¤³þEÏø~H“í#éû ÝzAb. S¹P¢î…%9™D±ÈÂÛrH{ônCr2eB™Å'`uDyáZ€|¹i‚¼'Oc²¹¹aôŒöÇ”“Y‡ÇÅT²ˆ¶©Øš%Y¶ Î…8%(mj°#‚u´N ¦¡•¶‰V÷Ó·I<Ï7Ûåë9A”Ekî’w,`RÃ1ãpÌÒt=ì)…=£P…nSGìÚ "„·*ˆß’KDõ©¦{ d:ß ÚÁ¹¨õè›™|ë#ÓXiâ í¢4Ëük»–iñ|»`˜$í• ú?§³Iç¡Iõþ¼Ò°ÏDÍ$KŒÞ©ñ”×U-WÿîŒÐíºëp-g’o³EÛP‡Ó¢pþÂlÔô¾hµ‚=?n/*š?é‹çÏaéȹ÷H!n#˜G?£T‡e¿[Ù‰+%Ãg¹ï†u§DžáTøT‘¾?¥Ìº4Fo»«¯Ëûçõ#ïgàæa§öEe¿ú!9¤WñrVY^`•óyZº³¡X®¯Õçl€¦ÏU cRÅϲó/¿.6šå=.w7Áv3,!ô­v‰fXzû›3Ë‚˜úW"é+8G‰õív\„‡;Ëm>´ ‚rdsqvŸ2‹°³4Ìœ'Û³EI.È‚LRY*·cè\9Äü0QªÂlQ¹É°Z¡‡\ Ë Ù¡.R+—UÀCûN€Å,KÝdN(ï݃õ>ém"•p¯gbq½œF¯ß£ àÞ‘g¼ÔMöùfî»–¶¥úMa,¡Ñþô¼bꬰ›æxì)kßYZßwÖÅr—ûcά怪 ½T0;ìUÂ%ãª+93Â!Î#˜*B…—öFXÒö,u™ûÓ‘ÿB&k•"g ¢¬ÒŒ hJë_H´Ük{bÂà% endstream endobj 283 0 obj << /Type /Page /Contents 284 0 R /Resources 282 0 R /MediaBox [0 0 612 792] /Parent 267 0 R >> endobj 285 0 obj << /D [283 0 R /XYZ 63.8 705.06 null] >> endobj 287 0 obj << /D [283 0 R /XYZ 151.987 559.902 null] >> endobj 114 0 obj << /D [283 0 R /XYZ 64.8 526.089 null] >> endobj 282 0 obj << /Font << /F58 130 0 R /F73 286 0 R /F8 127 0 R /F56 129 0 R /F47 126 0 R >> /ProcSet [ /PDF /Text ] >> endobj 288 0 obj << /Length 149 /Filter /FlateDecode >> stream xÚ31Ô35R0P0Bc3cs…C®B.c46K$çr9yré‡+pé{E¹ô=}JŠJS¹ôœ ¹ô]¢  b¹<]ä00üÿÃÀøÿûÿÿ üÿÿÿÿÿýÿÿ@¸þÿÿ0üÿÿÿ?Ä`d=0s@f‚ÌÙ² d'Èn.WO®@.Æsud endstream endobj 286 0 obj << /Type /Font /Subtype /Type3 /Name /F73 /FontMatrix [0.01204 0 0 0.01204 0 0] /FontBBox [ 5 5 36 37 ] /Resources << /ProcSet [ /PDF /ImageB ] >> /FirstChar 136 /LastChar 136 /Widths 289 0 R /Encoding 290 0 R /CharProcs 291 0 R >> endobj 289 0 obj [41.52 ] endobj 290 0 obj << /Type /Encoding /Differences [136/a136] >> endobj 291 0 obj << /a136 288 0 R >> endobj 292 0 obj [859.4 650 796.1 880.8 865.5 1160 865.5 865.5 708.9 356.1 620.6 356.1 591.1 355.6 355.6 591.1 532.2 532.2 591.1 532.2 400 532.2 591.1 355.6 355.6 532.2 296.7 944.4 650 591.1 591.1 532.2 501.7 486.9] endobj 293 0 obj [500 500] endobj 294 0 obj [319.4 383.3 319.4 575 575 575 575 575 575 575 575 575 575 575 319.4 319.4 350 894.4 543.1 543.1 894.4 869.4 818.1 830.6 881.9 755.6 723.6 904.2 900 436.1 594.4 901.4 691.7 1091.7 900 863.9 786.1 863.9 862.5 638.9 800 884.7 869.4 1188.9 869.4 869.4 702.8 319.4 602.8 319.4 575 319.4 319.4 559 638.9 511.1 638.9 527.1 351.4 575 638.9 319.4 351.4 606.9 319.4 958.3 638.9 575 638.9 606.9 473.6 453.6 447.2 638.9 606.9 830.6] endobj 295 0 obj [645.8] endobj 296 0 obj [525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] endobj 297 0 obj [525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] endobj 298 0 obj [613.3 562.2 587.8 881.7 894.4 306.7 332.2 511.1 511.1 511.1 511.1 511.1 831.3 460 536.7 715.6 715.6 511.1 882.8 985 766.7 255.6 306.7 514.4 817.8 769.1 817.8 766.7 306.7 408.9 408.9 511.1 766.7 306.7 357.8 306.7 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 511.1 306.7 306.7 306.7 766.7 511.1 511.1 766.7 743.3 703.9 715.6 755 678.3 652.8 773.6 743.3 385.6 525 768.9 627.2 896.7 743.3 766.7 678.3 766.7 729.4 562.2 715.6 743.3 743.3 998.9 743.3 743.3 613.3 306.7 514.4 306.7 511.1 306.7 306.7 511.1 460 460 511.1 460 306.7 460 511.1 306.7 306.7 460 255.6 817.8 562.2 511.1 511.1 460 421.7 408.9 332.2 536.7 460 664.4 463.9] endobj 299 0 obj [583.3 555.6 555.6 833.3 833.3 277.8 305.6 500 500 500 500 500 750 444.4 500 722.2 777.8 500 902.8 1013.9 777.8 277.8 277.8 500 833.3 500 833.3 777.8 277.8 388.9 388.9 500 777.8 277.8 333.3 277.8 500 500 500 500 500 500 500 500 500 500 500 277.8 277.8 277.8 777.8 472.2 472.2 777.8 750 708.3 722.2 763.9 680.6 652.8 784.7 750 361.1 513.9 777.8 625 916.7 750 777.8 680.6 777.8 736.1 555.6 722.2 750 750 1027.8 750 750 611.1 277.8 500 277.8 500 277.8 277.8 500 555.6 444.4 555.6 444.4 305.6 500 555.6 277.8 305.6 527.8 277.8 833.3 555.6 500 555.6 527.8 391.7 394.4 388.9 555.6 527.8 722.2 527.8 527.8 444.4] endobj 300 0 obj [312.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 562.5 312.5 312.5 342.6 875 531.2 531.2 875 849.5 799.8 812.5 862.3 738.4 707.2 884.3 879.6 419 581 880.8 675.9 1067.1 879.6 844.9 768.5 844.9 839.1 625 782.4 864.6 849.5 1162 849.5 849.5 687.5 312.5 581 312.5 562.5 312.5 312.5 546.9 625 500 625 513.3 343.7 562.5 625 312.5 343.7 593.7 312.5 937.5 625 562.5 625 593.7 459.5 443.8 437.5 625 593.7 812.5 593.7 593.7] endobj 301 0 obj [489.6 489.6 489.6 489.6 489.6 734 435.2 489.6 707.2 761.6 489.6 883.8 992.6 761.6 272 272 489.6 816 489.6 816 761.6 272 380.8 380.8 489.6 761.6 272 326.4 272 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 272 272 272 761.6 462.4 462.4 761.6 734 693.4 707.2 747.8 666.2 639 768.3 734 353.2 503 761.2 611.8 897.2 734 761.6 666.2 761.6 720.6 544 707.2 734 734 1006 734 734 598.4 272 489.6 272 489.6 272 272 489.6 544 435.2 544 435.2 299.2 489.6 544 272 299.2 516.8 272 816 544 489.6 544 516.8 380.8 386.2 380.8 544 516.8 707.2 516.8 516.8] endobj 302 0 obj [376.9 513.4 751.9 613.4 876.9 726.9 750 663.4 750 713.4 550 700 726.9 726.9 976.9 726.9 726.9 600 300 500 300 500 300 300 500 450 450 500 450 300 450 500 300 300 450 250 800 550 500 500 450 412.5 400] endobj 303 0 obj [693.3 654.3 667.6 706.6 628.2 602.1 726.3 693.3 327.6 471.5 719.4 576 850 693.3 719.8 628.2 719.8 680.5 510.9 667.6 693.3 693.3 954.5 693.3 693.3 563.1 249.6 458.6 249.6 458.6 249.6 249.6 458.6 510.9 406.4 510.9 406.4 275.8 458.6 510.9 249.6 275.8 484.7 249.6 772.1 510.9 458.6 510.9 484.7 354.1 359.4 354.1 510.9] endobj 304 0 obj << /Length1 1954 /Length2 14534 /Length3 0 /Length 15727 /Filter /FlateDecode >> stream xÚ÷PœÙÖ £Á݃5îîîîîNãÞ$ nÁÝ-¸Ü`Áà$8—™3gfÎ÷ÿU÷VWu¿Ïògíµö[ME¦ªÁ$fél”vv3±1³ò$”ÄuÙX¬¬̬¬ìˆTTš¶`àåˆTÚ@7­³ÿ¿,$Ü€fà7™¤øÍPÉÙ ïî`ã°qó³ñð³²ØYYùþkèìÆ4ó°µ(1ä€ D* go7[kð[žÿ>h-èl||<ŒºÄn¶fN%3° Ðñ-£…™@ÃÙÂöþŸ´‚6`° ? ‹§§'³™#ˆÙÙÍZ˜Žài ¶¨A@7 %àÊe3Gà_Ô˜©š6¶ ÿ(4œ­Àžfn@À›ÀÁÖèzsqw²ºÞ²4ä*.@§ÿ+þÇ€ðWslÌl‡ûËû@¶N:›YX8;º˜9yÛ:Y¬l€iEf°˜`ædù‡¡™ÈùÍßÌÃÌÖÁÌüÍàÏÒÍÒbj³7†ñY¸Ùº€AÌ [‡?8²üæ­ÍRN–ÎŽŽ@'0ñú$mÝ€o}÷fùëpíœ=|ÿ‹¬l,­þ aéî¢ådëꔓüËæM„øÌp±²²òpó€® —… Ë 4½]€*Ùþ¿qøàëâì°z£ü`k|ûAô™y`7wàß+þ!²±,m-Às µ­â?ÑßÄ@«ÿà·ów³õ°¾€õÏßOFoféìäàýùŸGÌ¢¦/­ 'Åðå¿•ââÎ^_&.n;+€›ÀóöðáãüÝÿ²ÿSªjfûWuÿŠ(çdå àû‰·îý—ˆÇ_“Aû×ÚÐþ7ƒ²óÛ<´ÿŒ¿!+«ÅÛÛÿç%øÓåÿßìÿåÿuüÿoEÒîêiÿcðÿ£7s´uðþËâmžÝÁo»¡äü¶!Nÿ×TøŸ…wv°ü¿:9°ÙÛ†ˆ9Y;üÝF[´­ÐRÕlaóŸ!úï)¼w°uª:ƒlÿ¸pLl¬¬ÿG÷¶söo— èí¬þTßVêSJ9Y8[þ±{ìoçnææfæøvôoˆ àËö¶¤–@¯?gÀÂìä ~s¼‘û°rvCüãD¹¹,bˆþƒx,ÿ >‹Ô߈‡À¢øz³Tú½YªüxÙ,êÿ ‹Æ?è-Šö߈ï-ŠÙ?ˆÀbþz‹iñ7âä|Co÷À?Öt‹Åò_ Àü|+ÂêoÈõV„•­Ç?z®?ÔÎînÿrx3±þ|Khó/øÖ'ÛÁ7vÿ‚o<ìÿßJwü¾í(‹Ó¿à[¡Îÿ{³}{oüKýV™Ë?ê·D.okâü/¦lo¥ý«p¶·Ò@ÿû=€ÿNøüÁ[z°ð_½x«ìéü/‡7:îÿ‚oçâñ/øV±çŸð&ÑÂÝÍíí–þó®xÓÿâ?_ @ ÐqiÁÙBà“]Ý§Ž»1BO¦½I¡Yª=T:&ß%·oî¨pÉtÕ™7ÜnÅ’GzÑWw¤hoD—IŸ}[àÂÚÕÚýžLâÕgöÚLãN‹Õ#1iŠîû=»úiÙC·BvÉSåººó¢ªæcÝyöËxÕ”¯Œ‡.ì©íWs+ =•gŠÖŠ2 *™£Ê3ÏšÇ'f"†§Ç¼ðB›»¹ÅÌ™z%•g@üpÍQä«¿És?ï³V©Éê& $ÐÇ'†¾ÁŸ¡ö?ø"·è[Zµ!´˜Í;¼ü©?a^A›€Ü_ßíS“PF bewާE†›ƒ¶Å”2€š†´Þ7„ªTÆ*ñ+ÅH©I‘mÀý3±F‚.¤%÷’î“3­.z¿„X|~¶èŸ“Ž$·BXÛYþÜO÷ïX*Ìfda“­ Ö)–•Up¿Ohä}RE7ú ¼æ1ÿf²ƒ¶ ó+;®ó÷#yñâ©N>š«6$žŸ>uÅÙŒ4Ö`ßàO£›tò…ïLƒÙ_8›x.?1ʱ㉣žVdñ˧n°Îc;‚ˆ´ t¦Õ,uOȈfDPgŸ³:OËEVÔÎ0O8OꑲÑHF³Ÿ™Ó\L¦'ˆD2ƒvyϲùù›µÞ»J&ê8¦³ ›5ήî,p¦À7:\s'Ìãîý©IuÒC*=Íø¬1Uá{\m¶ÔÓ'sq»í<¾ÎÐ…œj]ÕÉŸ§«‡B(žâ€gÝÄÍÉ÷ϰú ª²ñnÒ‚¿¥äóëÓ7g˜•ý˵gk\áåLfàíf¶Á/z Kù¤ß€†îðiŠj®1‚Ú rb !ïîùÌ:àLÖi¨¤%›ùd(´Û‹îE=ì?€[˜¥ˆü|*ºôóm3²•k‘UHYxÈ/àgÐËdÅ–y:D„É+² ²ðÀ'_F<ègö¸º¤¥QÄuvØB4HÈ^  ÙéOßÍM˜FñòëÆµýrЪx×òI.ÿZÄÀ³êýö¸µþOÓ‚™²œÎõd¥,Pº8…·…´€ò}:HÓ’oNÜl³0ýcȲA̸Y<åë:¶ö'+48Ãd8ÖCžS3õ)c Úô'E<; Š12GÏuövŠv§1·-J¿È×MÌSE¸¤D£iß ÝÓ×Îf™dO¬¦ÊÝ?Õ;vñ#ëÕÏ+sûnéšl$¤ åÊ+;KŠ8rî“ â^k¨ýXßû úûõ³Ó‚$,F µ]TöâöüÇJjšR§*CÓ:#µÈOÁü¨Ûk­½ÜN¬æ|¡ŽF—ŒÇ,Ë¥E†z”Üï ‚´¤>S ¶D)婜ТLÕ1K>m)Vo—ãÞÐo‰ÞùpДSO'sº`OY}÷¹‹ –6ù:Ý>д_rã…¥n*Ùžs$!&Ö>Ý¥lzk|(Þ÷†¿=_k(䤇er[6–Ðð‚ÿˆeAÕæO‹M¶Œ(ï±BEû:Äçºà¹?½é»“ËŠùu4™ˆ¡ô) áŽZ©ÏåãOšêÏiJÔu< ­_Àú0†nÄ~\ÉJ%-\äõé;«ÑºˆO–k¢&“%c¢êÛ¯¬ì’âOF;¿uAÞçŒd‘{±öþ¶¡€®Øp7]þ°u°D¾Œ8b)/EÀ°ëÚ7Úð`î{µÂã”!œ'ØKõè9äW° cfÊ#ý¬º‘ˆK† ("-SØÁm”D±sª–#÷ÆÖ #D^•lò»£îÈ ï»±>°Íêè]:A‡ÀÆòª‰:6ouï!,©M0¦k·‚²|º“ŸöÄ,PÚQdHf‘ó-ÊϧšH|4$d›-¡k£K¹a²¾ŒƒºI ¡V¦us‡¬ç G¿Ù'éÑ-À¸-ÝÀòÒœ· olòÈæä¶›BöÇÀuÐô7Ña¸!¶m7}©Ï‘Y¨†*ʇÖ÷Ïø™‚©Å ƒ")ѾőûaÁèô¥¿d[ +¾’ì>HâÉÀk|Âë«S¯„+E#…¦m3úµíÎ"Ë¥í}°ˆ‚éòHv^?úÒ3áë‡CkÉ®ø:´ÊDÑÂoQ ²Õ•=Ç÷çe+ŽN|ãliLa¿÷rqÊ Ð  +OPú‚íxà9”Ö¼·}Š?í3n‰è_4‹î?¨c«ŠÛ _íNŸ¬x„kKÏŠÙØ×:§6}…ÝDÏä…!}•s~Nÿ®k8BYG '”OûkçâoÇ 4€/±dÖц¹ÑÐR6Ü«àù„­õÞÍûuÚBSö”ÈÖçBüsXÖ¤±&|Míߎj„;Ùó¸Hã0ƒN –ƒøÐö6JJ ñg”òe`·û!·UX¸K˜S¡–8Í”NÃê=³qZ†ŸCq#¯`…ßX 'ä1| Á_p}]%àˆN"é›ì øÑƒWŠÖ»àg ž¾U+Ì$õ©<Ë­ùÙ Ýæ«7ÙŽ½ö˜ÆðWž09¤;M›a3ÍÄì5ç㑠ߟbh¿"ëX‚´äî„ÎfÓЕüfaÓã-åï õÊÕQ+d¼Ñš9-iÑ7”cwˆZ|Éqî ?Œì‡¿òj#¦ÝAž_ˆ Mݹݴwné÷½nh¿+‰~ ŽÖÝ¿äö‰7e›óN·Îè¢,¤)•Õ|kˆªÂüQ²i‹è³™I7äv^†œë¿»Æv•ŽÔ»›'(`ÉXm<Ë]´g•ŨÚí2YêwñÕ¾C·§ñšDØ)ü]xS-`Üõ©>3Kù{>‘h{ æA–iµ¸tXç:£"Õœ£QfÇVƒ80°ƒž²†ÔÉÙk‹C€~Ó{¥MÙioÐõ’j¥%@Àù]—M öήõ*ááS}üçwÖía¤Ö)Îë«(dTÄZï±»;l"ŠÊÚWiç²ì7­‹9õ]µÁù%Œ€­†Í´o*øÓá “&†"1:à1ÁáÖhäFò}u¢*ǵޯ9t_o˰3¤b ݆uØ{fgœ“Ц± ¼w"–èÄÇ?_vŠ.[FMÉ‹8¤\]—’>]ór/ÌŒn£uÍHæ4™=ññ ï¶tOûV”d`Vè“5˜˜2¹-;,ÅÒŸ·»B~ÌÀÏÞ%Zjûñ9Œ £(iý‘ßÉ\!üA±­ß5ö}ÒÛO;.ã~>èreuízy´ŸU<@œÍ_qNuT'[S5XzƒÉîÃà…€/$+0áxœƒ-‘;‚®ä:`qC<±Ò;X£§‚X’ºB+üOoo?Yì<ߣP-\A‡®q³¥KbØTdˆÎ@Œ3ÐÊbëM4“™ŽþÇÉyaéÉÈþ”Ï ja#vh9/fqãPe[BSù7Æ!¥|SÙ‡EB}ˆ£1[Ò`Kÿ5 ì÷J#¹£€ŒmÉñB¼<㓃ý$.Šü·ÕL; Ÿíȃ–†+ì£QÔ¸ð"2Gå‚ËíÆž¤B/Í5éÎЪÑrÉ£Cë…=×<ë·ü(ñ˜9éEgA"+ˆ¶wáS. æÛ†nÑ|¨b}›ú‚÷ å£ïª%vÛ“'J‰Wx¡b±¿Ý{G2{I|_Ì¡þØ¥UšüaÉPnï}¸iÖèÃ(ž¼5!rV÷ÿþФþû²Q@mƯ÷=Ì_Nˆ¹¢uÕ‘MYV¾•úÂñ™~åÝÄA‹Üî_–Æ”¤Vü8îg2ÿÂÊÇÛï‡9º×gò:ÀÊÅBÖÔNp÷š–£ó÷´3ø%öB ¨”tY;?}7ù 1jŸß¬|’¾'EÈuî½F/ËÞ=QDóÕ\æù%(µr¾ýÒí¡ã/Ñï¨Gp%ô¸ÃlIõ€¼Ï*üZ,°ÕÛÜL¹{i< •+̨—ÉL,ý¸šT™žC™$Ӈ׆m×ÉH q†«E=©QYΊv”FU‘ªQ5aÝi¸ÓÒûø9íxm†Á†—9 ›l¤¤A$þ•ó,ÃÀøÈu^ê¹¥ÄøBžÀí1‰LgMA`áà€>…XC~^Yýùwt «T«0T—ºb9ÂÇ—@…¢”~K’:Ui‘³×,ªÊõ“9èYnvƒûŸW›é>ÌB•?T²&ÿNÉõÀ{iÒi]!b—häaTÈÊA›ÏŸlŸœ¢ËÝOç\G~@]e£€ìun«øÒÚŒ‡#Gªk‘¥úû‡D3 àÞì×Ç]ã¢ÎgœnâÙ$:;b•âe3@¿б³÷s´qnÅwj>¬”ˆøŸCTù]‚‚žÛ¥Bö"I“Ð+/v¢•ª~Dö·¸œÒ/'¡ ôºÏ}?ŠíJÒ®,\ŒüÓx»EwâzR9š ìZ÷سÂ>R%Còñ(O^PúøÇ÷ö|†vTìSTÞáûíq\ßCz0[¤{7EªõD'É,2±±ÀבUmÅ©~Ë^~3£ÛÚ:ŽïIA‚f¢îC¯?îN纵é xÀºE½ç°ÙÑ8ÙÈø©Š³‰!9:àõŽŽ~ö¤>‘j!¥w/NÍHpιÜj:ÒÁ*CÈ5ó[3¶|E¥$™þJ缂$áÈw‹žßG´{‚ùºøCqøÌY¤Ó²‡­(²¸áC!eò±7½Ðª/ÙŽ‡K^‹×¶ dÑU ÷ÈéËÈú%!7|‰Z]‘+‡ŽàäqíKïµ.y´¸ú™ûÕcÖã™;$¶v5…ÖÝhºØ@’ÀŇò÷É-æ[  š_Èc~9ßSj€†ËËürd~jüW½uëha¾²ßÓôU· +²`þ‚EÏM'TÒe´ÖdÀ¡¨ØƒBºˆuL/Œr¼kèQ 'D/:]¬fÑ€D7æZiªºFë”Âèÿ±=gÁöªü—K‚_VŽFRZÆP“‘±Î.×è ¯Vä\¢b‘ùû—æ®ØGFD·: ôÚ*±$JUàåF kx£Æ\ÖÏ_˜dFuçï|êdüàó¬LÜŒ¤dâW6Ì\W2c¬ãJ敜 ^Sà=hk$ëX®—Í+0#-·Ï—Ô«Vd2DDÌäû´5Ѷ^¼Vª^›­ ý7ÓMëôÙ£¶¦Ãý"a§}wÅä-RÔÔï ‘],i×ÑV2½Ó~5ß:KN˜j–ËKĬ^Ɇù¨›­^Í«>Õ=,&¡/EŒz fJˆ¶¿D%*¹L ÄF³N‰”>‡ ô5®cBÊÔ òíﬦJ¢_±q‚gð’Ì`CºÈË]QkÍ.j:7–†èwž^NÜ~Ÿ,]ú}åçoF׆UŽWéÑòAY•5¿0“©–”E­>¥ä¦ä+v4¢WË›C6"vÈ)ËáK,dº6š1+¤a0V! J$x#:$ÃóÐd;Z%"Q78² l•ñ‡ìÛ¾|)ÃØs'®CqìY*OBæ¤A‰² ÄÅOpÎ>èÓæÍáªbqtC [Eì›–_;z>zCÿ¨¬Ûì2Jü È ïê¼%¿x:H»^:ß$àÜ]Ó–*Süùè5Á2)«$ 5dÝÑßíÔgž]E”ù½¶Mt|ŸÕàÞÔÄ{ˆ‚Ʊéòå‰CÒ•1q°“ún Í€C ùz ô®¼À‚5UÞÓ¢‰,ðó,á± MB'ÉHR²Öu ®y¾PíÉ@È'ðe´H5^ABË5Á>")x‡b [ä§}k  Âåé£ ‘:IÍŽ )¹ºÏE‰ÎKûêwˆÙ£…Ášãˆó´VÑÉúyÍ5eÍ!‘k¼¨Â•³ ³vù /oÿV^‚aw—Æ|?”6®ó‚WJ:г²¥`ELõôæ¡V…Ò-ï4 Iš¹T—Ú±,æÞ;t0s¯÷Ï÷' y}ZØãëåBfÆmþèø;FÏW»¥¤ìßñÈà!%JwLÂw¤åygžûžÇGØ}¯»Š ,Ð1Ø‚£p†¬ uG"Z!’1ó·|»ªä–C0¥ó‡FKYe²2»Ã·T j•‘ø[ÌçÛ>7Jp¬fg›Ðòfóó›zykëSæÄ?¾ƒYûl-=×ôs5ã㥹¬šAötÉ%YsàZ9-§ã%*ŽÀÊÕž°ÌŠÔǘÛ’l«ªl?AÁ/·ÏÄô¶!Ž;pc”éØ}¾šŠ YUô†dÁèl(LŽþ•¼fÀ L‚!M—G ÃfâëÌüùªÛpÒoVÓÂó鉻‰´hhAñ®¶²´Cä5„ùo£–äaJÈ)o¸¤n¦7Ú;£¦Œ˜¹üˉM Ãìc@¼-šè-èo¾Ù}…C{[r7SÕ÷[ò£­ÆÌç™^ŽœTÁ¾P/øÜŠ s0‡¤8–1­—@„ÊÙ˜b) VÀtÆ÷mÖ¶ÜÁí¡‡í&`ù‚´î;ÓÒ_>DûÐ<æ[2õ‹Þíš«‚J6C<4œPöžq̘¯¬0×6Iàuºñ/É%.@Y'ã-¶4›'™4…AÝ–ÅÓ®hxx–Oª©vâÒnIÕ«æaŠTeÚÇùâC·3Ô¡>Ç”ód!7MWQ…‚Sö(,F;œÂ0Å HdYg¦%Ì¡¥vµõw8È~>à;8xO]œÁŒFIdÛÕ±”˜?£Jé?;ÿøaÔ—´;ŠìpÛCÞ{ÒîŠo@±M$—>îk`÷žG®‡“þ"UñúQÐ4öÊ;|hÝNì°Ò1dþ«)‡,Ú6uÕô&†¨#¸`È¡,~iºrUÓÄ8ž.4ár1ߤ¥P°£Ë`kÜ©ó}´%á³:µ›? ßà÷>®- Ô¯›þ—"Ä3-6ûã5>/&QÙq™Æà_È r³Ž±M›«Ü^¢z>XˆPEÈ4nžæÁ •BbGîƒE¨¥“»›ÒR“ìÛ‡Tñ½„A7uÝi Dy+vwãF¶ìz¥ÀP'I%1i£1©9pöÍ0ïtÔ—‡¾%7U S[Xn:Âe¥¾³àÁ°vÇ,äòÊ¥J'‹Ë‹v-?¹Å‹a„;VF?‹˜„µ0 –•K¸2k4žgyؽÊ8Ôïñ¿}Í{RƵaûp»…½uy ÁúT)EIµ\¼&j2O ‰G‰EVkTÞµv‡ë¢Æ¨ÛÈÓËÀå'¥ï'Іºå%«ajÛ\c¿Y$ vV•G~.ï<zãsÞÖûEÉóù¥âG(~MQd$…$\\òì·Î‘yüb à<ÖÊüUüÔÛF£~o¬fNº'!Âöó´Pj›WäšûíÝëGɧ^kž¸TÐŨ'2êOà›:2q7K@õ[@™3xJ–¥WÙtØ‚ò|ä^CúÂ88™Yuäíž%äBÂFŠîl+ù …™$Èýo;§þ¶«ùºµ°ï£æ\´.{¬#Z³¶=~P &ÞØškD~ã¶ŠÚUó“a;s ý8Rš— i;dÞ)Ë Aäf‚FAN?ßoÌÄ/…b§þÇêÒ½2]¶có”=æ÷>^Ôž¥^Çžä¿ÆûšöM¡ùèJ¯Ì½távÄF`6Šé¶”˜’Ì5´€¥Åm+‹ºÂ t`¤tÇúžýoDή´:ÈD…r6ýL¢†_¸œ²ñ08wºö5¹{­¤“Ž9SHáÍÝi.öœé3¿k;ìß(dýævBF×V§ˆ¬Ó'g>"lŽ$„íX:ÁPǜРáõów|PM×ïä([x¿zÚ$¸ÛºQᦉDÛŸ?ÏN=;û+*éÌUfÃU'Öð ö#ä¿#»Œ¸%-œÂyFoßÒé¬@b™^[’\Í,æ¶8Îë¤)Ì+cµbBG=ÔS#Ô.K.ñ €¾±#|Ú%§|Њ˜Çž’÷¤sxRÉ“yüW~¸BFc!0÷$«Cm'ÉA­“N’'­¼×™&J’œ6Ôf}´˜:!«¾ðzÚÛBRSc2èí zèý~\ˆŒ „«:t¶¡²ˆ·/0Ôñ M¹¤”y69‡íÔtáY¤)ôÊÌy êî v0íÓ/ÙóªŸÒQn§ûnã¹ð“Ñb=¢í¦e®Ñ'ð^åõ›±k1~”¾|´ãÙ»rxМÃW(t—‚ÚUƧ¢äÞ ¦Ô—á¦;€©†®î\_†Â9n˜V»ñÙèNøô“f^ü1x†fT‹\®.š†)×µ§cö .÷üoÛÚ±?N1Ü´,NÃÜ]œ>Éëš±Q `³.†Ë~Ì—û”ÇßÑ‹/Í/™»ÐÖÔ®¤æ\'âM‰ÏéPØ£å›UàˆùR¶m »m¸µ3}nA£`FÈbMqju0‡˜Íî&JÕCz¬P áYz©$j®Æ½ ™œüÕðãxˆÊX½ËtÛ[ÉKáÖPâ}ÓhÖTÜçú[÷+A²zÆÔNhBøäØâŠk”™+Gǯԋ°Ÿ˜¶anŸž‹Û¹xæ‡ñZ¢šŽŸl½æš‰Â?~ôª*rGÕº»‰wÊôžã~ÌÕÃæê×V}oš~Ü)¤6œ4/ÆÝê¥Åµ—…Ðà ãwŠ‚DxiOfT±è –nÙËzOÖÅ¡–¬‹„êE"©yHäxS“ÊI{z¡¶þû¶àDqÞxhÆ,ÊRßí…]|.³Bå˜ÓÍ °#s±ÌrÒ":U¢• ÂؤÿHâ ,ïâY[Ôˆø8ÊðPÎg0ò%l==6ÑA_§R¨ò,G†M±ø¢*ÐMå€è.wÃ÷²®ºÞàRöµ¬àfYrïóGY§ ׌F8mk«ô®Ûõ9~‘q¢â!ˆ>IEû#³,Ìýp‡›6¿ÔˆzfŠ—Í9Q•Ó´B@«æ<J„aØÏKBŶXkAóFZÆ!Ý oIgäË á" Ñ0 à>N¯¦P_­°¦Âs—R}¢á‚’útO]íâOP ÅÚ{b+ÕD²è¼ ¾O^âÀÑy{ªHSä¨1×¹&Kq>ŠyìG+j2 ~|i7„ÊÝ‹arSK¥w¶æ)½0ý::fCimh‚ó¸p†ñDŒí‰ ¼õ·™híß@Jº;êé‘ Á!N"„H°«ë³ÇÓŠè· Ñ×ÎŽ§‹¡÷‚à‹Õ×EúX.ÈN+ía‰@Xª=TP[ çk ñØEm¶ükðIÅoèCM”Ì k:`M…bzÀõ=‹Vuíh«P§êò©„Y‘è¯L Ím.£Œ3‡v‡™ëiÖ¶{ÛäÑ*˜eAùæoꩃß[Ò3µ?rl½bK†|Ïý²¾ !@Á?]éWXu§ -Á:.äXv¹u†X~‚•0ð,ŒºÕɤà.§|øð+ÛÂw<9`?2SüÜý‘çÎJQŒ¯1…’1ž(‡ä¸³çö''Ôè ÷ʪdƒzo–V””²’#|™Ç¨ìrý×V–˜áÊLæq¾wn·º%e7ë:+µTHã#e×sFþ±`"ŸÜ-T¢m®²]ˆ;9ÈÚ4gE6Òå箫êµ–Or¸ ô>RgΙ¢|TO$NŠ*Ö•vU5V¾6ÕÖÉôÄØÂaØB`\Ê(\äu~¿]Gò†²¸Yý_SÂ>U?”Ä꫞­0]ó†ï›ï%À *„”hµ|ý£÷ÚmÕ ¾—J£É¨A/Z÷ŒÃÍØfœÕΚÝSE.RózÑ 2¶E0䙨ùß)ȵ?DÝïi “¯ˆ–/"ÏßL<’£xmÖØ!øä°ˆ“¬÷‰-?ÚŒ+IzFacò}º¿P•ÝëÓ)Ååg+•‚Ä…=ã"|êá’­«žÜd&É¡I5½Lâ@(Âc‹æwž´ÉR­ŸmjøC¾é”ÕñP<^Z¨yŽ‘°Ï‚êøhLÙ3^˜çŸA0‰Ö>Iìn)Ä“‹$o—Æžv–XÇ{Ïæ¡©ïzwÙ)ì„iv¥Îª&ýÎ/óô)ÁuBØÛ ó"'Oin–òqPµíUy¤‹"³$½I¯#ŽÅ‚]h ˆ{mð&ïËS~Ã(¨?žˆ8NiÈ^À²àïó‚ÌbBô <8ΉKx¦^!L© ¯q‹u¥øžÐÅ!5â—áåcv­râšásáâáï,\+–#NÌÔÂ"ë.Ì`•AÉâ&vdY£¢¾«yïº@¸qkóà¥À×~$ŸÆþ»sÖj ó º©õÑy|fp‹âÅqÆ®© Ó§Ës¼ü<ôFiô˜²-Q-ê3š¯²À ôR«—;~r;ØÍ›¬²Øc†ÃΨƒyxP˜Ôãf˜g±°)9²Qÿà`dŠz¸×Æ;môõ{®>Ík}ôâXßñµ‚õm»‹3×ÄÏ銞‚R[J˜ñ|ë-adKQ4TÍÆ~Á—ıŸ4¨å‹b¯ª!C>DÅzö¬”K¢"ÌHAàîm³O†÷aM-ù*jjr:XI”U„Sƒâ†ìáÊí¡™ç¡ªÃï1𓪷ùÑúA½"Ë«Á R5ñndáRÖS£fqµÙš•e[Ù×+,+\îMxtó–j0O$ïP Xæàº-óÁ¶UûúD8»R{[èze{AœñÖ³dÐÚJ!ê ¾É•g¬ôí°rôgž¯ƒ+…Z¥M»`·µK¤ãbUQØ× ÄX­pä}økŽ·ÜŸÂ—Æ¤Ó|O¸¯|k÷éUÔë"J€C[5Q3¦­º¿vÀì°yL&rjoäýåáë çÌ­iï²·î/׿pfãZõ€ã»ú [ l ŸoÖ »ÑŸ%«¶ÊØ? …™“šRªŸÏ« “®óøYWMìku×}ùãКún³’Éù_Rî"'\>Z‘¤—ÚÝ@Š³Ž ÷Úã_mN…Ê~—‘’*'Õkqÿ晢Bþ¬¯ÕɨÈ6Öêc·¸NÇ}I×£?N„7òi¥WE¾øØù5´áåU=J‹Ö[$—eäs¹+<&r2/1®ž¯ÁLk®ç•þi=4£Øs`Ü8Ö»KëÁg—¥q€7=¨¶ÑÎCXNS¾²yÒÚ ŠRñ€§"M4ªf&÷Tvâ›q¡é,-JÝ&µÅb¸ÜJOlSùªmÖn% {LgQÝ]ÔÎS?î1CAÈò—…ê!Qñ®ŽåØvøìVêŒÁHŽý˜‚|Šv2’'L 4®«§±R:¼«V=K–®¦­+èæb}å¥,ó¥rŒPh®¹Ïh©)jßñä©v}å_¾ HQ!`?¤›¢—R£  ±„—ékÕWÝÁg&|òOCÞ¬Šìôvé§®üèuÈ4–cÞÉ›G¹ÚôZl½ ¾¯yeQ“ˆF8Ý™·“9:öt\ƒe—E Á_œ¸“x¾¯^PÖ)Û=õêǪ²³I³lñ§8m; ½Sá5ЇMuÂ/íwY.(zOf€s¤™ÔH.t,á?N¸šZ>çe¶¶úõLuAÃN Xk+÷ÒÏío±¡ºhÔàdúVM‹TzKj8–Y_Ÿ¥Ö9 'ö{T¡öÞâ‡@«¢bÌßY~ØcØóòÕv+òëÁ¦õŽ'±2rWg6õA¼›šrKáZšÊÄ¢©ü9‹"úCIÞ\ÿ.¨F4á[íÞ,‰ÅD§R7‘ó‹®²S 4Yô¥ÇOé$k.&…5ó`Ämœ¾odʈçPréÙ­‚%‹öïÞ?…BfbHyúÁ†F~~Á/€8Ü”ñ!¾([pÞ-æõ—Øg\›OI"E§"ã*™0t“WžíqÍ!¡<Á¢®Ÿ«›äNu, óXP@y}¦kñpJòßv¹Ì«?-«»ë/÷·b`¿ófèšs]¤æÄµKç±€Ðì.ßË3¿ÞfN—íå@½¡ƒ9¬LCÕY]bè–¤ö¢Çâui ÀgE¸vªŽÆx¯crŒo§nÏà ­‘ü{>ËàB6¿§Òèâë€îNA ‰ãwqõu E&Ã#öIV—ª¤PhVÔòãu]¾j+£Gzv£Ò™éñ’l;hÊóUë§Ú^>É•Ÿ&8šN•&IÏPœj4â@ºƒãtµøÒ~{áÛs¿¬r÷—51EuÈ]HŠúNXŸ_ÁeŸWJï²çÑ©.Wª]ì^µ7¶%2=,•wm(›J†±Ä˜ü~Ú?¨¶Êeе)KU ïçiv9TUh|Š?ŠÁ¡ÜåQ¤^!ý1d¶B_¸ì>dôÊ©þªZ™tœuOšm'ˆ¶Æ«;/ÚX+äÞÔ®Ñ!·/Åg¥|¥½Î~`KBŒÕ”Ÿ¤…·4èûÖÀ&rg¼J…ý%УÙãœÍ%ÛX·*{Á|¤ÚÇmAVAÔËãÔ.Ûi#ªs·X´.TDYg£½wX¯±‰UŠE©>Oßj%q47¸D€ 3®êÁ椳ˆlQ}Zœ]·¿5á; IúˢѹœÞdêWiÕS¤v…µÀìˆIÕï«Ë”:üM¨ˆÏ´ÇÉ;–?"µ÷ï'¿NÃevÆú¨ô+‰,£¢¤Ö=M‹²Ï‰›4È'WN™¢µRÙ$¦8ˆ=»¤(-j™zÓ¸ ÙX/¦u‡«‘V0tC#öNl”¾]4šfÖFäšôÝüñ¥á§­iÊ"+Àx‘+õ ™£–SK¨;¯ÿ¾“øeüíæ²¡™È^ìÃ*­‡ÊMþV§ó¯1#K¤F „Ïþ6Éý&©3óF§îëâÛÊQ/¨s8 Hdö>\c‚uxzÃéšz]’€æèIâ3úWËqáv묙Ù³jòC.ƒ§~äs•*9–¥7]÷èÊâÕà-|±ª>› Cúè[Á(¡¯"ä²Î1E'M„”bD·!Hš#»Êx¿àÅú¼Mz1’1Šu¬­Ã{§é”êµãxΞKòOR'}ÙÛa—Ì.5ÈjC.׿ô'b¨œÇí÷]}Z™ulÑ.Ï\³XÃyeÓwÒ™ÞŸÄ)]ŠÿnX—À±(ɹº2SëG®~ÀwVó#]}Z6Úä+ÛàØZ1¦³.Æh) .V±³D«nl¤üLEˆŠ.7­'?ý³“"´S 2sÜ=ÂF%“’â Ý›hò‹%Ͱùq½¶=Yå¸ÁðT\nÝõK$hÓ¶Ë7l$•þƒ æ^*úõ4DóhbH¦žó/ÈÁßôÒè±Jäá*ˆÖ2PQܱU¤Ë¸ôYs3zËÜY¹¯/!©§ùs͇x}§ÈßÂñÖ*Û‰Ôå0@›­ƒËB¦ò„Â7Yª åaÆoô7ìÂÝùб-mÚèO‰9¬Úí7„ç¹V0ðŸVb‹ß%|f蕆ÐfÒô)QÆýzœ ªÜ”ãIr¸¤þ^Š`45(` Y‰ÂL²«“xo4ò'/)övDUc1Ë®q –L±4OÖª®q&¹Œ¯ÞûéFTm<Ž •ûÆËuL5ˆ¶"f·g컽)/D–Ùœ…JµK×+­©=åÕžÒ<ôþî’ºÁiÙ³ ÜûѰ£]ó¯õÝG%O;gÎþ7{(‚(uεÕ,Ù©úlÌ(¨·í,P«„ ØXs˜º¾n˜Å¶3=qr»WÏ5Ô¹aÊëLƒSÔ{c‹ Ñ7uT×ñásb Fë«Ëî{ö“h´ž¥¸÷÷?Œ{1Ýdßü6€Ü&½哉±‰†Q‡8µÒzé.SøJ@ï}l62H²°òhbM]üéz*ŠÏ7•N”‰ ì6¶Ç¢µ~ez§ÕÌpMßâ¼\ïW€ê]K–Ö[™‰` XúîŽ6!VêÃ…ÂI†Ð»ceÝr¨úúD–9Š¿¥§a"Îö)Ha ßX0Év:I:Dx>îËB(NeOÎ[«î¸ã‹ct›]l)rh»Ûe‡8;P‚à,ÜNÓVDût]8ˆiôÕ‡ƒçvÙ—1ÜÙÛæ:¡•ç§I™°ö´äR·H[Ä ĵ¨Õ^Û¡£êËÉl|£vÕh%:àòSÛÀ\êßÃ$À;é, Ôpy4 …ã×n2Ý·9îcàÕý+…ä0Ïùïí¿Ux„aȧb;ñvT´ôS„%ÓT\™¦{·ÀCÓqê!í¦›Œ×„Üãsz/¾ýUmbRà2ƒrÝ;ÐE@ÞmcSUÉðÇ«o'̧‹R˜¾…2%±Ó®(.ƒ¦9övs-øþr¸!×à´áFJëT3ZÇÞDò±\‘2|hþô³¢C垬w¾ìNéÒé˃ p…‘}ùJWAIÛ“—ògœ~ZßTæ‚ ªhzÝÛ1GÙfTÜgðLŠG÷àø´ªÌ8¦JqBòñFkâ3%J˜/]„s_̶’÷.åÖ` Gó¶aDbhÀ’·5g•úJ`Ô/ß YªáÐ#>‡ˆG±ŸSÔz“ •›4¢¥¿†ó£r(à˜§2yºŸŒ²v¿~ÆrDUXº±øÖP)Š"™“íj·3A}Ò‡$ÛDî°à”Å D4)ÌpÅþJA£È–[ÿÔ®€âØŠÎÂ÷5Ê+Ý‚ï·)™ëïç>Øõò«­iŽ–OÂ;ç MÖ~Ç8V-ˆ'k ˜@£òP¯ñ 0¶xÂÞ-G‹Oÿ¡í\rIw#ÝTüçÿ.©PÚo¨~ |oÔÇ;• ¯ä]ôˉˆµ•à#[7T‘4ÉI< â{“w? ìO°{|±üÌ” w¾^åYRyIR®„û? ÜßG±²bwœRgµ•(ŸœÏ`ÓEuù%Aÿœ&|Ù¦5Ï ‰®’ÿNÜíŽÝ†'¾žÂ½†Ë,2@u}<^sŸ0;µýþ$Ìw©W¬Ø3jrrMþÓdub^Š_œK+,I®ˆž$¿ÍºÙ(A®…$,Œ¼y›XÇg+u©°HŒA°µC¤ ¶3® ÛR~ºôÑ—Žœã'+Cï÷ªucÖNQd]’GÑÊ­±4޼Ü3à›k§My­(Ê µÍž‹¨êø/)ã¨ÎAªÒ…Øn`—;ìm?V÷lYœ Ë­I² u\o¢¤ÇÏ2“³CmEq0Ö‘Þx¸ÒZ¡1]:F¨,N5mSwýØ—³^CHš'sÌ-½é:ªXâ!Ýd^ÔÕ!ô–ùYaY¶\Á3Öêw{†ÅÈåZrwÇp‹a?U¾hÅý?[™œ endstream endobj 305 0 obj << /Type /FontDescriptor /FontName /QZFKIE+CMBX10 /Flags 4 /FontBBox [-56 -250 1164 750] /Ascent 694 /CapHeight 686 /Descent -194 /ItalicAngle 0 /StemV 114 /XHeight 444 /CharSet (/A/C/E/L/M/O/R/S/V/a/b/c/comma/d/e/f/five/four/g/h/i/j/k/m/n/o/one/p/period/r/s/seven/t/three/two/u/v/w) /FontFile 304 0 R >> endobj 306 0 obj << /Length1 2102 /Length2 14187 /Length3 0 /Length 15444 /Filter /FlateDecode >> stream xÚõP\ÛÖ€‹âÜ]w·àÁÝ]šàÖ8Á-¸ÜÝÝ=¸»‡àw‡pÙûHöùß«º·ºª»¿9|Ì1Ö¢$URe1³7JÚÛ93²2±ðÄäEµXÙ,,ìL,,lð””j–Î6ÀÿœÃSj@–öv¼ÿÐs;¿Ÿ‰;¿+ÊÛÛd\l¬ìV.^Vn^ ÏíxâÆ®–fy&€Œ½O)fïàádùÙÂù=ÎþhLi¬<<Ü ›DlN–¦Ævycg  í{DSc€ª½©%ÐÙã\Ðð[8;;ð23»¹¹1Û‚˜ì> Ò2Ü,-*@ÐÉhø«d€‚±-ðߥ1ÁSÔ,,Aÿ¨Ú›;»;ï6–¦@;뉋Ð ð *-PtÚýKYî_ €7ÀÊÄú_wÿ¶þË‘¥ÝßÆÆ¦¦ö¶Æv–vŸæ–6@€¢¤“³»3ÀØÎì/Ecý»½±«±¥±É»Âß©$E”Æïþ»>©“¥ƒ3ˆ dióW̹yo³„™˜½­-ÐÎÿW~â–N@Ó÷¾{0ÿûr­íìÝì¼þCæ–vfæ•aæâÀ¬ngéè”ÿ·ÎûüŸ³Ï@g' 7躛Z0ÿ@ÍÃø·õ¯ã÷¼½ìæïe½-Íï?ð^ cW ÀÙÉèíõOÁÿ<++ÀÌÒÔ`üliÿÇûû1Ðü_ü~ÿN–î]–÷ñc°üõùï?ý÷ 3³·³ñø£þ÷3«É+ËÈ©Òÿ»äÿ EEíÝ^ŒœìF6NV++;€›“àý¿~þÛÿTÿ÷©’±å¿³cùãQÚÎÜÀó¯"Þ»÷ŸB\ÿ=4ÿ^ZÀÿFP°Ÿg €æÏøë±p²˜¾±þ^‚¿MþÿÍþ_^þ_Çÿÿf$ébcó·œæ_ ÿ?rc[Kk¼Ï³‹óûnÈÛ¿oˆÝÿUÕþk¡EímÌþ¯LÚÙø}CDì>Ûü·– IKw ™’¥³©Å¿†è?·ðîÜÆÒ¨d²üë`deaù?²÷3µ~¨€Þïêoð}¥þ7¤„©½Ù_»ÇÆÉ0vr2ö€gy06NN€ëû’šÝÿžm3“½ó» à½8o€¹½ü_7ÊÅ `ùëè_Ä`ýCÜf±?ôÀ,þ‡xÌÿ%n³äb0Kÿ¡wŸrèÝ‹Âz÷¢ø_úÈ`VùCï^TÿÇûØÿ¡wŸÿ%ž÷<ÿÐ{“?ôÁô¿ôW‡™Íþ¬fàñ½ÌÿºÜ? ï)™ÿQxOÉÜÒõ‰í]œþað®òùøž¶Å?ð½Û–ÿÀ÷€VÿÀ÷Ìmþï©ÛþAÖ÷ÔíþD~¯Ùî}Bþ!¯Åþ¿Èñnlÿ?â÷Tþˆß#;¼oŸý?šñþŽcvü¾§þÂXßSý ÿ]ÿHè]ôþ$ûcðâO'ß7ŸÙÙ øÞ½×ãìfÿƒ÷’\þïÝpý¾äöÙÞ­ÿŒíݽÇßø?Ûaêâäôþæøûùõ¾:ÿá¿_S@ ;Ð~eÑÞ”/Ȫ.¨ã¡F„ÀqoR`ŽrO3…–ÑkÅ©Óå 6‰¶:#à§ÓHÒHêúŽÍ­ð*É«×qklh[‚rûó—Ã8•™½vøåiìÁ©‚c‘ú¢„ŒjÂû_^¿hø[C¶‚wËPæ8º|DVÊÃxpë—r¯([YÜSÞ¯æ’Ex)›eŒRÔó/ž§Ì5É\À%ƒqf$‚£C¿pG™¿½›CÏžz#‘‰£‡÷>‰b/ôÒÙd‹~\ðüQ¡ÆêÁ£ÀÓÁ%‚¼EŸ¡òý•,ƒ³äUR#QdNd°Ø,؉bìÈQKÚ½Â_66µ5†{hè/V†²3cª¼M):rh£šÝ…‹žSÏ]<ûÊj˜Rî:xÅöŒ¨œÏp ´v>Ub MýoCtK#Óõ+ôWò×2^ÞàÏ,uCü›¯pÜ2›I®³n¯—±;Òi÷Ã¥÷Ô””\–îšö© Ú4á¹ñ(«i6ŒÑi–æð`ú›µ 8AiÔ „¬ÕxíO™nOä·ï YǦB«üûˆ›KŽj{.AËfeºÀ™è4+^™^;¨1Ùçpr6Õ¼ÝÄãLQt¡ñ yðû :îêcã‚ä°$?gÍ,g×LÈï cŸ¾î–aÂæZªš'âOQÓ9!k rÂ¥Á«PÂÊJFÜ$Olֱ꽳Èi¤OQÿíVýv¹ÿÒ@»û}z[oKSI¬FcVï\aŸ0§³¯… z^DèÊÆÔ[*¢Ô|_†Ðía®êQ²µØm²‰6ñ݈DžÈ!zðNi{8¶FÁÅi‘VNÀÅ¢4z!`vX|r%·­Wi> Ø·¹…º§g~—±dÒSnb˜½âÀçnçS¡N çž2/ÄÂl; òâÖSâ –©{[v¾+î·2|š´t~þp®å4NÙµù´zð9zÏ4©Î\pÚ_'튄pÞ¥jÌÓv©‰G{§ˆw9x,zx¯ærˆéNPË‹PIþŠýo>p«?&N£Ó+{PÀ!ùÀƒhF©W÷Iü¿õš×"½0šj~ OzÅ+ù8ú¤2H£‡RÔ6‰‘Õ¿2ÛöBáp‘@:MF´~ÍS©àÖ¹ò.ÍXÕ§?öãjÀꦎ~À‡±mdì¢û¹Ó³ÉQ„I±’¨!®ÃXÜ[•:¯¹*›ìÐXx–×Ò”ë£ær_x±¨x\ÏŠWAúèOècœNÅÍQxy¸>Û=Ë ÐF?V¦!‰cºÏ>À^3†7ôÑzÁâÄúƦë@Ä.ö§qÚ^c@óBÏÒ|7ïEn±n*ÅD¶ï´¥)ÖbªÕ«Ø³<Û®Ñ8§S•\Ì5o>în}ÁðÓfe×„ÏæoÓô%y£%›a¤æ<†‚JGÕÞp’¥w•‚ÐËû)IM)°{p D=êpô2¸§ÐxÖhxˆü‚ Ÿ|ª ʇÁÕ«}ÐÐ7|h¡xp’¥²1 ƒè§æCa¾±=tÄÚ¦Yî?Nf²‚9Õ&•žÜ ꔟoMEO|ÜVÒ·ý Cn Wº™I+ùÊÕF—øÈSä*`!Ñc¨E3è¢ðKÃ_|€cƹȟ·¡ÅQÝΉAs¨%–S#A,s]ÞÕŒª·<¯¯•‹‰Û–LÜP•þ²bC×2?NÀ«MØÈ(Hè0Â}—Ô"×öÜ0´¬“5$æS?dsûx[ŽÞn–ÊZ0ÁËìÿøLÊ€9߹¬Ië‚hîRW"‡Ã #¸ßÁS…Yóñ™ñC»‰±¡4ô~c‚­EBÐüŠº£Åï@×1½¹Ž)sQŒÅ…P=ïžè¤“ªloAdæƒ#=G=ÅF¡àlkAŠyPX–N¢C"¬ÚÊp„Q¦3qÁ„h2?4ÿZÇ,æ¢Ô"49¶."¦_Ð]á´4oÃa'Y”Ù*%ç·¢Xh!x=gu3wœS’‰ß¶*Ãw!C¯g ?IB(ƒ÷Ì…;Úg‡½hëÏC£€0ŸíÕí¼ü²àróA1åبrõNGQ+ü 7Kþ$²ôíÄ\vþ¦’•Ô¿2ª8AÕî±``LJ<Ê×.DŸ(«QÏò‚ëQfÂ2cÔq,ÅV [0ïÌùêA§úŽì}f)¥ÁåfÜ Ž³Ea[âÊê©£L` ·pÀ¢p¤â˜vGºFÇ=â"§Ø1)`â;ásöbøCæÃ«X€´?çe!4‚¢'¨¸áÔÛEÎ(Y~Ù¯¬‹Œ;K¶kòìþ ýj7äÇGE@„×ÕUlÁ—W#Zâ>&ñBBöÜ•ý$YŠ$<Ìü_R; ì¾uiɳ?@ß3ÅqÚ7çTÞ ûÔšüÆMkaËÙNâ)ý_<ÄõäÐTy>-_(Gu,d:™ßH¼èqr†&‘טּbékO5Ðb`Ëîª6øØµ¦VÊãk=3|¤Êç6F4£øýíG‚3³&ºÿ²ÇT·ow?n1ÜuG‹²¬íŠÀX°¦x‡™`»=>ðhU'Ýa% ß2ˆˆ"¬/÷fó¥âŽÜšŒ«[6 YŽDIkì§§ rQ¶Nˆéì½÷›ÿ)-%ŽÜ²¬¹"Ê*ÿíMÂ|ƒzl5cð­ÓÉ7;òÊQ¥¼Õ#RÍÚ[°z³îÓéâÏLc"íc÷³K-| =¦MƒÙí.Gãa‹g©©(4ûAMF—ºÂuÿ%x?RH3Lá!B‹® ©FÚòüLÎüÚ\rž¹X!l<ÑurÜÐx‚4gi[ôÈYÿÖ3@¯'ºb#Q…9Õ‰£àø×1¶üSI2öXú’¤›ïð9“:ZÿÊ·A§Gi‚Øa‹LIžšlµED¯Xš<ª” ŠŸÁ±¾¼c7Ýø÷o·1òoV=°%ÙˆË'”±’8Ao«_¥¶‡]›`„ŒTy7ye€*ƒãM#(¾Û<éå`‘9c?øµïu톿5UÞ m@DÃaÎmvm-~<¢xê&'ÂM  /X!]šo˜å&ÇDf!T¡—4 *¹H4òßNQ(´­òç½–¼}%³Ò‚n×A¾Ê;á/IT7œd.Ƚý"=¡3Ç¥O'W ‹›…@dbGïÙqçN¾ä"'è~3&½øºC>ŒñüŠ0’4âRˆa’לðSª»~ðIé^¯TÏÈdkgâÎI ‹vB(–¹ÿž'š?ÝCTõèx…»Š)‡³tW´iGEZ_ÈcL†«AбCEäŽÆúy¿ø¸Â1Å:I 9ä$’ ÃÚUÝñã“îyUÚ®¤1d›ª«ðl¾åa“ÛÁ¬ù«YÚDߨy*%hô§Oº$ð1ìaNŸ&ú|žwïʘ­­@hc}Ý+8goG*{1 N¸Žw0צâid¼ÿñ×J—TÛ¬F¸yû ZGîz×qá¸48¿QëY4£ÐÙ­>ãõ16Œ”·*±ñÄû-{Ä¥&kês·tÔ×êoþ`’G)Aß؈1[ú½¥é6pDŦ=„Ò GÀ¡;8¾¡¿ðn'ÕšHähè±6Íj\<š0’…ÊÚK²˜™Äã·à½go˜sHŒWXÇÓx|Ÿà]‡‡Kmü½¡Ï”i^6ÁO3õ_ªÍ~·¹Ñ£Oæù†? 6‚Ò³Uëp21;—xX‚×^ÎŒ;ýn¥l¸’dÇ{ùŒZ˜]¸A•'ï½¼V2Ìž-n=la¥—íäb&øó’ïÞ²U„À°ë, Þ^Òp&ÕÔúV!}>âÄÎ(ïÉu k–--i-5~—‚ü‰ëqÆë÷9ÜKùÁvU“ž¤ë­ú‰&B·ŸÍ<¥;´îç†yÔÓ`+.ŸBt1„y¬u²øxk±ºs”¶uJÂß$´Ó”vMš ’ŠÌ`˜ò¨©•¾#˜ó>×:ާ¥«$–ÒyÁþEÙbcjétîeúÏeÉ´7$–ÙààÎ:éÉ`óú¶{aþs`q«ŠÏ þ~U·´ŸÁ,·Â_Q2BȨæèš×¨iqÏ33ᛆbGøÃ©C}e¸·à>ÿ(ŸÇ1uDøÁóïÎxý–Õo['×Ût¥›hr$Áø8?÷«öÃûö¢1¹ï-ýÙå!e 57Sœ(3*ÂÌ^æÇÊb—Þåf£=pÃKw>Ë;Nõ‡¤Õí¯Ù3±·í‘æJùöͧ~ÝòsôÔ )Èg\†Ìkš^Ë#ç#Ìa3iGãVõªÞ³¿OeB=f@!á M»á[‹V8J6ê}<Óå¼EôÀTf-(h#x=Teä~xZdõ'Å5‚ÇÓΪMûLËê@Š`=)±@ÇÀÈ(aûÐúðlS}/ÜpíÝ6x#ƒ „î¢í Õâ< °€T˜ 0V@]®+¥Œb…Þ^t…a]ÿì*tàÇÁUÏíÿé.û˜ô÷u£ÂÍk¯UÞ¶"QI'æJ—É·½‚Ö(pç\É+«ýú½ÛKªs¯k7e]zp™ø<ÇxúÖ-a„ó[;†ŸVòvæÒˆ¶%*RDÕêP• ÚÈÕûÒ‚qJòß2eQÃy ôû DIËp„üd°ÂϨ—D˜î¬{¼ø•†û¾ íQ0›äíPšª4ø‡lÙuBÑî\¥åò`b~ 'YW@q1TËí¾±&;¿d5çËÕs˜žÁ÷Œû9] КXš¦íN1Ó‡Áa8‘B¾} f~àz|E΄j*=”˜ò{ÅO|[¦å²AÚ^aâ äâ^Æ¥zV|Ív…¨f£ÙÔ²ˆÉÔ {ˆÆsÄwë†bh8ଋfÈÈ/£/ÆÈëdÝEüºG#ÞÐÜ~Ü”Ëm©~ÖÌlÒMÖaÔ•Ån&üã¢Ièw_†ø´·ãªºmz$½–˰î2ö yà1¨mŽ óu…kŒ°Ãp1Å"jιðV¿\©ãýªÓe*õzhßÛ÷º1¬' n›ÌÝšÛ”u‰ŠàØ ªYR&çCÚŠÂXTó‹Û…ùkî$˜h›»4y·=-þ „/#Hݹ-n¸läí£¼_Ʀ;¸6r—8>=ÖÎ[;]úHIDÚÞÌ_¦¹V†U›0ô馹—øo £j 7§l:Êá4÷P?‘°ñŠp‹ÅøhÑî§t©KíŠhô;뇋o˜!u5~XdñÛ¦ówù ½æyc²‹SRCp\î¤=sZT§^“ÝDy=ƒ÷ìj_]‹Êbâ+Wì²b×ÁõÓæ¼æ$[­Á*îC,8²§Tõé ÀR!gv²üõÕüÓPõlEð™é³Ñ¾(—Ôüëð±hñ˰™ÖYl#æmt«–„7XmÆipð>P½ÝðW¶r)×+Œ¥}I¼$},>û|ê‹äïÛ ”ØÊ0n“¸?#¾{¥SITFòæY P .ÓEKj›¥¿&Ágû,¬¦W›Ë–ZZ»bÎ<{m[sìO+õ>¶§Öð*ùŒ…¾Í;NíŸjAÉ«a«/:Å{eLPú¿{õqòøI›°,hÇß¿¤›ë~Â*³Ya_óÕýê9ˆ<À €)>Ô~-nOføe6ªwÝÍe•rZ=¿Üó«_¢ï#˜Ô‚.ê,²yC±‡°·–n"j8졺&5W»ŒHɳԭ ó9…Q4iöwÒŽ”¼l=‚H³ï]^W/R\œ½7æx•¤rîo„j$vB³’…*,öäþªkëkšz¾e=øÇrÜÕó.}ƒûÄ éñï .(Áti*ü½?¯¶›ÈÎy™ }&Sà¨*ŸCVÕ>$‚É(ðÔKùÐOvç2?-…´Ó4À¿ÁwCŽÎ½9ñ”Y´L ïmçÛuÎR"Èú𯹧l»x+_*›â|œ¶{¤HÖ5, è«lûí¦®Û+ovpz¬Ü•ú{ü! vºÑ÷Çò1d*ý_òm|étÍ\q·/Ûò}³ÏRf­·r„Å\¤u”IJ›q i;v½ØÄr>šâô_@£fšR\Uu¬°&嘰ZвR…uäýgÜ3ì ŒNب¨qdvH“"É2×+è0I[$X|L>à1â² àcëö:EÓ|ùn&î×ÇØ¤/A}šÌ¶I}£Ýƒß$6;Xϱ1Åp\õáÙ#ä.è ¸î—§î-²ºHT}¥7åÔZŠpžØ<-à0`Ëæ«™ê¡¾ê›T¹:ñunq†ÝÔn·yÆÄ´*îf4¶Ú¢vL³g;ÒÐ+±!”ÜD¥.ÝЧëc>‡’#8S ÀQhåLlüÓä tm°Zü&⃿ïbwA‘Àä÷{3ï¯iáÀޏ=Úì0“‰†UyC#Ð$6©º:ï'] hˆØ–ý2Þ£¬:ׯnedÔWÆ\AÎEß!Ø |m“à·ÿzGn :™–´ÓÓ­ªt¯‡µ]}8@ £å1BÖFĸIoù®JöÍTŒ> `Œ×tWS¾j¨¨XæÉ Ò‹¬»^çÜ Õò }>Û‹ ›ŽQîÁœÔnaûîP]K¸¬W.ªŠíŸUpÈmµ0°=¤%‰Ä°‹Ò î}å²ögˆR¡ óWsG=Âíó6I+° Kµ¾9ö-¨K¹Ãá4¢æ†îÔ`C*ÑNv»gÊ­ žû~öÓiÏn™Ó ˆL×CŠ£–ÌJ 'åÛ»,ƒ”aXÇþBœÔÂÒZÉc•>„b,ï[ÀNõEd‘qD†èÆxÚÜóƒ½(íþnòyZ+žCe¦á÷›œŒ0µ(Gy©L;Мí¹Fæ×tm•Æ·ØdßÒÒF½çO‰jÃ=FCvê÷iCè¬ë°Ší:F.øÏÔ0"QFaؼ¦„ªÐÊi>ʧ3ãVî{QÙR2ùšh‰?¢°ÓÓ#~V)º [ªÛßg Ò1K¯ÙU`äË_ùKËi(-²˜PpyŽÄE×Þ!ªÅ|T^í#>šþ½öñHôØ2Ý(•`:û…sy8kn¹&p »<pS^þsQß #£¡b× =šØO½BmÍ=p`º"É+—Ç­xÄõg»Fk†ßB®¿çöùýíR²á夜gQ\š9¨A¿‚;¶ Kü¡«ÅZkü…9¿Ô$)3—Ÿ¨æXK˜?$í48 ëü&WîHàûdÊÓ"ÍýCBEk:Küõ§ IU ;–›ÍœRÜÈÐ,ûµu5îˆ<~=-i]‘¸Ñh[.T„Q¹¥iŽúžçÚZ¿KCš¨õ±Ób—­y‹ö¢’å[\@“­ó:x–õÔÀSΤŒînÉ åQ»Âƒ<4+å› ërÐZ9´6}eié%±{xPh´Z ³*b÷=ÁÃã74(ÎRå_;‰aÂTö³gjK±P‚~Ô½YÇd„)ÍýÑ?lÎÆçÖ_Yí<]!1f|êÐJ†@Ñc%kWÓ6dPz‹EíreDb³Ï?‚Ñ£]—ô&ð¯ GûLÿ>£;Æ *°ôñDÒbh<to?ïÛËfC#nø*´hL•·Îek Oõú¼çH§yx^»ÈBüÅËtl÷W^e‡ð\Uƒ‰GçÛ ÎÛ÷l¨”óv0[z_%öâÄGYíµ2NÄxN”ÔÕG¾’·<‡¯”çQÿÉ‹5ÚÛÕŸ¿_'D‘8eý`Ûúä~F´êž“6#_Ô3þ ÷¹Þ¿‹y@f+° ›SÝÚT 0áÒØøø[·ÎQ äÛêF½tx›ü)Í'/*GæÚ5(õDh,rÝŽ|ïTM‹ ŸË¡ˆSÁ&^'Z¯ÀÕÐó–òh@OE‡ Vz¡gŒüÁ¶Ã®Ù± åiº“qÏêkù—¯‰eš9›NOQ…YázŒt¬¦îé5oßïõ’«*·ô2¶\­˜æ%8t¸RÐ |W ¤ÃBc‚S)ÄÑ>®Ý½ÞšTëÊuy`@¬$zs<™ÿ˜GHÁH¤ß(×;yyZo¹N’?BçU² ³ªKlv°pœ@ïôÅÑÎE›ò‘üU6µ½"Ê,c¶jy‘þñƒK=–£vvâ’¬•n[ÞCÅ©ZÞh~® ï¼H¤“§–íñÉ;[Uºé%1î7ž¢F¯è,oËŽ²åI Þµ€4åö­gvÖ âÁó¥Ô9ʰª“Hz«VÄ (úã%1|^·‹ˆè|ñåçåÎ¥í 0¡k¥ËõÏœLMúW€´oÓȺ‚PJ?Å=Y"‚8™»P6uL+ï{ƒ;TJú‹"HO2-~tœ[pbq>ÁD^ðò´-T»Öu—½´Ïú¯ñ½¡è†#®K+£¿fÄ5ºÓ#ÀÜ£­ï ižc!ã#qóÈ3¨@*Ý–4¸=bjNf—%ÒÏÆPÕˆ´ÒÂ¬Ó Z˜áKkl5>ç¢S0åÉ.׎ß>\é{ù’:Éä¸A#ÚÀ²¤K¬h ¤&Ê¥‚íY?×-À‡ îj΄#`Êâ—ÃU,¬‰l|„©CnïóxœzTj …èC?&œü…-G1é¹4ì£2Æü…<×™…^Þ¼¼¥ ðÙ/}`aŸÊS›bØi±q|ç žÉhRG"ÿ³mNM><,’DIÂO}ÖýWJu|ìñØO'é%(ÕàJN—<í›PÐú ÈœÁ}µwùˆ%V—¤gûZùs"Fg}*zª,Â¥=¢9¥$¯7›í{!æ¤âr~™S:sF»Ã2û;ôZåÖÄÓ;´éhV’ØC½çZù­(Ïo«•/JŠDˆâP~&ÎVœpòS…Aú™0§.å°üXw!UI!ßC kç× ŽÓn/"gº¼ÜôŸƒ©ÖËËýˆzFRßâ0U yŽÅï—ßë9‚_€™ª›k’pßµ+Ê¥Ò†@I3æR‹R_øóÍ«âïû`–E£ÃžJKR¡Z"VˆO%¨àkÝöñŸˆý8x­[Æpÿ Ð-d€³Ö;«x(â²TƒžÑ¼š-ù¸ÆcÛÙÐhšÃçs?´õ“ˆr»/W3>÷÷ê§èH:äׂ¶oTJŸtCADBiižÈÉ*© #jØ"4Œ!‘ò´FY¶¶"»Ïô¡É“fyÈŽIÀ½‘e;`mÎÚ¸dô’rc×’J›éƒ%ÅðF[› îRZŸÊµ®sи§Ž“ók‡º''&` ¹”¹È§ú„Û­šÿÅBéõ’67¬›˜ÿõ%‡^´8v¦ä|°¥Ñîå 'y›ŒÉ‹ObÄÅVæK½¹±“™"Í›ñdÚ‹@‡oa?fÙ\Ò¹š|ð ¶Þ^\WfÛç¡ôï-%7ÊÖµžäZ¾éH®ö“«öwW©¡’§¹¡®iâµå¤`™8ˆ(…Ðýž £I/Н£Šfšeªwt¯Ê[ÄÝ…h¾žÑ?kËOõÐteD òY|B!—r1µÿ0AdnM+? À1žÜ=´¤”_¼Ÿ«Çle¾ì¥ÌQ™Êødç²ëw;w–H½³Sˆl´†V—Ø&Ϊ>ˆ¯R¹z~Öô2r^î$Þ›é æÇåÙ ;ªrf3¶èbбØÑY\W¹VY5=½ïé{^ž®¥Mô –ú!˜~\`ÆÌCEovéùyèZRðix¾Í‰4“:?\ƒäÙÓýë½þMýôAF`ÂÍ¿êÚ µ¬ClçXµx)ÛÓÍWž<*µÕÉ1÷%¼ã1 ^N{ m¿.¨ŸwÓ)—uŽû ¬ìgFpç{¥°ñ0F›ÖgC•ÛØVóÞ5Ž« »¦#–ÖÎtj2 T× AZ}‹cØj€ñò¨ÅÆ0âÈfìL>¦uU i‘ÐJ÷+@ |øR Gvñ¯*f‰‰&¼Eÿñ—¡_loØ ƒ9Ž„3%mLN¿výPò 2×eòu:@ýgêÝ´ —ÒU’ÕO7eÜo Ök¸B)n )S7¯ÐPµÁ±kL )僴?‚yÅG„q ,]q"†Oçu¯í1뜖°|à˱ëº#Š_ƒevòÅZ* Ë†géÑ<]G—Jú¸æd$.•5/¨ø m-\Ý˜ÝÆ’çâBRèD£Â:™ÔäÖ”LÃAûkÛ©±Bû¡‰ZÑà ç|²á!mÒ+˜êù¼T±Ä‡m0ñ•o“L°Ï¥—Qma¿3âös›¹$“êdNzšÌô;*åÙ­±.'.tZˆáFŽ\'ºzàsˆcòô4ÎHŸgúS°Ã]Í9ŠÚ sžäüpÜaàÇKÎïVÆg¦–’ÀaŠËÍ<IÌ~ß²ßt¸hD½ îš IÌüXuÃ~KP%Ÿ%‚êj‘Û°3Æn”Eµ9”†òWõAÍÚ)©sŽ«£EnV+¾K;bê5¸Œ!)Â¯ì© Š‘Vª^YŸOàéw¦IÆtÒXt— sGB¶¡&#ð°ÈBSªíq1Jžxß ]mËSÎi¥œòÍ3Û£MÀáqAŽ/Ža‡#™û•M0cè…º¬ïƒÐO6´/H¼Å¥—±‚êˆ7ÎzÊçûÁo^Ù“ZÅ•Ñáeí¼{æ0&áü­ô(w1øo.ZËÚ@"¤ióßèÕ„û¥©d,»±ÔÕ¤Ö!þ¼„PœÈëï6‰ïÀ›–n “sÛÕ?8Pˆ=ZÙε ˜vÌZؘ»JU‹óqd¿ì§ †¯J?’q¡_<Øû 3Ë»bQdL‰Ì­¾ûñŒ¤²Ô1AyAv@ªkÛYݘ7EnðDó)!’øÎ©AN0“rÙ¥bó[u1þ›Ñ~ÿ/‚54;ŠÄÅÏ*g¹Åyð,<‰2™x²ßºg<7|Ú¸ùdµ=ø³º™îÏÚžî/[)“¸ÄÁ<¼ñ;ÅÒC¢bê«Ä¡\6¬'¿œVmïaÄ[Ú#ö¦2×aâ¨PÔn¡-ßðd8ŠàŸ¿"ëÇ5z+ŠE„©§ïÖ†l¯“2}!Æ‘Žãö÷©Ç¶%3ðÁÐX µzuœ6éºíz3G’O5«§0_áhÔFÃI —¶2†Â›•ËsîÑWëô’؆Ô@e¨·ÍR|©ä-SEж;8‰<Å`à°ö$³ÏÛ½¯†›—C4L¸PÜÆH–b›7˜ëœ£ç5Sû¤v¤ÁH×¢Jj…ó¥yüêd’];ú-â€É•k™ó·—þ™n k£Y:'ƒê Vcø÷ˆ°Š¾ã‰}G8¹ÓÃñB©¿GN| Y«zÙzù'ô¯3®o—‘ªŸ¾‘·>Né½òÁöûñØŸhµ««+ØÜÜfÈWd,;Œ~`úª‚$w ¾¹v–0“áñy£×©¸ku;BTÁ[¸oŽb“Ý TFÖý¤Ýc=O€µe]á~Z}±*+nÌÝRT9Áfñˆ:Û:ïöZ©(K>8¬I¼º`ÈCmý6“Øöu5÷vɇáJÍ2_nÀwu M¥ýp nPÝ;áb6ÛÊ鸵ª×ã(ãç.’ÖÑ‘ŽíˆÖõjk¬t÷'I½ëâ–Cý9usIù˜»>YC¶&·øz'²›kT û›ökø ×YÖÃtĘΠy~ù„ß~)Øœ¹’› ÉŒl ùY?¦GËÙ»%”_´&¹uf¼®­¿IÆ­/öÚ'í2ãã&1ûÑWNn¨ÃI}O)‹­‡õÉQ[sÚ×å„ãò=´»½‹ÊÈÚ¥)›,µù®³8@MÛ¿g–ß­?‘Ï(¢¼vkà; ¾ÕB#îÀôxïµlrš?ooý8+ –J]¹ºHkˆú̦ÔW#©¥ÒÚœ¬ÎØNͰΆ=ê>óX1å’J8Ó‰?Ü3ö^(¿AÞ†ØÊ‚)"eÔ9+Õ–øÒ}LA¤’ùŽwàCùÄk{€'äSé Å<ä–»ö ß°®]¹ºœƒI¦òÚŒHË9=WZ!I­6o¯V`ÒBPÁÚÏf>®¡—èu“`j¸á´ªî¡œŠqßè‹«o 8¹ŸÖ–[Æ7à@ÈŠþ[;xoXå+“+‹³™I晿’™¥CÌx L'ndˆYkDðö5‹Ü‹~¸_–~G±(©(ÐÚ…Ë©ÛÓ +ÙÓ¢IvízBM†œ^øô±«ÖÁ·6´iXË\`½ËÕHa¬ÙƒZôÅŠÜÖȺÃÂ茖·¯\îÍð¹,3¢áî€Áü+ðãt¥Ž°zXÁï£8 ‘žÚs,{!çåc°d‹MÑ”¢åjV*= ð¹±iIÔS¥Ÿj«¾@Ô9ú¦‰œŒ\uUØ€£¡V€=Z©ê¼4Â"v˜ }quðÌ@èpî6l:Çç³8–‘[ ˆ=NµÍÒâÁµó)#}B«ëνMè9®'¨ïÞûF‰/z¸æHëým%àÂ×OoþÏS‹‰Ñ²Å}-pH SâÈêS3اyRlmݽŸØ¨ ~' RÊm„Îbžê8Š˜hFþv4B‚ µÞðˆ¾hXØêCGŒ¥™ L¯Ê+—þ¨S£ô¢ZLH6Ðg_ÓÞ¶¢GC{5Q’z“¼ªøŠíôøÜâ¯Ü?PÓ¿dª~îQ™‹¥ýþÜxp+‰Ž6®U›Fõ˜ä%œýH[Ç"B3 IÒu ,hù]ÃkÇò:µa!¼ó"j?™'½´­ÝÚ^%¬ÞTêÒλ<Ì;²³Nü£€z–DízÁg ¼€U »úcàGÆãÎßp)Ê ªl¯”ôP«ñÚ'Ó7~Ø~Tö¸âg÷P?æK´sŒÅÖ®ú¼‹ˆ¬q X¦Õ­ft!“Ù\*B Ši 7¤ÜmÂØóc”r5—>ÑW»úa)%OíFc1kBw A5Ð5Þ„®ÑÔãñ1&ñ{¶–=Ž»-7_úÐ;ç Ž¹„%#n6ܳ1mpnãï¯Ë$ À¥ űú¥É²'ºR%/Q•³>–5Þ,duÕsŒ ZÔ x‡C]’]"sv’Zì™Û»/L°|b±ÜuÇ [ÎíÛWŒ„Å4Ï žÒpËQ?š ryiÍbÒCQžKSÌøÉø”pU?ƒ  10@:[¬¼Í"º÷y½Ë±:´rÅÃþ‚,ìwæ&ˆÉc뤶´Û¹7ôÍ}i¤¬þ{S2ûèf° ÿ÷eX𞊠 ÷Û²¤McE|E „è‘“=»+TÕ[Lþ·¶6¯õOÁ£Ñ-nŒŒÌÄ“D#|ƒÒ>+gÖáïÍÙ(ƒ®¿o gÃÇ·ßV>§± åɵ*†:«b?«»´Œè<„c¤|N9žÜÞ–1põfWnÁ¬êbö 0µµnm|ý<š·³JãtÉñS‡sð|­zêC¥Z¸•×ȼž½QX’`vzŒ@õå xKFú2Fò½vm²Wíé¥}M•”5µÐÃ¹Ü û3ëýÏV †óCQ¬×«>Ð×[<8þ¨Aåws´ùßaqQ=Ñ—`"¼x|_k‘ewõÅVŒûʆñÄ^½• ¿£ L£|x ÈŽÒÍaæ­_2~0 úÁ_~™¬‘ÙŽ¨ï¢)8”³tÖ°f ·;ÔzÑŽ¡ ]#µÙgú¬ÛwUQ¨ª-`Cœã">úÆ’4?dö!ê ÇÚÚEÙrªVc D2>ôbœµg’œ¶•Vë­ÕŒ€œÜ/›.ÐÆ©*VÞÔ9Š~ü6Ÿ¹h¢wÝ\ýŒ/g@¿ ¥ïkF\É·Ü]äðÅÂYA¥|Ny¥ÂÝ–Ñwº©.EÓÑSã¦ÀêY$x€g÷ˆˆBó üTæÜˆR2/imÈ>¨µÙá¢I !uuhËøGKûTR¥çrÌçª^Ÿ-XKšV‘ó¥È>—ÐG<™w14î‰eoºR‚üRÖ¨T]@3(Q¾ñ ~4K™1°½¿úFÙêƒú|&×m÷×°½+œÆè[2¢";‚,§/­~q~“Ô Õ&ð’⬩ 69w5]2Š3ÍΊf:æd<Çü.ñÿ>‰Yf¶÷ãNi€ªv!8DyÃr½6 e»¹G?޼_rÊ7UÜw§_ÙÀ7ãk!Í+|"›’“¤É?ÔsNO\F·©©€0q¯N2z",ßÎDX¿ylbúHvoJ'´\ÐÚÓ…õûG .£Ô“nf1Kv}â¶ÖNKç8ÊäÓ$í+×.ž‡AÈt—꾘¬I¥©Ç.˜ÿþcÖí¯ì¤s£Þþäu©¸4‘ËQå3,Ü#¡½ô¼Ò˜ÙÖúeQý}m24_Nr¿Šûo#³rÎRA<ÊzÍ}®>V“C™a7ñýͤ_ûÛS¾H[u% ž•6?/_‰|L6{+H—'_ÎÝmÙýÐ×=–áÏJ±PM Sv¸…†ŒPÏ,W*u›’Ú—XS#¶²5ØA®ûDpˆËã÷âÓÓ²pÌpÇiA,÷Œ.®:~!в">媬Yý’ŒMÚ7Ê8vdJP¬¿ÕW}ž?EXuÊ}Ö;|­>p X8׫tÙl¤}Æ¥jäR«‚ÎÚO*›‹Éà¡T &Ñr†ƒ2ÔÑA·4û0zºæ²lÉá8ëZ<öÛâ>dDÓv¯2›ëʉ®rù‚ʱ›Åeªyy<ì³7|[=&°ñ¶úÜ'ìWü`¥:§¸6è(Š" i êe0Õ¤;ê@gÜÀ@c¯hÚäËÃÇj¤#ºû™½“¤¶¡Ç€à’Ÿƒ [Ð7ÇÈš*ßg÷q7èX¾‰h*gøbÖ|8Ôõ‚侑±0­ÏQaÊ+ªnò¬fèáxÎ1Ü@ô(EÔv&éU3¬ ­a4kT w¿럷àhÜ/nz7TŒ¬-ïvDo,¤±½¤6LòBE{ñ¢Ôø#¤Wø4¤méVÂqÌsX’o6‚r2,Œ}ê$¨>/(ÙŸ yYE|²¿ËÄÝb ù”ÙS˜F¼;áÅEðPø:"i€øô¢;ÿ ê*ãÀh,ÌЂ'>0ôu¬ñó¸'ÝàÃFÁ/.¢<¥¦Öº0‡3BsßêEw8Õ{È¡3’"ÿÃ+qþ2bm8ð؎Ѳˆýd‹/Ò6[Bóóêì—‰v_x ðtE?´ü?ñ¢E endstream endobj 307 0 obj << /Type /FontDescriptor /FontName /TMQJLS+CMBX12 /Flags 4 /FontBBox [-53 -251 1139 750] /Ascent 694 /CapHeight 686 /Descent -194 /ItalicAngle 0 /StemV 109 /XHeight 444 /CharSet (/A/B/C/D/E/F/I/L/N/O/R/S/T/V/a/b/c/d/e/eight/f/five/four/g/h/i/j/l/m/n/nine/o/one/p/period/q/r/s/seven/six/t/three/two/u/v/w/x/y) /FontFile 306 0 R >> endobj 308 0 obj << /Length1 1486 /Length2 7257 /Length3 0 /Length 8246 /Filter /FlateDecode >> stream xÚWuTÔ]×¥K.©A†N‘RºTb€Áa†¡Aº¤II éînDJRºS„oô©÷y¿ïoÍZ3¿sÎ>çÞ}ïÞ¿µ†õ¾–¬Ü¬‡!yøyyu9C]~ äXYu!H(øŸ «>áÃ$þ#›#Q¹'æHT¨:Cü‚~ ~Q  Šÿ„#$OÌ] Vu^€*v"`•‡;¸# 6¶HÔJ=Ø-9üââ¢Ü¿Û²ö`ÄÒP7GÚ‚íQ+ZšC:pKéþ¯ìR¶H¤ƒŸ««+¯¹½/a#ÍÁ p… mOÁN`„ Ø ð‹6@ÃÜü79^V€®-Äé’ÜéjŽP (Ä sB59ìÀj}€ŽŠ@Ó û¬ö€ðçñøyùÿ÷g÷¯AØïfsKK¸½ƒ9̳XC `€¦¢/Ò É 0‡YýšCà¨~ssÔÜø½ys€¢¬6ÀÅñO†N–ˆÒ‰× ýÅ’ï×ÔA+À¬äáöö`Ò‰à×þž@`KÔÉ»óý}Å/apW˜ç?±5feý‹Š•³Ÿ âè Vyò' •"ø'gF„@ ¨(?ì»YÚòýZD×Ýü»ø;âáíéwX£¨€½!Ö`Ô§“¹ €D8ƒ½=ÿ³ðŸ`±D,À6Á?ÓQi°õ1JˆÀˆ!?øëó÷“JgVpÔýøï‹æ{Šâª&Ëõ7é¿Ërrp7€'€8€G@àˆ ¼ÿ=éï3ø‹ÿﬖ9äÏýýÇD˜5 þ ÔùýEÅåO}°ÿiÀ¿WЀ£t °ÿcS 0ÐõÅÿÿ6Ãï–ÿË¿¦ü?lðß{Rt†B#Øÿ‚ü/„¹=êþ'¥lg$Ê%êp”W`ÿ 5ÿan98Ôê¿k*Hs”Wda6(½óð ñ…þÈCœ!n`+-ÒÒö=ýu¨ X îùõBuÿUCYÐò%ê-ㄺ´ß%0Êaÿ^Wf ·úeEa€9aîN€Ò*xò£Ø„Â>§ßá¿6héŒ@ ¼ü[K¨Ýÿÿ~q€Án`K‚¹i¸¥d ]U`ËE…,+Ïæ¨€Qß××gx ´.ÛÚþòR?NsÃge;¦¶Â¬í ÞÖ¿4¤¾|¶ìõ&\‚j®¦ÛÚbÛkŒìÑ従š³À¨½Ýø… ÌʆêKÃÓ×3™IjnÇ“ÍOé»JRÊÎKm¿à²ÕðbŒF†ãÒˆ‰ b¶Ê¦·–ÉUÊNNµ©°8}•=ŒgPÜýñ¦wX@x­o¾˜²ú†noÈt–¾'²Ó%rôb 0ɺѥ@sÃîÖèÇná4¢•X ÚI½êw§ú:ûFuD©6Çûy0R\Ó‚œ_c[¡R'S$¢Y›J•JØìhDt]IïT[V3¶{Ÿ…Ãz=è£9Á³¡L—¤d½ñ³è¾ÑËæ HiÃz丷Â1{®3øs¨r]!¦ËcçüCñÚÜËü^¯‚âS.š"–€rÛVCÿ°µýá¤Åo‚Gդמo[=É-éX:yAdXI¥cYZ¼¬uôf[M¤1 \5\X2T‰ÏF¸êv$ebl@LT®èãz± ‘¹kÅélõ±ÉðŽ4tÕóн/eD½¼L³>„îK?ß“ï}3ñýÎcÉßïJ=@ýbî<óÕ§[+SÍ™ã›r:åÛä;^+³w舚U?L½`H+'»Ôó‹9ÏxÙš`·I€ãwN>ñÎwZ3l²¼E!Èb\Ì\ëå,>€Þ¼m.2áTذpïëÚ;‰0§Âl«] 3´@Ó®JF‘›"Ìí‘/ÔòŠŸ‰ÎéœL^¡‰È4,y.Ñ—Õî Åóê_‰l%¼ÁùG€O‰¥Œ˜y>#fº^Øèhˆ’â–åòûŠíwÒ J3g»±ú+Lª+ÜÄÜd³ã¾4=«¶“ë§U‘Vd»d xÂÝ©Îhk¿ÈÌà§WŸHFîcÄû“óy¿‡ó¤ó üÄD£¦i·ß M—}·0©ÓùÄ5³ƒ#äAZ·‡Ü¸»èÝrÎCàv>Ÿ‘êi#¡‘•$èMÂébjX²‰h¬ ÆJ“wH¥_=_L:¸ã*Ë“›H¥ZN±7 ½ˆO7èjÃËÕ¨kV˜Ù1ÓdCû°W$‘|•ñ bÖÞ–è©ZØ2f_ªa‘²ƒÓ[ˆU5¸¯û¦ÍÎP¨ùñªò”Œï¾Õ±CêO¤;T£U–sa7¥|Èü9Ëø5îsÁDÓ1FÕF­â•øqi0iwwÜœváÉð\è‹Þu•du„mWàãýæÝTÚ½JJÚãœÎå>ÉÂØ“†ö¤jÝúwήŸf¦o ‰ýÛ_°(’»oL&¸óñÞËϸ, 1 ˜Ãln—™ÜÔ>bò ˆN̰lªål K£©ºlñÌ9Ü8X 6"fØ‚ªÈÙ%jòÉSÅÓ‰oÊhÐ}ÑvÏÊ;Eëžãµ[ÂчIBËé ’ëK¿%37¾þ¶Á‚9L±˜¬ù˜Ï–1|¡a…³‹ö'´§‚wë­ÎŒ!g¡f¤ƒ)Æ/ä#¤©¥ÉXôg[“˸ê£'ÆY)à/‚­/úئߧ¥\{^-¯¹4}d‘©øy„++cž e–ÓÚÐæÔÔæÀÆ%o–@tȤ-‹×73ÙŠFžh¹U¯Íß¡=½)›ÚÙàp ˆ|tÄéŸìáPÄâ–8ülPó Iõ[k´q|m¥ŒfB¥ØâñÈ”v³2•h‹;³&«äë|¥²µÀ[Ó¾¡–Iv„ó]ÏòC;ª¯ 8ó¬½F2‘ä´lºtÒÈ×”hœ—Æ+<áo¥b6ì)Tz”Ѻ°"Ó·Ý‚ïòi‡Ô˜XO5½¾}EÏVÁUh(‡Õ=(ï#ü@ ÊÄœ¼¢ oƶ}»êí¶ö(Ú£4p##õ§Øïž¦èi‹'àÆKà»l0 ¸¤ÔÇÊHýޝwÓoÛ âÔYLúxê‰æó°þ§%™¡Õ–æÚüTŸ ©»¡L™L‹6ù<Ïù•CœÕÒAa›I£¾|ØÛ÷¥ÃԙÔöKñs¼$ýÉ2‘ºØÔ]F»9щÒ |ì 4×Ï“ÿ 3™=´át¡ÁÌ3se˜õe}?:ïjd™?Óuø:JS8’Š@ËQG_ý|ÿ‰ÓEÛ'øyð®±þä:‡RqàCö¯Ô­[:ØŠ°­ Ù‰ w‘×AcÏÃÕB®Wѯ;ºC¾ã÷èkîS@F·dR£“|:œ&žäÓb~éŸP®Ìµ“¥%«_=}]4ÄŽ÷¨Q&&d;"ÿ™Ý=¿ÌÌßcŒî=Ì`q~Â(‡N Õ ¢q¡tRÔ”G4TÞ߬¹Î>ËA>î•o¯L)ø â&øŒ{’[8bóé(ÅMl~·ÇûÄ&uÝF_¥u€y…ƒ£ÛjÚ¶[$2íâèrúà~K¿úìý¢\¶‹{€½­Ì°L½¶ÈÄž(s&ñOºm1ÄjZšˆ‰ ðuAbÊŽ!•æ½þûʶ®Z ý´üY  ¦f¤OOjþ|I\<âPgš²Lx–“%8 àM8ç«Ñ¾¨fªpG÷”y=9ÙglÚÚýÝû}’ž(Zè°®Û›cïO—-VùÌS:l%ˆçI¦Ê‘´|W÷ÞD:ðˆvºõoµâ…'~Qñ!HÒ‚¸¸,·hVÔHááÏ_5Ôð[€6Ë&L÷1ÀŽÞþn%wçn^.ÉùyÎpŠGwšÈA*§ËNx¤Âb2|¼Ä„rBù‹z·gŒƒ;Hº·žŒL=/Êñ~)ªø™m?$#hL«ªxàV$=«î‰@¯g ”–¶§’Ô³9`µ Ø-þsp¤ü“R›ËÇ>ŽcÐ|gzуþCBWÈÒˆK,³l™žÉ軀ÆI¡kê‚wÐPï§§ jU)UèÖŸÛã×Mt Â9=·1/º‡ Ïp›bá,9;õÚl]“Y\<2ù.P(­ EðÛ ªÊ>žÚ‡¥ . l=Ê; 1Ž\d/¥{œŒ|€ÞÈ—™žR™udò,רΙœó{vwQ>Ö»»á-Úl,4ª«iÅqÉx¶: –§bÂ?¨ˆà2ø˜ ûì\·tÅ`”ž˜™ý¼$¸šLh]Gޤr;£ZBì6芭U;Å$sÏX™M³OÍëWï**Sîçš¹Ó3’Kp[ÐØSˆ??Îckéè©×Cß\‹òº¯Ù®H{?Êç²VÖÙµé¨áÐ4¸î¶cn·(î¶Êxhø5@Û&_<[ÆW£m›0ùT¼*&| ©q—GÙ)x.Y¤ŒÜ÷³€fƒû÷…è iÊ;˜×cÞWâ”#I‰WŽÆ(B‘ÂÈ!·ø„ù÷˜:ÈŠ^¨’©˜T<+%gxã-ÎÎ×¹JÓ06àùE\(ßÃ(V³ÍH””ÒGøŽ˜—ö-< 6E{Óê{„x]öÔbðÔÇ~Ëï|ê™C£céž^Y@Î&6nç(c°ñ¨§æO®O4‹T|ÌkÌgú<êÊ]âid»Çò!:úapØsG[3ßaˆÅD×v±6Ï/Éãá)ýÓ…vöù84ýM—BSkºƒ Of¼6R¼ "«IM9Xr#…ãOõ˜o,¶>â5r'Ttb“,ÅÄë¹¶lþìn¿ÿ"&¼ÿЪWo²½Fm§eßíÛ®p7M„>öžaB¬ÖýG/HîHç¤Üù,׬c4?ÏO+¯r6²°ßÊa³ªH2pR¡h»½@H³f‰©öUl8O?ñ1õHw²p?&Þ1-Óx­‚á¬Æ#th©@Á£÷õSè¦RkåAãsõág±Ü_óŠŸ^M%X?â¡•8£8#]A¬6×”Lº=?…#y@5ãëÜM‹˜’·Ô2Z9ÛÏ,Áì¹Ñ#öŒ¤m÷ïÖ©p€*‹[µÌ_ºÓ­5_;Ý¥äê̋ˤŽhì4hË¿’KÞ—;4i€@SÜ߶̧V<³ êÀSx•OFM ^Oz:ÆPèÝGEzÑàaLm¶ÿpQtÜ5 “ÉJvog¬æLÄ6Q ‡Ä©eýC½+ÏÛãÙYó¸%+¿ñ•¨)hoY¹•µ?y›/[R—Óõd™öl?ÎHsÎ\šf”„pÒ™E€VZ¨n©7¬½³µ•ŠåŽ1êDc¢Î£\ЬªÔýœÎ•Þ þÇ@îc¿ÙÂb»KÑ´¼?¡ºxâ…Áå½ñÝ„R?!tcw僑¦d}ÂÛÇ êÉÖÞ_÷Í€.ì 7‹Æ‘²‚–ãl¼Á9/¬¨›P¾¹í$™b‹ÌN‹^û/v¬ܺv¢Ïæ c'çñÒZ„º0ðçÝ+«Ré,òÌ[-¯†ýÍ9~Y_Ù±‰=yQòž¶¼ “þÔì ”Z•Ê2m{Ž”ùÌ ;ˆÇ$0^ÂñIºà^Ç‹ß;S»ý¼1/HÊc6{šÈéFœÅ Øñm€\VFèë¦j<­Þñ$Hv3ùc ÕÐè‚׿¥Ó^•tH–„ÖÔXêý3+!Îܱ€eµ‚!:‘°Ð³’ /LÉkÊ!Aç{í¹&Û‡ßÖg)Ê_²á3õå\p@k/…ƹˆX¶éê~Rf„»ùk=»»“ä튗—vÓå½y£”Ãpº<—xÌ¡ÇÃ?ï‡û˜MVd)ù: ®b÷ßîiáßVÎ-2uý1‘%#f€¹ýŒ˜s>Y-N»J]BqزdÒ ‰§šñ*ÈbDu½_n‰Ÿ ²œ>ôʱX}­´é’ªLfA&“Å­Ák§‹Î²û¤L¸*+…z'6þ“T£êÝGC…ƒF,h¥O)¼(ÆÑ^œ?ämì+ÞWøê’ÔC*°/JÒ÷àýÓù9åV?“yûÑ[hÑÔ…q ʼn‚¾ÅhW1äÊLÒ°µÞɺÅj,ëÅÖäÕØ|Èì¶0ßë¶CÚÍŽ|!UË  šáêJvj6©µÛiùl4hJ ßzw%ÅIM¾Q¯£tÎ<ô†sÍöÁ·­RÝE§­óqº|ìbHfÞV½ª‡Fì¦òz³ÐNÝëËŽ&©>5]úªÎ²×y_¯(:h­É1yòv§¥Ú™¼ÔÈ>wúÛ®øzÌd@N_–Í=Ìø¶XÅÃ$î"a¹Hú)6»Ž а³ÔöªxMpGÿŒQ,½!½¼«2¡»Àóq'±ióîZRfw]A}*†fÒ É‰|Zskd»»Awª;§‘§ª5ícôqŒ!4¼ôŒCÂKн-Êp+A‘¼Ý _/¾C]ÿÆ_©€ã"‡o–€YYöÂÊúö $SŸ«ŽšqCIF“U Þâ¢ãLÉÔ‹´C§k}ÉB“©Ø9Œ˜Ñë"è˨¯"§līԼs¼ö²¸Þ×õ/u㢠¿KÝܽÑbîg6€Ÿ^ðø‚çž^ûõ¥œ3~ó$­äüº¦7Rùë] ÁZ#±¿l%ß×kºšÙ(}×µHTQOº·þ8NXɆYl§ëëz±Êu÷-ú d‹æ1âe×cöÀñK2Ý·¡áÁݧ^z‚:;l&…!!敜ävük˜ûq`˹¼ÐyMeèÎðf澪g¯²l›8YòZhûnùg?`åýĔȂjæà*,9Ãns’T_:‚‹§åëZ•¦ =&ܼ!gœ“4úÒ8»ªåw†^e{<Ð{‡YO?ˆùlu¹¡ÊhåÑ-ftÓÕÅ'Gá[IŸðj™Lœ.ìS)þ/&iCBSí‡ç©ÞKÄÍöMždÑè6j,ý¡±?âõ¦§*ru[4F¾«TÞL¬w*k†U!"î¾`}ÖÇŸ3!v©Þ¦áÅÍzœá£J1ÇO0Ö®ˆÆ¸8FŠmÌâ3µ›A~ KbùÕ$z¡{:}žY­ËôZ i݇–$Ÿw/åÆå[ûtpHæB0ð©åGR›½_¸‹Ñmܾ¦Ï¢CßV8rÇUó+™=Ú’ácu²+4Ò”>ƒ"¶‚>ƒ2Mi« Âó“ãÈs%éÞzÖ‡-æ°S¶}…;—/–GÈìtïÞ*WM_/°w]@yU•®ýÔ¥,xÍÃ2?ã7d®VÜv·;¹É‚E{Zì 4:ù­B €¹<Ä,/¥Hké¼åüdq%f&›èç°©Cä˲2ÍÞ Rî¿§_ upŒõ"f­}­½fcÕ4‘÷µ%—ÿæ·çÍ¡ñÈàÛSER7ËÂ[Æì—‘Š\&]5_O4¾]4b&ìRI¼v§|*ÿ|.˜h¬BfUiù-Ÿ‚3Ñ`ªy„ŸÐ,'®ÑþËù[ÆôBbÆÆ²'yòÜyõ‚š$$´K,L?ß›ZKÓ ƒUçò›„Âß8^Äoª…t”l¯îBçgÞˆÝÃaÓ˜—X¬‹C–È®,tg9õ “õáà`Ê/Ÿè5|#Œ¬ nÅiË÷§ÕÏn™9A`KG;-píçóÈ~JLjêî«Ì øÎZ™Çº¦O‹WÂfþP»¯¢–'P) Ü2PÛ”Gžücè[vÉgÓö|¬›”­÷‹‹ž‹F°þ bOÛöyVÞ~饯2Wò*ÝsÏFƒ°ò}]‘K'YÿÓÔ\Äè‚Ú™m):£Øõ#æ—}ë‹ ÕÎeRú´o2i)³ÐndɇYК×ÇM¨ÞkºÜ_ú2}×—Ýôî}RŸ¥ß¹ÿòÁ…¯aõ>刿ûýsò©jšˆ#ŒàÂÇ·Ôò¼IÉìóº8ÂZk‘“mÛZg$/°Ùq×u<ߟ ÀºžêxUØ4 Èóÿ1ÿûNúà¹Ëó‚3³Ü½‡ß˜zš÷ÒSËR©¿ú ä­5WsösÙ¡#û«/<çZ„å Ͼ9íŸf DçTìeé1–]ûÛ…ûMZä;¤V¡uòlhI~#»°Œ—Iä“@×KóÈ$b¯ ‘ÁÐܵVœŠ õz¶1»ÝÎ{«èÁìç3âfüÛïõMµ¼ŸÉ´µD®ݪ†ÉUÏ e÷pžÄŠnMïRïÿ°§]·;Ivª³‹«×¾è½H“¡x]‰Œã]ß0“Ycó€.™‹âQQ´©» чÈÜå~ü›z¼æuN2«”eôšíçÐÓ 2‹‰ï2sÉì|žYêZÉ—§Óü.M'†á£ÊƹµQ4ðâvFÖøÀ3£,ï~¶f N¾ÖþSµÐ:6FÄ<ËFghÌ1l$øU³4…oë'Rì­_ƒÿ·BJÓeh)vHßÂ35Zå~šÊlø¬ ÞëçE·—÷ßèŒê•ϰñ­Ns阒E­©Ûå=¯Tí ì|?I͵ Aî‘…è[Bv¤°€VG çÊÊÜJbç, jøÒaééÑsA…&ϼo2{nr®Mµª4Y¥Ì½16\9ïÊxju0òÏQöYÀar”òŸ]õáŸpò—Û> ôú?¸ÂdÅi i؇ŒO`„ÐuU>;Šº7.í„å’·€OnóÖóež±9][Öw©’[ ï#nOÖ¥Ö´C²ð žné÷y3•´¬\qÞ°ðÓ®õ纓)™üŠ<®Þ-J˜mDÍ82Œy󉱦elϱÎÞ&¨o·)ƒˆo@0¦1ðóŸÖTþÏ ÞMA'‡Ý,Fú ´²Ù¢bï¹€¨ˆ /¯¸4ÓB l/‘Àô἟‹@Ù–Ã36çd‘Ð Ö—ø¶u#8±Ùâñq$N=šÜ˸§¼d «%æÙ¸½ÅoÝ’¿4ClK^a3OѲXD¿ðKN²¶÷!cšÈ νXÈGj°?dê˜plÊÑ9÷ÑÅDÓ£™Q¥y©^ogÜèß­Äæ¨ŒX}±÷õÃýªÎ žð’þ²ÜŽw˜q†š¾õðÉ× ãrûh^‰e Nù3Éñ4é5wSÜ.)À·ª4æ'æ»j…@Ý5Q\"­M¶¼¢Ç’Æ”d+Ž~vqO€dy¼_%íÁñIóài¾™7˜kUîögÒ ~~ÁÌ”ÏYß>ºK‰µæ7Ç=©R¸TX¾§ªçc‡­EÍur+;ÕËRæŸ(4¹ê4ä"Ù*šÑ¾¼X€‘¨UKÙ×hâ’Ú‰.4îþ¨yŠÆ¼|{NéM±Žvâ4Ž0'KBÆZf;y=†–Ý¿k5µ&¾V>@+s2«Pj1£ôÁA™Ú7ª›d–«):3ÓÎÊÓ!Û}{\À¿.¡{Æ3û;fzlÛ´Ûíª_£Jà431/2 ¨zWflÔ³+ö1!,'P½¿f¨T[J¤v©ÛË`þ }Á>‡¤Ô#D¹cGv`°ð›RMã½C¹Ë™cȤm¿û@Íœ·ovÚdWöO]¨õiÔi¼¹*m5–‡Ž8Û9¢îG[hR_FÄJ<Γçᇌ8[Z¨gάæÅ8_%j»-å›R¶Wæ¸<Õ Ì}—‘ÿDï¦þhº™×á¾àú*Ýå$ßæžL,HêG7¢mnZ™i;–xÀ Ê­5íU÷žOzœ];ÚR&_é48úÕëë¶Ðèê8ßA©´ñô’ÎÈ–#¡4‰«’×îöGÏRÞ®/Ý$ùŒ6õWŠëç-¤Ý3Œ\£hÔoó¦W:¶µ–ÕQšM7r%FÔÒí¼Í~¤LtsdËùéüUcœU4mÜeíÉ7FÑ?ì§-.*=˜»ãC੹"3ÑnV=§îë2ñð€UÒ endstream endobj 309 0 obj << /Type /FontDescriptor /FontName /RXTILA+CMBXTI10 /Flags 4 /FontBBox [-29 -250 1274 754] /Ascent 694 /CapHeight 686 /Descent -194 /ItalicAngle -14 /StemV 107 /XHeight 444 /CharSet (/R/a/e/g/n/s) /FontFile 308 0 R >> endobj 310 0 obj << /Length1 2521 /Length2 21244 /Length3 0 /Length 22675 /Filter /FlateDecode >> stream xÚŒ÷PÜÒŠâî 68w îîî0Xpww Á]‚'¸Kwww×;Ÿœ“œÿ½ª{‹ª0«míÕÝ{¡ QT¡2µ3ŠÛÙ:Ó330ñDä”™™LL¬ LL,ª–ÎÖÀÍê@G'K;[ž?DFÎ ›¨‘3(NÎÎ íb `f0sð0sò01X˜˜¸ÿhçÈ5rµ4È1¤ílN"vöŽ–æÎ šÿ|P›Ð˜¹¹9éþNÙ-MŒlrFÎ@£‰‘5@ÅÎÄèìñ?%¨ù,œíyÝÜÜŒlœìÍùièn–Îe ÐÑh øK0@ÞÈø2 €ª…¥Ó?v;3g7#G d°¶4Ú:2\lMŽ9@EJ `´ý'XöŸ:À¿½030ÿ·Ü¿Ù²´ý;ÙÈÄÄÎÆÞÈÖÃÒÖ`fi (ˆË28»;ÓŒlMÿ 4²v²å¹YZƒþ>¹@\H `ø¯<'GK{g''Kë¿$2þUÔe1[S; ­³Â_çµtš€ÚîÁøÏd?ÙÚ¹Ùzý Ì,mMÍþaêbϨfkéà”ý7dBøm3:Ø™˜˜8¹Y@ÐÝÄ‚ñ¯òªöÀ¿Ì™A |¼ìíìf @K3 è‚—“‘+àìèôñúÓñ¿™`jiâ 0š[Ú"ü®2ÍþÁ á;Zºt˜@»Ç `úë翟ô@ëejgkíñ;üïù2JË© ) Óþ£ø¿>aa;w€=€ž… Àü×’q‚>øüo™ÿ6à?âÿ¶*Yþ{¸?*JÙšÙ¸ÿÑjÞt¸þ»Ôÿ^Àÿ2ÈÛv þ½úºLìL& ˜ÿ?_€¿Sþÿíý_UþßVÿÿHÜÅÚúo7õßþÿ·‘¥µÇ¿ Uvq] 9;Ðå°ý¿¡À®²ÐÔÒÅæÿz¥œ@×CÈÖÜú¿m´t·tš*Z:›Xü³Cÿ™¨¼µ¥-PÑÎÉò¯Ç@Øÿñ.œÉ'ЃâšÕß. è>ý/¥˜­‰é_…`äèhä=±¼˜A7Ôèþ÷jlíœA)<€™#Â_å`0 ýeúq…#N£ÈoÄ`ý¸ŒbÿEœLFñ߈À(ñ±%#V£ÔoÄÚåßÄ.ûØå~#»üobWø/â±+þF >åßħòøT#vµßħñ_Ä BF¿ˆÝø7±›ü±ƒ|&vÖ þÇÂÆö—ÅÆæwþ_“e4ý‚:ü]¤ûŸµúowÿò;¸€nÃï,³ß`öüËiù» ë_Ðõ7ó_†ßÅØÿ ·sqü£:(ÀüR`ñ[¨Oö@Û?"@6Ë? H‚ÕÔ½O@P‹þ”êŸÍR@½ù]™”j Zý?ü ­v¿J¶û7HŒýo7¨˜=è{ÎÖhö»ŸlÌÿZÿ§Íl SÛƒÞ »ß£a5ÂÞÚÅéú ‹ÃïÙƒØ\윦ÆÖÿCÁÊöÛñ¿,¬Üÿzþ×ÌÌ ÊøcÌ Žþ¦e%9m,ÿw³ØÿŠºþ1vP'Ð÷ÇÏjŸ“µ‘“Å…A*Ó‚ž`Fg Gàëj™³›Ý  .@Ðô\ÿ€ “¹ý±y l÷? ¨¼ÇÔ.Ï߇Uò:þCõ?Ϙ‰‹#h:ÎÑ€Þ¸ÿà¿ÿ˜Ý& ³v&¼ÁVµÁm÷ß„ðÝèwÆ>NQìh¤ÑÐ{-8¶»<¢À&ÓTg®9Þ %÷ -o‰Qß.¿x}¯‡ kITj}ò~6ˆWžØiE˜ÇøUx$T×OO@¯*¸ëýâà­ð ò;x§4E®ƒ Šb>æ½[Ÿ„{]ùÒHèìŽÒn5‡ âsù$}ŒZ´n@É4EžqÖ .)Œ3=!ÜŒswÔé›Û)Œœ_oÄÒñ´>Ç1¬E^Úë,±3ž+ª,N]xäxÚ¸„7#”^Âû)Ò8s^¥EËóîßùŠˆséR—éÑöY2ª-•£l›zk\G:˜·s“ÁTø˜Û‰5eMï I°ª[ ¢0kX? ÷;Ì„WÚnջͬR ¹'ëÞÓÈZGþÍÝ^Oõ+Ã?èïBS[~luûh”ô ˜»1³Ð‰\^âÉ L….w…èÒJ½C£[tMæz†6 áó ¼~|ϼYÈĤÍÝ >BpÊžë}ëSÙp.ß±>>g톡ôÄ!ÿfÜ™z~^ˆgÁ*f˜J—!Ö‘·G¥Ä[ l˜*g<_¯Äf-ó –MØdŸ¿$/b“’èÝ™«ŽÔ ô°zà.`8U¯TkýÌ^ D²}E?ºß0$ÒÇ}kº¿yûõ«°>ÖúÃy¥[¸ðpì†*gp^D‡²N—“Bº„PDñÝÖL/¼1Ù‰ª°+‰MSª†êÇÇ­Ñ®âg7ºr)Q ª¢¹~™¾0ï½yÑ¢^¼oþ‚Ø7Mþ,µí ÷Ô`H™h+±™»KdíÃMê¯ï…ñUTïóÉ<×Ázç&G·H~Nl‘{YWê–°õ5xÙ£Ó!­ã)Iæ¶ü¿\­}¤ŽŽ|5‹l^Usª_$¨É˜®@ “Á¶³2½ã;––Qe®ÊѾ{›M̶ÚôÌ|$ŽkþXå¤[»úî†/äëGÝ.-pò5QpµCøñÝgŽäœIw‰<%ÛÁ¯ø_"ñ¶-«)f“²Iæ&dYÀpjt²¿ _oùÑD›…h™ì£GÁmñÍP½ªK¹PÆTdË# ¦ç©A§B_B‘F­f€^è«‘“v.£ìõâ„ùÌQƒ@ >Þ;Þu43+9ƒŸxÅXöE|ÎÜTœ=)ÎíB%œÜ»ú-ÀN‰olo,qÂз‘/‹ˆ™©Ì.ý¯õÀ款éa>suØâ|57x­òÀ®¡áÛ· a6æ«οî%ÁQ‘y9Ò¿7û8ʸ0°>}Qƒ¶ü‚]/é\Y;1åsëK4ûêkBD¡»æpæ¯ÛҲ˦ÀæJ¢“ap'Õ’ÿí¬®úk`×$ê=Óá×K9é¹-¦Š‘8W/Ž5ܤYÝû^„cŽÃðRV¼wIYª“Z2 Ë2¸‡Ã4Ýt8?d¼ŒÂE´…%²Ûˆ=–¨Q"e¨B{Y˜¦ÔS«8¤ÉÉ­Ÿ+šéqÖuºp¦£ÃQ÷ƒïáðdFæ(Y(Ì“Œ«=Ãî¤GðÒé\ì|å*Xúp=W]Òsæ9>|iýPŒÜ߃üuâ»s¬tM ¯@& Û„÷篻 ÝsóçJJ²­Ø_}×O¶0ªGn퉻m书òº"Í…c‹ ·³¿‹4X܉÷¹HdM'«¶ðíŽ|·™Õ£‡„? Ö\?ž0%tkåÙy>Ÿ<Œß úSôUvN c¹m¬n°èÙ•÷®ª ^¤,~¢ºìç ÛœŠÃàð40£Àͧ˜Â• ypÜv-®Å‘KƒqemÙU.Ý(Ë覾UgKxÞ—râ~¢Jئyi“z¶¬ŸõÚVÀ ¤1CʺšÌØ`A[6wQ‘ÊÚô 6iÌ„VâVÚ,S0-¤Ax4ürÛ——¸–ÈhvÓ›eÝN¡(Æ’ÇC¤.D£",˸ËWŽ}ÊŽY.’-T°v—eÍ[åõ³ ‘š¬e^ÚV&. , ,˜ËKyÞ.½»O‡zÛ@ãÂXèÕOÆÛNÑsv*U}í• ¾Ùc[nÿÃÿkn~û‘s61œ óQc˜øqR#«Yú– ªœÜܸD¿öËŠ¤MÅ[‹ç¯hq?x ëò‡¯¤=ÒüU@¨yuá8 aŸ=ušÏPË*CK–xtyg«%gÊØÍØEí­â1ƒåíŠY ûí²Pþî÷PŸ:cšêáè8ƒW×J¹ÕȪŠo7®A¹Àt ö¯‹ïƒý,›]°/>GÒZ{½‡»*ÝÍ~64Ãá`}/¹¦hä:ቧ6Šeð-gôÝ€öWf¢åÛƒ1Õqr´ƒÆöþ¡¼^+å#ð•J¬Øûêê¼óym£áS(ÈU Ùë–tm\\_g‰‚Ž{CCÌs>ê~\$_”¿WÍ3~J‹ïPˆµ¦¶6¯êÎZ4ž¬ŒY!iÞ/ŸI™ù©»ñò`ĦČómÄð•{ÓA½¨¹d¤à¤ÿé$ßÉ46ÃÅ3¾¶²`¯g–@6ÛO/ý¼Ü1²(¿<ÈU^´#JN‚“›\JÖò•2QhÞÃÖšÃN\¡á’O~çHq´P!VH÷‡kh¢ßê¤u>å^ýÖÎ\=Õ˜ÆâøNeW>S€ àë £%¼å¤ ¼qöû®Á>O!É¢™Vp†K\÷ï›+ÎÌB.•åYHöB¿tØ TæYŒÝ’hMÎe…§òÀ÷¸¢#µ+ˆý¤é$D¾Û_yi9íu ÝÜñ0´6%ôWØÅªF—÷±0r –¿§H4ÜmœøS !Y7aNœ2.s¹0\¹Ðžn->^ñóžÓùy×OP صV¯åºC1¥9¢Ïáah0‹»ÿ:ÞO]˜¿ÚÄÇ4¸«{Ü4,¢Od‘ê‘yú⦖ػ^v#g†Æ§ßÎ÷—28 sGcÙ6k‰TŠ0?ö9—› ’Ý•r’›Ž’ùž;Å[Ðu8h þH ƒ8-Y λ¾QdúZÑótžP‰ö¼ö¡-’o 8/y«3³Ò©«˜›¯A"YDÌ0Dý ßb½}¸K)qL¼ÈN±½os=ȼüs;é+kÛ"÷÷±vŒw8•áV%ò±ã¢Æ|RÑñÓÔÍ`R± ŒYR¦>¡ÆJ% ›F™µ'â.ù4‹Æf­ÛJÈÀ±·ñ[Á©BqæQÞâz+ŒÅ†åÑJ5ðáÃIºJÉ=øâÊ—-U±/böõå·¦r†A…¡*ªuò-2œqÕp´Êé³Ç:ŽEÏCZ7ý˜'Z@Ÿ¶šy¤¢¨»y­0ÅÇk„1qp5±üã«×èó)™ ®TÉhªÚ~pm%Á1T©…ugŠ‚í·”Ì.RÎ>ÊŽç\‹1Û,¤¼-ªé%£žFÕÞ *MG¿éµtF[ÛdHiÙXÛ ÏT$§d¹’0=ì7EŠ'"­¬=ž–‰­é„šÝ+º³ùK†äbyÂj<×ó.I;CÓÂ$e¾f_¸zÞ½ßÔ%úªsÏœ2–~bÂ.Ï]nÏÏÂ)Ý*ürÕàÄyÙhN}]接D‡â̯SµÉ5š(áÔßÀC¬LέÇñŽ2üÑÆ£ŠÆ²/ÒuøÀªçV£4J¶OYXŸPYØÈºóȽΠwN+‹§–]®¤jm÷téÝY$,flk%j¾_é£UaÈzÿB‰ÏªaÒé‘(¥ÿPùö¬’æwrɵ’=Ôg©ÂÊ6x¿¡†-‚ Áy[¬¯Ž)h×ǶË=pÈ Ï[ÎBòÐô²È¶)Q©Ð«Øú!Kæï|³±âxc ‰¾Ÿ”ʇ­žsû»—‰«ã›ø“ö­;•ìãCßÍ÷›¢é mÌzh(ºdŒá…UÁ£BÒÿ~óí %]c%xøÎýk]5“ÄÞ±¬%%ˆØ²Á¤OªTßϳÑx³ù>;àÛÎo»8[ËŠ0'jöØGß§"8ÄÏõ9LlG{2‹¨Ðv(2÷ú‡!TXFY¿J§È-þN¶¦¾˜j ‡#j+í0ÚØË³Ëp‚k¼#½iz—æW"%S*×µ¿OU³¹Ä¨ùtö÷íõ^—¼SLüLÑJ>>{ ™—‚›ÖÚ)ÊÁ“¡Ø7)«n>&zÊø(¼0"¥‡ï¯Ã| »šjA·@ÑQ •µ(×¢ß ôUq|õ0bÈ)jI”ÍŒóqCÅèA•MàhaG…²û'¬¬MP¿G¸ÏŒçGÌê j•´ ËGÛrÂrÄ t_NAØeèá_Ÿ­®Îûõ)µjѺ—2¥šŒooñË·Kàg³‰mqÏ Ã¦Á&ü-)0AIʾ7è¶„S( «-f@–x î–zM9kÿ•Q¥‰‡GÛÏÅí»l’÷sè”@ã_r¯³Œf>¬k)G?‹·H%ÊRÐ+÷¨Ìäœ&`§‰55Ô^|žoššµúbôý§ç(¬FI$;΢$ßà†Gc‰ £x÷ÃjÇ.ýâ7¥›]óPjô–ÉÈ`ËQ—¨D,ØÓù‚Up_[O~~ë¾L¬ÄÍ‚ÿbTQïOÿ.]ÈÏ$2ôÀÚN¼^Žú2Ƭ©„lÉpnÜVËËjÉÕÛ•°Ê°…JÊ:÷Åo½†d§þ9ïfJ±çDZWR>ŒXuÚÙÇ1{£}}Ä€y‹#…O†YM§[ö÷H•\.Ë䎗)+WÉ.f>&½´ìݾ$/+z3Yø÷]Ç(jt•àι4»–<’—¹ !}KÔU@…€BqõŽW‡qlþ —ýõ>z žð‹>Ï ì Im]Š8µ×ù.0"äqÏ-}ÜõŸÂ1þòª›Í¬q«4ÖÚlÞI'ÜcÓO±ßZnÍI .0ûôò©Y™á(ãæÅ•ÊІƒjTe«G´udÁÚã™—3;IëfV¤®²ßæ A¿±ZÂ…Ý@"ö¾a¹ø Õ™1zñu=fdóa-¢†¹Ò6ÜàI”ßdžv׬ܜۂœð±´\OðLîÁp^ò»„Ì-/ûW˜B·Á£V¨m)G‡3¡RV3¡À5-tK— ÿž•íÞËö‰³ãI -G´BÑ›[ž¸˜ES"Xå"È@¢3:Ò}ùgºw4›-Få…Ã-›¿¸u¦K\ÞàTöp¹eð‚ÑûTeÊŒ4É·Ý̇‚t6!Ü£ðƒ < ¤¨SÞÚ¬ÐØeKÊ¥ºL|¼-ˆºÈã=E71Õ~õ|vkÕŠ¡m©Ðæ;ÛëûUØŸÉÜyÙ`í·ìÂ7t¹„xï UqLŒ5»¾_ÿe@‘ÿ”1ÛcâÉÐè<£x9R§z,Íp²cD,» Çí}7ô±>Ržç®å¥¬Q0†Õo{ÂO‘;>ý~gаé;¶aN±iL¶P¼Pª­´Ë<¯¢’`Dñ7ïqÛÓËNPG|HÀš}Qú±Q*olB»ÔÖ±œmG ³P¢ßæ9qe~h>j´ûÙ¥^qKi^'˜”eN@n¾ýzy¢Å\(Ö;.IAb8Ü éï%ý ½¤Â‰Òµ¨ET G°}fµ„LH9¹ ´/Dûu7¼ó{+Æ"ÆÇ›ù¼r×Z•÷ªZèdK¸U²©olc%§{`¿¨nïzüÄqLÕ%dgéh÷°°*$^ ×õ›Ëê{¡†oÁ-¢ûQ+´‰*<ƒEËœ‘Xï€_2röåæù­hø4, ·åÚÂùßæò‡ß|7€ë'ê¢Ò3Þ©--š¨>%"Ž‘C8ªCBCûˆf¸/i IŠ>¼Ð‘¤Sm2·Sdcñª¹M(âwº{ï_îô§! ßC"ò¦Ãwy*Duû‘%]¦9Þ”ú_ÆÓ¨²”X‡ŒyÝÉšc‰Y¯ˆUFxÊ­ŒÑO–(š¥ãaùä)¼f:ª¯ôà¹ë}ûÓÆO³y–ÓÝ çoõÉnצ³—7.΋F'OYJ…iY©[#¯Ô-u)9=z=NÜ% Ês"8/~†³'ÿ†«¢Ù½ÂTÃWAÓj±®1 ÐÎfö]\´É"n‰a¾N‚F_z‚ž(ÄÖÍç…1\[¾Y k\üºúQ 1FØàÙ3}{ÎÚ6©‹Ð8ï|òúªµÁn‡#îkáÞ©–íE¥™Ð0,!ˆª6‹Æ!…¨Kœ¼·|ËÿÌ3¬nð1Ì?SÌýAŠÉ{ªA—Ôk îŒUmÑsàbØe[<Ó rd¡0äFq­ôØçp.ÔÀgµ¢ÌG7šªssÌÈŸXÓ<ë¦VdEß«—±Â-`‹2Ûœìé¿ & È@JpÆm‘Vz+‡Aì–?î´/=¼C} údgêU0#‹xüÍÊglÚJz„XÏâfÏUYú>âÅÏêÔ™6Í'>Kgê.×aU\b›/âú?? zÃütî°bžÈÚs|ĪꚨzÅ‘ví¡“!ö‡¿¬ù•¬¾úùs&BÚs†Rp½Îò*ŸZ·&Tàâ’€ í-Åz ü‰|ë²° ;wè}PwxLy6iïl_fù¾êAÛʶ¾q™F?Ìuír@´LÅý> VdtâVˆþ;yÇÊ^-Ï"¾¢PJÇT^!S)|CÆðz+8‡§îOëKÔ‘—ÈL¶÷FdèñæV4ŠTv£F«„Ê%¨‚ú°û–qêÆ'GÄÎXæÇ%9»qª‰N´¶5†ékŇ1Ääâçô¾ Glæc€é]°Pð)}ßÝôÝ…´Ðß Ú:9þæW0H¶8èeZlï6LfùhyHlÇí˜8ªæeëùÓ‡CEï꣢ÁÖ v@Dƒ* MIÕ^©H^Y§$òNÁ®ðEC£œÁt`£ò½ ÉÞ\ê¾þû*œ=Īe‘&^ çå‘ÙVFè]ÚfndfÌ<òÒ§1Ia2ã)&b_‰D1ÞØr¢¡t(ùÔIñ6¬®ëmS»û‹~Ñyp‘&IV%ÛÍ„ÿmº lJdøÆþ0Ëï××+àA½óZP}YUøQuøfù¬pŒÁi¦tkb€È>aJ49¤ÕYþùiÃÌÈÄ-êÔb/L ~”ê– Us!½¡µR´"—F'!ŒÐ ktS„vCZ'§M¹1 îö­4užlcÀ·^Ú±\¶KÁ Ò5Ý䯍-"°7¢¦²X<Ãï”.HÛgÉú“qjŸ3+¥ò—µï?ùI0md‹¼G¸¹­=ƹ-2Ò:I«Wô·FC ošÛ”§Å}DÖö*o¦gI[<˜Q~2rGÙ²´A§!f€aÏ©]CXô¥'¶NUÞc·=Œk^çØÞuØ¡ßÀÑK™ ÔQ„Ó"AB~à÷röš-B"KéÉå°±øn@ëã'ï&üÂwÏü©¶•·LŠ/i~]Ãôl¯yà­:Yß®†‰´pV xõ")¥˜v7ôDzÄ/ü±¶72&»QÄ~vp³:©×ÐJR<ôuï0ü!³æÄÈÌñÅÐ]ͽqÕÆ ½`¹Þv˜ 9eq=|jˆ°-goÃ)±©WÖÂÈçЯrð[Zõg2¶ŒÕçõé’–GÃé×&…9XØîvQ#Ö\g¼qtƒèvóJÆ ã“Ù·Å–ÛÜ éH–§)p¥tSªImòœør®eA±5O¯.0p8ÙpÓð£H£l< hi.ÁÎüe^|äD[*^z–l¸6ÙT­žOG3äúfãJ”ëË¡MŸkùºÓ #:ÁƉÂår‚Ü SQkÆÑx+)Ëzm}еŽfŸE›Ë‡\€œ„øæ> ":„KàïØò±¨9׉åb€MuSTúS‘¸z8vÙ«µ~Ž!ІÑÏœíÕÄúàD…’Ù²XE^ ©0«·&å•5Øž'àvzl·„öÞMdOsŠC>á±ãMû³Ú íõ‰êÓ.‚É÷ªÐö0÷G¦ºLâÅiÌïÞo­¿ÆD½°Ã¨à}éæC£çEóå^¬®™‹2~•<÷¯2¾WU@W¡ Þ¿Ca@]cméÒ$ú„Õ ÓüA]N±ùF˱õsæŽû>ùp ÿˆÁìŠêÄä…É€ ó'¸.Rk;JŒ›;e«N¯Iw/Ïù>±gÄOˆô{wšëcî&Â!s>Ú¹~‘SǬ"D­0/_$OùäÖƒŽ'Àiæýt4- äMù ]ºfy1eêN 7)±)»ïx›¯iD¾×‰CU /&¼~ÅÂ!èp¹J78¿:§_ï ]‚M»3³mÚpÏ‘Z#ÑŒíïga 9²å2¨J¬J}hßU‡_Pe)cZ³EžHNÐÜö‘:9Äåj)ÓŸl—L-‚ƒÌVÓmÜg,2|5€&¶Ÿ”E›`«Š÷™^-jÉ-ÿ¬›žÊs‰~©,C²1înJŸKíþ„t¡Ö5kl`Ðð1…—µP‡kÔŠ”—$+Ý}êû#ç>tå:4pb#,)W1-wiÖx™äÔêÃpŒëÑçØüt É‚Á¡æ²ªÀžN¶'· X íL6zÝŠ0ïq==„bè`_½›®ÛÝMrÑD¸ ÑÙ þáSÛ[A ‘£·—€÷ºW]A0V ¡ì…³IªÍGW½¢Íl¡¥P‡æYQêÒ6 Ðt»ð S™/‹OáÇã†ç¤<—›ÔGx~Í0°KØ®(…I"bˆ.¤= E'R€Ãß~N€Ç¢Ç|xÚâ·÷MDŸ©Á1Þ\ÐY?/® —zˆ~(|+Èx½p!ò08s¡»V¢“;×ò -7h7"±V^`–ä:ý‚`»^¶÷Äf•uÝôíLDk¨²ä³)`&å»®– ŽÁŸúŒOjaŽIøž\ ÀM§cÜ]Š¥ãŠábÑr1×âÇÓJé«×aš^˜ ò(§aùÞl¸*NÂ0ÆcÈ}¿Õ;´ì!CVJh²8IŸ…w¾5÷ ˆL‘+Î5\ÂÃ:5„aQk&jdÐIþ‹ßosÊ—™„]goqrqåÝk&ÖôH*lÓ„ö+ íìñÃS¶>Ä"D%‚_Ҕɓ^ÉYYÞüØ ËÌÃl‹L“…KOН¤j‡jQŸÏÓÄ£ã‡,á¼½ou¸Øôè¾VÊYÅÈt ‰Ó¹¥ï~Tp[¹òîËák§ £YášVó!èyÏ+32Y”&_Å0ÿù¾Õ(ðBCB.ó4žÑ¬îø”¾âÀ2œ>·ÖиÎdÝzÑIàŒÎ9‘çó²çÅœ|\,ýW: ƒ^Ê\V.£‚IÃ9KÑñ­À¨ÜFKªRAmˆ¸ðŸ4–í»¿Hd3“Ô£H6•ç“ÂD¡†rQ%G&kß”ƒJècúÓÇäVreŸVß¡+TòºÀ~¸;NË&)8×ÔáMhfÆiÞrØ $HOÍ³à †w¦i©i =J#EvÐ&îÍæSÀW›N‘ÝúÀBJXd+å´Òº¥BÝ”sÖÏø¸ÅON¿<Á‹Ò½ý£{=»8ß·]ƒòùD‹ …U~£Æ…G¹<Ãk£¼9TÁR¸^öÈ¡ÙøýÅÓ9å’ŒÂê çnìÌWq‹Â$¥K×%MOVò¨uMˆ™3B5q§Î4¯ –þcQ·}&Z«:gáÂî¡ðåæ~,,µ%fÛlÃ<”îð”ãª3Äâ1Ô íÉðM倹"…Z®˜J£ =®Ê~ªį±—N¥¨Ž%Œ‡;F|=aNqÏÓ¼GŸå'h¦ž üœÅ;QòzOóÂX†w™Ô(DQ›÷T[òžÚ·¾,Ù\.šêxŒùUÚ®CÜþšŸrü›C-Ãjq²ºý“äæ[MM‡‡ÞÕŸª¿Çµ¯;,ÂzrècZvÁ kaz ¨Û˜ÚMCœJ– 7ŽpEš:ŠÛkDœà2ðÙ0òŠŽ$U½QŒÉFŒ3ª°kioÉn¿^ýq–¸½†‰[l«®%§DÉ·[¬2úŽŸÊ˜-ìŒ)J”óAkm¶ EÝ­/ ZX†])¢qí0‚£†Ë%À&í?#LÑ€ýÖ˜BDB³´‡½†h¨„¬¨Þr\i”• ,±w›“O>YªUÞÐ|~FÐþ#ì5;J[+›W®þ-ØüuIš~'ŒTçÙ&î’gäÚÐËùQèA-¼ËÅwg({˜ü§Õ¢ù–¬>l+¤al­9R—@q q¯xžœj ¾wƒ[wt“:gÞo¥¬ÆÒ+ù¨|Žw<‡©jwóÉ©;g–iœÝ¯Ñ3z¢Ê:FeÇ-JŒêýyÙ¼`fRº[EÁ!ÏÚHPEJÖ«ÚlW£¹ÕÐaÓw_åVwWžC£]¶$N:Wg9U“ï:R¥Ì|oà65È~¥¤æ£=ˆ´Ä¸ª½ÿ Í©µC¼w‹^׃û S³[ž»aõÖ¶G`+÷qWަìæu4ïÒ”îÒ›Xi®rr»ü£&ó|g"ԯīy¬obà ^'_RbèŒ_‰% kóßq<˜¨þL•û”ðž×!æÞA ÅN¹íÈÇ–ç[´êø€Xãæ%ý]šÚÌìŽmý» k`àKX¸!KBCÃëç21-: â&&‰ËŸN@ȧÙ6ß‘“õ¯‚ß>ó#éÀU%’Èn¥FƒÃ7ý{Ñ&Û€+l¹e¼Ä©c3¥YjùŠ…/pÖœìáÔg¹w2¥~î=k/0À•AÆ}NÝø§HM!WGÍ:®zôˆXêöVùT=`ænE³`Ÿ^NÁ¾eu ¿‡ž¬ã䔤±P˜~2¸P¦Q3ÒV„”ZG«c†;âÜYßû¬ I4ò÷Šk;P–?‡Ôî×'žHˆ,ßqLJÍå± hˆƒÆ˜pe0k¥40Ç)H¦¤ä£2à«qS”ËäZ´V ס^1"`‚òT*JP]³ºø¸ó©å׃-TL>\u€}–°å.–R$íõ÷©ë[‡sÃBQ&Ekù²ºAl06Y¿©é©â(ûÏø;)º¬;à;B`x|”öÉ3¢žu×Å…Ò*oÒ=cU„lË÷EgÞîÔÑMVµ·Gž7øôÙË7¼\ÒÌDf– ªÅD½O5~vY¬Õ·\·\Ò„§sÁÕnB"(Kïı :€‚@½ó Ð&LÖ»’û: ¿¯ŠžœM¢ÆŽ†C[C œ.´=‹­÷<à|COòSè¢ÆÊ•>Dç†!™zžTz:?»«×F ébÕ:'–•iäšäƒ4AåmÚjÙ0W²xÈ·¡úºL´¯ Ø÷¯ÍÔ±”<_3si5Ý8%¦˜)§·©^<[^µ½Y%Ýs0'[?k@ýz2Ì}ß¿n¥ø€ô N˜+ð¶Õ]SCŒ;«»ì€šÚÈPOר´çï¨D%Cv¦œAö}X†WU!aï™Ú…uP6E˜Rµ_²AÓ冇¾íº£[ÁL’­§8þ@®TýV)g¼!gÎRG‹KþÀeWïÑS?Öv³~Á…MM®Ýæ°JYVîŒqóAb%¹0“½p-Æ’ŽùsQU:­zìóI:“]õ#ÕCÁ~jÍÏ€½%vx×s¤¨²šjLkˆ²Ó‰Æ+ r憇}P4ƒŒ¹¸–ŸòA#],þîLpöØc»o­ 1\›3–Dûi>¼Êg5K­Ò’[‰þûAŽGòô U°“ÀJMW0Oy¨öú¬©Aø8nÄ<æèð+®÷Šß ·kºvµ1ý”^áÑÜnKå`ΘîÌ”ÔXâ àYÌI-´” Õuë¬ý Êž/\ —§‰„’ßÖ?1¦f­Šªº€×ú¬Ã']{QÖOêTìÑ~B …ð=ÃV PIÔUDé‚ â‰QÉö}{ÞÞüA‡À¤mXµ¸çdOEA“tB’)n]>àêÁªå¿p…¦]ºFF‰q§ÐàÇøì­­ìuË¥"—ï̉:¥x±Ï""²ò6г.Ų̀f/];Os€vëº{®fÀ¦"7©I°«™Ž·(oX¼c$“V›X0ÓZµyöÄ‹\Wîû¤‚aðÐ8¸˜°F]¥ Ú çXÐÏnã†sˆëää »D×Àg0âw}ÆRÛækßP‚¬bÐî° ëêó§é¶ à,T÷‰S©X—v-XOÄÅtz!êÕ¦N±hd“?S‚鵸²\ÕʶÝË~WP1‹¶`‚Ò{޾&R¨Æ¯S¨¢#^Òvrb'ËGü~άn3•öâCù´hæ!×ò†–‡ !¬ µaÎj[|Ø, {3g# ]oü3ždt¿l͉†ú˜™»YöÑh{€h~ãòè¸>>Ú.¤´KçT@ë¶WÞ§Pý„ïß:–Íe8ƒdIHâf–´å¶¼¿’ ,ü Û‰ùÈl†øS`öü¡ÔJ´%kTRæ»È"í9†ÌŠÔ7IºçlP®ñv…–¨@¾ëÀu›ÑÜ@Â/¸v"piŒæ½xògÌQ _òSRpRÝd©\£ÞÈš^4I?ÉÍ<»ÏÛñ­ƒ¿ì»œX“º’ gil:ì„”1Ž*‰—€–flÝ)6­F4Z?~¿IQÕ0ü™7u;š¤&‘=?ßàId”ZãEìÚ¦tÑ"ìJñªªzã*’ïY§‹ $-¨QðYسvËÛàˆÇ§²{>m‹š8KÙÐ.”êü<ï“Wy‡x憺 Ý™þ 5¿®Sm¨kQßчXÒ¿ÐZ®çæ1 B É2à•d¯4®ŸK/„lÙmEK…†|_ÀߪÄŽËœ+5õ F&iÐ("ÓÓá“ÓÕ(ˆ³Õ.ZÊûnVÌÉGÀñg)!;fô¬Õ)̈Q v9¹G„gº¾^ÇþsÎ4o+\IwÙ/®•ŸªtÙ)ê1_§æ9e¨Æê+dõ‰Õ{ +`ìÓÌñ:ÕÉ£Tv§ë¤ÜÍc†ß—n%ÑÙZNWãÚAÇ!â“°v©áÖéí“ ß BäŒ.– ¢ÈQ#ÒØHÚfU_E¯û6é¶n©³Nm½²_?Ùôõ«ðД=í>ŒæÔ³™~r&'õ¡F§Ç:µW2¼ópefhéÂd8”YkÀ‡çËlÎO;¾ÀÛT¿ñG#:\½Xê·_» ö/à–·|^XG.dÈQ {ÙOûµŸêÁÆ~d\3Â%@Þ"ñˆúx´*¡c\1©^Zþú$¥Š¬~ó’1׃3"¿`¿J¸×œKÎâR‚Q56S19ONýÎŽ´7ýó‰ñ—°.Ö"–nŽå¯ûÁZ±=L[vajŸpQÃÕrø°¥NÜø1 È<^Ó7~ÎJnhžÖ›Kò'ÅPŽiZ(IQ §ŸdÍà¾ÆçáûÍ£k1ØÃvp'_7i±éÑÓ­©ÄYS‚eßêâgY’Hs}$a¼?袾ô•ô !¦ m}7<¶½gL7‰ÔQp0ø¨¾Ôó>ù§ozSaQÞÁ öÖ÷ÜÝB›OCЈ&n‹ESX¦0—ÏÝ÷J ÏpWÀîEÖÇ'¾w®ø Ø6fè=™‚M{mL¸ø[Ñi½¤mûísbØ­0[Ê«†›ªaS´?@,Ñ_È1ÿr[ö}žû>Å‘w3*ML`…ݲv ìêØ òÔ—‰¨Êüº"´ó˜Y†’ºJÌXǵd8î‡y1m‰È˜ÖgÊéžè¥äë´)è©Ì#k‡-BÉâ‚Au`ÛÙôîâüO~Ÿû»"õƒ¸°ê °bÁÁÞ’³@J’¦¥ªŠ*žzœ¹ÉŽ fX=ÈݱŒlÖÚŸÀ$"FÕQ#U„ÜZ}SÒZ¥C6Óštr¢«>âÔ®2u+å>ÔÆ'uÒø7V>¬c¬wèˆÎ¤†Û{½³î‡«<É„A±%ŒÊ¶Øjn­fîüeÚaåg_‚ÝFhX2ŽûëÔS cP¹ äÑ|ˆ¡kŠ®'%¬Mûv¦`)…$&dÉ÷úðQœ]ÌÁ3)\ÎË:"VnUpè™=yçžÏñwÎtuBÖe ½¸‚koVìkV ° #dEDV \f¤äò`•/àFçù-Ÿn­Æs.:ÚçOª²M[Dß *ÞY  '¼¼N }rŒÄßÊ_š¬+çixÁ16Í̶JK¶à^TZ¸¨ìÖñ&hJ$GƒQ¼hÑ*Çâ9+ 5¹œl‘Ç›qÒ…s#ÿN—xG¸¥?’MÔ?]ë5]*JΛæ# ×Ýô‹~É%©ªk­ã|Þü›ó»`Êd{Ö`Ö@qìö>ò_ù¹•ÔUÏÍ.ã·­Ì%:u1Ǽ*e⨌ÚU’¤‹“ÛÊðQ3_øÉ?+äo~pµ*C bæŽBŸÙT[,ÖzCXâO,G Õ냤Îqÿv\v&NÑ p|ºéTÄŠ>@û’ßê§]ËW‘4#äj%ùwý*ëæ/CiéÒ¥f±Øòaz#7j.Îñ(*¼Y<±}ÓpG±ó^ƒ(ƒÁé;b€þ’r*Ýõó#ñÝû±Ezêp“,‰š Kºæo€o‰=qÆ´òk¡uW£®Q{°Ð'Èï-ðžY/êëµúEÄšñtqH ßùZ&æk²HvOßÕlUZÉyõÓÛê­v!äñžŒÞºç‹¿—kT¼68rË/!o^Tñ¯;té8L‚„© ‰ ®ÿ¡|ŬǑÃQ‡§ ™(ËZ”w¥å¥d¹f¯œÊ.Fêé 3¥^íÚÛãt-)#ãâáQÌå^iìiaÇ=¹«îÈ~E¾È*$ÞÓ_’•\Ÿ+È?—ù·S€.¢’箣”kÚJdãÚÊãU»fp4emk9”Œ–2.Qo8뫪nàâ,Oñ˜§+g››|Drb·£’DXDAÈÕ´v¢%—ZÔ™[i+FÔj¸þ ®v¶Ì˜Ç½±þ$yê)XBça;wäÀ–½«z—ÓY6c¹]áa«•6  45µpçT—ƒ+ jO˜vd<¹ýV„èï`%Ì–j=>tì< 'Gõ׋Í_}Tn·îadÌ…¶½e•’)ÊíÅÖ¹{ßòÚ$RñÉ‚=WÉ­ã¯.·²ñR‹G!λ-özQÐÛå±ÑõÂùˆ;¯ŒzB_ç²NÛtÍ’+V©+²¸‰)V©Wj"ÔFç´›|+¹†<‰NTeøæ›ìû\€ê¡8=b*½RΫ*uH'ï°;üøƒ´ ×õgÂäsø —¿Z¦ŠÿˆØ´­ùø^ÇíÓ âÄ a<”wFl’Bgμ²)å%4ÿ«••Åà±óýÁ LBr¸0aaú¨ÌÓв¼šª¯ý˜ìÝÛz´nÌðÔ7¦Hºc*Á²gRŸ:¹Š¥{“äöº) ÒˆñJçy‰£üBÌ¢ÎIx6TsyÝ]MàäptŽÿ L©ØÎÜÁaë!?Âî‚(\aýÄ‘(^ŠÑ8lqæ7:;{*Rør^A@ÞDtl—37æÄ|\rúªÆjûFºÒû&¢Ÿ>²Û¨¿íKÞCÂÁüL¥*Œ—ÓK臘 ú >éÅuV1ŠZ4‹r!Ïañ*¾zÓàà=€¹ÏCb¿­Á/>¯Òª©rGBUŽÅË LU;#(}3ÂMG*—ÈÜ V°Æ8“‰ RØŒÈÅBQY„„vGádÌ<ûì¡•¸è¡jqg¡Nå%±G"²`xÙU«œËõ}úcç²CdéOÂ똠:öÄ~b ÿë¹Q?^ÜjÂã<ó–`‚4§`âà›ì¢NbwþÜ{ÄÀAü6µ¶Þ¶†ä+Qw¹xTx•]4â “ÃJm¬ó÷}Ú†'8¯­ÓO…@…L•{Ó@Û&¬7.¤PŽ—NÛZÉŸŸƒ, œÁ«¥ïÜÓ!ø±†âñGOçr‚Tq«}«ÕþH–e½NØ’`uüÓFNå;¹ÆÌkÉÇM„[ºùC@ú«ä;££›v,†‘Tb.ÿ#|Zù±…)Šzð¢$“ñÑz€ExÿééûAZIsKwõoÆ>ËnÃïÒt\ÀW±¦¾?cúäÔ„!éPÁþÔ0¬…§dÞ=[vãúÙvü1Š·{ ·2·œÉ¥gºR|˜qúÇáBštÓ¥¤‚V§Ù2cT­þºÛ–:VŸcq”ø‘ëõx̺úccÉG`ë©hÞXÇ"²K¹°ï<ß-¼Üù§}ÐÌÈ (Ɔ®ˆ_Œž^<ìã¸×¹OµµcW ½ ¤,õÆee_(—Î{07Ä.}€ÂÙ¨þSKtf2λ§ö•›GÊK‰š·é>žN›#µ=i&FŠî5LÎ}§‹…±~}Ï<\_¬øT$‡.•¥¸¬¹`W3Þ3‰êŽeÖ'»\z&#Õ¡½òO²F+õómH¾±÷ƒ×\cN«¥ ¸ÖÞBÇÎÌ,¯ïÇå¦täB†N _‹û÷ýH"H°«g±—9ÖjÃCæ –n¥7Œzœ“íý”L?%UÕÈÜís‰Ÿ+!këó$´œ/^ß8¿¸ócî›ô³.dïm¹Öo3‰CQ³›}±¾ ë8†+j1œø_³d‹÷ZÖìÏ߮٠„C·2Jì¹Hq‹—ãQKkHËl»peŒ}å Ij™èa Û Ž§u-jd·Ü¶׻ކáÄ¿Ù7²HHZ RÇ Ùº8XeŠ4·ôÀËõ Èc½Øc²Zb]K£´”©í38B\s"á .m«mºŸ'ò×Ä–>0œÝéb;sc/~vü ·ƒÇ‹kŒhéŠ$í…‚Àö¿ÐQ[C’ÒŠ1 xÛÌâM¸ý2Jæ1zÈ4Kò$3ƒ<åñ›ª ês~²ˆ+º¾ÖÀ¼êŠ%Dìg©ñ¼Xܱ¨Ç¬Z­1ÍÌ23¨ø:"XíøÜ~[d4T¸K(üudt>Í\öÖ^7°1à 9÷+;ÎQ®~O>Ü{á~" „ Õš|5³ZS%Tq˜;+Ç ¢x¨§®Ðƒ^ÖÂöËY÷$—jeº |ȦÇ::X¥'ÿnÊ–¼»pæ |B¿oÙ­w‚å&ÅÇÓ‘”ûjTb‡lò¬ðâG×Á£s6š—‘§F×±¾ú¶ßë»Y"œ ˜}’y$±³n Ú8]ö/Vø‚I êÛôÞ'–ÝxúsÚÎ+÷]ÅÖVÈÓhU'?QR¬h#$‹r‡<àµ/íÍ3r麋¢XÇÚ^þ2ûž¨šÒxê¥cRí,s}€•+ȳ³L”¼M=$áα„êYôYI5 ¾Q§4ªd@IJjìö+_§YPo¨ïM+þ8áULŵÕWçþÕóÎ#€oBb}-T›jÛ~Cšl¡†äà«ß ø4f2\guôu7á Fgxï*çKk²’Ù÷’Ô Ñ@ ÓFÚ©Õ䲯ú6b¨c,þ=&¤ˆ£V‚ 'QbÇM%‰óbG·aú:ŠˆG+Ö÷³¶^æœëÕú<ªÌû]š&[Žl«þkGxÞ;Ú¾yJÏ­{î4°¹’Ë‘ÀxÌ—›+<²]ÓU‹å-ã—Vî ä{þg ¨ÝÑÏa½Ff匆ðÞ²#77ŸÆ¥‚ÌÚð9"ÓÆ,ä¿pú¥¿…øÀnyOߘeW4·Ñ.(¬+# õw´ X7‹ÜÀ$-¤'¾÷¤RN1+ ëòg§šnë&¥ -ä?0×¾ÑpŽ\^È”!#åü ~W>ÿ©VY~¥ºNâ­ÓÙm æ\ïð¥‰^µúê9óãÇôÎy!>áö ú.…¾% ¿MèÖ«4ÅVÿu럽9ÀJzH?O¤èζçÆMz ?vÈÆL² Úòª‹‘‚<‘·úHM3.´çÜbà‡LŸÖä fÃ×Ëön4±•¾ò3Å)u´.¹)ޝ9ŒÿO×(éÓ³—úU‘û«ÂÊž6¹»pÇ õÂt×2 ¦qb FMɾ”–?þt»ôPþLZiî©ññôrDåYLŽ;]mEÝ@Ø ,œÖPM+rÉÇWÂî3ÕM€Å¢ÅrOñ ãØ˜^¾æ$àþþ¹Qã×tš. &òxŽFUS/Müf½¥uyLã3¾³zÎ x26õlè\=û âãç˜yêxúØÖ°´IåA’¢°ÖöFavM Ú+(v—OL”A`õ‚Þw`Ç`K”g˜ü¯´ÏÑÝ8*¬Z$ø—Dþü΂Yea±C‡ÇBSçÐzU?óì éÈYH“ú¼û¢…uÁÇ­ÕŒ/S ”»¶Kh/€=ÎåÉL JÁÞêß;áp°¶làßµÇÄØcÞÁL4¨œ¶¦Òl'ª#!áÖfâLzž’{$BÊ­ùÌ„R 7¬c쑯À£BÖš±Õ‚s+•_<ÒПBÈBÆ€ëÑÿÇaZ*(&^ÖÂܼt,K)†r’‹Ÿ þÎX’Y8…WÉq¼R¢ŸFêÜ™:Šø?”5ö×·ã_bw$ûÚ‘Ä¥©ùû e(¹ó+Èe‹#ÑeÐøsÓhª)¸Áƒ19ÅoÝ0ñ˜áDÆLò6 „™†¾`” ±5u£‰‘yÜwº‚ 6üåþ…õŠÞ€WnËÈŽŒË-kŽ|š&IŽ`n[Vî-¥é&’ÊÔ’˜zÖ?BŠ“‚Ò¤^^jS;ŸHñJáãò^ép€oá{|€¢Òº¿ï1 _ŸX5ËÑ-YšÕᬙpŒ{®L‚2Z¤)^Œ‹çÈ£{ÝŸöcï`Ýé:}:c]•ùÃ3Ôƒ@EJ«æð…Y4ïÛ²˜úÈ€M¼ŠÀí¬xy‡üW’oË0…vY„œ€„ßÀà®´D¶ù†Fd--‹ç¦gt2=«î’ÅOñ _ ï²M`¨u¤ °€ÓR(G®PîûOI ¸é”áÊ4 ”dv£¦ÿVWu’à @-´"´h9{¯ëM—ïh'BèÆ÷箈N^ù¨,g E•Û} á2éyèV •Mîõ4ÂÝL:º”vœM3i¤…ÍqŠ|_¤l ‡Ow^‘,oWc²ºÜYB­Æò5³ìk¦ÑÎm¹óÌå·7ˆªõ‚t{4½¶4øp¤R:èGã±NgC‰Éy"fq]¢<.)ïnÁÜ·ÿMèÚÛ3}]ª4¸í7À@#:²ôËÅ à ßÖ’â\çxÝN?ê.aÃ?R³]:E8ø‚í°›âJª1™üS#Æ ¹%&~>¿¬?tE&OVƽ`ªUÏDuÔcg¨N“ã8}7`á_ÙÔéт΀(„qÙ‘TùJi %HSÖìóýÙu¢ˆf–ÄQÖL™?öõâý>–ëvºKÒ(‹¯/\MÍi¿SV h«ŒëQ.alr+:”É‹7O<¼Õ‰/SB@ï9þXCØEoxK.èÃ[;¨•ÊSu®‰JÂ<Þ¡ËÛûXD¤É "&8A3/áãü‘†L&ù¡ð¼„T¼èÑùت­È³d½`Ïh—ƒ@”¬_€q*CäúŒ·ê€B;Áˆ_Y»;@f‡f—<ú—$ä°°í©õsÒü(­tƉâQåÔ6?˜3ôõ›¡CEW­g%õ;wDa¶éÝ ƒLB˜—î†AIp·»ýÝxñ‡Ù±cÁ ÅðÔÑä ñB¥YNÉÁ>ñôC·$bí /R´b?¶[¥2”‰»^ 4Û1Ó:¢Š«¸ØÍ#-.7Ø–˜ ìö÷å2Âz®…(kò¢B¡ìl¸îvŽvV,yÑY÷«cÏj—u¤µv|Áò «T«e¡M¼ËÿHx´Wæ ’ºb¸Ýð͈Ze^Òx.¤´ŠV0§sžÅkÝÉcãžé¬mïúyónwCã“7½Ðys (óèÞqŒªn%ZYšJd;4Ò¬ôçµù~Ô}çÙC¼eü£¿W_j –™èX‰ Í Nº¯òN ~þ{²¤É|{Ÿ&£YDäPj/‘«IšIÜrc¨@N:³ÕïGœ–<ЃÍý\6±Ë‰‰Ûë/ñ%à/Ñœš{>g…øë„ªˆiÆ)ÇŒ1?'~À3º‰y곤E<;ÿMO3–M“q,ÇŠ”4­Gò%JaÖÞ¼‹YP5 6ô  üI^~]_‹0pß–éÝa¥Òs>®ÍàþªŠ%<ñI)ÆŸ1ž‰1–h~ò•ƒ Ý?ÄëNÂÒeöõÚ¼FÒ0á˜ý]!}<ý//#åRd"[]+.ËcÔq Èaµ‹ÃÅ~Cc“Ûx™Â« <ñ*@DøJ×± "“Á;À•$Õ„ÕÕ„Okü0Ї·Ïæø«¶4´¸>ž™%rÇšk+?¾• ¸¥oçU«3XL @§ §'fë^OÅÉ›÷ûFÛGÒòb+à˜W'÷9M4VõCyÿ{Q,F „éÏwþA³&?}ZKs¬Ñ±vBn,ÚŸ¹Â^  CjlaÔõ¶qýöÒT‡ÉçTUâÍüóq¨Çb¯[¿÷0§ªŽ7}v§ýÖ•ì×Åš^‚ê-Õ/ ‰ÆCÔ‹uߘRŸœœF7sgp‚?c[UÖ&½;[Á?×½Þ F¶ˆxÿñ|ÛI¿œm’øIXŸ½Ù‰u(ÁL>ØÌlÅ){CÉ'ë4ˆ¬ÒoŠŠ¡ÚÂ@µITw3äúÐí¤ßk˜’Pÿ ,ÞWz[BîK^+]ȃÇi*òµö› W5ï¸`4¡@rkF›œ3$HSÞus›?Óúà$Pà•ÞZIÔú>ý›(‚š¾°­.wÛ,-Ñ–÷ÓVF¾QO5ÂÓº~Ь“Õ§"²Á .zàvºìEÙ÷õvq-?d®U&¥1›¶å ;Ÿ+Æ…Òæ+¯ù‡ ¾ùÄgQ£só¸aôÒ·£â³9IL2{ú'*pû)GPíñVXœv:…€‰Ê^äíÿ¿ ø‘(läÙ¦Ü0zþÈÀúÒÎÆY¦'©†Wz½s#^˨˜ ^ÿòÁŽõÇfÂ/¥îÁQœªz¡Ð*å*÷ ÀP¢îrúÝøJ@5îVÆð…x‚³Ä¹<õ+øše0ÃXn¾Àxÿ;èF(›¥Åg¹­“Ïu©yjîТº´¯1{–ƒ—cp)K—ˆÿÈLªFx0±úÀì+¾éß÷)þ–èéiI ùù½»pŽ>Ú(Fþþ2üìa¥ÿ+€2ûêû—«ÈA !ëùº¬3|Åã{JQŽÖ×OÜyÈ; dû¢£O0aøø4êºÇý¾”¾úqô¨ø[èÈ ¹¨ 0(v§iBðªÈOŠ)Ö'å÷¼Û<¸‘bæ2‚‹ßuæ½1lœ»>K"É"Xø4œÉ›/§Gr7qZ£²Nl5&­±•¿ ­Ü1`I– sñþxÈ3~Æ·ŸÄ Öðéà¿hJ91“AÐô µNÊ(…Aù¸>tfù€Wª2Rv/ Ú1àÙeÅa…p[·¬ŽÉæôjÓª§2¿‹¬æ5à®2j˽ü³}Ò@Ev÷ ìÃΖ’Éð›÷qAø±‚ɇ*g²²ŽFDÔT»³7ƒ¨Hã’1©¥vÔ§ï“Z D„"Bvácû<Áø£ðvO]§ùx®DÒ_Jç ý‡ImPiÂËo]NŽ}ÜÙœdÑÊñÐD!TKN$hÿ>@Ñ µ!•MnÀ®+ÀºD%†ÆŽcû:¾é}{a i|]%6ðß?– u»lÐW²²+ÔÙÌ`Ѿ_ØVÛ/„=z+aHéþíãÆ… ]¶Ù“˜\Ãmù]¯(f‚-BJò?Ænä^IŠ3÷yDZò;+׎IĪC"Ê&h ž˜ƒrpÿrèDÌfG‡ä3Ù¦%®´ü“€"þ¤ÏU¯Çm®³¸ ‚Ť±Ì•!“«H£üâe:ýGa °¹iz- ¿_v˜¡bI€£R!z¨XªàN£ï5¸ãÿ †”’épŸ¢)ýA‘ÉBÇY„³Ï¿VËÁÈçUœÃ«ßþHL’‚ÇãµNTãå{7£ Á؈åïp“é_A»ÝŽ·ï-gáô¬ë~WvÈ= jŒãÊžKœ&·¼•pÇÈÞ•¢]5=ý˜QÄŒ7K©tös‰˜­Þ¬¦Cš¾§ìaИ7Ìx7½>ø™ÏTfî£RâålávýZî¦[¬…qÖÝ<ÐÂ×Ù|É4Љå;S¢ÈW¡[Ô2}ÍaÑMظ»~3Äå}ªúþŒØ˜ãˆY‰ì–3zfÖéNŠi/mZuUµ!‹&;… ؃uü?³Mãï é$4ZÏ_Ó.LÉ“~©ÿ¯ŒÝ¢újìTùÑjüZÊzz‹„’Ëtè0ùö-`ÊÐ1¸K’×~ì{Nz³äåS€<›ñ[Ѩ>$œýÿ®KÌÅt¾„Y9rf³zN]ež—>äÏ/¡‡ÿ0øþ LB˜tm²-ý!·Áà¸n8-½Î8ÝhE3¥M®ZävqÛÕÍzˆÑ³ÐRáDͽv±’íÔTSNrŽûlÙ9 Éå¬û•(é zs]! tì˜cqT.žtŸ½ø¯6]KUP»Øš.{{7n³ )ÒÞÿ|€I—`I†w{F¥J;(#yý-?“ÃIQå!Dˆþù®ËτͰ~€›Ž'µ-ÏVcG½`-…7¬G`P•…©÷¸Ú¥>} D´ôÏ:ý ½(¶…B[(‹Fh½škq¥ˆt’+Ñ2:´Hûó #8ÑôoÜwmût…&¢ÏØÿºC*<ãd<±MûZ¿j“WqÉI|”•jÀÿìB î™×Yña”·þ^%B&~ÿ5y,‡WܤÑl„à?"\N¢ú×µÌ;Ù–Ô ñÛ]ü2mú¸Ã°¶|ò%è­$K"’GÞÀ¬q Ä(PNÝQY™CÈUñ|{Ïo Ú˜iäTºþGèƒ?…—ÆÚæö½ò  èé.œdÓŠˆóS}Û˜çfƒ 0WèÈ£Jêf¶å)„«Â~ýG{í½$}z~§ÆVí±È+´5ÁgVj"Þ¹ÐuÙˆ f§,‡<.U†<:q`VñBý0äG±Ù¤ áµÀ K¢qï¢6üáEßHÚRá!<@²,s¸®÷²×a>¶í ù>¨4~ÙfÏÊë¯Ö5G–b-Í(EûÒû‚â² =KìDgÝ81gk¥jÊíóåél£¡—µÌV€Ùᵆš!é€3fs,yõ¾³ÌÛ ì«’XŽ^°þ%$JÝî‹÷WLñ ×æ0Š>þô¢pê3-‚'œ†q!âB mêÝ»v1ô(¥6Öž»*"Bt û.- ¨0a²ƒÏ;È z70 Žg¢¢öìÉ6¨’)7íæ¤š:à§TcK×ý7`Ÿw¹ÿÖ{*œyÕ•§Zgµyöž4*cR™§þG½õ>¡ìK¯8]¡0+FTôöeC­m—¯E>ÉûÝ;1›YÛàô©#AîZI÷4Gtì¦ùƒJ°ÛâIÛ_+žæ5™dÁ@I;+ÌÒ N™‰¬¸ÉéÉ«¡ö´=ΰʉh°'Ëšû儺$4Á™ÒU¥¬aQÃu{Üžç$Ç B®ÌÄ}¨ËÅ–âù‚=5Ü‹Má™;ª->'šæ­h3r•LÖ ê£Ýeãõ©Äÿ æ_Ö) h°”C~…ŽÀÇ®o˜#aRmôM—uc•‰GÖ² òy¿n ^Š­s8ßÿáØÏÌnÎöP·nrº»C½Ú $Þ¢ˆž® ²Hsê#šŸJ^BÌÏãHA¸Ì“!``Rä¡ùõ|‘ –«:lа{Ð"yZÐ,8èß¾¥Ò©ÐZ´G@·éyç)¶ÝÍ „+3]ꋱ-ILÆ…r}䊥ҪÉÀ¢`¬6Ìm£»¹¬÷„  YzÙÁÆÞ¯Ks{€;aDë—ª(cfXèò¨Ánì)GZÐ>h·ÝPÇâoBñ']BÉq´‘ûNµiˆlb Æ~;_¨¼Üq~Ý(F PÏ3S-H–]ì]Ë>Où kL0b ²²à»ESÇ©¸Z4MOqƒæ¿?³v_s Ò°.°Ú> endobj 312 0 obj << /Length1 1859 /Length2 11456 /Length3 0 /Length 12622 /Filter /FlateDecode >> stream xÚ´PÚ-ŠÜÝ·ƒ»Cpw×`pw·àîÜ!!¸w $ ày¹'çÞÿ«Þ«©š™Õ½zu÷ÞÝ›žZ]‹MÒÚÙôÊâÎÆÉH«hrr€@nv •ž^ìîúÛŒJ¯ ‚º!Bÿ"HCAîÏ6 ÷gžŠ3 èáàäpò qò . Pð?Dg¨@ÆÂl Pa(:C@n¨ôÒÎ.>P°­ûsšÿü0Y18ù_þtAÁV€Š…»Èé9£•…#@ËÙ r÷ù/ &;ww!///v '7vg¨­óK€ØÝ  rA=AÖ€?¨Z8þꌕ mvûË®ålãîež Ž`+Äí9Âb ‚ž“´”j. È_då¿/Ÿ €“󹿣ÿCþ ¶°²rvr±€ø€!¶°# öJ™ÝÝÛý%ÀbýÑÂÑÍù9ÞÂÓìhaùLø³r À+I €Åsƒ·çf»¸»±»ÿh‘ã™çS–…XK;;9 în¨Ô'†‚¬žÝ‡ã¯›u€8{Aüþ6`ˆµÍMX{¸pè@À® ™¿)Ï&Ôß6[;€ò ò@®·•ÇòÚ>. ?œ˜Ÿ;ðsqvØ<7 Û€žPýÜ,^‡ä¦??€Cþ7âp(ÿFü•ßHÀ¡ö8ÔÿA‚ÏL‹ç3ÓÂêùHû–¿Ñ³ßêÄÃóŒžwý_ñÏ»ÀúäpØþ†ÏZ¶Ð?vñ7áYÂî_ð¹Cð¿àsqÿ‚ÏñŽ¿!çs# ï3ò| ÿò?×âü»ØçÒÿËýœú/øœÚí_ðù<Ý‹?K¹ÛAA¿ÃŸï˜ÃÝËù_Ïù=þŸkõü|Îîõr=ëùü.í™ë ‚þ%ö_cå…>¿¤îôó8ýÿùlƒ@Þ +Ô•Eg+ápûÆðî›zI2/¶½IÑ9ú=½,f6¿è{;Lät溼ÐMè•dúhöúŽ,Ó¥Ä*ÕƒßQG3rTgªF×/ÿ{³dÍ™½.Ôåi¡©²#ɦA r6m‰}ÿWÝøØEú"WLõ¼¯9ï¦ÁªµñÈÅ=ý:>%´ûªY¶xãŠyúbËüb$w6Š,¸§ÞXó—Ws¸…SOTŠÉ¬¨Ç Üå~†[\‰· ¾Ÿk´¹Ü>’БSÀ_âŽÏ0øId(-ùU–oBÇ3ßOl;¥q:0ùî©jÞ@š2ÐO 1‘sÀã+ÄÅovʧ8UP§ ñ䟮+nz+üäï°t{©–~RsäoâÕDÜë½+lò=@f"hÔg‰Ò´#Ho¢‚ôóFQÀ61`F—îÙß'm[}ûŒßÒ.ˆi.KÑñ>ø‹m^£WÈágmêÑuï…ù3EßÙhÏÃGüÓ «\硞ý 7k'SØtú––PуúÎôB4V²8¦| +Á2DÒÚô¼œ¢îu´a3“ƽ#4æÜºƒ®A/Ô›èÁo;øU:UO’uïŠòpÊPä‘“oÛࢶ'<妷…d6p£¶£™"KÎõÞõO|8ÿaRÊa¯²Õ’ÂBWuLÃ3,P{­üc®8‘—ÌT°¹ÿQ¨B©“Ñÿû+ÔÐð'¿þÀjTpÕ¢ìËM’‚_®ÝpDbïí¦™ÞGƒŒúý‡'A‡1Ý`ôQaÃQõK÷v„8B±§†åu—¯”œ!Zºõ°IÃBo>nTYœ[í–ü‚‚Dœ¸¼NÆ 3î" "ly‡áC3F~À Þ†‘“ Ê…ÚÇNœÏ3‹pkÍcDX÷TÃ)öÃ,)Sº²Ä]öГEìˆx1r¹…œ›ªÊx–¶Æ`ç±Ë 4kAº½ |/K!ôËýÅž¯—ªrAŹ&2ÚÿÝóA}Î.˜V„SVÍlÏísY×ÀÈ«k[úþBË-û5Vw¤È›§Ô”âÓ_…NêÕÌÞŒw;I \|~æ.6‹vX1D×S÷ØÈ `„Û3 •ê)ã.UäšsÌ3ÊqÝœÊY"ïÙ\}Ðw+2ð›1%ôÞl¬ÃLþõ>q,Â\¸ÃyæÌÇ2VÒ'F­?$ß4Θî¶U™#%] æð²‚ÓYÃâ?("zס õ–î¯Oý0Ðü:e;¼'X7}è~è¨sGàK]eÂÿ%ÎbCµyãÿzáj†©DöB®w¨G± âè{:Y,U»ëߨQ,ˆo’,d.˜ÌªŽ2@AêªÁϡЉé}@ôù‘@Ì{Ià’vÚ®Y¨sÝþaØÝY‰÷:”1ƒm+÷m£^úŒ»Â“¤7Ëx)Ý6õº-•&<±|° yµ°f¯.̉ÎVð±8µã›••š.[<µƒ5vüíþTâ»V¯©Ô fñøré›Eº–øü¦_r Þ^* ×Xa ª~Lc9ÇXI#ÿø¦lkÅ?7e¾Ÿ2Z§ìÉj¢v³äs´Òq>h;•oÖ.‡Ñ…ke³eºð5%•á–§ÎEÎÇnuzfÝávL§ÓÎ¥ê| \\Q†n Ô¯5„ЉýnYáf¥ã)Ùˆ>‰A+¤þ~š¡% |Íc™R™Iüö פÈ!DQÁ#Y\™¤Mø1÷ôèOYümDÍðï5ùÞ ]ÿµ=œ˜öû)‡úí‡Pˆz Hl›Ç¤ž9½8)–†Å…—·-Eð£p7šu9Rûºã˜3Êi×zªÎöù¥ÇG¾/YÒ‹qô¤ƒÚ—Œšñäö³0…΋œ*UåÇ$V˜ÓT!µÇŽqók‰°¯s…s‰{0£<í‰ÍÕŠ¨˜áRèqã#tÕ õò(’ÉA¶@B4’s‘ a¤Ì_žþ"'|Èór+»î ®ú‘ñbÛ£I. Dïèë™(õ/<ÓÇöù8›a«%ë”Vkƒa©øÊq^dd˜¤öb³æÜm58&_˜ñœ3fMs¯›;°h£·2Õ¾5)èÇâãÕ\f3êe’}w,©HÍí&„b‘,ù¶^:ŽŽhøX5"ëÖ¬:ïÔl5]uÆÎ¾v+†Õ=÷3OL£'Š¡ƒ,cØ»vïh¼Ã’…Ùé ]YoãªÇ¶’þÆçãŒÌ’åÂÊ~ekïhX¥´s'Kšçâ*w_9[ña {•Mí%råJõó¤¾ë»Ê¦ñÛmáI äÎ2¥VÜsÏ@u’U1sh§o¡ˆî8÷×k4Üo´.X×SõðÒ° ûzvíÝt4˜Ë(â†jœ(½ùB߆Á|9çhÁãó4¦Dïnƒ5±Ëð¼£ü ©M±>xÉZ,Ù4Ì~m;=å%ððqXÖª>3’f_Á+­õqï½Ç9ûyØR­f7¥(9œÓÔ-fZ+èY8÷Ú‡… ™QÁɽ}®VÈZ•öGfhišòÙ¾…¦wQ?uĽ5õ{M4شܠ蜖³"¤ž]Áý""­ÚAk<‡å~ÒKºú;ݳáÈ*S÷ ž;^Pò†¼j4t@þBùKµ6d>Æ­r’í)Ç’&ªÈ\Ôð§HUµoÄ«´Þ0(cjÚ/t÷غ˜Ú¨[Ú ?øèo¢¼¯¤6©ó]Z—Xbo ~{K€Î{3Å–”*£ÜÌk]‘ß;|çjZQÇA ýZŠ}`;Q§NŸç ¨±þÖ“ñÑ»h^òÁêh0k¬sª¸äÞÀú3S8‹PÁs‚µytI‰¤Êºex|$¤,9ê°Î!Å„¶¥(×±¶X/Š™ZmèÆñ áe ‡Ü_Ž<àã‘0×€¯àAA5ª¦ws…¼œ7d`)ÞG–ý¡ðLï-È{ ª^Ù_p2êObE :|…˵cÓvÈÊG 4ƒ*1‚›âÚ­Z/ñ^—þíæ§‰Ôþ‡m÷–|BеÔfœ€î¹kh£_ù½5zÊÎËÔY‰Ÿ&¬Ë­Éïc¥×°|;.!8~‡@ÍcÚ¥³xò— !«‡dTõƤCï^¯ïN—p*KÕWOáÒ*î6¶œ~<ì?k§p!"Lða&õ#qq’•ø •eh,JÓ/lö8+ÉÅçíÝûG„8˜â äŠ W‘‘`ÆZøb‡H¢²0DÂX‹ßB¯7yÞËö!ŸD£›ƒêº{ö|û>P#¼j…â€äT{ôU]$c2xtÜL,…m“a)Ø”…¾Æ_sÔ¬ÖŽ»àY,g¼ÀÚ™æô¾Nû9²kžŒ¤û1ýŒAV®0D¼Õ ›sñ]z-s8›Ÿ¿‘Í|x…¡îŠç&ò7Šo„þM nñ“èµ|úÔ¶´ë©(£T/œÝðS¸õJb¦ó¼3Õu…YÄqš3æŽÈç®*¸èòaŒ^,8Ê(o•× =¦¨ï/ÞÑYËh3\ľEŸí·hÛ Mû«±•ô²Ô‚ët”Bö}½½˜3ÒLÝ’Ãe{ W¶xÏW‰½µ6a‰lÍ¢êø¹–¬Gʉ$I³ Ñ/?ãlí≀$‡(QôªI³ªJ¾Ý$²å=Ñ3õžgBôixZ- ¢¬ï]u ÂP-¼XTH” OKÉŠé©Î)§ê¡yM< ·LcÛú ¿gðcòЬ6׈“&XåM”Û‚8|4HMió%eø±+V+AÀO—l¦iÍì £ sk ¢…#3[Ï 5c3u™·Ð'Y ‰Œ½sI·s§®âb¥¢£ÿgHh>6‹é«R*Zqtu²ýÄö`6¤û¤Nýö§iy)/^y’ë¨b”N—Ù±‘ J®†/ Cc ñ(b¢ý÷qóÞbnØ@ù±¶[ƒ5º!mleÞ ܽ£X¸÷äÄF©¡Ájš  ¢{±=¹)´r_˜»:{õOu/íõ¾†¤j®Özð7»bwÝØ;9¢FÆæpR¯Ÿ’BSÂHÀ(‡ØæÔ¼t¤MV•·::Ù÷jcÂk•Xí87Öbá±#¤/Æ0Ç3n1¨l;? #Â:êÜ;{–?IJâ4ÑhÐûŠÐUêÀÀzˆ´(òiÊe^5¯Gy:mì6Ñ_Þöw6Íâ›ÔˆªK„߯›q­Ï;<\âã1 Á¡ ƒäø—RË2nâß5lz9:“¯PbQ‘lþÈ-Qk}ñçJL}5-œ°øBÌ-t)gÿ:êš9Ð!=g|E…Q2®bMSLš¼sSÅ4àÎ$ÒZYÊ£É+kd° §È‚õcþƒVÐÿ@Ú{ȹ§¬¬$¡*‘„ŸumS7°ûù6Œk£¾¬¼-æŸAŒ¤'/ÁóŽ™à)ç;øÔvÜ5RÂë¸ ôø>_ÆË…¦ZØþ¬^áîʤ¹–¦q«fû¬—êуtC²Ãž^uà†‡<í!“æ”*Àk“CˆÍVø ¨bCê·œòë7JjB˜–—<Ä%@¦x‚|wtás¹kaS\™'É-.{•È®‰](… »‰¸’‰h5¥ã¯ö³’µC‡‚®:#ºóº– òú¡ù+¯ùxzéË­mŽùSS¨0¯8©àØò)–˜Fžê’œ!9¬fó:/Ù63ÒEÔ/rÎ k$8/?!Æô©ÙCïý\¹¯®öx󎮂ÊN Ëfi8_ò¸Õ×ÚUS‘Ì_^æwi«æjMÕP®nâo,sùˆÑFh-ñ•YÓ¤÷ÉN|ÕÈ)ÂEœöØ»4øÁk_ÜÙ·égnÛú …/ªRòXŒÇ°M§‰DƒºzUñÔú|ó ý®sŽ ·Ÿ‰üœ¦µAΘ“÷À»n+YÑH׈1ûD_ë݆Kå0|¢Ëˆ¤*Â1‡0l~tR‰¡'CØ)ïAÎ1FìéÿÉï"]STª\[®(Õ¼¼Â¹ÌÕ ¼-uzâK|‡â©þ…O®î~gO˜«ÑÆ„>IÍ=$(©co‡ØÑ¦[ÒùK1®ØèbaÄv U@«D´ÙT[ãÎâÛs=|†¯•̈´·“KÁõ9ñ‹¿X‹‰èF_síƒÍ²ßJåûz"ü0'7‘>6±b=™‰ï oFd »m©ÝS!vtG^/OŒ<"9Q­'ž;uꢾ}Y®mÔ}ŽTº²hþƒqš¸úa¥mR”µˆýÐݬeö%cð›>uæÕóéŠ(ËÎ6^„Ë]¹Ž[|kåL¨T Ù9 0>’Ôuµ(»ÕÂ\mÜßu'Æ: ±xc{’û~®¿“nûǹÿ¬Šæ]›y<ÙVú[a¾}•;ÿÁÂ~ÛÀŸÁ×*£ÇŸLÎÝ+OHó!¶¤Ù޲XÇ^©mí½‹á¬ÁñA.Ö«MúŽøI2úTø%rh”–\*p w{1, ¥¥›M°æš¾·@‡äA¦,D 7ÝX“ ©È'Svn+$·>»/ŒÌ~ê^[“ø‡zj´®uåÂDÛ`Æ˜í»¥§«õU´þu*ü9„ ö3iجCîmîã@ Ð|Â˃„…*ÉÒÅWùËÍ–Æ—;ž Ÿ¯÷GáÚÐà‹5p7pÏóaeæ¿ÿr¸qË(±kÍ1H.´Hx«^ÏhO¯^Ù>2*†…Ú"§ç˜®2#—µÛrzûæ ásò[†ÞX;K†÷”’°‘tØñ¡ óôw‰‚VÆêè4rL4èƒ_ªn.["·G?öâ§ÏbÃøF Çf²Ò¤î“µã¯¶‡Ué~‘ÍN¹\%iIà”[-¼–÷Žýb€Õ}¨Ý81[= ëöš­ßE+©ºWº©±ÈU5^PÐd…d¢9çç+ÝÕ)î£Ö©µÈ¾Ïº¥Mk~oN³ ArHÎsà’ÌÛc 3mü|@¢é;#jƒs˜Á|ck/ù9•Ñ;ÊRJÝZ¤n§Üt6ñå5V±çžÓ2š"ur‹Hm‡V#ÜHœ¨Ê¸`€>…Ñš&÷ö$«j˜õÍO˜W|(²—)F?رŠ'ç UUCeÈ(vú¾RÙÄ—úSáž*}ãcçeRÚ¾#˜cEŽ cåéòY¨$Ø@ÌOœ–Zønd@ÕÞv‰RCÁf~Ÿ“–|6‘L]^ÁæÿöRSWʇbM‡cŸp]íU "-ì|—pÂDÏnÎ~õÃýc*ª9ñÙHPtÁÁUs„sÏ€ñYiæoÓBnvñ7ÔêáW"‰½ú¼ÔÏ;ƒlI¢èDoê%ºgGÑ Á·Ój> ¦Ópˆ‰—ÙúîÌ~û±††¼ž‘ÂÐ5ñjQµ.«q›óZš®UÝE¶è¤ó½ùËw+H§7}§g½#­ø¬…BøC]“ùË:㺜}e³+›ß:£Eˆ<ì"´q,\ÓX‡1Gg®Z¸%’DݸHPE´ê›tÂv\˜:cÎT'wùfßi"Ðl·píZŠúõ¦ë¡I¢*‹Oë¥é%+ªd¾ßdÎR0iÇ$ñú&b0ö‹â@Ý=R6i‚-û.&K­Ö$ºZ¥/^\¸¤xs[PáÞ³Èjè5è¾GÍ@UÀ"+š¾{èÀà“løˆtW,e½dÁÓPsùÃ8Ó£OHË4÷.¾'¤àR¾rÁ%®ýCY“œÛÚú3 ÔùV;ª)VqÕ…ësàSlŽ‚øÁø"‘ ){ T1àû¸ú;)íFÚo¤ °ö6õ‘Õ:¬™KKÇ ¨.Ì q\»Õˆ¸·J¨ß—¿¶žëI{Óü&‹/’såñOJŒŸ4ì×kû–¢úÚ~NÀ ¦fÈTÈÆ÷ZÆaMò´!‡É•pÕ‘{ÑœŽL`šÈ"ÖjLÏ;•MýZ3Š\ÔZ÷d‰ï"ÂnNˆêÿe/·:-ìG*ÎýCÚ›ŽÐÉPá÷}ÿ× ÷`Á,³:ÔCàî„"l%HõÁ˃/ð÷-½·¹ÉÛ3„ý×ÜIÅl¹›gÆ‚D7Q ÚfËÖ½Ž}°”fئÏÉqzâ]±sõ‡Ø´³íK+kh|N¶õÔ²Ä~Èœ[3Âý”>¬Ì}s´Í]Í„ ›#Íj4`ªr,›i°4·—‡í‡O|l±ÁG&×ê–duš*HWAÃÁš¨C‚ÕO¢7ŠAoÖˆ@10ÞAaØt:Ìãe¹{ gˆúГâtn=Cj¹¹¶I‰Œ/†"³Y]è+Eìð)gðfáùþ\duÎÛV¥v§__Û#«xàJÐyyõí.€aw“QÍ×–&»AËÂãÚ¥GÍàf …%|Ø%ß!é¬Ï’ …Ú;xÛ]0Ž÷qÙ.ƺN¤™j³bSÏoöÓ Í´hx\ÂÁ6[¯wCÇvËK´‰†É5ç(HmNOyÐ}ßm=èê©¶ìÊ2uÖúÐÖÚBµ¼z É¶†¨·">³’щ_½¡ä²jˆ,lDƒ…5ཱིv éñ'¼öi‡”Ò”*¦0­ƒ4*$Tªx£˜Šï´ÂX¤ !ɰ%"Ò&»ÍŒo†FŠ5Tñš˜Vé)ªÌe*ÒÉÁ0Q£Q93I¯'Õ@êN‹ôòfذRkÚ´À/šâ¥Ä7°öRº#W¬ž¤b/¬’xZéвål‰ml¾€–J6VíèEù“|%6Ë´VØé‰ºCJ’ßðKŒ(½ãŒs~R/_ÌÈûìEöÃ{g‡wL»y3pÀïÜ«­ºòÚhO¼l®®.}™¾Á‘theÊÅõàRDÙ¥ÕЫKD¥XÀ!džr¼‡DGDRk~Bsó>Ñ.C=ÿüí¤ô™ÑïÁ¾ÕnùnRaò _æˆÜwÞóËBØø¡¶ŸÔ4³qLÙÃSË _Äpé_gÔ†R¿Q[X~’½q£ ×£¤_X'Ü1X¥”¬ËªÞŸfufbÙùåÔϦEF?y;b6ȶ£8~;å3 æ*VƒVX˜€Ùpv‹²zYº„^Cgm3BoÉ_ôäg“¸ÑC¿HH9¦™"äAdè2°ƒ·5R&báÖž–?IsÓï®P„Ð.¤z.k‡±€ÃåÌÝF9 ¼VˆéˆÝ/ØKÅ·ÿä7lÞÉZîÞÃW°P ÞÏœÛS¸`ë¥oϨŤգì½å>sçÔ×…5¸~dÄ%ŸåîËòÀL@!/p…tjl*à@µóY ýxL¿_PHôxâ…|·]ôP¡½ê£5îf.?×}Ïæ+•†£Qb:7>Šó1¯årxÇ.U~y¹—Ö…­:åj»,,¾€S|Qûá[vG'šgAú­¸ óªq'3AË™Ò@µ>ÜZ¿L¥ú së/æ»fŽÑÉAo&e“‰Ô‡‰†=6¶Ê%XiÇÕ=•W)—–,ªã|)ìò‚…«fH´~ËÚž9Œ`uáV~qªáe‰­^ŸîûÚ®WÙµ*îf+^šCÇÄßßeRîί¯ºêÃzRVêž‘™z-ë…ü0”†Å¨Òvó/~EvFgî -÷ãñ;û1œ¸Øª]Z1á‘öȺÇverñJ•þÉ šñýœ©é/wWgu핵G£ ?¸Û=TÌWÔñŽ_A%¶¢ó!ží)£sqU˜Ä\W,ÕP<à‚šË¾¿PŸ¡­ªJþIâUX¯ã8Æô9ôÃ=?²™™lvy0Í;ïÙ Dæê¬n¡“¶¾r¶Dܦ•\òÅEø¯ç/F€ëE¬ÝË >m#Ç”¤/x_Ú{fÈIîxë͸>°:ÉlR@2RœÊ<γK‚ŸLv‰<1˜BØtaØYÖ·ÙDAôöûµøÃ‡8â‰î…­£o66K)Ø+=Ý‹=®£0ÉÇéqá²[kÛí¨Îö~`^á zÓYc½°å_Ÿ ­Q9QÖ36êJ{×6'¬Vè®Mçx¼.Ú Âü$õy-зktª†vV¤ùÔSéFA(€úEþÒâlsÉžº îD2YW̯F’‘k"©£³ÇÄ~Ã5GH8L=þ‚uú—I0¸ö²‰¯©0Õ¿¥Xa×qÅu$¬á“’u@ênL­¢siÝ”/¯Æ«/ïwJ!e.)ŽÔ/æÊ²^ÚAONÏ2E“”Ñ`1>­loÆôMèÚp>Ò¼Ž=¿‡&Ýo*w»= Dä‚ÇÐém'ÛÒµS;ÔrK2>‡‰¤Ê— Pã êG¾•¬AG/ro÷„?6r¶ÆÎ!ª!uPÀHvœÞÑ«çi-by›:¶ãnǪAÔ#õz›ßŠv!E-¬QDCv;Iúq«f)PnÒm¬ˆxÈOfŒŽÍ´ zûZ罃”AY¢&Ú~N‹¯ò®Í’œÄ4i-‚wcÞÆ=lÅ@B[å[33Ê . ~ÓG•MïÏ·„Iå"Æxn¶8'5F¥€â‘@4O™ï_íkR]¯¬«éàñ°½!}ß?.Ÿ%Sߤï´Ç „^Y+HlǶ¾Š =ô"‹ƒ§à¬‡oŒ= ™Ý)>ºÌ!Vß~—ë¾KÊúômBF8/ïTVì+$$»,­‘î|6·êxç¦/±ß¡h'm"Éðé¦BØ—,uÉG1=¨³¸¸Ä„ k/KgI^ÿ) Å*(虳qÙåºêÿ)ƒ ` F>!tt‹›5¦‹38å&‘ã¯5ÈeɈ…XÚÚÏhÄË·s™÷¶ŠXBÚ0à­&)ì ³+[DnŒ Št Òv²r3ÂÊöÝvR{™Z1²T׸šÚ§ª¢%4qgÑoäší«Ó±€VCy–©êAŸX-dxô ‰€½¹46ì}’ñå§d6`µÑܵR…× 1’­_ÖyªÚ4Ý=º!õf›§ýêÅÍ{¿Øux?®MO§º7¸úd·¾Õ¬€Ç)˜úöÝúz8“eÇ—pϾ9\wîÌ!0(àÜó]x–/qêd Ðõ¬´K.ž1±•ÙÂíªõZôŠ@çí/¡ ò¬ ýêÅxY!QJs4‹ÍApŠU– <ÑR ²¤cC³9¨×× ª÷‘H¥æ”Ó^ê Ù.;"æJMbòÛy&GBŠBþè¤}éãØ¾ªáRµáÉXq b–‰f™5ËI;íÓµÊP†h½²Ê·¾G¹*NÙê’D€¥GÚ´ lÓfÓ˜D§>cRéQ²x̵‘ý|vQ¯u³ìël1phãŠ(œ(›a Ö\ë'¶@šÁm¯¹]øÐ¤^Ú}b{)sÉR:ZQŤH¯ µÅÊ®‡þ;ç/)¿¬uÉØö¾&3†PjÕ°~Ø™ › >S®7·-KëˆßâiÿŒ±ûÊU àMÉ™¥˜}U×A¥Ö¯OiÄqÆÂMÚw‚Iå}ð¾~;ˆctëök†¨Ê|熃K˜×Á<ª†WUÃͤc‹ýÖ‡@wÉ&D%”yﻊ˜ûY^•„û°&‰2÷.G¯cD©õÛÞEö0‡ËÍ\Ò€#•ˆ7vHˆ"–çTµ>7._ AòôlJ®xó‡êå¥Ô[«Ëù¢FoRÏ›>åÎM V]ËÅϯšaäm[ΰ5Ïaë-¾U7°_" ¯[O%ËÒ>,¯~Êi›ðéÌäÇj:ú5Y kŽfg!À<‘'ÇÿM%*ÚHãV£*'žæÜ蘂2n³X¼3 íl4ÏŽyh›{›[Dl&ÿœ)ø5:w[ë{{#fµÏ\?¡„tûÑðÒ Fâ°«1crìgï×%l…àçMH¯ Vˆ—X仞úýjYW1ü7åº!œ3O™^Óe)·Só‚$k‚tÛˆçÖžöo¨ùhÔ[ß•XItÙàK¢-¿ßC µó|?½ÌMlµ†¿ònÓv‹oŽJÂÃê‡ ³L˜ š‡µ<Ý4åŒS~óh®ˆûP¾jõ…¹Óœ5wsµk2|Zl©†/÷,IS²Î&[“*”ð!x/8­±,[}4£…³Ï΄fÒZGÅ3Š‚@ n³¹Åòâúãj½º´Pzû“רÑuOCå Ou7Jì{²­ùoùq@ί볲gð^†.ŽêÒÄcè¾7u”_uB‰<Œç#ïÞb}£8&bc¶)nÆ»§;` WúGÒ ªCcîöË“3›e%ø)†ä”h„O|òC(U~´A¼T‡æcš.¹mÏŽe+¤Èz-°•“Iñ{8ê®ëf)À¤a-²üÞ@œ; ¦ ƒ—׶ݪrØÐ懰CËŠÇ~®+œc¨Ç8LåC¹=¨äý€&¥\3zl.r ¨Ó½ë%¶¶Í)>Q[—N€lXP? —î×Ju_æ}ÌWqÂßç{_—†W}dyÚ£8“¾,‡áÆÏ"1oq`,*•?Å%ø ›MËßÎÞ¢Ê~A7XKI{\¸á¿Á#5x­D×|ªï˱+’ ‡Ì+ùd";!ÁýyËs´'TðiÒS¼ÊÛµ×ZñE«S Av¹sÐ…º722(mõžÞŽ y÷*b:< µ•AYœƒbç’+Jô)„q¹|MÍBžÒ1`@«Ûçëé”ýYÁÒQ]›n;v¯æ›”÷°&Eg,Ò?¯›vm¢®.§‘…’%—æ\ÁdL'Ÿ@Šl{õ™,¢M×ømòÈ‚ULs¾õa ±˜5êÙ{ …wbÌ]xûÈËÑ2×rõ/v»:n³¶é›ÚÑqW´d²"CÞeYSØÆ!-`š7…¿F¯í›)q?V‡¯¼Åoòbï…­2ÂÏÕ0qð}^í/–±ñó2¦u6٣Ѡ%ˆ -PïòK0IÊ–‹qYQ*!—rfénßFúâI F~5‚8ò2´ì@½ÞÒ™šXìëS”mz»MC`¾_¤¢Íô˜³hÒba¢@æ7”6&l¼Â“øÕ9oت~­»! 0V4eúŠÿ*(H!o'ó‚éN2Ó ¢~@W8w˜ä(”!×,Z<`mEÈG¹æ;J¯(~¸ç¦_tï[’ÇÛÙ&¼qêœT"Yy ˜eŸ.{(•ët‰y§&ÚU±€>íÔô`£¼zH° ¯ï?Ú“2Û¸?¯(S;l^8DÀ”u•^r’„IØ¡)ôà|×DXèÌOHg8ï/¾úIö¤µæ¦`ýIQQ”³7àÍõ gë5nšÅ~9.åä…µÚ#XRÓ—Ée‚±ãúô½£OEéé¥@Xx,ÞÅþ–‹PLï~tÆñS"Á+«_‰Ü8Ço|zYRH¾†%–7s/GЦY"l¢BÓçâBX©+}ÃËL •Ç/ø©~Ïââc‘‡"¥‘ÏÓiw8§ˆûÓp° æafÈ^î Bü+ãó~¡|߯’uÞ |RñK‡@4IZyì7 ©qñ7,×_,+OÈFM0ÀÊ_pFbjj&`á„&ùë2>Œ¯4Ȫ÷ràë\Ðá²Ì¶‚vT/¡TœË­d–1ÜÆšÌvà-§•øSâÛÍ:ƒ#Æ ·îD|uß+Kú³©¬OЇönpó*ÇíCùÎxååÌf®6ra(É9ÕB$¤TMòÞÄ«ŒLÊgÉѺÊçtoìÉŽ’9…XøuÅW?ý]<Ò~$»ð‘"ŽhB=q³º?z.Üö”ºô'‰hµî¼ë¢ø&žÖ¹ƒý ƒÝÎ'ì#úÓ þühP:­šÉ7º|­ 3Šoм¥åΉÌè_•³Ö#¢~ž«Â R2¨éÃæèëø­\§õ¦ŒT*~‚ÖÃŒšâ5•NN|ÀÆÌÓ^@T£‘uÆ|—ÀÃÛ~2‡µbKeä†ÿ5­€åŠ ÃÜÝH.bËÞÛOÿeèÑŸ R©.  ÁŸÕ^`èsÈ8¿Ç’Æ’3 åT2Ãö×QIÇb A^¨t.Þ<æ[P VûTSÈ3.þ–K¯qâÐÊÑú¢LòÃy.¥ Pc=•ZŒéEŒwYÆl²ÃC˜¨ ô\wòþc'6òÚT¼ä#ÎK4ïA¯4ÁïóLOÞÊ §e‹‡)z¹2è4'u£™^ËϱþÜWDõÝ3=¸'š ·¸¬G.sÇÏ Ö\Öcz}6“/‰L¦1¡«¹7®Aÿþyò%¬á(ÝÝC:™û«ÿ|G? endstream endobj 313 0 obj << /Type /FontDescriptor /FontName /NSPCWB+CMR12 /Flags 4 /FontBBox [-34 -251 988 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 65 /XHeight 431 /CharSet (/A/H/L/M/O/P/a/acute/b/c/comma/e/g/grave/h/i/k/l/n/nine/o/one/r/s/t/three/two/u/v/w/y/zero) /FontFile 312 0 R >> endobj 314 0 obj << /Length1 1517 /Length2 7437 /Length3 0 /Length 8439 /Filter /FlateDecode >> stream xÚ¶T”ß-Lw£„ÔPCJwwwÃÌ ÝÝ¥„ JÒ! ‚”tH—J#]rÑ_ÿ¿o­{׬5óî§ÎÙçÙÏy‡™^K—SÚa Q@ÀÝ9y¸¸E²ê:<‚nn>.nn^ff=¨»äO3³ÄÕ Š€‹ü+@Ör¿·ÉÜïãÔp€Š‡€‡ÀóT„GP„›ÀËÍ-üW ÂU ò„ÚÔ¹*8Ä ‡Yáìã µ³w¿_æ¯G+˜ À#,,Èñ; ƒ¸BÁ 8@änݯ9t`(ÄÝç?%XÅìÝÝE€@///.Ì áj'ÁÆð‚ºÛt nWOˆ àa€ùƒ3@Ïêö‡]aëîr…î NP0îvŸá·¸îè*«4!ð?‚Õþàüy6.ž¿Ëý™ý«þ;#`Î ¸n°…:Aš j\îÞîÜæW ÈÉ qŸòA@Ö÷¿w(Hk@÷ÿ¤çv…:»»q¹A~Qþ*sÊòpY »»áüÚŸÔ¾?vàu„#¼à~[(ÜÆö g >êâQ–û3äÞ„óÍâàææ@\o°=ðWy=gÈo'Ï/ó=ƒ?g„3Àöž$j ¹ÿÁñsyB;þ‹pxx6P°;Àb…ãüSýÞ ±ýß7ßê 0å¾×€û×çï'ó{yÙ àN>ÿ„ÿî/ÐHSMV[çÉŒÿöÉÈ ¼~œ||N^n€0¿@_ðß*óÿ‹ûo«úçÞ¸ÿ)¨ ·E„ÿ pvÑðüS¬N à¿+h î¥ °þ£|3nnðýÏÿ³þ§üÿÉþW•ÿ›òÿwC NN¿Ý¬¿ýÿ7uòù3à^Éî÷S¡Ž¸Ÿ øÿ†Bþ˜duˆ Ôö¿^ewÐýtHÃíœþ>F¨›Ôb£uÛÿ!¡¿ºp_Þ ‡h!Ü ¿î'7÷ÿøîç ìxŸ¸Ý÷ê· r?Nÿ]RFØüš;^§«+ȇû^^¼?žûµxÿV6ÈG¸ß§îél®8¿:úT”þeúù@å¿‘°0þýÚÐæ_ð>úä¹÷Âÿy@Ä¿ ?èú/øtÿ=~Ãÿp{¸ºÞÏüoõÝÿ ÿ¾` ogn w¨ o½¨’¦òâÜŸ`Þ4Lgãô›smó¸"ÀLe«Ì]v=“Nè&ZX—g=•š§»õÛy_‡ÕüB»åÚÿÆ2Igl³gö3YßhÑŽtm/ 65§žÔ–ÿ­‹¿Aˆ#ê{äæW.BZ¤^=ŠÞµ½e_†"§7µ·*ŸªâÞ”s>Ó7 )ždηΙ¢`Àpç¤Áb'9ô&œ<=› ɽ£SIz‚°ûŒïµŸÉ ïóË)ßÅr=^·NJ&J ÔS’¡±Ç~2ß^ªÏø•¼‰#jâä-¸UÉ1ßÁ™U¡gµØ þàç0¢Ú…)·{¶ûØÙ6¸u€uè«Ð*[‡·ea¬èÝ%Þ Ó¦F¤ sQˆLÎ:ü/¦<öTÆŠ3É ÖÁøCÜíKïcŸ?tM{€Ã*b`’[–Àáá­;[ÔÕ~hW ßãúA¨^Ƙؘ`{YkB2Uq¾àú­ ÁvÂŬ®­4 «8K¬­-”$ÏD `¡bñÓ zêk×£¯KÔ•PV7fÆ|LÛRÀGñôzUF«içvŽ.Â9J$仸dI§~·@i¿è ‰‹Hˆ½Ë/»¯NmŸò‡|;c÷^³o]檧QözéŒÿ)Y,WNhúИπü›gæÇ±w·Ê´\77ˆÏ‹Ñú5æê 8n–·?6¶Ç‡qèÕNÑYIJZâú¤g‹AõôŠ˜ÕæŠZYGIJŒ­lú¦ð'G8u§nü‹óàº'yv ‘y}†b‡0Åà¶ ê‰ÕZÂGåÝ–ÒH˜¤½Þ•òP3.y»Ýãuû_³>Åh¹}E…ÙUW¶f÷íÏ{Ëë&d¤œt0Ù%JÙ¾×€Ïd­ÞPÞswgó"ªB˜[-ºF˜”תû_é¿>(@i½Ø²ûJÛ¦µûá6×ò#VÜ·Ôœ®uqÊé8ɬ÷öõ‹$¿XÅþóO±—„âžsœøÂH>ÞJ5aƉ2̇ÍU-S >o«ÇæÇyu4ë=œ¡UÂ/>Íä%ÓèŠÊÛØDÅŸQäLÉ-a‘rúùX¤j7?HY‡QÒ{%*È­à‰´}ËÁñ$Òi±ððTÁ×RÙëÕ§YÛ`©ë­•à Šf±´ÃJ…6óHåªÑ“^ªË§Äcq#n^ô£)J$šìÂêŸÆPªó=eHãOßõ®J°Ù¿„›ØŒ%ÄÈÌ×>‚þlƒçñ¥L“*9ˆ¦Ä»{PKk„ë<܈*- °(Bn!ñJ1–[ªVYÎñIcÐ åD³Í×-žõD“K8<ׯõ?)ÊGX&|\ôðõ= Çœm£$XËÉ j ÚM´¢¦!æ}#ªu#×È—u$åï®þhœú³»ùÇ.}©Ü\A[>g3u¹},‚Qy:Ó;ÇP²jN“ØŽ¬•‚¦.yuãþ8÷ËÁùùzaiR¼5Ë™®¸¤)Eé¶³}¤Â×-©%^ņÆzÝK}aëÁûîô?ü'GìûŸ`²sŒÝÎ Ùû¼ ó1¿&¶ÏÜ£ZtàÐôžˆj<]H×óˆnšoWý ­Àrl¤¬ÿ)Á9¼?8y:µ«ô¶o¼Ñræ¼0J¥¾â™r /[è›Ú5ŒŠ²iu!«C県/Ÿ'_#ôð ÿ˜U4øâS0mD|‰rÍ~e·‚£(Þ¹Àô¼Rù73ÿÄ=Ú%æù6ÇÁ›ì}a†Ùܪƒr‘zoqkçÃ?/èM…¤m8^`Î|˜äÌó³õg½¦m– [5ªþ˜¬­¼W-¾²!·ßÒÚGÅÉ7û)ß°ëIeªÏc‡#dHu(í[1ˆ ¶;ÖT-—£N;ÔOÎæüõåb—2ÞNűï±÷ÎvkyÃÚs«\i·®Æ >éQ>lÓ —z<Àóº0â 94üdW h³8·—ƒnÿ¨ëê€dÓ鉖˜~+äi§Z—VnW}MªÍsTu¶jÝbpŠ:8 ÕY=¨ïûX88´/|ÇÈB…aVÜXšK0ë<²]ž¤" ð¶ ÃÎU01ÄNQ©"zT–5äùÜÄõ|]g¾’Ø %Ö0%aŒP‹œÊÒœ‰õlmâ¤7¹æã–}ÔЈ^ã¾uñâ¾›ém|Ì&jÈ ØBŒxá~8]ÈÕÕF|q¦ã×ÙÁõ¦ÜVîŠE~)#ñà1>ð–»E¡šÁºM,G†î ;…éW-à¤^¾mœMw©f,¨…ìI+HH:k|ׯNMX¾{ =ÓÞ îÝŽ¼S¥P¯Í¶Á±Êhë®Fnòxã¦g|c¯\¸D ‹0·Yì{‡Çÿ€„´âóiÙiBœøÏÂ÷g¹ïFÄuÇ“VŘ_—rÞ\N=zmÅD ”ðm°œË½eqøªL‰ÁÃÝD|ã¿[ïn皟â-b“2¬(dÑлÁ,ú)öx>9â ·¸<[;›VÚœi¡¸Sû´î"ÒñåG¯Ölãd²d'mÃIö[ ‰zÍ“¥†hu¤¦rmÖ†”uPµß[ ÌhÎO\‘;R˜Ò:±ÒèKœ«’F+!~²Ë,]Hp‹(Ýç†ìUOkdP˜[¡h †t…‡ÇÅ8ˆýùY1º)ðÆnQý¥MPì¢Í»a“ÐèN63¯I}?ÊHm¡S¢4}1¨êoÀT÷°4 u)Ji£»#È—:"¬›uÆZF­^¥½e 0§H¤#Nõ.êÔe™ãõÉ;xp8ó8®>Ï»éÞê€üC»Xwzo¯îˆyä@¥ZvòÃâåµÎ„]ÓöŠ+{ÕÌåo/JøYÕzhöS¶+âÒHó¸ŠËȹóœÒ F£›Çk Ê×ÞŸº4ƒ>|1H÷þN¸Ø”’1ÒﺨAXí€pD“Žnh®Ï HŒŠ]êp˜. fMäSU®š½¯ó‚÷¤{ñé½ZÕ_åU$E›ìWþJ§érj–:W±`{!J0–éô(;CðõSK^uqCòǪALþŸgX8[†çÊö%²uªîBÄØ‡Pzgô'\hÍbÕ¹í´wpf¹»O¢uÄ?((3}¯ÛåÝ(9÷Œ^&™¥ÅF~ÏPöÔ~‘AÂY`Qÿ•«“­õ…¸™VvQyJã‘Ûn=9v;^´¤i»]óç_âb~æñbF¾Tøª‘¦ˆ\»ƒÛä16ÓÄ{}pü‘Lî4)Ÿ¬¼Ú`—…dZ2æJx¤£ /Û¯– k§“äÞßá߱Ъ- ²9cêu/[”ûóë{Þ|"lx*¥«ËžPÕ-‰sÊø´G³ê&äÔØŒ HvQ 9\ËC`HÕœ’lÜ O”RRx~ÑÒ% Ý[ O»ü‰ëõمB4iûÈ pêFÓ O1jHhÁó*mža’s4‰·3ŽÍ“T&Ãsö^Íîï*ù’¡Ý]9ÚTŽ+o·#ò°‚šÏŒ}$sVJçÚÕËnPzr®Ï[T*C^sRa¢†4¦IJÖà=sz«hÊ3,+ÊÔ”_‚Q掾ËZ¯=þš'y\ !rIïíq§íèeÓI&xH.JX¹Mk¢àÜ(›tî@¢)ÉDŸ… ­¯ìDsñãø¹˜ëTˆëSM&÷Ù3ºYˆž©¥³À–w,]&I)ŽJ£½«hÀ8AÅ’®“è™JÃÑyX–Ø/Ü–)«Û¢ÞYÝ|úU8|žà:ºŠÒƒ´ýcb5õùl*Zkm„ä¨7Í´V¡]oùÖDÒ´Òú5òÓÎQxíÞ–õVèÔT;¹¼|ÔL×s.9593¹Šâ‡_¥]û‰%ò~õ{6=â³Çö;|zgKÉÜ.°§Q0öp C téÝëbo¢§I9ÈiÍôý3N$d*ˆötåü–CÅ¿ 39Ü-éï³pûü ÞCÿïô ÃÁ*ßœ†ŒÀÈ[¯g¨åÜé¦ ùÎDzFö‰UCœuÙ+Û)žgâôÆøM˜‡´ÙZ–Äڀ׋ïzCb‹÷¾Äîâk5q¥|š<¯\T”}ÕCæT˜"¨ýžÃ‰[Ý ê'Fk–œ˜ˆu¦þ6ýêÛ>ý"o­3L[íxÝfFî= W²ÜL }!Ùû Ê}¬0ôz>DÝsu$¼4¤œVÀ‘¿4C=öŽ2ò1ãÉT¬šÎ ðMqŽC×býAøÕ4®ó‡¬ïå5ï·ºÏ`^„#{%ëƒ8¦ˆìëë)=>uæ&PT5bŽ¢†R<ÂaÇ0iõnìêÙ^´mGâ¼ aµ´›-éçyRƒg*ž§€¹ÎÚq&Ë)ï÷Ïu}}L^½iòÏÊb¯8)"õí\d¤®Ù?cˆûš\ÓaðN5ÌtJ__ô´Lë)öúûÂXJϯ+ŸùS0éÚÈ2"È RŽNiðâ~3bÕ€èù³ÇO½Ï+Ïá8;f¹ë š¦u?>MO½7dëæo“ N ü¶Ø«4©N™¬_ÊfãÞˆ~’×+÷°/fù„2?3ðáJeƱèðÀ¦·œU‹¶—m‰óË6…²/M—eŒ¬*ϤXP>w‹ïËÐÒ[ݱí¶ÛÞ…h°7ž1Ç„1u5p‘Ï﹯'`óû (–|á1!²Y•#>›q’t}ºŒcØÁºÆ"ñ…Ð"%‡Qƒg½´ù¬5?® œ¢èžt8ŠÜ s f6¥t½5Îùˆ”9³­‰Îj¼°‚­–xŠSœ36Î>ËãÖB«E5 ›_É0íÅ%n£3â¨[“ê†KïŸÇ)Pq],Æ?æKF2f‘ÓÇ.ȈcTŸüì[›3'¿‰ù„®(¿ª“sIYÛÁ¸Q/$-›ÔÞU±&É|g¡—5Q÷ÁÁöÇgÈ’1Óiq Ͼ#À© 1Ë)Eº¬†ól"f87güÓWšPïükr¥öGèݱlE ¬Ûy¦Ú†!Ê%Ò°:`-èšwR.ÙÙê"É~Ðéùê ›•–û‘€þá’Ì1Ydµ1ð¼©+Ï BØÛ¥šË«Q{›©¥²3áó3@è$®ž,ñãèWi¥"ñ‘ÅÂáI; ~ëqÒ­º0ÃÚ­´`s†¸[WyϹÍhÆ+Vêyû£üì½N'="£†fáŒ6•˜À´+~™è#—þÒ'é>Ž…¶”ýóì¡{¹•.ôÚÜ]„BµZ:=ŽpOU}†·+“û»ã¡\¥û7PЇ² éØñIü'9¡Sùp!mäwB>Zè]ÃWG„LÎè¸öÍ}…/÷¡gú“‚™ÉaDNê“KQæsJ‰Lïú\äªÖSpûre1@²V[ŸZ<.|&Gq)G×è¬ZDžöŽS§ßŒÐ®BQ(ÁÒÄÜ;øl*ˆreo‡¼–~sX£‹ïbÞ’²:Lb%Üß }B§&Eõ–‘k$| ´Ý\ ¦/Fî@Ë?ä.›aNóJ"ËI§u>¾IVgØ»EÕU!u¡øK1¬JÏ–b›Múiá«õ@º -2o³Ï¼¡ Ü-ÑÕu‘t#@Ýf¸ó«ÙÙç4|õ„±Ižãf:CûÌgj8zœù&RLǼؖ^IjÏMe´cX¶ç¬ƒ®ÿõ—Ÿ/<ò/å'=N•Çhg§çÒ©FþÄ9ˆÜI~‹ÙB6Þ]ÀO>Qrÿ2Ô$û\gL‚t—¹ÅëS¢Ïµ2Éréåùý·2•­ŠÌ:dËBXdŠ#ïúUÁòú[OU¹Òãm¹ÙXÜ•—VÕtkH\ w²é( g&‘Ø©ªØ'+=º¹ª$b˜Ìòùó°Ò7k34Ýê=†qÚ0O¢Öâ Ã+ưÐEøpÉ ƒì`’ÚþñÀ–º‚ÒPªö$k¯.aVí*³îaçÇ—nw±M‚ðÉLp?W ¬õâÈaâk|lsç²Ï6Ñúµ|;Ù­•BÚK3W­……R·ÇÏêÌö:Vú½¦\þ!Œs’Ò™^2š´Y9´yœ‘;6çåß*@îdµ0al¿èż|TUë Õ™b,þˆ>;@%<|'XB ¶ã9ÐÄÍ9€ò®8‚-çÚÌù*ôsÔÖ…cÐÁÅÇóTË&B\u âù{žëb6ö/Š[Tkñ »T†(P Î'hˆ_\:Òø·™õÒÙŠì—ëfÓÍŸœ–Mû½’ÞÀVO%ä$§4L™èd`DÒÄ:c¥ÊÑ'A<ìSŒ³T°Üp¬oŒv‘lB¢4/?• \ê—ÞSv®¤¨°©ßðn+•Í6¤|“òž*z®7.B[øjs¿r£¡åk9ËÛÞži2, ˜á4Á¸é ôGÞ$šÂÜ¢Äâ}l‹ÍJ†?·9§GÍÔ|£{PÄž˜Ÿ®2G=Ì›»á›ü?ö­†ÌÓÅü>;ùNµwô?¯#SK…{‹d‡{õ¸?³½šhÚq0ÿÊöÝ!6õr€•ïêL;;˜Ã"Šÿ²Ží>qúBNêÔ¸šª#‹¤>­gMO’J±¸°`œœì8õYÞYM˜‚óKB^œÛOÚ(ÛpV Ô‰BYÝ´ŽWÍÏ 5‘Ñ×1!+Ç@‚ R&··mÚí;7C¨ Ÿ ="Æê#,TP„\àeHÕzŸkozÌ `žC‘‡†®½|v½&¥¹®s´_#>:2a¥¯2îB€uü¬ÏÖß’¹`‘ÙYyd?žÈ×~¾^*"àÙã…\ÈÄ…Q«g =À>Xû6ݹ±õþìfÿ‡ÛÞP*ÝEÒh?¤~Õ¶§ŸÖ{0áw’Fâ$‚‚*­ Ë›‡î?¬²äZ‹Ù€nûI¦”ăW»­Ð °à^³Ñ1È ª‹y¬KžÂ$ÁË…Œ™]çä¢*º–5±5}Tô™j\¨ 9•™¬õ¬ "ñ#óòb«|­¸ì •#‚ ºö¤¢½ÃWï( fêý[p§•>/â– FŠö•´ßýTD‘ |Ÿ Î$™öÔ¼ãõ«ÅÔ‹® »î7¦j‘Rû‹¤abtLÇÕhž–²^KÄJÁ$þ x{MØ’1.ƒ‡°Qé’aP¼ÞVhõb|تhtqc)€HÔù+°OÉ~¿T=QtÍuèFLr{õ€$1ÓÉ XJ˜W ©­¼d±sgLd?¨ÀœÐ,Á•©*À(dHï'ÛNX•íº9ãÒ×Õú}ð¡¢­yifT‡Å³½p*5⫌•‘S¼óÝòpÈâUJû·ëyuŸê>N4ôCû´{£P£a¾zË(ûíÞÞÇÂï,ú« «­?R(ÓJ„ÊY‹}ËFnØê¬4¡ÿ¾³µcÖAOnt+>Á×C¢º‡•”NÞѪ„‘8_pvºM ‰UkÊå»$ %™Ê¿§gë¾—´ 1Y¿ÝAÞRÚ F*}ü]$ñªo3oîÈŠáDí z3ŸVVcÙ%i#Bî{‡wãP?=¹û®[ôëCuOc‰ ¸ß™œ» )oFðèh5;u" =2ÕÑëbEw£> $•‹ª–ÀKjôÏ/Ãpã¾@°d>$á¡IRsDê]Üdˆ5BëcJ»/ã¦å±èòÐ"Z0ù£¾_IeòÀ•äU YMG i4%a•ò‹ÍH”Ž×0ʬÅÐJç} Ч«ü™æˆz"Ú:þËh$Ñ ø•ˆVë>ñÖ#*7 ×ÓÐö,<ë(Þ§›ãM•½p³C×·fèöD¬ÖqÆPWf¤•ëXÒDïç8þ,ôÉzR©(u<îàACPuj’b5c[ÅuÙܯDîÒGÍ){Ð …7bÉÖu–Ø–›ú“I†Í‰ÇñÛ®Šïv¨AÝuÃ¥ô¿r(ˆÍ°-ιŽÌVHRO³–3žÙË8þlhf<<Øxc¥>êP4-?Éüíˆø«Ügâí®-—ÙOp*Â÷#æ]‰Æè·6†¾óHõóV$£$vl}’àåd[Â(U3‰¯<Ó|AÜxöp• 4aâÜ“áfõ9»wà‘\ÒuÉ£Õš9ÀØa·bÕ[ÙR3Ê®rê”ãÙI=ê:’ÒÃg{8u „¦T äGh 1˙鞃¾ e^Èwré‘1ZÝÀ« ¬â²m4V¯üÜüÓŸmM%ÔÑç¢ :IªÏ‰Ê§…F*ˆÜÎÎx¾hOÌ–CýÉÛ‡çãâ`Œ—åÄ"ã P³ØÚׂôìCv§j®:Qç¶{Kœí]¦*ýú3UM‚(ç„ÌæœP\TB-ž¦oúpQ°Ð~o‰v–L{d9.y!:Dç`%µm—ç}ì–.ÕÌÉð˜¬æK©Uälˆ¶ç†.<â0 y4êUu©:Ô?îgEíG½ßé¸19@‡q+~*1ÝnPs´øN'i«¹„’§EÛ6Ãró"?_·±À㵊–&0ø)m1â\oBìÖ÷ž ¾å¶sO–]'2—ùi6³Âÿ-8f) endstream endobj 315 0 obj << /Type /FontDescriptor /FontName /XOLCQR+CMR17 /Flags 4 /FontBBox [-33 -250 945 749] /Ascent 694 /CapHeight 683 /Descent -195 /ItalicAngle 0 /StemV 53 /XHeight 430 /CharSet (/A/I/c/d/i/n/o/r/t/u) /FontFile 314 0 R >> endobj 316 0 obj << /Length1 2648 /Length2 17008 /Length3 0 /Length 18534 /Filter /FlateDecode >> stream xÚŒ¶eTœÙÒŠOp‡&¸7îî×àÚ¸»kp î®Á]ƒkÜÝ݃C°Û3sÎ$ç»÷Ç]¬oèjhamh6ø;xC€„°Àœã2t2v´°wvbt²°þ+K¦¿hÀ…·5µ³±Ù:;!þŸ˜…#È\y¦[lekçfëõ›ZØš˜þ•Љ‹=“š­…ƒ HZì?V`âo™ÈÀ¹À9@îÆæL9Qõ°ý­dþK ÎÃÇËÞÎ` Näca ÿAôr2tœ]@>^*þ!23L,ŒF 3 [Äßì`1Èô žG w€6<„Ìà_?ÿþ§ ž3;[kßæ7šIYCDIB–îߤÿU‹ˆØ¹¼X€VV3'€ƒ›àó¿Dÿ–à¿éÿ-U4´øOxJÛšÚ¸ÿÉ\¾ÿfâúŸñ þÏöÐþ׃¼x¬Aêß[ dƒ1ÿÿÞ…¿ü­À_,ÿ?¶àÿÆ$ábmý·õMþ_†6Öÿ±¶‹3xIäìÀ«bûM5@ÿì¶ÈÄÂÅæÿj¥ ÁË"lkxnF6ŽÄNî E gcó¿‡ç¿í{°¶°)Ú9Yüu˜ÿÛ”uà 4¶_2Nà¦ý­ì½ŠÛÛ™üµ‰,ìCGGCD xÔXØÙ^Ìà•5¹ÿ=å&F[;gð8C€©#â_­å`0 ÿ%úq˜D~#N“èoÄ`û¸Lâÿ"N €Iâ7b0IÿF`NÙßÌ)÷9å#0§Â¿ˆ‹<ò¿˜Så7b0©þFàÔ~#°?õ7؟ῈìÏÐÆ<ÇÝTÿ•²=:Ûnádõû ØÔè_ÄÌöhdèø‡‘£¡1Èdêü‡˜ý?âà_6æÄV çÿ±çfýWþ€kaü/bclg ’cfûKbcó;·¿¦‡éwR¬à2˜ØY[ÿ3ø†aý&[€þÇ)Ç_zð6þËŽ<=Ö†6°€Ëeú›lajáúí_j;—?Ý‚MÌ~;ëÍþú–‚þ4§cþ;9pÍ=ìÍA¶X€e@pð–@p›­þ€àzýN‚\ë¿–è·\Ý?2_¦L¿]±ƒ¹lÁË÷»`×¶.6F]f„¾è™ì~ æ´ûã338Qûßj°{ðÙöúÏÆüéÿv|w0§ÔÂî!ÑÞÚå$Ào&‡ßA‚+èàbç 21²þÃ,ý£ÌÌàL~3°ÿ…@®T™lîþ0ýë\ 'kC'ó?(À¡ý|³39›;‚þh?8Og7»?€9\~Ï5Øçßï'c;Ç?‹î˜ë\L·?¶ Lêþ{õø‚ íù;f0“'ÈñŸþç®4vqWÚùïÏø"ý/þû ¹ƒŒçìŒy?YÖ}j¿¯&pcØcíãP»}u!aCŒ¶†Üf„ê•ǵ*%`Ë»áJÊS6¨Ò†–ƒ† ‰%æt³âé`|ƒŽŒ%ŽÂXÏ'σüžzâ؇…›’s(ê1(uNZ~«I! :Š®b‡åGt¯µà G@\^P‰ p0GÃý+ðLAÊÚW‰næ{§Ð204I¦«iòJF ©é䣲Ý`v®_…Ýo&Dѹî§f)'OçhË/óŽBÝôE¹TûWôEßïe¡ã}ÉÈù9•°¿F\z‹Å$æNGYÚn¤£tíÝÆgh?ñÌ!§Z"˜º™KÅxfs–÷瘖¢>ÏAŸê²˜1 Û…É‘äÃÉ“&]Ј7;” nm>Á»}µŽÛ•àˆÓÓoÀCÐ|šMrÞ@Eüæ¯*£^¾v ¢G‚u„Vë™6ø`¨]@xêM7A>|ðasÓW\BU›«¹ÕÐ=q›j±`–ǸÊUWëgOÅ^•GHý¸Ü$3]\éGÏ“É?b×qVÝ@áJ¼—¯äüñï„u' ÷ñfò‰]LËЀ*»HQßaY„5nõ©2Ÿž#LKAú´jõ@¼– P{´ÃT!§T Ò î=LÁ˜,SQ/hcêà›¬>‡¾û”Âe06üHPºœE»N[tsX?f$Ãö¦Š;]†,’¨†>ÏÇ®€GAmdÄ…}³7…âq¤êMZSᮓ2Ø@ÒÄ@[DÚHE¸æÝ°ûŽû]*êwEDü‰þp·QÜp&ƵˆŒ(‘â°±ÆT™¨GœíÄž‘ ¡?ûºê"úùöžt^ÝÒ´ˆ›w¤ÎÄ­áL›ú¡æÎ• XõëLEÔ‡*iÝ#;þ¤wÆÝj7LºÓ3ßñ(pUMf¬†dÉS;;ÓÙP/眤ÄåÃ4a7Å! 軞f.¬ìçíïÍØðíyãÕâ ûüoë®üvSªàJ¼ ÙqªšOž ˜$’x´´¨T)éŠÊ± æzÁe¦Á(ddrÚ[äÅ–9 ÃS·¡ÂYµãÓÈ1¢êÞ÷Ô+kêMSZ®»W¡ßé&?ÎÈ‹Þa¹n·÷ k‹8•ôÎ÷5жõ\âòW_éS°RUý“8ú-®Iû“žŒÂA³qR_Lj!£Ã5p;\ëˆðB@¢ú'Æ õòÛ¼‚¢Œ‹ûŸò>z» “þ§ÄpžOÕ æåbXQ‘ÎOaSQõJC‰ŒŸKÒTÎ÷š,OKJ_¯ä;ZÛ 3›^ÊzØá‹Ã¢œÈRù™ò uL;lFÌ#QµG§MVçmŸÞŽ„a\ÕÕ7¨£?qÓÓž“È(ÚŸûó§,åÃãB9Q|¤‡3=Lð?¾Uút9y YŒoרÅx±oµ©ŒŸýÆósKÚ³ï©È¨æõN]Dƒ¼ÒÛD&R´Š§˜«iæ·1QfnZÐú‹ŠÂJ­ºHÂiꬦ‡i•C d÷œÑ%ë†Òä‚j¢ü¡o{š`.µQ¹%e™5®ßëå—àÁ½¹e&;Òy+ø' DLÝi¿Öyr¹ôqûeý~°a3UaåkZ‰;^Z&9CÁ üð¤æÝ1£§0-þ,&T”_ìà¯WãŸÑÕÕbƉ]Uµ»÷ÎË¢7¤ó/Ö© ¢ÍH—ž¿l­šËH°Ô5¨Ã8ø §(Ý eÉ‹4ódÌ?ºO¿<6îz²Á=ßqˉä;è¡ ð}‡ÛöM~Þ¤Ó½ecÏrçÒ¦:­î-_»õ{„©:!_õžy[Ûw†ÅãzÈ.'ûö¤{¢%u¸Š¡¾ Ð2 ×=¬¤ÁKÍÁGôÃ×p è0j©Œ×(ðð5àm/ÌA¯c›¦"Aµ¯ÁËþUј ÷"‡ø~¦løèÖ!ãrµ¯Då¢fÉeö·`bÄ®‹å~ÎÀ¡ó@r ÑÂK@ÕÓ©¼h8õ´MáôÃDoz-Ðó2à¼pÒ&9b²G[Ä¢ö Qµ±®å+–~‘àA´[ƃT'É¡¸\&gTËU6EÃùì ˆõcJÏ,]3['Ì(%ÆÏ××6–îY>ÄFÂe2£á' ßsV a-ã‡Í(²ßåq|tÅS¼ G¼SÓÅŸZU‡õXæhÓ&Nô÷¦ßå‹¶ÛS`ÕŽ¾à’SÕ»º?+?°¢TÓcÂr髽kÞ±ªú…Í>¹ØŠ#“†\ÖyLÚo¸÷H³¿g(6Ò]òèá?¤-´×]1ŠYø½„æ)§`¤cƒÁ†jV´"Ët6mU™ùAO>Uaš^Å}棪)0î7p·~dǬ ᕎ‡qþ²‰ŸûkÓä†ú´¦? þ™ª*÷CZøeiQ€€êQKðUvJ)òœz¹ÝJ¸Âe1K#¼$éC¥7]¤ûC€øÕðxOeb7V½LIþ w@E8°pv©±ßñBIwïc£ç¤gfä‚Ân*ÉmöhgfVÌ•ÀûÄu)1þ*–®#n5úñÒÍn…r8å =BxŒæöYšoÅ~—¤Nm’¹ÞÚÀõ'ºd¦'þÚðÅ#ñͦ·yï>¢}ñ&ÎO0] ¯‡ÊŒ8$[ÈŒÒàÈ`Öûw*×¢*…± ŽÆE¥×ÅUyw_ö® n\€‘µ êŠ` nóí¹wë9šÁúÞ&üfé4“K&íëñsÕÐb$ŸgÏ'Ïà7DÛæ“#’ ô{¥× W”æp…Á°NÁú´Š-ÞÙ&çÖz_”šÕ;†¡¼å]gz“Î…Ø×mÑØŒ÷ß\eÌÌ~\¯›oødklËdòªŒ³>ô5éP¿iö7‰õ™®ÐÙÁú4óóó¾×;[®q ÷ËozhbÉ“š­6l©%÷Ò}5¤n6ÆFo-vrm îgAkF,¤uØ)/Œ,©Ù®$eÔ¤óašèß †¬D?› ¶#Tºx)}¶Ñòè¡:zó\‚awqCì×Hms=}*£ò®äV‰ÄëU‚Øïãl±h2o$IQ–KwÊÓŒJ•Yny³Ê{Z²èØH²ó"fWµÑ˜C˜p-ïÊmßÒlýšZPúh,猔’ -gFÀÂÉʉ¨Á• 4Ûý±_r‚rn2Í/®_ž&ž8=Æ 5`‚p$Ð4‡HZ¤»’›Ø-ÍDkÂÓ¸w2šgd_“$ üª9}ÈA£Æ°}7ÑɔܬՅ&O[ p"c­ŠqÃÛý‚¦KÉ`üýÅè¶Ä™¨5 ¹¿.È0øÃ],O¶ÄÑÉ a<ä·e€bŸN¤Q: GãzqÈdbf’z¾~¶¤#ñÖ$­w½ ›Wi¸–±¨÷-â&k!„Ö´ðÆS5º?bîG j‘ùIWªÓRò}f¤†Ä¾–K‡&ãGb&mÓâýâã<Ä´¾â‰ví$åúAÙ>Ú^Ó=ÈxÑËpvϤóbƒµž€‚ ñÊ\ÜûnG,Ô’Ì}³`óÌD Ñøo«âiw oçûha¼ÁÉË„üÄ® ¸®3½‹­ukŽT g/ØJ$†D/ò㙇^Ó]mO©o¦hÑ ”ŒÄ饑aCX½í3éÙ¶U+~…Ôg;~%øµíµªFtSåø¡ öÍôžb$Yñ"±‚ uôYë2hAȳÀÕ¤³Õt8?墔å›zdžϙ‚ÇB´ Ÿã®qéF‰ Ôëf(Æ AX $ë#:åvŠá3Œ¦eÜénA!@Ä€8WÝ%@bÁt®*™)üɨßÚMúÛ³VÑÖAÑîvÜT¬9õe©Ùšà»¦Õ@Ø1~´ÂWÇ ôÑÕ«æ‚ø+Êf»¶{‹¥ñƒêfLNÖŒõŽòYŽͳ&ÈÝxVV!lGqy<ᆹvÑ(B ÇjËZâ˜ìÜ”¦ñCãu9ƒ‹ÉæÅôV‰[ê "œKÜRÞ¶²þK'–û\öUݾv[ÜÕcöŽyvnå;®´Ÿ;ï4Cüº| £Æ±¾AûÏDP.ùÉKØgcRTש|ª/¹83 Ö/c¢¥¢ÁÝ@ÚN™kåð)ÀVº[½¿ˆú3ëäj½²†­Æ.Þ’Ëó[Ñ—ˆ÷ÇÛ$K‹ˆ|Ôeâ_L‘ç×y«Íד4A‡E1ß]6v}•c’[„ [•N.Ní8çm®Ú—¡¢çœìp¨ã×» V(= æ öÞmçzéÐ~¼àv¸ U¤Àr;"sž'ÒÉ\ðŲ©~¥{¯›wÜ£Î$Kj `7ô¤ý VÏE.lj Ñ€çøZ_Ÿgê0«°Ž%«ëÁ¡€éÔ²±øÃKÇáçÌX¼£(ƒV­k6×êEÜ-”ë‡è{Á+ak—´²õørâÚÆhGj9¥Nˆo‡€þl˜-ç©y„PZéyÍ/ˆñiV0þ0»d«ú—C}­¯Õ´¸„³óA© b “ëÓ ’#üijd0 c0a§è&Ü-õŸùú „œµ6³Q"š»4£ñêö^8“ò!¾e4³vœO2‘ˆDdÂÔã +îô8óúšèóU´wbÏž %ês6¦ˆ|øñi Q¹¤68"ñäÑÌ»F'¹Þc®Äµju“æjè:–ÅÒ1™ý}¨ L)÷â<,\EÖ¡€›—(Vó"Þy:ì—‡Q—¿¶A°~5ö|§é*5)OµHäÊ}DÇÍÉ3ÖwffÂé ʾ1k‚4æõ¿†AˆÒöÌýæô?·ÎÈ >c~JW£î“!——/ñï¸Fò~ÆßW^±Ÿ_j€3,«Ÿµ¹áâË㽇‚CÜ*j7ÿ`“.™Þ)ѯuyÄù4çÊuÌ[ënõ.Í+ú0~Ã|‚¦¶°MŠ¡ÆˆWж O«¡xŸ£9s¯œÔO mnë "×i©Æœš"Aáu&<ˆ=Å!YmàïlCôç¦T.hªˆ‹æ"î¬8<ßEM%yöæô5îW£p¤EKø0gßD¢` ÑÜZd@ŽSñ(å«-ëÓ}Uk'{Ó©|kž ÌÔiKÙqÂú¾mÍäÔOñݹ{H¬Ã:áŽc JØç‹–䄵§xøøj)ÃŽKyÍéO› O6¨C v¬yÁ!OˆÙ$ØW¯µ›7.㼕¯lï?ø¯s—CÑT¤Wô.x†‰j¶­ Þ;OdÙz .”Vã}€DnŽƒø1G1jÇ#˜ƒH’úžA<ÎR„TúŸ½lD¨›hðp¬tÔÀ}´)r‡COÏ›ëÆr7üd©"¤dÝrÕþþ=üIê„‹2`Óæ~ù\ã;šW²Ž™gyZ¿çt€Dí˜íx<#Û"âÜ7õµ½ð·jÖªI¢¤n3Ÿí°q¥êvk{<׸²™“Ó¡RˆCe+_ú`tH?s:º~1øø|ë3éÄe'uº0“=b @û¹ç/[8ñ³#‹áÓaxw×Ãtz¡»yUíäGÍT j!ü<°söÆ+V;i£@9fv}ex‰Ãi;-פƒ)ìÚ5xÍD;«ùnCÞì|²‡yé{ ÂÏ7‡‚㣵vi„nˆPƒ©;‘¾ú.¬žý|/w™ ˜8¡Ü†cU ‘*‹ß©„iö0KTljxã ÕÝÊcªáHY?öéÄd èì OÚ[ª åöâ’Èõù5°òy•“™9]ï{¸ë`À–¬ƒÚH6øuY¤´7ÊŸEèöS Ò½Ša¿ 7üM§³g£¯;Í3å ;j(Ž 6±`ë{ýr¢÷nXÂôÐÕÒµ×Kê;„@b«Ih¢7f)÷’ÁJr"HvϦ»‚”ÅI÷¼²º’~•ÌŠº$¿.çFP,m(.­ZñT‹ô&†²„˜Õh„r‰‡>m‹•µât_«‘:¦PfKÂÜÑÐبò,Éq´¾Ž²²'³.Ç$L¦†^wzÔhÛ‹8(´ Å8¬Ù嬶;÷çìÃD!ƒ;:næ^Fq­g•+‰^µ§¥¶J2Ï ß´¨tf=F)à7·¨£ø§Ì9¨(¼•ê¸;¾¾ùÚ>ÿˆEc õd+¿Ras†UF:ò1}ê9†Îž4·‘œÚˆÃ÷ ëáì$ÉE–®¬„Ëv¹†º+"Ý]âµuÛø|^uK’…¢f0Qºe¡Ïú<³oäÁµ‚)³ÞÅÛE>R¿ÈÒ hJ±Fó4]ñ~JØzùÅ€mJãÄ`ñ på§è§kÉx¢S€¢Ò#µš.AË¿Û>4M}âšóA–;¾þ´,+Eø.’¹&sÛ«ÆB·]90Pÿ’.†q“g´ÌŸôñÍ¥)|!&;;â°ç÷¢n„§·³«(W*;ˆ\ñáPçt¬õJñl£xfFµ^PŸËUæ.è…'~©# ?–ŠÞU,]N@CË?,‹íñ|3Tº“X!”_ªz²?²á¨JÌUûu®{þ­¥º=*#–íØ#q‰Çf‚—<Æ×²}'¹Ðn¢n츓›÷‹²E»$“šK-ljYï§ i¥)‹cƒ2JOŸÊ¯:/AÒú’ŒèüÓÆM,·¶Ö¶ÜÉ“ª´L¶ç¯àX¿ÂòjB!ù®,¥˜ÜØö$^¶XÎ)ý ƒ\OK$)Û2Ö”NAÕh Ëš|s¸¸¢®Ï5;,)y…RÂgÒ–P¯5Q¯fº¶ñ¾B_V#ý=-£­ÊG9MâÍjÙ&óúl<OŒ“¡K¶ÐâSRMþÅ i%׎ìf^6 ÖA ­žÎò¤ÚŶ¹ª°c˜ŽŒ7L/:²çëçèÓ6ø7õW*2*Å~¾‘Ž žÐèYÔ*“Tä¤ÔܼYüýÃd@ ³_ÇÓ`;k˜ Á¨§¬·ôãÏg8Ü6ÝQèMò^„®½(ý˜v1Y-q¿SZ…®é|Ï÷NMDö«þˆ«ôJ–¢ŠSÉíxúÚ«‹è©ôK>ü<|ß·øØ…U!-(Ni²5°[oí›F¢"¼mê=GÂÀ³’<|â æ²…a!<:wXò+¼Âê÷~—M+–5ÇÑæ¨Wlj’‰}vÔühFîð1=‘”kE7öIEŒ˜/dµÁÀ»;=•m~ôÛ¡‡z†@¶]R?Ñi½ªûí¬) W'•ù[½—dö'ùk^wI¥ÊýàNEÛ¶ÍÕCÿéêx!²W½7š™ÈŸH\àŠzÒΉ¡µ<ñI¦óBsî!] tå—º‘šCMš_s?×waeˆ|]R4Ô$z¥/vÇÚË8¼Ù>–è ƒöPfß<о938—h©p_ñ…mW^¾²95íéŽA ÇÐ#šÄ¦„Y>¨›˜Íí¯tóêpJ¹§]TVÙâdzô‘¿£ljø<óÌo[Ùñ3òçMêe BemžÜj_eXND4µŠâÕcÿÄÕD©-Ò%E¢ñ¼~æ¯ç†ÜmVŸG¬"ZçMZÇ%åæú æ<õr@ƒÇHI¹©8AТ'3¬¯h§í¢^ S6þ4Î’V2¨ðþ ’ê¨Uýù|_ù1æ ¨r¬rÆ.#U>oP¤-”äfVÉO¼ŽÕ¦´9Ò ƒ’ Vq…ž#³(=Ø€ù2~ŠYe©Œ‹9Ôbz“2nÓ^’Ú»Jú]5ªOP“_ÿ—ºq-¨R Ü‹Ã_X­­Ÿëž¼V ¸¦¯‡ ̨K í/÷ ¥Lc­×(šÉñd ƒ 4.É ±ï5±ãºóÏηÚï’ì–Yù;"]V™‚¹/©½ ä*w§¸ã?å¶Â©Ï%pgâÜ{§Ù;vŽ#€: éU)¤i¶ƒu¢À¦AË»ñ\ÏŸ¡Ïí‚ãÌî´Ø¼ûWu—ÄHšižs{ßÂÜFt¹ç$}¢®(ä2²àÒˆf‡eß×Jè_ɰ§žö a)J ÚWÙ eƒ/I;Ûm¯j¯÷‰Ì팊GÊá}‚åÊÃ7È/´Íª5:ûf›|T‹§Zx´–¸Äi/µN°÷q7«âOžZ8¼TªbKÎA‰ä†<þ ¡HmÔ„-Õvº Q C.L £=ó;)ÏGX§¤tJùÈ“*¾•ýt’çä‹N a˜>J¸,u­ò²ùr¯~®”»’Bé$Ò}}»‹[ð¢$½f>g aÉÜ2‡MÆø}Ú#¿½æäØGhíÐf:÷hc­þ!ÛŽt9ïhAŒ~)Y.ò|OÖ{wËñócJŸ¸ÈÑ)˜>ûô…ðí5¼BiZzó{%àa'9«ÿà<é^v»îg:z´oGÏ%™ÍÞ} uË>FZ}öÛBÊC ê´lø ¼÷V…QbH½ ;L<_/!¸¯qXbyyo×ò¤)é-ì 4D’žÐø¹M¾{sYÿ0bè3Ô„ù~nÂã§çã§¶˜ëÖ¦›|*ÆËœ²Ú®ô|à§1,²‘4 ™p WÖ}R>4Qò[&Ò f@vÉ6ÜÕöA7IvÔÙ¯kÁõrŸ7WIñ¢Qîª*L'’ WËO™å¾â¡×ÛØj†@Øö1Sa×Üfx¬eˆ5ë±í-t°a tb€ºÎo`µ+]Ô\{1sÅ"Îk•ýׯNHе#ÐïZƒzhŠ´òeõL^Iô½O\Pb¿hþøÐÆ‚¹üÖÉ£á3R‘ƒP=C>Óþ/æáD×LŠNuxߢÇ. _Y>ˆ ïF!5*#Ïc†#ƒ\ÑÛ/*ô>î4 X€^ØTë¨.¡‹áZ]W§ºáx:4n>MÂÉTI»<‡´\îbÓÇÑÜ ¾›Œjé¹Ï([r¼Ü-š5T¥[j5¯ Ä ×9ºñ¹¾ÃÀ™˜-./=’&ÎÕ‚ààÉL¹´ñfl´­A,æÉXo^un)”†0ô …†ñ²/Ÿ‰rïöÖZÌ·mÙdsbíT”šIW#+¸®p¨húÃŽ{ų¥áEÁUtaê‹^¡²î­3õžÄv¢†è*ÐÑ?p/MN<ØW )±9¾Ñä1g ‹íPMyÚ*j§{Pf’_€2ž¤­­È1À +Qÿ‹¸pc¥þB A0Øugî/–q-|^–[VÐÏ^ûeÊ[¢6¢ Œ5B÷é0ŠžLÔړן íIƬ¾:ÁÇ`wâN}K³OE&úú´6@ÑAû¸ Bì, óTQ.ÝëTf€c²‹ÚÓ‘í< N`HÕp˜¢ölß"¯ÑP„ Èݽ»<<Ïçb,gKŸn͘š gÀ*IøûYí(ª–kkÓÇÛÓå²ÖŸ‰µÞ"–<œOèÆÌ1¤‹ÑŠt”#,„IŸ¢¾ˆYág¼„z»1²‚Ù=Ç~ 01Ä =ž e(Cˆûº})XCÆE\y¤¾]þeHPŸuý1ɾ9õÓç*¡Ð;²_Óe{Å&LRå3CjÀ¤ó醱G’xxÓ¢Á¼÷‘IÞ7³“uÝ2ÆÖ˜ÆBÐ7†ÅÀXºx\ÎÑêЯ‡Ü³ž4Sƒ0#Ë -¤‰}HC¨ôœ 3Ö´Dµk+o*>ª¶Y¤„è<á&Dç|-3Á¡½÷ˉA°QÜ6”ï8ý­¡Ã¯+yDÁâïƒåý Z^¿‘l÷b™©³âL™Á@é¹Ë[ÁÕü6”³Q‰é;¥{禾Øјç‚јËèCÓO]Í‘ìÙ¯ «•P¨¿``‚„øYr¥â:DCGÑ i]—.ZŒZv~iÂX-ð¶ëÀlv©!öU°°…²‹Sˆä%k‘1­ «G5&äK^@©ïPœÅŒ\±&½ÛSWd©ÈEîFúÙn¢ÆÁ)a¸ðC a”ŠNQ¡—Ì›a C¸á@Ðãõ2%( fñÂS´BœDrLíç;ÀO;<"c{ÞÖkÇû7Ù³X¦è3BwvÏ4]¸úùõ„c`Jß¹ÓÉKÁuo£zi§%ÎøCEQ4 D“¼šÈMó³M·ŽÍ6F1uˤAºò ÔCBÞâ¶bbg®½B—Ö¡¡ ÿ á!aÈ#À§” ü\Ès¶æw_?|ã#^Þ„Ç­Ñ p:g"ZÅÕ‹É\tÁÚ.»ÎîÃXUï­`>Íñ430áÌh"`ŒvsKÚ¸÷ÊÐ[§ñÊ=ïº}°àÅûÙdy¨Ô±}ðˆ/º¯2µ:ôxÔ=e«‘ªa;Ò¡ùÜN±¤ƒåý>ü³„Ù‹Tù,Unß3GO.[æqçìÞDB;$,Üè­£{,;‡Š¢·D ³‰óœªåK£Þ¯¬bŠNeî×ÍR )÷ö¯b KÙräSLò¢!+”ãjÌ^¹‡Ùo™é*Ë/5ö­u‡Hž}ÞBÈPTJÍà£ã–¶ïÍÐ[j]ÌpŒë·nÒüíiR:DÉæ7¹ölŽß~Te©·®t(ôqSðÎÍxGUÏWÂc_ì×^f„q\Í Ãâ]?—ÐbÕâo£¾oFØÃì]DŽ8¤d¾¦¸¼þʇ+ë8eî4$]MÆ@3£Ø³É[îO‚’’íæ)ßMðúÖv!ÙŸ©îŸî²¼øGý¼{ð?nðI“â¶V>z¬µÛå°A…ñḭïú—±C2ȯ}B¨7=äÊE®þìõ.‹ßúZh6_ âGBz¿1XN)­ÞŠázA÷òÓ|óÌùúþyfCDÁ É0Ïßsåº|ÞžN½Ö,)Û-·…íB!ð1v*h®X?i-…tŒÊL²C ÿ YФŠÀŸù(U†BÈq·@ÈÍXîUnF€4‰ò«"túL½€®ñг[1;7Íè­“2^zÝ‚_ f.eô†yé,yKõÐÛ°jt—Æ5›vw?üî™ôE‚9Ò†²+U·VnX‘å;_ô¢~Lj%ät=4±Âä|4®Ž¼ïný?òó³¿ò£³¯ Ã6µ•FÊ®lš#dqÑ8fˆ£¨¥ÈœÀ‹l…M]a6hêà6çãÕ´àaè®FîÊÒâeŸr67|2ŸÃnª¦ÁOVˆ#Û¦#¦é™Ž žy× Uà±ó¨PÇK4- HVg·`|Èìæµäœàµ_ˆØ¨n‰Æ{«‡å:9÷Ý3SÚvb©ÂË’7¾}Ð.‡Ï»w==@yªylþÚ×·Œ¼Ì ôëèøÜ/Ô ôèŒù™ŸL.ð5¿ASÜs®Öÿçž¾-s‚X ’¶¢ Áûo†ûVæ<=NÒr+ônERĨrì¯swçxÕô)ƒ®–#)ðk?÷oTQöîU8;ü¤ýšŠ!ÕÝÜ]ép2 £ƒz¦0Q ÄpÖ"§…Ê‘w~QÛ‰œ¦¨&½- qp€!÷¿Åôž©Œé7oöÈ1{¯fÿ+7ÜQ7‰Ñ¿“=³Í»ÎòÍÎÍ>©‰O”´²ÄŠr SÏF¢½ŸZçU¢ 2Á'³¾p „¤AŃWgîRºc~hEÐbQr¹œIJÀˆó A–>sK¶ 2“„´ÿþ°êY ßÄ­¥ù )°V¨hÇ®’€•ýX¶ì© Ó²ç¼æ ýyÞpöÚ~±ãc0®ÎPôàÇÇ¡^”®^%š—î¼”JúÝq±•A7¯å]î:üŽf¿8—Wú›„±p&?v-J3ú¶:»”+ÅÞÊNÎWùyƤdÙ/Þºº$)tcbVùúØ?6 ¤/ VYÔ) ú†#ùëWD—T¦¹xš¯¨v82Îàˆ ßaýöVÃVã¹âîѾ_4ö|SºÅLykbÏíªÕç‰âM4+€+hð¡ksi~¤¿Û«µ$sJv¯6±.œŠŸv( ¾ôA­×QÞ~)ïþÊ›0T™Ý~]Ú(AÙ«qUÆ›0ãG €0¤LOh”™”‹ðvñÏù©ŸkƒmÖ‘Ú½Å9]4,Á lx‹Öžœˆn„I(¯ÌFGÛK¾ ÐÈ?Du©Yœò6µ;g©4øO•=’ýJ=&ˆýÅ‘Ñð²d½•Ci½[M´àYèŸÙBIzŠOΤGÀ™ûd˜ù¹¬³Ë°7FWî¦yeAýK´*Ä·ŸI¼ìa †Ü0ÚSGcjÙkÐôÅ ²ªz»Þ1®8ŸÚýÒ¿ «e®ƒVô3 Mq„'È+ø”öX'„§:IóúöÔIÌz+’ˉœÞ/ˆ_å£2IÌýü®ê9uÌtè ¶Õù’*ÜûQé ÌS¢s_K‹] ZlÓDž³)+g.ݯIF Pa %nWlùO"c{°"°x_¾½ ¬ äÓc†£ÉzBGʰ ÃÈ,q±ˆ\C·Q/Ã¥Ÿu‘¯©2F¿®>ÑuÏßÀ(uIÔjÞ5[Ãk?E5_èçnöºË×bø„Ì1Yµ’ZªPò© Ï`KÝd;ìÁÕVg–vXŽqfEPbî ]—ˆÑGp5G°áا`$õA¿@Eq‡_T R4ØÅqI°´4ðÅAU~Šcÿv‡×Ö3#ùåzÒIy1{ä>¥†ê±.)žË ö¬€Ô¼øž+Ào%ô²OʲÄÈa\‡—Å=癊Ǣ8ÙÇàÑlbäÍ4š/€ÃxÓô†X;™Žhæb ‚ek–D«ý“;i^NCÖ¥vÔ¢hÅ>ÏF ®IëÝ¥ü*èºÕMyY·D"þÒÂ/ˆJf2‘{–ŸÈóFïK‡¨2†‘(¢áè­ÝÛJz2—‘˜©æò­6–-ÜATý¤’Á1©Oè§²”¦QýßT~Û_дî]øà¯Î"€ŒÕ%X¤Þus” ìë—ÜÉÊÜK)‘œ ewÊv~oºdÅ›IùÆÚñø†hd—(¨/ÌBþg‘#Ë—²y`ØM7y£ÄØå°¾ÚÌzUsxS¼Ñϲ¥o4)pLô[‡¬öõ–ÜäS4PëIÜã42!6D³^‰Øn= #0–:5^F!nŠÅf’$<òPÆx ›¡ù¾ÚÎrÛ¯Žë—Î%Ùö´¿¥Ä|èaèø1h¢¥Ä:––„CÎ2{ ”(µ2XðÞàâxÌsâq­€új×ø¡€#t”H%S/׬<'_›Ð}óëÅ'ÿmã”/ç…•ÂŒ%Ò <¥ß_Gñå­¨_ ,¼| .Åœ¹¼á8•©ß"pÉ4U¾+m·Éýôi¿ê`9“;ELÝ‹$<ñÊqÔOG^¡&6j˜ús¶£´øvMå䋪ÚÄ=f0œCz0# VTÞ%žùô·3nM¬¼PwÌ\éÞŸÍ.™®—+kŠüDÚé_¾Ð‰Î#ôoCâx!Du˜KG¦¼˜à™pÌTÍ2—^ލÖ*°‹n®ba2-ë[}R‚„·»¢f§žC$Cf¯ÝMVh#P-¥¾Êov‘4?@ˆ-J¿àí¡§)Äc±²>݈#:·n‰Ì20u¿MHžB4é5òB[Á¡y¿Ÿ°æšUB¼8T'>ø®Ÿ3|"UGº/÷e;œ\ø-Ì·ôJß°Ù¬Ú ý­øŸ#ôÊ¢ þzÂs‹tòé[[¿J¤1`L)%* <•¹ìÞ}ÿ²»õýÙð¹‡2©*<ÃFgñMéŽÅE[WSæ/¯TÅ*gf³µ´k¦4x$Cw|Ò§xdÎI›ÏÁÛE¤îÕ²¨³l‹Ûêο†Ž4‡‰3 ÔòÞ+bóØÕ³í;¼s±:ô \æ§H^ DÜ&nFr”|ÅÖr&ȳêN'·V¤‹{¨þí|ˆÐ£Üž2³½"; ¶‡J·½i켜Ï]U4âB³Šž +âÞ6`oºL¼ïÕ¯ê>D÷¼½|whR±‹j¡ÖÃâì×É„Ä(Zžwv?/~/¶l’ÿP†’j ™?@‘•tâíš/lȺ‡E’ LEO•¿`çÀ >ÞÐbø0ÆÚ¬|3®7ç vEò\¯E‘˜¨H·î¯5¯…e¨rß‘×$ià×›¾QÛ¾âz—‰°h™]õ–µU …€(çèeðÝl0ëk‰,UЩ÷À¯‰©ÉH–‡}¶-=‰i‰‹i“Í®LHf·DiEB,7ܦ‹¯5¥ènfqîók‚¬i~Ï“HAæêÏ š3¶öŽö¯ <ø†D’˜†¬ «ÝjVfàqUÉÓ£HDSa Öì¸!·ÓGUMx8öåñôxÎ,]7¼¶tý‰Ðª}Œ¦Þ¦žd*|*¢íkßyA ±Ètqu¶“CÉyJ?øcqž±›´ UœÅq ñˆ9ÚƒTC¯³wuì±÷b3q¹e|ÐVf±#>ÝÃn…÷ÿŒàÄÜ þŒ2}"/tÚ€`f7ãú†œ1µUÓÈïa-O?‚ÈRâæKzr÷˜û]{-VÚÄ:ÄDBÞió¶‘6Mñ¡ƒ þw­#hÔ™iaJ,mOÁö‘.*'¬£UÀ$ÍÞ'}ÂTßÈäÂü/–,5‡»D?âïÒÑXQÅj×VçUø<œFÔrõ;ÛR…êglX§ˆáå›ö±4"s)Α ŸB†°˜Î¢L~¹6%c`òw:sr$2»A ¥|ª&®ªSV‘vñ¼¶ãF‰]–™Þl7Ñ@¤Ã%=ÉË&X{ˆøäuù3„Hú =×G¦Þ¿ŸŠ^ÂísúßC'jõ$‚'†#«Àåb(1æâ™Ì'è›W#_±bÌ8ºCݳ҇–ê7v‚_Üx‰1–˜ Ù»Z:û(mPöðOq¡’w‰ŸËú=v Dm½nû'M‘‡ý°jëô¶Îh8c·?ž¾uÈiµãûLÁœX;’™& ù´Ä© ƒ\] ùaˆ–[zKã2˜xŠ|Gg^÷M®AxÒª¬¼QæsvT2—ûZF÷R˜É|žZYû…ÝbÉÛc;ÒcMr¢èÃd‰QÊ¥“K+è~³0&4ËæA¯ì<–\~¯¹Šîˆr¹ÃL1QEH§oìöK†½P ïz¿6EX«Ý¥Äý|d…¶Xåÿ:zK™GY=ذ"A°7)x4þ\ÃýÖtîñðÍ{1˜ØùÄìÆ ](=N+õ ÔÕ&•·I2væ·Y‚þL×áøÝÐb A‚Ÿ%‰!ür\æà¾å¸¯QÀ(9@9z|‘}øLN¡œÝœðÐ…ʽ gµÁ=xñ™…H‘¡Ê4å¼}çÀ€:Ó^IvW.kĹy§Ç¾<¥nŽûë—·îyõH±ƒ§íö$8X‘¾=}ÆE7 EüÍê N.KÎiŸÔ^ê`Nå¸î½=ÇR‡}x‘ñJº“¾(˜Áïê÷ï¤Ûߘ3ZÆT¶O·•U!P(æ/c(’ìÓ›‹¼9|±†æ“ÇêK¬Fñ+\ÂÀîSÞÅÊ£w”~„:§÷q]ÎëUà*5Óo ´§¢8èüÂÛñQ5N5}Ò0®eª׆¹[¸–†©¯ÄUZ/éÚ§!DÓVëÕÑßán=² ÁpÒd¸·"ã5Ä,g R½ÀU@X²2ÍVfЭ=bÆÀº)fGô¼ˆt0mט¢89J&¾Òq#HaŽu­J<Œqö…ÚÇõCSK¿ò:“ó,¢þœùÓ†Ÿè·™‡5\_^™‡—ýKžëZ³âÚ²$Er¬Ã+­ÛÔ×þ.åQüY«ÝQäøè+Ÿé*7c¨mÕz”¸E¿šÏÜç÷¨Õ¢³HÕûÌ%Ú:£š8æCw[Ã)*P[#Ê|íÒ_2ƒ¬øL…tƜDŽôoDa)+vœáËÉ@q“ñ¬y4‚Öñ’o2‡Ä1É·?FêQ*…Ù1m“ù:Ýcw›éäøÆRL5#Þ_Ή8v²ÓúC/}þ˜çwÐ$Ç´TÁìWcæt]É–î}óÒÜÝ¡Õd^¥,m¨â«8¥Ÿ™#êk2Óß±yÔɆ„r—µwéå'ò…Të¤-òV/ˆ(Ñ7ç&ƒâUõÕ­è~ÝÃc:‡×ijñRÏ{À1ˆFÆbÙ/r†zV­©Àä¡É¨m>¯GÑ ‰œuPñ󭆆pj?gq&¡Ô8ïòE„aG}+=ßÃg ÓS±ï%xƨd‹áæ- •úÌ¢™³B¥ àÐ5$Ç}/c2JÛ”Ù÷BEìS1Ÿòj/Âtñ#G`#ûµ€Põ*åÃÙ˜üÌŒéYÇF<¤ºš® 4¯GJ[8¢¬…Ozº1úë|$K\­‚A¼òhvuB­Šo2:HmþlÁZ—82ù4¹ÚžÞ 3¥Î¯ue§'Ž )¹…= Z©Yh¥Ÿò–+ùRžº#lÍRôàç-ÅRŽ®A˜d×úßà}ªZ]ÌéQdÍw&Ÿцh ñt†¸7YË6TS+~gÕoÒ’Ö* Iz‘D¿ -¼õàL|›L0¶±ÒÑO 2ò&««S@èKž ±&¡5Ô¢£Úx¤Ý[™lÉ€þù! ðödßÇ¡‰%éP¬âɼªÖí“ëöêzHøŠEæÄ­ý{ª‰¦Ô5šcXá”_a$K]QRQ2©jlŦ¸y$/\º÷Ý|n8|À¸¹nŒ­úùŒ *·ÎËVnÅRÏ­i\v·ý|±=]L¶Š89¢H]Bkúo¥¡o¿F‘X›Ñuˆj%3À4òÁ®…ÐÅŸº.«Ë¼á(˜œF·Õy‹–bps€» ƒhM p0‹G{W$G[8ºûðs{üÀœéX¯ªËLåÿ¥µM]¤¼§ƒôxÝ $ñÇY G\ K*×ó.,ÒÐqÍ&×RœQçRJ…ýjþ“çÎñ½H„í˜ï9•ZØRýUý79í,JI=‚ãÞþžˆþQïq’û—½ú‡1g†“NW2èÅ8S²Œ å.¥]Ü¥Ð?’%fi¨h,ŠkcΆ]0´Õ#7À¿àcA`È)·"g =æl³K."Åö] ‚v‡‚ ¿ MàÅ;*x™@¥ò®¤wŠÏÚ9PI«ê]oyÒT4úÔãUâcùxA &aqóÕŸ›éJmOWµé@4£T"âk’ÐY-8…ÿK3ì“L¶§t`ý&ØVjGT+·é"ÁµKTx5NùTc…4dôØ)ÙNˆcRxA²ÜY‰Ú8kWs§³Õp®1\"F½Ë˜$ì0Ö9ÉÎp›}ÂJvÐÄèc× «>rógw²Î¹¥¶³8ÉØ(^nÏ#ž½ŽQŽƒ¦ª@H#Ê¿äxþÀYˆBgn7Ÿ¶ï¾Ý%÷£µÏ{Åd³ÃI®Ô§Û„UOÒŽðu#•JèïÅÁÿjFËêÉôPWgúýF†Ym¯¢}w]s¤ƒµ÷D¨yÿÆrÀÕKpω÷ÈX4F÷Râ+‡NÊd¬A.g<__uÂã»!ƒO‘›mØäºßv×W {ðh?;b=—OKõ_ë²\å•9ñÞfk%Më´½P˜Óâzb¯–º?bÄ@¸vµù{ÉÁ^•çlòµ “8=÷’ÍjË¢O¾ƒÁ>¥Wï‡íeC¿W–™\ÓÚ©+L(Ñ!¸t“Dƒãïåé-À’a 7bÅ}þ·}7m˜ü´IRìm.Í©Sæ_ÍÇ9v†Ãu÷36ê)… g[}ÞÊÓ·BdAÛð³Â9Ÿ ÍrÝQÊi¡Ç“Tuj) ¢ß­~ZSj˜¤\j1Z[¨b;⦧œb-µi‡ø³ÚR#׃TXöÈ þ2Ò¯B…"{=ÑWÿO‚}ùQî@ÿ0(,‰§6üÈÛËôãÛPQ‹ PΤ¾ÄÈšuõ僙'›“#Lé Ë}Û€}ê.ádT-*‘» PƒÈ¥ÙHuÐï”<šHç¼^-­« N]ýʇ³^éÉboÆ@Y%ÝRù óWxu‹˜\v‡È._Kz$O¯ônE\ÿWÆ´¿ÑB ²a53X:_7c²f º·bÖ´–z 2ßy%¸Œ.&}agOž| ºô|î¦ ¿•Ê•¤e¯A¿j•íM}Jß\×å£#‡Îôµ¼¹(Þ[µ úĉ(¼¡YÑoúíbÝšG>^ ÊvÚ“@šP]¡.$\%ûÉ÷bÎ#íÂà8„ ç›à‰·¬¡âh¾²>&l‡¸²Oì½(•«YUû>t‹ _œÛ2H°¡0K¨'³ZdÖvÎðK3z…{þZȈørGÒÁ¨8‹‹ÒÔþ’Úöñ㤘U÷6®UfîÆx㊪;±?ï8±«ô3¨èX!5ÜS‹¡y»˜”ºA0y\å`:©­ýóÝŸìH™ŸÏfxß¼mqïðñ˜s—6«šìP‰¾X˜Â“&­| Ê3jO”®bô)­°<Ä Ì5FO\‘$\ÀMÊ9Rª­P-õÔ#þ~Ü{†€âïî®Éøâ“3Gxœpƒrþíì Lî5N}<òȹ|!™ÇuaHð\ªuÎYD–Ö¥k Æ?–…íÞÕÔÛíãŒXÔM V(P‘œŒŽéä—)„' §¥œñ¹nNy^JiÏ"}’—çµE"vCÍØ “,Îùë”ÜxÑõ\\EZpcmÃ[ yÏ& µô)ì ‘I§ŗÁ_ßÛz î£yѱÅ) Ùw*^à^í¬‘Ðj“_œÜ7ä[Ë—Üâô¢Ø¦KI8ö’‚³3‹YúÓéåÚ>eNìø’2³KØÑ¦l(òh»)Ò;íá¿g,?éã¼ð#7tT›Ò°+có 7CE¾?•¦ñª°{ðàA%:Òþb ¨)÷6£ljW‘èw Ú=éèûx© ºn°W.ðm½ÑŠJ¹Ñˆ„sZj‚˜…Œ.à—G}Sbg Û3î’À Åe •èŠ6»Ç:ZØM¨0…E]ÛÓÙ dÀ€âúès!(™ôµý$LîtLëw*am½0‹év ¦Ù—Òûô1¦®FS‘ˆú¸¶¬®¿è/ŒÏ* è÷Ù¹¢’8ø¿Âý‚`ÏÆÍ F²ßÀ{ö³¾ÜGáÑ¬ÊÆ¸˜RÆ—+p¶8H¸‰î8‹yÏ’¼Üßþ%È» }?)Y™O'¯>£3 Yôçë› ðKßO–KgÁ<…Á‚WÕ’¿ï<€ʘ©s”ªí¨R+мS9Õ)×JvsÆÑ|=ÚÙ)5ùÍÀ^ñWÁ¥öUààÃVæ ½`«ðž‰ °IA 1³ýº ÕOµ?ø—hâW±RÀFÉPþ¤àî–tÐ. Ò3ö" rÛ;äç¹Ï{Q=•QÐÝr4¿%2@1â¿{­÷庣:Ò&lÚ»ŒHúE¤]: ô0D,Œ ms·BsNAq ¦Á«÷mK”þì¬i`ÇÑ;–H¿Äo”ù`DF endstream endobj 317 0 obj << /Type /FontDescriptor /FontName /RWBQFL+CMSLTT10 /Flags 4 /FontBBox [-20 -233 617 696] /Ascent 611 /CapHeight 611 /Descent -222 /ItalicAngle -9 /StemV 69 /XHeight 431 /CharSet (/A/B/C/D/E/F/I/L/M/N/O/R/S/T/U/V/a/ampersand/asterisk/b/bar/braceleft/braceright/bracketleft/bracketright/c/colon/comma/d/dollar/e/eight/equal/exclam/f/five/four/g/greater/h/hyphen/i/j/k/l/less/m/n/nine/numbersign/o/one/p/parenleft/parenright/period/plus/q/quotedbl/r/s/seven/six/slash/t/three/two/u/underscore/v/w/x/y/z/zero) /FontFile 316 0 R >> endobj 318 0 obj << /Length1 1392 /Length2 5960 /Length3 0 /Length 6901 /Filter /FlateDecode >> stream xÚwT”íÖ6R H‡ÀC7 ‚¤tK× 1ÌÐ% ‚ Ý’JI Hƒ ˆ’R"Ýâ7úúžsÞóÿk}ßšµfž{ïkï}_{ïëYkX´õxdmáÖ%8 ÉÃÏ ’ä5ôôøA$È  à±°èC‘οíx,w“ø„¼;ŒDÙÀHPT=œ~A€_D‚_T@ ñ¿pw @ì µ4xU8 ‚Àc‘‡»ú¸Cí¨:?ì6¿¸¸(÷ïp@Öâµà 0Ò₪hvôà6PÒç)Ø¥HW >>///^° ‚în/ÍÁ xA‘€.q÷„Ø¿(š`Èj¼x,€¾ñ—Cn‡ô»C”Áj!P!0[ˆ;€ª詨Z®Ø_`õ¿ÜÀŸæü¼üÿJ÷'úW"(ìw0ØÆîâ †ù@aö€Ôh)©ó"½‘Üfû vFÀQñ`O0Ôlü¾:P’ÕÀ(†ø!lÜ¡®H/êü‹#߯4¨6+Âlåá..÷ë~ Pwˆ ªï>|†ëƒ{Áüþ>ÙAa¶v¿hØz¸ò=†AÝ< * 0(Þ¿mö$ Ä@‚Ä €xÛ8ðý* ïã ùíäÿeFqðs…»v(¨õƒç‡{B¤»$Àï?ÿ<áñó¶P$` ±‡Âðþe†ØýuFÍßê ˜‚PëÇ€~}þõdŽÚ0[8ÌÙçßðß#æS”5R–5àúCù_N99¸7àÇ#Âðƒqqq@TXøgš5àoò¿­Ú`èŸËýGB˜ÿ‹ªyóðü³ìTÃü³‚&µÎ€ýßÛoÙ ¾øÿÏøòÿ[ý_Yþ×íÿï)y8;ÿö³ÿøü`¨³Ïj=(ihÀQý7Ôò—ž5 ¶P—ÿöª Á(‰ÈÂìÿÕH(B ê ±Õ†"mþÚ¢¿ç€Jï …A´áè¯7ÀÃý—%:'Ô[šÖo¥©–T„ÙÀm‰O@X»»ƒ}ð@¨ üøQ*µ…xÿ^n€G¢B½ÀîŽ÷k¦bŸî/Þ?ÒÚx¸»£4÷{ô¨šŸ ñ†ØàMOÂm$ÃkÂZÏ«ei¼xV>b/,µE'÷F #Y¿äù9¨ßÎx4ê&ge[A9˜ª=U12éOù{>ìmÖ™<Ÿ¢œ‹DSì]–Ûçɸ8ê´‡ÐÙ©í?‰¦F/ßÛKÔ¡%´2Å4eK2œ¼í\«\-üцX3ß\€âS"†dœlNÛzŒ1óòƒ±Q<±»iš‡¾ÊãO?Ðc ñgr­±T>˦ñé¾~íÏêëM<,P뮩ˆ ¡"õUeÈ|þžŠ,1KµÆ*'|*_–$¸7Þ–7ø{tûN€µN÷±Nvª'F4Æí·6FÔ[ É»ôêM±8Ôbp%¯Ö¼7„ ÎÌÒ¾éæøš”{C’BÝStlmz…¥ÖÄþOcÇÏúæ±”LÐ_ƒìæÖ#09W„+ ȯýưñÏóçSý—†X}‰üDI¾·7|XYáƖ/L‘ÿèÒñ’޹8,$õ¤2tú=‘¼áš뺸á{ÅèPyQ`£!!ó–ðµÎ-~ƒ,:èÈpÛ( ÙݾßwQ,(’F[óâÎ} …ûëíb»›eùÞâãAŠùÇH ¿-<ÿÛ®´üÍó6 ç¾O…O¨“,².•žÄ D[{“W×l½|h¹ü0Í×>œ|>dÚ|þ ÄÊ}gÄúÖ\«nåc°øÜÔ{viÊÈÕÞÁ±QZ]Ãrº°F‰µøãFÎ i±}|ùª„`*ú+ZýHdU=Ç.Í8ó·Ìïö›ùÑÁöÐã\˜“çó]žV{G¼Ê‚ïN!â ƒ'ãQX®»²É,V\ÁýI~/B#œ¦5ç-»äw-6sê âê;Z˜‹¡–4¥86;6W‡Ô}Z3yõ÷ýŽZÓ?{8V?:øÜváÊnuËÿÊóVJ°Z-õöMêàÆ¤ã'¥pÙ4® ×!ƒ)νÚN«wzáÒþ 6ÛÆä›[žw?¢?]æájóú6=³îQKÖkkʰ¬Ó8¸HJÚNðo•D+®Gk }Õå¨ZZ·î´óгÈ6XBHÏɹ1š$„[Üq‰K 9ŠûBãùaV‰uÃ`ÎXŒÖ1°Ï×Kæ¤õå&(`¯+hî˜I‘2‡©Ÿ|Ã’!™ê* #k¨æ&z*BZç˜kG5#£u›³ZÄ÷Y¤áØ%c7LG2©2"m…¦PÝQeëÔÜ®¢ëÞ •EiŠ„NÉ8M:ë‘ô±¦^M<úÓÚQ³œGÆiÜÇ/óÄÀ¡Ì´OœAsxêÃG#?^úadEŠÙ™º#ЬÐ>ôG xÞ¯1£ß9ݧ~ñ½5÷ÔºžÊ0GÃ@oáÀófqIDä@ðx_~[Š'z¾|GYK¦³r¯µŠ ©‹íªp3¿š¶°–ruÝT´ãO¾½¸Ùýã‚îÈÞîzKMX]£sÛEkÆm­h#HÂ¥’M›ŽÉÈì|´lvÕùÜHaõ±ù2¢Cþ1@vYíÓ@±ÁLL2Ô_ÚA²%B눂ˆ4 ®)æë†e_î ឯH„‘R÷Ôe³jaPH@§ÄF9q¤1)ÖüÞõøâÏò»³n½ÒD–zŒ–ŽñþãpªÎ¯jzIEÑõ®Åw¨CùNÅÄ´´^HÈ×sn™=Ž"H7h ŽáóŒô%hÍÙ÷5';¦àI%Ù?_ïs×Q,%»ËP"=³!«¨{ýú;!Ö{×ûáó¯МT6m(ˆF÷^è‘-¼ &U+›lYBšÉËà–üÊIB@û·Ã¾hð²† Ï Ò\5šãµãTìöÅQÞXæ™Eý*”ºç©‘l2'ÖWD•“øýÄ’™àä\É<57º¤´cqûݟ•8Ò2=c)!ÃH û“7¢Þéîwe–aRÂì–/qͽxUòޏ)é lsÔ P»wIR–¢s #Yh>=å–õñlmZzQŒê“ùl‡¸´v8eZŽm{Õ(Õë:¹AU§Œ/Ü? M™–ÐeIÏa;—¤ç'ÙÏ3‡Ø×>ôØÆ·ô~žmJð1Ç¢¶V'ÅØŽ¤Þ­HSš”ìÕ¢Oj†T)üÈ#Ñ7C°¶¯¡öÒôyß$¬2ƒ×]éæk¥I‹ÝÚ»å}na9׉f ZùæÔöj’OŸîš_E|<¢p.ü¦ŸHÛQÍP¯²g¯xºå†·ò=ôýmšYЃz’\øB%)Ü›¡+†«œ»ŠesÃ¥/…QÓ˜’á ’Da1Ç{8Tš¸IØu/‹I–(ä0#ÂÕ1úöËp›§: ˆî¸ìðæèl>O|ÆTÞLó*ÚdD„#Ÿ–¤‡l\!Fª‚wæbØãZ—(Tójœ ^t®•šxOÓ§êáP&¥¡©HW$Émhæöþæ3Ä£3’ŸÉáÏ‹ÈÜâå >BžºX¹KˆÑè =9ó½ÿz8Ã`›g(×âìÜ38ßýmÂv>³Xü.¥©O‚0BOû¡ÁV_PŠ© §îîâzhú‚­Ý­o;]2FqX{kqQ ãWwëÆd«7™{k>îNÅLÞí˜opv/ŸóD¼æH²Ô\ß¿¨Å樘ÐnG¨™µ‰^lVð-)@p¨²¨¼¤[¿3±Ò+tÚÊvî„ʣƭܽÊ0uÌ‚ŸK–“ý3Ç¢!>¬×hÄzJ]úhEǧ‡è‚«Ê\ÕD±´{Hì“AÜx'‚º;ž Û©Ó¨"ç’M¾6©BäØ×»ö$ìˆØÕgDé«íhnxœý€Ã /ëÜØªúë×aL÷®znqr‹¨õºÚ'ÈŒiIÄg7æÉAæ•ÆðX}’N=Œ„[´mØÈ(7ŠaÑÃó-~Ωö˜ÊžxŒMáFÎvä+U²ÓÊÂÐí£ ªwoZ¶ñ, `Xo‡ö3ãk·kX^O¢A4DhÇ’Óª `CïI¯³,_ Ø¡®—UUÂ+ ;9CÏQü˜³öt³›Z¡ËÖÔ)RŽ_w( n}^Ér ÏäÞ(Ÿ°pÖóƒäñô¤tn”â÷dõ¯ë~R(‚ŸJL¾]6"xEôÖ.ÒxÃÍqX±"@ϪªWN”Ôß>OØNóZu„%úàÚ[ ²¡€²ê ÍOI"NŽ¡7˜mã³-‹”—€ÒʰSÚd1~w[ÿ …Ñ‹Ï:/ Tf²­²(È µsk}ï•}­F'm*”_?r½¾« ]8¥ŸežË•ÒãJùÙtÕëK@Ò@B·_jð±U—›]t~¾kwÓ¾à|2ËÝp-.È® J8@ôdŽ(íuµ”Ùøi½Ê<»Å®be¦’â9¦‹/ó¼^9ǨH8<ë÷Ô¹÷jònÙyqv¼ÂÞ~í]ê¡’Üî k{ʵÑ?¢OJ\û4eB¯¦‘k›>Dƒ—ófz=> MÀ$?=s˜o¢PÓüˆ¡ºügŸe»¬I°Ck¡4“ª4P«)ew+‰ Æ»i) o¾ÈÝeâ}¯ømÂÍݘrqϬãý{ÌÚ‚®ê§¿)mÕf¤ê™Æ©r›.Íñι”q›Kò_*[˜×°&ÏGø¾åXY0’Ü1¡1c Vºa^âë!›H•¡Ž}>Oíª5ÍBß6;е‹øáâûúتÂõ²¦ŸXxÞÎ<λU¿fÐ,]–Ú–øE8k7?â×Åx_te}Éð®4ÝYzbGÌÄçÐAœ¥¥¸ƒ 䩺ÔäF,7×}ÿâÑZRºWµïâ°M?7HÈʨtÂÍ“UGß'kX§ù#×4´4qLuåˆÜƒ1Â>Ÿ ÙVßôÌkä ^¼OîW\Å 4€Z“|Æ‚¨B°ï> ¤¸N¦?p íÇ„ËQ³’rø­“êan c„ñC¾ç¡§öìB•ÅÀëLŠ@FºC%XP<ü ]¦£8·Ÿá–î×Í”@ª”ÐÄÌÃï¹›=e˜;dÌkƒ¶!w û9{—ç ˆ÷°ôb›¿Ã`ÿÝËÙ•)î$Pѽ!›s^ëâËß/Wâ,ðæÕ&þ<Ú¡üžû¾TŠy¢øê}í€u<õÈÝ< +à­ÐiNïxnò+'Kol 7¯"IwÞ™¹ÆðU¶—Ž,çwUëÈæÛÉŸRtî„|ÊÊš?Om•IzIEØæ'#ŠÏ"D”yɸü¦èžþfÉ÷G-¯%v“Ñ`S7­IòñTêSAêдںž“’ùlÉÞr^W†7y+‰{ÇQÒd¸ÎA­*Z¾ŸÑûÆ9Ô_’”'0yÍóSÓ/6u«´x¤¨¿‘œ9ÍK·‰¶<žÒogqzñ¥>$¤˜ôØÄÙÒÒ°ú šo8tGf©é¾‰ñJÚ€¢´œÂ„¹ÌÀ–xfˆÀ¼º}mªe<1ÉÝ%çö1*ƒ¸iúõü8™]c@)íµÎõéĈ¬mMÚ ~ݰzIù{ ¦ä©!CéºÙʾæK›ó¨=÷•á\_9Û}`]¿+M‡êd Rö² r Jvî‹ù>a€4§¿@”Óxâk =ƒœ’KNto2{r½BÓ­î7Æ&_oI‘O9Nï˜G•iMŸUñÝbç RÛZMïweê"m?BÀ¢¼T\ˆy\ÑëÂ}RÔ%IL±íî‘l:‹ÔUjTÇÚët„éƒmqxªF¼<Û.d¾‡ß¦^|lh/¹×þôÓá÷¬éNƒ`/zIG´…‰ùï,ÞR§*S¤ž78)Éõ±@G¯SÅÃ.Ýs»'lU­6Û»ÛÆ=[˜ßœËÑ9+¹ßü|yÜ…ƒ Ò‰Á} ˜ÛVyÂ{ó¨3y=‘`ðTˆŽÎ9ˆ,_õ¢³li¦ÒÎ0Yý‰ïó8VÓ!° cÆœž>žŒC›ç«„90`fJ¿…; åLàæ’e²Ñ;ÖÄ>Å7be×ã*Žû3zJÚB#Ì÷"erùÃ,øÕãzyánüÜU|Óˆ ùÈ®wD1^4<Ï€ëù69B®Cƒ6^Ù™Ý9MÕ>b©›O}m§‰räzÞ©ÔN´—Ôv¢ºe¬^ 3Ñ 3-á‚Á‘Š_+DüI=_æKëŽ$]ú M”ÁŸÚŸ_Ý ó:ÜPvÇWÍŽ Á¼ìY$Óú"!°œcšå 4êöh™¼oÌšš†TÞQSÑmÄA¼G‘3£Ã¥Ž=ú ÁÍPÿœ`¶j¦œAA ï±ÒnrîúYþõêêÔ×];‹ŠP·*z¾­Ì8ÞûM"Ïhà"—hû˜>¦^£›­hæ©TŒño‚:FÊ“¼Ÿ®Üf+;¾wÐZ8L ¤§NˆÍ,ËF³ü<^¯Õd)-ha¬¯¹Åv„»Ê£Ã1q5»¸0UÆ.}Ñ,­à^ÊŸ¸J좩Át„zË~9¢Ð˳Îÿ™ÔN·½U«wº6q»è'Ý„2›ºª¤ž1y†@6ã‘{U`Ûáv¹A³ïŸ¿?†W`‹Í°ù(7F5ú-+Ø×Þ©Û5†n3“â”ÊqóbV„e7q†'@-Ëg#ÔuG—0Å‚æë”Hú³ñdóùö¢3B6«ð¶Î ‰ëÍúâVšÀO¯ÞÃÜ?~ÂÝJy|ÞÑXò“^N°A9D¨ˆ~–ÙýìCÈ£ òIHe>¾ôkεº÷OóÉíς̖X?<9d纎ö^UÑ¢ÅS|§wÜEt3 4³TdÐ>{Aâ1ÌÒÈz€c3h¤v?Iç±ro§g¸Xìîabõ«ý§¯#5-ú¿ƒY¨Ò¿) žÔ@¥Ê%µJAšõ*ãw®Låä\T¤Ž›öM0—:ë.?Öv=V œ:yIÓ/ïd÷¬Í’ € & /¾ ÑÐÇAw5ÇÅgøhˆ­ð»–ЦF'º|*»¾zð–Hƒ§màixÉ‚¸°GLI÷^cÊ•ËúªÏð¸þÊU-ÃŽ¨)½%µm‘®/‰ÌšvÛ¦Rük„‰§ ¤ž;ûñ@äÔÖ6fæô.Û,·«Â¬6&êš©¼ÝïðæêÒDŽ$UV)J}Ëh¡tºŒÊ‹ÆwLG¢&õÊD~ÌXÄXmÊló0Õ:óÛÇ •bç8 VOKàŠ±^²Þ?YðxG]lïëÇ•¢p^”®¶Üv.ÖêØ1ê¶y† mÒ´½³·o·llÍ´õöu}Ù¦âqö0 4’°m‚®‚·“&ß>áü´À¦è3[Ó[e©ÑûcúMâ$ö—ÍòƒÛ›}EæîvÜÒò|þ 2˸}ðæBïÈ»ÅKù¼GDù=3,u?íMǨnxÔ‚PÙ9%ëéÜÖ'g'É%¤Ï(&ØžpÐè‘Èhm˜Íê6 bÉ}(ÚøW$ÄKW«‘˜Ú9‹ItSFÔ—w«í»ÉÖ%‰²a3?µ+}vp2-HÁq§:¿µ0,7­•w2Åÿ`´7Ú9Þ—x,øCƒEêâ\.-’§ýÛrß%þÇ“°}s3kwù•ó¥¥oA–-éSØ…ìÊû?ŸÒüèWu.CG”¾ Uâ«)“Pt«yûcáØ¯> ·× {#”n™ö/èY¾©ƒYæë®Àüï^ugŸïUtv •_õZÞßÚoÑ»1¯½oÒ9>µ~i1¨ÂJðhV #Úˆrrj:zºÄlÍD‡ì RŸqò2&\3êAªÀ©BL¹aØhô©'~’/èE³o{Aº°±‰M—-þŒÄ¶h¦×@æÌ:bøË†}ÐWœ¨sƒ8mLXx8íï0Y–:‹t¯¼vNŽßì/ÔÃä6»ÔœÇt"¶Õ´Í^œã÷péTÚ–6?ëvû,dÅÜgü,­«C_é¸#)"ãõ%”ø}˜Æ£*ñ&”¥û–ƒžsÄ—)OÇ÷ÕQ'.)ä{‰ƒNLö¸ƒ˜·ÙnË%ÿ$QÛºUP[s‹¢¼uäªO¸M*Å~“„øÍ»¥ŒØ!Rú];ïf C†PŒÊ•à˜FÄëð§hâLƒ%—I9 u[mN0ûCÇ~±GGøz¸Ž’Û©iâÁr¾cëK\«}õxð|7ày3–&Û Kí»¡¤Æ36ÖÂH B"6^-Q[„‡>€oöñ•7ÝVï FØÜŹÈ|ãd¤H¹þÏ Lé·Ns±vv¥ËéµX×Ä%+¯*ˆpMƒ Þ¶OÈqrœ äTY¾õ¢ä ‰°³ªÿ[Ù[b endstream endobj 319 0 obj << /Type /FontDescriptor /FontName /EAXHAV+CMSS10 /Flags 4 /FontBBox [-61 -250 999 759] /Ascent 694 /CapHeight 694 /Descent -194 /ItalicAngle 0 /StemV 78 /XHeight 444 /CharSet (/R) /FontFile 318 0 R >> endobj 320 0 obj << /Length1 1431 /Length2 6224 /Length3 0 /Length 7197 /Filter /FlateDecode >> stream xÚxT“ÛÒ6ÒE:ÒÒkÒ{ïDJH@H„Ò«ô&A:* E:J.¢ MºTô‹Ͻ÷Üÿ_ëûVÖJÞ=óÌÌ~ö<³“Nc3(Ú ¦‰FaE@¢@Y€š™ %D@q2s ûÛNÆc óÄ Ð(Ùÿ@¨yÂÀXœMŒÅ Ð(€®’€¤dAÒ²@ @”ùˆö”¨ƒ½P€(@‚aÈxÔÐ~žg,®Îß~ˆ$##-ü; âóD@À(€ësÇU„€‘34Ãúý#¿¼ ë!+&æãã# vLj¢=„>¬ À†yzà€_”†`wØj¢d<sæ/‡Žõ{Â8¡0¸/æ ÀU˜éèŒ<`¨¿Àú„ý+ÝŸè_‰¨ßÁ`íîFù!PÎ8 iê‹b}±Â0 ú Fbиx°7;á¿·hª˜À8†øa ž,Fƒ@þâ(ö+ î˜5PP5´»; …ÅýÚŸ:ÂÁ»ŸØŸæº¡Ð>¨€¿Wp ÿEêå!fBÜó‚é¨ÿÁàLdÿ¶9ðI Œ””$»€ùB\Ä~0÷ó€ývþ6ã8x =p XÃ}`ÀÞ0ÖÓ ðŸŽ®È@ Áœ`ÎÙ¿³ãÌ0ø_k\ÿ=¾[ N~ ð×ë_Ov8…AÑ(¤ß¿á¿[,¦e¦g¨£)ô‡ò¿œªªh_@€ˆ¸ @DF @RiiI@Ð?óüëþfÿÛj FüÙÝdÔAÁÑ™¿HàNïo"Þ”Áÿglÿ¬`ˆÆéàÿ·üï%Üèÿ<¿CþÚÿ•å•ÿïHÓ ‰üíçÿ ðÿøÁî¤ßNÏ^XÜl q‚úo¨ì¯6€A^îÿíÕÁ‚q3¢‚rÆé\tKxë/;£‰ð…AXˆË_Zú»¸H fŒÆ ~Ý;¸( ð¿|¸Ñƒ¸áî ®e¿]0Üdý³® ‚†þAqI)ØÓìG†Sn% áf óý-q€˜( Å…pƒp´'ٯƂ€â1'O0†„Á±¿|Ì̵ñ—ýu!^žž¸Ñü-ܦþ^ÿ¾`0_„ln ‘‹p}Ñ~V«Ââ#²6B¼¸Ô›lÓ#‰å}÷(ÀEŸ$Gkòžª#ôéá‡Æ³•Q3,‚_ÎF}ï¾Ê ]ÈÔ.Äâiô­¨î‹ ~;zå c‡¢™Ç¤Æ®Ð쥘°Q9ÚÚò¥YÍ\DJwK¬?û\rÙ‰Y¿#³ p”Psf²`T :·ñØpr/a‡lîR'ÒzÚfy™ëXŒ]â?@$žª¶Ç3}ó[±MÌúøñu^ßC‰Ãb½ž©§QtL×ýu9 †S˜èSòt_`ðxU%OÔ*3’¹˜JÝ£x¥¾O÷·¥ Hx5:ª…^3ºÿ¦É«-9£PнpÈê°škþMŒâFsj¬‹píCnUž(ÞÉPÖ^²°‡@\ß9ÿÓ` ]^qj£ÿ¾)žä~¸„ýçñgŽ 9) q» äíOU¥Œ‘ìÃp«÷ò:f:cCN×%¯á›Â¢_÷!ª­9ÒPÇͯۇº£÷ÑÜ_Øè'C“­;r¶{·R^èHž¼¥±ÔÂÖé½Cw9$$M›·ujÉÝQ–™çJ²” *2§yg®¿Ž—exÕF6R%dŠš’ÎíK%Û³÷O¤Þ …?£5,0~vÛ-H)MzÀö='ñÎéù‹ÑÙ©»è¶0ûwÜ/xã׎íhn#3’V_`Zx#"^‰%//Û äpš¯õ†€)Žð—ž|™¯_bí0ã*’KÚȸð²Ç3‹%S‘<Ì–RU ™/öFÍg›¯>ÍNªk犜8­¤³#  ˆ™èT.œÊzÀšƒ ¼rY z çW¦>MTQV†áí¹ð`¾UmîðZÞ-–0„­®=±|¿::ޮ̱;ÞPš&Çß=tÂ!Ó²\¨¥R~Åxw;”›n¾©—I6Øïršxœ^}•ÌrÚâ)uÚþJ®´þNæFWÿª÷,»Œ¹M"C£vªŸ‡³úà»@š+Ó.(o\vß4ÂîÉÇ\'-5%.ž°@ØÇRκÌ©„áRSã îÏ/Zdv¼ìHÔ¸9»Q å{Ò³ÖÅ"ÒÒDþZOŒ¥Às=×Å?û‘Ü}8²æÎso±>åí±—Çs á£Æ1ôõ9ü'q¹úÚ¥o[õ>5d}%¹W ônbã—Ñ7ÒVZ˜{…ŒÎÁàMü¥£ˆr= Ö’ø’…ï8o¬nü¤kV1XBUúXgMOHÇnÙ{êfhÕhórWsV~C5¨>sÓ­~¾‡dÑt—ÿýô˜½ø,5_åârÇ=¢ /~”j莞z½Sy‹Éd­•þiD‘_>]`ZÒ{oÚ=¡ûÉ%…ì½éÄ·ÏçR ú·ß‰==acØÆÎF\hÃr¢æŒÕ6½ ¿¬siI‘—íP|!),°k©0&¿ŒO \¯å_m±œ>XŒÓªx‚”Óƒ³X]÷_ð,tØUø®ÅÀWuk8ÊÚPÆßu£'£.jÉ_ìC}Óœÿ¤~ψÀ–Xõ+ìý·D¨¾-5v=šâ˜ï˜7© ,E?!©½Ä4Û¬²šÞòª‹ì¬Õ¾,²Å3õÅŒ³EÇ 6<‚Á*“Êàex>nï£o°Ÿiƒ¤I+’\ ã={aÜ@¶Ù¡ Õ=–Jˆ.ZÚXÿ£õÛý}]¥ŠÐŸ®~æ9 ¡=–îŸ.1Ý+ã¬6Ä”r”²7û²5犌?QÛšyŒÚB°X/ö~kJ_VQ9šMp÷¡L|¿çش΃"´kÅ®Þ ¯kQ«èUaâ‘3!'PíÌóò\¤ºþžÉ‰ÐÓ&cú¸ý°ƒO~ܦc‘&²;£Œ/”Ô¼ù}P‚NÌ °S«RäþA yÕß™s&Î<òAöt”a¢3q1ù£ÝÛuäú–±÷_ÿ¼8s§¸ŽRØñ\ßå*sLn«txfòÁ̼êñò¤/‘}ˆ„“Š/é'jžDÀ:9òLàà3k±yÑ.^Ù ¤WXìV]ý&Îõcpu1) èÏX¥õŒm‰ã^실mp¥•É&ÄÔ Ýç-³Ö%ÌÅÝX?`oçcQ©›±}¶i7KØÂÕoj¼ Kõð¨Ñ¬®øZ·å½çi4EI£®•ÐLÀeÂkXv¬e¿v®+´çÈ Ž,è³ÁñGè{dRyÁ©®rBlômÀè«ãïUR{jõ·B­õºñç-›øüçî½Qa{/põådìZý´y{:MOvò¼þè"¥îöÞᦽ:¢âÒ¶l_#Ÿÿ¡Y¼›óàú‚Eôy`.^æMâo’–Û𠋸­{Æ¡A§“ ?ãsp¿gº%{ˆ7092åì‰A«ki‚dlBÎ*!µ¯]«Å%iÔäs¿N“§îeÖ4>œe¥ÝÓ¬`algbMó–ZãðE¹X}`ä.ÌL]”Æ!`«3î‡_t£Ñ ʵuË™¡?ö·T&ƒ%Ê—Mè7»TÙ-ïsïËh·2$»*=°SToäøÕ8PIJœ–j~qžêª¿•¯š½±š»£RQM»ÔqïùØþ0ÇâË…‰[$qìÑ%Éã_@ÏŒá7Þ^}r$Ľ±¦·[ù•çæäøS@š;”{ yuÜ||¬hÍùÚ=v0¤<Šd ´úÉ5i©¦½q–û­ãt ‘¼ßYž¡8d«´¢£O´¬kØPÚƒNÝ즢c-ÀhpFÜdVüù§M檑9,˜8;iš·BÐ>‘m …Gµ|ã‚÷Å` üâh_ÉÃÓNö æÝZÚŸ[sUBéʧ!MòE÷ýøÜw0òÙ›¡2œøå&íï¿®ò•æj5ì-e)Râ÷UŒ¼tµk EIX+êù+Í©ï†(žE^épBQ°%Üct²áWäš»-¸ñ spÄ­ÂOâ ½w†÷r«½ÒM‘¤î³ÜrfWBÞÁ’L¿ } ‘J?TÚóÀ'tŽi)›F”›ÞriÝ…›wâïÆíæÆmwk»†žpo.:¯¡nS#´ÊT>>ú.‘òЃiRó(Íäsv,¡ÓR½˜ÇѕƣG¬æi÷:5'n:ü˜V¡IíBmÓ™¼%ùYì®—Àë/'?ÝU@ê~¸b‹~3ÆÐ°÷ø€OáòžuˆùÔ!Vže:ÞíPŒT©RÜI `x ~ÜR³›±´\|æw“¥Æ‘ç}@ u9g» {ž³èÛr _W­z2íù`OcqÏ;ñÞÙH5Áä1÷9÷s…ëÌŸÂÞå)mA•% ÔvUÌ™”[Ó¬Óx<‚AÚ¬=ÌÙ›¥rjÐÇKYDƒžLµ ë®—…š4ÌÔ]1H 6cW‹ïtYínf«‡áSây94ÅuÓü-ç¹¥× ZÉë#(îõ{ó6Õ ª-®Iâ5éßÁÔû˜{¤0`Ú[ÇjÏŒ ‰ä?­,²xð°Nó«Å™1W›ÞhT”Puû¤M'LšN XÍŸqBŠ€²°äè7È9»‘ȼ¢å·ÑIŽG:>ûúEÎqš~ý³Ê8©¶lóGK6ÚlN ´Æå6í€fŸðS{›‰&Ja²GÜšo3µÕç-™•<Iü&¶\7^àÑTh ëèW&>™;)ÒÒ›5v©¿oØ`ÛL¨3ä°¢FºoÎà¿0 ¿º~U~*3=þ"ôŠã-Ü·²hF—¯ýré#·céUbª0’÷Áw+Bh– ÅÝàÅà#´—®´D~0õVá÷ÒV×q°Þ¼U@žÁÔ‚„Ò»¤„JƒC»o²VLr×i¼9’#©³ˆ¬—åˆ"T9R¯Æ–[Ó%‰/éÈ)rš—ÄD¯½À0ìœXØ­> OU˜°Žûqí2U²áe\ˆgˆVÑO¡&Jp%ÔI ó¾=E¶Eų®É×tÖW–qqtåîñélá «~(þvx‘q¯4K…â¥å/§ç|ëýÑD»Ü /®Íz¹óf™ÝÞÃû_Õî×+u醷‰¥jrIYˆÖ׉ñ…>è™LE™¸†¦ª'¶C0› »á¾h]»¥wUœo|.¤Œ>Š=(ÁnKÒì[.WÖ =¡)}ñäéË 6é¸z LXγ™Ê~¿õµ¡Þ4óÂx5É -Oçe â^jÉ7ÜIÑãyk“»âHïg|ÔªZ½]ðp‹¢¨†ØÀ{m‘ß•[¾² 8+FìæÚÚõ™à¿±ºi4›ÂãN)ÿ8ñéþUSÛNÆñ,´¡¼ëÍϤ?øÂÖ{ÛAOéf)_ÊqPíGÞ5·ÌðËÎÂ’ê”N"£Vèîdßb׋qŽ&¬ìÛ(é®\§¢SŽÏ3’˜æŸpñôë:šè}*~½r襕—KtÄrÙ{[Fôr¦¼m݉Ù["¬Ñ%¤D>(YË”9¶n1VG9_ÕÑ\—UêÆ¦Ï&›YBú)]ÅÕÜmK?UI+†ºY»•Wvà[×ð…?ÿÂVÆGEß-oQþüáüm}4ÔuóŽR‚:Z‘<û& óAæ–Ï:J/#¤!]·o¸JLš ¿ÐgwïÞ’/Ít­ÿ€º í]"})”Ù›é ~±MæÉ´Ýñf6g¶F¯q¾´¦úÆX¯«1•ÌòáS®ÜWÎiªqùñ£}sÆ_åTíM’Œ*Ó$¾u ª^“¨÷Bµp¿XÔé§ÜúYè`D ûáø–Œ#‹ûå¢cXˆ ½‰XoéšA=,¤@iöÕÀàÖdmãvê—U»¸2§ý®«—›m[Õ[âòg#™ýB„Ô;XÖîªZÛ±¼º&Ý¢•FÊ%<):a ›زÆYoâð¨é»Ì-bN+=‡–šôC@ÉŸ£Bn:kâV2ŠðÌ Êêñ³Þ¦c ltSõÏÖ"ת¨²ž@®ò†ÏÇ_’gÈ mé§ôã\ ñmhéëfÑ’Ònô‹?Ònò“h§ÞÅ~â;xŒ©Áøî–jÈkêѬ¬FÏ캔_k¹#5~#Ï]xaÂÅLÄêm%Á¨î ¾µ§C «| ×òëÁÈ*ÙXî3#ÉEãÕŸ‡ñX `§Þ‚Dìø0—ýÚÄ7ç{?d€up~~9.…CpÈ;Ñ\7-Ìî´ÚðvèJÜU£oÛŽ´C¤å©YÍ‹:RŒj™z—jb>µùî×Iª? ™½å~fò}BMÿ¸ø(¥™Á7Ëçê§Î2¶HÍæ…\"^Šû\«iŠ#QMrŽ„T}äÞßyÎ8ÞטÛîBfˆíöÂ`øq\Z-˜]«‰#üâö±Þ¾Ó²^P“¯;~ן›C¹Òª; ­¿2в›EÖø~â“ò9\‘²~®FÝ¥®ÇnDÂô*žËï¬ìc/³Ìî¶Ý ¾¿Òü¶ÉnO¥"áýäêÀ²Q®÷d k“øor2ÿó5óæ…óaàÜÇëN7Or¯Øæúû¥NsÂ@OæÝ¦%BMUvùû"•’ˆü¬»öcVÏSjÖý”?÷ýl±X:'ýý—B¶Ü$ s_ÞOÕIºÉÉë›ÔºO¤\ýv/ƒTZD8ßᵺu¯{ÿ3WVð)Ÿ×—¡@zNÅy‰ïÀ†ÆžöÇöÓÏÒoLg‹¼0Jj©5š9§6­èn ò}½±MÊcÒGzì£ê<ž²Ü~ivÙVËõ® ™ë´â/×R—¥ã7}WãÑ«á­XÏ 7òÊÄÊÝ0Þ—$2²=C±X³ÓϽå\/ Ï_âJ¸ûi-Õv<žÅßžüÛödÛÆ‡J¼,üi{6tÕnçû\M§Vcæ”—Û^]Ë~'> }…^†¥4xÖÍÖCî¸iõÀâÍp¯ôÈvkuóåû?¸h[·V#ïåk^ üÁºË–f帣`Êðô®£‡fTM …<³Õ ³y~ä«Të=WukJFе‰Ç¾2†A2DºD ÷šŒ«<±gùÇ"”ºý}‹¾Rçì®—è9hEP˼TÓîIx&¬FÂX÷€uÐßÿfù€M™´Õ¬ÇF”)ú› P]ÕÖJÐå‚ê µ—2ÓýÙÂdŠ<¯z§éÍÝ¥¯ºš.ãND»'Ñ”¤oáwˆ …ß"DÁ$öÛÌ;Aý’<‹?Ê;;Ÿƒö V "•Y‹ÃcÚûŠÓ6“7îÔÜ¢¢v9z?L)àœl9¾ûóùÿ¡ô3 endstream endobj 321 0 obj << /Type /FontDescriptor /FontName /GSKNIF+CMSY10 /Flags 4 /FontBBox [-29 -960 1116 775] /Ascent 750 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 40 /XHeight 431 /CharSet (/braceleft/braceright) /FontFile 320 0 R >> endobj 322 0 obj << /Length1 1931 /Length2 14682 /Length3 0 /Length 15868 /Filter /FlateDecode >> stream xÚõPÛ²€‹âîn‰»»»w‚3qgâîÁÝ!¸kpww‚[pOp×Ë’½×Ú罪{‹*ø¿ö£{@Iª¬Æ(jbg”²³1²2±ðÄÔeYY,,ìL,,l””ê kà䔚@G' ;[¾Yˆ; Aï2 Cл¡‚-ࣳ5€•ÀÊÅÇÊÍÇÂ`caáý¡#@ÂÐÅ Àøhg tB ·³ww´03½çùÏ'€Æ˜ÀÊËËÍð§;@Ôèhalh P0™mÞ3ZÔìŒ-€ ÷ÿ A#`Ùó13»ºº2Ú81Ù9š Ñ2\-@æU ÐÑhø£e€¢¡ ðïÖ˜(êæN)ÔìLA®†Ž@À»ÀÚÂhëôîâlkt¼g¨ÉÊ”ì¶ËÿeÀøûp¬L¬ÿ ÷·÷,lÿt646¶³±7´u·°5˜ZXJRòL 7ÀÐÖäCCk'»wCC kC£wƒ?K7H‰ª ß;ü»?'cG {““…õ=2ÿæý˜%mMÄíll€¶ '„?ê“°p¿Ÿ»;óß—kekçjëù2µ°51ý£ g{f [ g ¬Äß6ï"„df@€“………‡t݌͙ÿH înüSÉú‡ø½oO{;{€é{@o SàûO'C äè ôöü·â •`ba Í,lþ‰þ.šþÅï÷ïháÐay?VË?ÿýÒ}Ÿ0;[k÷Ìÿ¼bf‰ÏÚÒê’ô·ü_¥˜˜À“‘ÀÈÆÉ`eeãp¿xÿoœÿžÀºÿSªlhñwuÿŠ(kkjàý«‰÷ÓûO#.OÍßkC øß Švïó Ðü3þ_X8YŒß±þ^‚?]þÿÍþQþ_ÇÿÿV$ålmý§žæ/ƒÿ½¡…µûßïóì zß »÷ ±ý¿¦ZÀ¿Zhbálóµ² Ã÷µ5{ŸsFV&Ž¿äNRn@e ±ù_³ôŸËxÏama T¶s²øãÝy÷baù?º÷Õ3¶z[œÞ¯ìOð}³þ7¯¤­±É+ÈÆÉ0tt4tGxŸ€wâx²¾ïª ÐíÏ03ÙÚÞ]ï=zLíþ¸X.N³è¢¿ˆ À,öq˜Åÿ!ž÷ùû/q³˜¥þ!v³ì?ôEþz÷Sü/ñ°˜Uÿ¡w?µˆÀ¬þ½GÑü‡Þ£hÿ—xß+3ü‡ÞuFÿ/€Ùø¿ôÇ™2›ü YÌÀðLMÿ¥}¯Çì_ø^ù‘ãý¨ÌÝíÍßßË,ÞeÿÂ÷J¬ÿ…ï¥Øü+Ù{)ÿòý#¹Ý¿ðýdìÿIöÞ½ýû–Øý«ö÷ÿEÌÿÂ÷êÿ…ï¥8ý ߀þ…ï'æü/|/Ôå_ø^¨ë?Èö^¨ÛŸø?³fììèøþÿù(¼âøÏ·t#,/ØóYÖµß׈º2îM²q ^†_ÃiíJ⻨ˆ <\±çG,‰vÏíGž8É;³íËuu}6`·51Ã9kVv½™¥Åep¸Ø›Ï<’ j®º«4?ƒ¥nüÅ„1‹ÇÃÃŽÔ!šÙQ%ö]tv®S–ÂéRdòw©£‡´16ÎíÁ•2p‹­4Âãcd{¹ëÌc¡ÔÃ^.9ƒiÀ,ån¯$ÞS,MÀu{?‘Ó¸š09–ìîô¥Ìån”¬ªY³ÌÐ&ä@ ¤øf,Ùù&¼h¶›õ¶?]—DIkør’z¡;'uYoy¹4¦ ã£Ô¤× ïQ”õ/De0 µ†™í• †}”¾×Vz̬—2k¢)†§c8‚^ðÑ£®Y&‘%Æ9kÛïû´ZÓª]$ó'Xj3ZN¬Ñ²#¾/5æ¨ÙŸ¥;H“ZܼßçûÌÁ³ë Ì<ʪ6ìð§R)D¾êò æUd«4J^+_×_h™×÷ƒ-MtxèJ¡aË.åvy¬ÖîËOz‘‰KÖ¸z‹ígtU±T±SÙ_¹s¨ð9É¥ºv\ÓÛŠÏù¸tÝ.€ìÀ¾Õð¥Ö1 »|Åÿ„ÇsÚ!pÚ«í9ŸšªÆñÁ5ëÆ lëµ/´†‘ ¹@ŠÛêö=š± ó_öÈUä|þ AP€„òãŠaŒ‚™ì7*Ö•©oq6W. %­*å¨Ñ:ϲeiN l<‰ÍvFƒܘ¤ £8 ò„S²\ÓÜ›„åe׊AUvÜìG!ÒO«“Ñ'¼m _Uja&“˜5çM궪ÀáÖ{é_ÅÖ °«´ð©e/ÎÖˆdoì³DoŠ1ÍéZJ} ZÐ5}‡è„—·ú¨5èV%Zl ÒT{Q «"zsMŠR}u³bù“¥Fç¨kc^á3½úY÷çï4ü¹lß×~_3.ÝûpWâè¢ÝøO;VS©$-²ètf̈*è~3×ÞntÓ%ްh¹OÛ?·Õz<óÏ[£m~¡™éVŽÃL›`ÂB6d•‡bªwm·0 þ)SYþztG.Åh`&H€ [eºN‹ žP+)âûŠ Ìu–Ä ´–"4CœåLëqâ-‹‹©G!õ»ž–þäØ@±»8˾’ßí¸ÇêàI0ç;±ü`Ÿ)±gLÊcEÄtjý»ºÕËÚ =©´Ž¹ü~-Ÿ:†MYW~ËönöûÜ=‚õ—~ñç%¿M¾ü¤­ÈLj/ÆY§÷`ìNpàΘDq" ýI2lj¢–}%¥°((龟%3É–¤µÔÏ¥R(†ŽÔ€ þlßHÏ1î³y6Õå8BËÿ‘¿%}æëæG¶†ãîºL¬p;`ÔÀ¼Hj–ƒ°/%Ç  >¢³îÁÁC)z›€cÇDöœÚR:,H[ŽÐYRž$zí$`¬¤p@lŽ|*z\Ù-«ß< h½ûÚ¥SiÄ;ÚüóAQµÔ1¨ Ž’EŽ`ólˆi§=ú—O¿z^š¸g8ƒ2¶óo^D(J2„ÎÁ VŒ‰þ¥Vôk½9 tÙU–’ìå]Ó‡­Z§°.êÒ4) Wi*¶Q£B| íÔ›i™É».H—¹Ù€KD!íŽK<Â9ª-2®K§ûåˆCnKo,Ðjós¼1Ûƒïy‹Œe«·ÃK[¹¾2Ž×º!ϯŸ¯cãVµÊ[·vEú'¡h¿ˆ¶÷б£à¯Ò ]2æâB¯¢Ð®ÊG6V'xî58uZôgQŽ{fh®0‚6£[£|o/ͬsQhFMÈE¼/¸ÞcR¡ ]•,wÆM»¶yªkݲ·_íëÝ-Ô„Ç=8€ uj&—oÀk‹ð7d•¬š\Ñ[iBv gN*¶‹‹“<œö¦ÏZS¯] *|ÊSíãÝ_N»']‹nÛ˜¯\D,›'ß6õå“DB ïÊ\û4ÃyK­™hóõĆŸºF íŸMR¶*”÷åøž0ç]ûÊÑcgd°9ü,75EW ˆBë1€†"C°=Ä’G]´c¡v:@„«Ð£ÓÂÌK4¬-)Ìüf×xñ¾õ%)Õú” Ÿ¶ž ˆùˆH¿T|×iöšŸññå-踓´Ö¬ÙÚ´Oءε- ´˜)—÷yþ twC=‘à @öB»ý)•Á#õaÀ#bº+ v¿¨š’•4©l(§±¦.D‹ÌÞyêhsm¨êÈZ²±ãøü\ƒ)"Jƒ¨—Õ„ jÜzSÕc) ‰˜aœyÎw¡š‰Õ=‘ÍoßI˜Þ“nnzEÄ—ª,"@îð=_$ÐtÁë„÷ù”H£G9¹[ú¦&X•+#ší0ŸãÕ Â, ^ÝÆêëj€ç4ö$y“$ ©Ÿ1Ph–Îð¢[Nœ®~Þh¸ŽyCûðæ‹É¹Ý¹ÑT šSq¯ú½œöCÚÊxòvëÔ³ Þ«XµõâE ñwPËE\Ôüb•†3×WˆçD”‡Çî•uì¾¥¦l8,,WmTiIÔEX8"%1g£mb§%NÓÊIÐÚÅèçT>8ψWípß—}JÏó%uBTTD²°Ø™75(Zšj¢Qgšùôë`³ñÃÞñHí7Ò7χY@ASy/ÔAýoÚM;´ˆ,=IƒÛ¦²¦£5Y—xŒ]ÂSî3?St¹ö:z§¶\ 6§‹è’ׯcúž#ßÎΰ=>!Q[_ûGuæ…åf*í·è¹‘ÂõÜUõhõÀ`~×rÄ×»Ò9üìÓš2áöÙâMœ©càüäºU¼± ÇÐùáÁ¼nò-G?ú#*ÂTÄ&†Ì²´^&35NëMëefôù`Ò™ˆ“Îh÷Yq{2ªžj®Ú{¥‰<‹n aû1Dð ”Ùë±A¼P›-ÓonL §›ÔU4å¡Õ𵺂€ˆÚL@PTU‡•2)~y‹pùáUeð8`OŒÍO޹aë K®ë ²ÐƇ(Š”¹å‘ðÅ¥ßßåÕ‘9{¥Ò† ’’/ò€½F–&æÌ¾'Áè+V-¨@4cÞ¬ñä–dCg&¬~Ñ}6ÑÇ­_¯:GØÒ âWÈù9Ééz…P°9Kn°|íøøuqé»î‰«…MÏaŸüXqîí–q‘BÓLŽ•P¼Œl%²Ø‰H¿ú»þÓñ§s0æ¬5™sJ™)8Ó°]_} $²à-ðÎXz^Éélêý°ãÍÃûâõçÑJ-:!uó˜U³÷È—?ÀÌCÎE6ëØä9õº ;ç‹m!ô¢x6±Øƒ»ÏËS·o‹Ü›ÜNLöžÕ›BsiÜ^œŠ–ÍG&[Ñ÷ÔëÆ0‹^¡ó¨ÚßÛÓ&ŽJ=‹É‚ÂR;›¤Kܪ¯…`z>›¯°§íO@yî“3Ìå¶K1€ý*X®ît!j\üBç½L߯'_QÊ£_Í HcôamÉ€­»_i}Öt³9“ƒQ'ªv‡aÄ<QÕϲhlõ½+µÁ³a\>R†ñê¤y0¢=G ªWvlï£Ûósã—yìncßhõÉâh£ÍrOiøtTÞè÷@«žQ\B¬IV8Ë æÉœÉN™¼A¯Ô;âí€}v­§—ŽW¾­ôGvŸízñ`À¤½Ù=(ú¦Vâ"¾§Kª?þTôxÃKÓ›†þôÕŒBhÍ-@ôä^,ØC­ Üâx-%Øý&ZC þsŽ´p– äL…üÐéÛÁ⌵²Mµ?z#ÌÙj™½ˆ-ƒ»o/Ç΄S1ø(߀›bFCîQ œ¶!ù#\4¤3È•¦ñy Æ:€Y[¿3^x¸¸"Ô6¸‚yÏ õÓöÊ]×TFÿE_Å]F#šyœŒ–xþ Ô sÆT:æWÚM:•aáæö-ÿƒ§ï1’»øõ:’¸‘WÄt'^%"ZS[ÿ÷$nL«ž„Ăݬ7¹5ÖËŽÔ݆¼ ëZÝNùc‰S&5ÐpÚ2™_LV³â-;}iÙÝÖ(m_¨­`ؾrJÅÕ6ªX_Öe9í-°•|8…¦ÍD>­rî&ÑÌôò¾l7/6%°ŒÔ×AYñˆ <‡U ßÖ0 8$‹Žô&¬AHœ„µq(Š•9Ã]v︃P§=tí+Z†‹É £“™„{Çãgªç˜×¬×t¬×©2°0ÂT}b´\ÅHó¯ãïžluyèe9]?éʸ`®Õvðk ¥’\nF*âãõ¬Ac´œs\f„L­Ó­Ãôßz~Îú¥ÁcG/O9±.øRsøFÕVç2ˆîì]îàTÐ] ²]#U-¬Ú)mc˜ Ýu¿f±I°÷MØÉýùÄ(ÐmÚTW>6F ]å®@5Dc‘« ¸z´ÜÒJ/‹S7˜:'Õ2ÅwJæ)É[ލ­ÌL_w\ 7à¬À*É ÓvßÖø$úk9‚¹×YžeËÑ ‘[䬑p@­lE¼R0‡ÒÏëm¥%çw·u¯QŽ)s³a|!C<ÄV-¯l¡xêiP§ *EŸàe[žŽ‚êÄ$ ?vR9¶6‚Ç­QRäŸóqâ5&¿/*76NÁo]Hë4‘*0bLëBHÿi>ðyñ¼V5ëcñ@ˆnNº Q*fÇ“_œh-k¬m@gÈ\ åÊ[H£ÚΓ´I¹²Å‡ŠbR•Þy› Ö– ±¥i}ðBãOù[:¨B‚t‹­"}À΋BBFT˜½I›ã¯¾[ ÷F1zÛaGîÌcf[ùêDK«‡Y²ukq[šü3"“[u`é@3…7‰$™û5@—3PÇ–!ËG—¸Z<‡·]l\s„ŒN1 ðó\ÓÐHŠYbõO:ƒzáçÕXجBåpqDñ ¶o—W´òó’+h½k?ÎÔÔ&Áì@JFaðe_ÒaÕ™—Ÿ®Ÿüœ†gnºI"nAåÂâEuʦR¸Å·écðkL†¿“iÄI—6À%ŒznàˆÆ3`$KÝ–-)7Ï|ú=Ð{&§õÏz™õ3ù —ù“H¤3‡‰×—óòÁU O†Èh¬éëõšà͆Ví¬¡3n\ÒßW‰ONI +ÓsÅ_Áw|&n#“†ßØÀ.ÑV‘GØk“ð†2Eó='áÙ¿òßOol÷›/ºŠÌì±T§qÿŠ¢¶øùÏ ’#§„™ó Æ$¼Ú¯SÕŸ1xD¹å>+˜&ÛHÞIÛk›Ë¹ÝÉÑço#Øuþ€Ë Ò§êBl¯­ú²’“%”ùÖ‰—‘ðjZæJh¤+äeðöL”>>"åt }×(±2—å¹ë1ƒÓ.`3OÈwîˉ;cg¬G`ÙA²q»Ý€m©ˆtc`´mÿá jÐ2<ð‚]k¿[êIèúU2Å(Øeä ­§A[ƒº)6øÀºï­?5Ô7ØàoSa @1ìSáºã!±®¹…°ÏVm±äX iÅÄ«Na§´Ém[$¿ns’,«îŒþ°Ïj>>#D}Õ„ð—ÉXн\ލ¡æ —‘MÂû8.ž¥À´  ,£³”ˆ¼6au{ÚdªPÑjoÖS OJHÎYѬÿI¼î+kd*úq·½V zÔ³àäY[…G¸Í¬Æ$ùçòRˆão‚^£<…}¿üiŒ¾Îî\)ø´.8¢é¿s$iˆ ëÓUÁ7Ñç%n H³-NUì}[Iœm£$ÉÀ¥Ùb û üŽ,ÛE¤^Ã×SóyJP*‰^6¦€—Ò8ãLŠ`Ñ‘ §ÞuüUéãàãèMúrZ'!V†•ëÓrÙüŸ?  ³ã²ü¯äûÔ6%}˜ð2kñþ<Ú&˜(E!Øß›H€%mî ˆnJËäßN¨y‚ÂÄ-7¬h,ñ£¸áWE›C¶PmÍùaºI²sB,5¥;VNÂÎSYꓯŸ„5SÎì ¾£„–.ãÃk½X‚UèúÙ­ýˆÒ„ÂÀgI4š+ƒJ•‹8(˜,"ªvF{×ëØ©QÓOâKb­lSžãròô‡’tÄe*7¼6л/µ¹S.–Š‚Ë¡i©Ný”„—{@o{ZÂ!ÝUÀi4P‰T2”HPž°9„æ÷0ÓE…Æohº)å\µÈü $‹Oˆ§²sDy\æ ¤e,ñ‹h“Ê a~´ÛÃÝ£6{1¦÷œŒ£Œ rAô$uëd9q¼_U!¡½_ÝPYç 9ræt¸ “úŽï}R³oLgþ ¯Õµáîì("KlÓZ•"Ÿ‹»p,ìGK»fìÒ2¼”œ‡ k‘–6”—édÍAl Ö2lm´`Éìmå¶v…m1˽óÏ•Oñ”˜z‰šÕ\ô RžŽr„eí©àÁ™6†Ü-ˆŸ¸1ô²?xözªNCfZ¾­˜¸Úôê*ŠJÉs7Qa·G”jbBS~£“rÓuc¿š9¯.·%*kv•ë'”/Á÷£°ù>Ëýcïû¦…§Þ:û®þc›>@¯ãŒˆÄb®¥<.üùå+÷Gýæó-о“_K]à‰&S\nÓû0Œ}ñ&•Z˜†W‚E5ïqç{6y|à)_â *,2p?•æOÍñÚ fÀ1ÐkuEViÍbÿÊ ¶b™¦0d°æ Ù…ô §…çTÑÄÁ]á Vxy`ø4&1ÃNÖ.o$e–ðÔ]¼ ÖQ (ÀñÐ/,Šp^æ„ÁZ`yR|Ú|¡8žòÝù™8¡Ükñ`võ&žÐ&ŠÐ¦ÙLä@•˜ÑK’2b²Íî)Ñ×8ÀÆLSè€ri+Y·ècs!±Œ3ìýÞG£_ìqË[ê˜Bç0²@åžq6Ù³e=h°ŒË¯cjmõßékHC1ï~Uù!ÑõéìViß|D/f^$‹<&1Ç8ÓôPYó”Ú7F5_o-–â!Ì(WÙOºj89Jž’Cn*Ù°¥ÂzÞž@f+èöä’à ½õ&¡ØŸB(.'$ÐÇ¡9dÆÍÈëY“^„«ú?åâãv>ÔE&¤z;Û¸¬;Ô¡ô3´®Y]O¸„ód©”Ǽ¥> ðêïI®VÎe ŸfÝžðc”NßÈÊþfùê<òÑõç•©óáøo¦k|ïú±<¯š,á‚à2r3û5ÝÑfFÕUœV¡Š^&7ÛÌžOvÇ5Á±¨|î/êo™z:¶ÔßoîPšf:™“:³mÉ9,Eâ»ÚT/†ÉèƒîmrŸ PQCšËóê×`gú\æÙP{’™º‹0 »öÝq(ð óèÚ‘0Ï.Ãr„Ïséxý:Ûèw »±3~^6¥û);xTð3Øt%¸ç€´Ïâ­:Ökèž ëøW7MNË«šW¶è;Ï*ïñ6•Ô •XÆð­“o¹Ð9„ ®¨MxÔá. ú¯\GnáMË)9¼6J· 3µÄ;Eû|7v$ —­¸-µ¦†(ûLþ•#—H{ç$×UË9îÏÚ—éK‚T±t!˜5¡ßMI/eõÈgÑ/^«_e`EÉüPëgŸx¹x*#5ý ݆8¾À‰Ø€"­Ótš6pfmSUâTÍ©„?ÊåìÕ¥ÉÌ|ÆÅÒ¯íø¾ÃèܰµÇ+)‰¦/š¼[0G‚ »ë­7=ìnÓ§ž„pB¦Œ»5:óÕF¥ãI;._%ËnóÚÇ¥Y낳ÂùíeûFè`ëzE1#¿–§~Ø£rùö¸î—ÌdFB°ž&™æ‡–8ôëf¯Þl@FÖü+è0 ³bê£gÄ:§?Ð.Wû9gÛ¬35Ë–:jrÜádó=œùB èíQù ‹B²32Ö ¼½ jÿ3Ï‹Ä<¿._6 ,Õ®#M.Öü/“WPJsc²‘>ÁðݶCfYÿÜ\¥[ÇoS¤ûYUq¯é2Gój 3OdÐ=Fœh]÷©°@h„ŸugþGŠë˜2à L_=s0jEÕXiÎx'5î¼ìm õ¹ˆÜÎ;g`¦Sã{ d~m4rÇÑ奊^r¨Ÿ›”wôJµ:™ž1ÿF¤ÒJ¥1T Âôõà!‰Û„}¢Aù<ìâf¼°w•O†ô†qîjðlªìJ¿Ë)û'RøPýj…{2cƒHÉëØ½Ï(?xOTÞ¯În»zVnÀæii?rŸÚ]ÛŸžÿ¾Èä+Ào«‘¯Cô{¦D?ôM1UfqjoÉ‹ƒÔ9›Ù:g\S ‘"Liºu}uÓNzÍÅïPÕB1¼uãÏŸ}¼*Hp*Ï¡à”n5ÄYl*ì­™©=ÞP†C ‘‰3¹Èï1éÂáûسѯÐ%êI E:ÇÖÚ°´É=¨w¾0«+=Äót‘cy¯A,%˜™@?Þ'c³ˆò=+‰`:èæ3Y㈠´ŠŸV%5,÷ŽXtÎf€! P¦þØI6':XH´9$rüYX;ìþ"¼ê±±‰ŽÊñ®ÔÝKŒB`ó˶y;©ãcG8œ„ |]Ôå×7Á䮋•Dî × ™ z ,{›Íäê¸H¯O‹³4h‘wã’‰ï )9«¯t)<·œ“TÏŽÎ He 2›xý±ñšª¬E·HoÉQF“|NÛŠ^äÙ+ú![)+pìÌ6R’Ï‚[HÙ3¤bΖŽ]pZÌÙy¼eVS½Ñ ¿ë!.|,™Îmx‹íQ9¦HÕ>ÂÝ&Jrb2†»õÓ19 y\xò$«ÏéÞ7„ïWt•b:/ºUôáœÀ_e-:)%\òïÅé]T2Àñúš ÒB­ð'· µE9k8ÎÞñt•@°j¦L \Â=ÇMÔ¥› pwäPgô[v{Í'¼äDbDXéÄð”ÚËÝ‚b cdUþŠ`OkˆqÊ\$½Ñ9žÜË%O‡7|¨-µ7VáàÒ÷ýúÉ(°…°)r$ž ¥úÚxüpô•¬ñ Ì›cš3mhe¾ÀFz•ìW'œ»Î͹ë "~ºVxf“ý”ñÃC^Zñ1i|>2myÏ ¨çÐëï8gŽc¯b ÎP¦à¹ç½“Î&"èc•}óÎ cq@5!mEL…â%¢s“­G!ÚÊïuíXnº%U6\!ùMpa[¡³yÒ=3ñÃyDĹ+úð-rYæ´ï¾Òê…ŸÚ¨fZœâu\¦å—’úrÄ:Oeš,Ö8âYlËC²aÂ8ŒZ£™õ+r!l‹˜7„ º3¤Å‹”gã* ¬…wÐã}Ædê¬ú’ó+QØòw£Vs­¥ÌÙ“Ý> ójÐN( #⑳§•8¶w©·Ê<1i~HF4cÄéÞ×OÑÄhŠa2 ªŸò.È$ãb~q¯æö?—ô *ƒæn3Øï{õ×9cÞ/£º×s""¨n¯^7>Çü~ËóËyfXÏÉÈ7œkÀøbŽâÃ#åÜÏlñ=©çÁ0NH„hãÕÝv5ÓáÝZà á]Ož‘NsR{ŠºÀuðÄðK©'W5Z58nÒ;‡![ìêŽ\¿ßjϦþ›âÞìÖÔ*½°•ï¶‹i‡èÆYŠQ¹ì¢,=l–ý/iþ¶¹ñèq£úØ3ѵÜ_éWr²;ÈÀV—Ÿ®ä©áH²då/0~*)Ɖd[¦.o°|Ë 9¤@ª0ttütX»ÙoS-òÅGV|mÄ„˜Fl?½ÖÈ6è ’ë, s“wŸÖ,R;ÀÅ• q*`IqJàÀ ß^ߪ‘d&àQö0òyõgFd;Ý›pfCÒXþD"º“õÇöEVˆÞÇ”s÷…Än)‘ˆ—ü<ÉIu“_ÐÄSz3~Þv, Åþ<«b”ÀO¶ØÇú­CÔJ” Õæ·\°ö{mQ ´ý·`Œ‡µì¦çxö¶—¸ˆJ¶–½R*Tù l2/iþpÄû-+¥JýŠr€ácìý9«Ñ–ªÖî›lõªµ¥‹NðD, C’#ƒbæŽHGvø+S®&ì–Ãî.oŨHlg³Ç“+2öóÈß]£¨Õ´xžÅ¬!Ô@ßäÓN7Ñà»s˜b…ë;)Ÿ¼ž½¾_"C—^ñ¤¨^F%Qe|¾« z(û;rd’æ3ʧ lìŠì‹§âSA_˜<â×£ Ø»À y?ý`6L)*™·åõ$KZû~füL’×?rÖäSÜ}µ?Tɽƒ.ðÛñ¹öh²E.<&ý§šß9£“å¨ð¼îá‡ÜfœH6PÕJ#ÝTᘛ’nbú|¼ýˆš'óT¿nɧp0ãô ]zPLf S>$F±²h÷ªØ¤H™%ÜÞ¨~R‘æÛ܉ ËÞK¾ :—Dý“ÕWþMžJ8ʆ}0/í.µ¨œÔ#Bö%önˆÄ,ADbÖ3&ˆq(s- p•öØ¿è?…7¿Ü­aEÃJv“haiÈû‘ÎO΃Å:|¾µŸÓê™ÆöíÚãÆ†‡ŒNÉŒÒ“ð‰Øƒ~ƾ@qHÓrÿêàv¡m Òò¸ ”×¥¡Qëji¬Ê‡•mÈ,äÒÊXÐl9©±? ÙtÒÀMô»ý8î½ßÝ•r~ŠðPéúP`ãÅ’Xpî<ñ`Ÿ»rÁœEeU/£Î¥Hm¸ã$a9îËãÉšoÚÿyÈ Z³?šÓ G`áUc3}l ÖƱ³åAon t©2ÒŠúNvÑ䓉¹¡êNMŽGÝïÏIßQ‚ã %pÑQË}P`EÅxTOÂ_z÷j9ê:¦fsøºwp@´Mýtß ’/.Û]ÐÉøã$ä¿×ÇyÑìp¸jÀ!ã°"l}núÎ0/³v†¤gö `L;}´Þþ¼º]к¯§àr’õ€íÒ•A{W°·2™!ãE«ü¨Sh¢] 6Ú(vμ¨’øö–ëº\}ŽUçj{ Ýݫȩf¢"}RÇcš‹´ÅuÖ‘ÿ<ñ!¾i¿p×èâ^Xn>àSJ´ÑsvÖ kx¦™F,¬ %Ž¡ÌÆ)pñãV¶ØØËʳCfiðÐ_ã"b-©ø>»5v´v©£(–mí9¶YÙpKË|Š_§¨³, ¦¡ëczÈôǺÕÕt• ua™ú6Yˆì§Ð‘=t/c¼ž7éõÁ“Kc)‰ožˆ•E–±Vr»_ÏF Möm,ñСXÝ”èøÃc3× fê† `•# CŸµæ¼E\EkúóŠ4+Z_5®Þ}9êÚÑ¿/.ñºB3r|CòѨ# R’ÎhHûU,„våÝ‘,2-9XáŒK„D“^|<Ž|ímJo‘Ê^Ó”±Ù!ž!U …HŠè'´&¤§_©³kÜï(¤çà›èÛ[3 >®‡²Á¬FÜøÔÚóØp„¿ LÓn_hêF£Ñ¯©øþ5-jÔZø›ª„ìø¾ˆ)‹Ujæ>‰¿–ºÛvìôØMváó§vŸ!*Z NVqHôØÚ0t=õ O#LFv£c*šûvû,üZ4mŠÌR­=­R»ÄÊ ÷óžÀE7-RÆ–ùÓ{X¸‘ù„f¢ó(ÇtÎEðb” ë 1†äþDˆÂÛãºõVr25R·µ‡4jÉhj–ä.­IÓÌ_~Gúü_õ¹¸>‚âÂDïsíçÝG3ÄêLt¨YÎkQLÛIàU!F$‡ß:‡O„‹¸W"Ÿ>ëã –Ê©ÏN»9Y€Ujjq΄¼¿(¾'ÓA‡W¾c, "ûøƒoeÃ<·E Äq§·d3©¤šÝmš-L2†¨ˆíG¸{@2x¾ã2M/*þg²Rl"-«”¾oÉT·š¿ Ò±¾œ‰Ñ­œ[é¬)ªØŠåšQ!¢,ë¨Ø-,'{n…CMŒÉ”n‡p[(^ `ÞžøŠTGT‰{®2»^%á’ûÀµJeìÿÐÃnö[&ÝÂM‰Â~é¡^c¼KÊRÛ(P‰«‘ ßì—ÕÕdÙÝŒB¦¢W"nR´žÛØâÆaîêŠ?„æ/¨Ž©ÐÌVÄ{¹-œæ‰/ìŠ3ý1ÒÚŒwÒ'˜j|[p°´KQæé¢£¯µÔW—²¡å6Ÿ`¼:n–‹ò—TÇ àý©à`úó ÀùI ³¶F=l®oi„ë"v@1/kùާª§‚1‹Å´3B©| Oh>–U©R Ü*œ¦8!ŽÍ»ï‘·ÍÄœ·öîLÊÎä*$©Q.>–¨êæVË?îˆUŠU˜(Ë+-É@)<ô^š0Ëö[œ4ÜX™¹Z󱛯ÓIôÒ5¦iltPPu{0ä;kB@\âÙëÂkJÙ£]Åí¨¿ÌÐÒES]ºíb…Úëˆs÷ñt°;GŽD£ì @)ƒÁGíDklÐýFÝõ_¸to=*2/<Ä+\¨jç«Gj\ØÎ"Ï9Ÿ1'ãˆT[Ñ é B£½xë7-Ó^Ã勹½œMçØìBþ‚±1+ÏžÚ`ö˜ÿ3Üç?¸“x#jmq™°‘Y]xöR¶½Mbà—ûkUR)s:þ²²m@Œ©6IÏ‹ßﶺ 2H¤Ù©·íè(¦«¾nyZÃ)8bÈ=;×ìÎGá6Cw Û%·è[¯Q Bm>l˜ÒWp(Ög'|tb~oŒä¸Ò¸äR9ôøqçÇsF¯ß S.Iú-q¦Øo&×jö(TBÝxü-çkWšC%ÐB¡ 2üö¡½ŠxÆ¿ùé(>fvS;¶çãSÚ·."®ó@Cp†EÞ¬£ôª! Kì\°žløÎÕ—î®s™õÙa¤lÅ¥ETÊí—pRŸ0çŠeê%¨0ìl;÷ǪBÑÌŸ€‹ð†>¡†©Ú§@³m8¥ÞT© Ô }tiw{ôÙwu÷Ïl‰<ê¥-˜Cd–bUT‚áþ&Í™_Q?eE^ׯÍg9ˆ‹ç—ÈSM­;[ï[p#*\…‹¬Ó®pÈ <4:³ž$QG°«N*"¹icLJ»™C ØWá»;ÁçGO´JhPã`¬?ïíœE’ÆI«ÙÙ‘ä_ J|<×·Zoê$dyy˜YSeÌ+Eãc±¦6UìG~þišÂàO<ñPh6‹xH™=‰8©GOtôÓÙù©X)1¾aá"¼HJ]Ô¼Ì,»áòº„j¾-£,‰Ò 9á\~TE‘k2oN~gQüƽ¼‚ ³=Ì@›¦#vµ›ªg¹'Ê£¼ãÃ%âeàÍ‘üÅ×p¿ø²Ù§_çõ©ŸtëRTWÐf[‘å ­’ßù|µ09ß$³†;ïRݪ±ŒhŪëzÉ{iÚªÛZÖà˃(8Óâ)lj~x£†Rn ÔÌr«Ñ|<(cœB@ö¾ç8¡‚ ‡KnRëÈPÀWîØ¯‹â“/ú™Ä÷õlŽ‹›Á)×Ò|C§yµÅØrÅô<3ÚsáÊ5™hòÛ·¢Í1ÁÂn%Ó(ˆÄ—«.)„ó¤v55*j5¨V†ç²»¢úÅ$¤Ó†açV˜;Sþ»šŒ7=OcÉPÏ«&7‡”œ_2C¨&J¨îõ5!Ã"+dhö½ðé{œßñ²ƒcu¶è,M ëÓ{”1ÕpËÌ,š®½Äýá½´ î‘[ÍÂ8àÌŒ]+·ÑÐe¬<¡À\%Ô¨¦Î²j—ü*i‘©×bÔb˜’î#å>T4GS`)¨OŠ› Wpmá*PŸ€~–#±` ý!¼AÙóüT¡³Ó×=>(}­ÕQºtsÌ}SPGÉsüÉ´ìrkhnXfÊj•RŽóîùqró)3:xÎL>”ýû8¾ÉIF´SE¼R#š×-«v©Ä]$s’ìÚ1€])îßL¹a–hU%äèÒ|¡Ø[ažb ^Y‡Ó|‡bˆz_C±ê•NçÌ<DnÅ50g{æíÅM÷vk0/¸âûYÈÒ`ˆY»Bò< |0êÇ/†Op†CâBöš‡:ý4+IñJàXX°94Br¯ø çå+ÔHÙ·ÈŸ+Téæ²-ƨȄË<¼Ë> u[]–ª@¿ýŽŽ™eŒ8¿¯¨4b¯‹-Ÿ/è-l•ÑD™nÉØUj!¾J®ørۨѲ^È}¥±=„iœ"X&M¥>ó\p[#+ô!3gÕBl°æ 'óÄØœä¯1Ù\îùî~8èø'§)´]Då•u‹ OË+Û;ÜgŸk÷@1%xy4e³Üqy¥ìwï‘a ÒÆ8 Ú"Ø(òóJqÜÆ¦ÂG=‹Ý·õ É.RúM© „7ãBÜÚŽWÙÞVat“ÔÌyûó¾™½‘¡ÊÿƒU~ü!ÕéÈtn}’Ê—I‹UK ŽS\p£Æ‚É<Í©I4ÕãG›ažŸ-#÷Óa>¬Ð¹ÂÀíã :¾¾—î¨eÂcÙ¬ÏbÖÁˆ± ‰±9ü±—[ÊœN˜myÏåú1ž½_,Ip«²]Ö± _Íðpr3eö™§Ûˆ ˆ‹U]¤BMIp`7ýøX¿õe|zëoAI+ï.h¬)1ùÚ²~8fÏvÑõæŸÿâ‰ÇÑ’ Ép4¨[ç÷K[zö¨sM`(Ù|ú)óŠ¿qÖ^Á¿Õ_“¼±Zâ§¢3×l÷öž$ÿN$ ´GZ¿\ɱ3[æ>[ŸŒÎ:Mè\ìÿ›!ýz endstream endobj 323 0 obj << /Type /FontDescriptor /FontName /DZXGTE+CMTI10 /Flags 4 /FontBBox [-35 -250 1124 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 68 /XHeight 431 /CharSet (/A/B/C/D/F/I/L/N/R/S/T/V/X/a/b/c/d/e/ff/g/h/hyphen/i/l/m/n/o/p/period/q/r/s/t/u/v/w/x) /FontFile 322 0 R >> endobj 324 0 obj << /Length1 1486 /Length2 7166 /Length3 0 /Length 8167 /Filter /FlateDecode >> stream xÚvT”]×6-RÒÈP# Cww#ˆ”Ä0 0Ä Ì -Ò(%R‚(‚”´tJ—(Ýõ>õ>ïÿ¯õ}kÖš¹÷Þ×Þû\ç\ûÜÃqÇИ_ÉaUGÀÑüB i ŠÞ}-!a $" qp܇¡]¡ù‰8@‘(.ý$ŒÆøTÁh Pj{º…D€BâÒBÒ P’ú ˆ@JUÁ^0{ žP‡¢ˆ8Tî¾H˜£Óç¯G 7„($%%Á÷;¨äE `8PŒv‚ºa:BÀ®@cEûþ«·¬í.-(èíí-vC Žò<|@oÚ hEA‘^P{à/Ê@}°ôOjDÀûN0Ôc„ÚŒ„1W GaR<áöP$Óh¬¥ 4p‡Âÿëþàþ¹9@!¡¿Ëý™ý« þ; ÜÜÁp_Üès… ÔuÐ>h> nÿ vE!0ù`/0Ìl‡ü^:¨®tÆ0ü“ ‚„¹£Q(˜ë/Ž‚¿Ê`¶Y n¯‚psƒÂÑ(¢_ëS…!¡̾û þy¸.p„7Üÿ/Ë·wøEÃÞÓ]Ðóð„j©þ‰Á¸ˆþñ9BÑ@1$),„z¡>'Á_ îûºC…~¹1üÝî@ hÌŠù!òG½ @4ÒàÿŸ[DBB@{ ´ƒ:ÂàDÿTǸ¡ؘóGÂ|€– Œü„€ _Ÿ¿Ÿ¬0 ³GÀ]}ÿÿ>bAu}uUcå»Rþ;¨¬Œðúó‹ˆù…Å„€BB  „ðï:ïÀ_ì{ Á°?Wú§¢Ü”úƒf÷þ"âõ§2¸ÿà¿;è#0z†¹ÿ‘ÿC‚ùú?Áï”ÿŸöUù_åÿß+R÷tuýçþðÿÄÁn0Wß?={¢1³¡‡ÀLü¿¡¦Ð?Zjótû兀™%¸#FçüB¢ Ñ?ü0”:ÌjoCCœþÐÒ_‡éá ƒC (د{“ýW 3zÌÝ‚ÂÙï3Yÿ ì °˜8ŒD‚}‰@ ‹‰ý…0³jõù-q  Ƥ1€$ѯƒ• jýrý¶$…‚F[R@Aðß–Fœ‚Ðÿ01™Žÿ˜B   ü?L1  ê·ù¯åB<‘HÌDÿÖ†Ë_öïë õBˆ&Ç™pçêðÆ“*%oþ•~aQÒŽ½˜BÓe5z¯µ{¡*²§û"ù±J-#«±§ó”ß…‹¯ë]ÌhA.ÖßeÄJÓNÖ6â;Ø-ñ=¤”;ûŽÒõ^Õin¶°Û;Òn¿3êò>Pæ¡ãóØ]ÍÚÐå|Wq\î´}ƒ«nK€§?>öÆmIIœð&¥¬¦ å7JÃ#µØQ{Šý?R˜Ô7N3Ú{„Å;¦Jù°a  ››¤î:Y›òéë­âÛAà0Çr«Úíó'Ü¡á!Üv¨^cÙwFF‰º)Aö6½—µž„ºkŠHÞ[KÛM>± ›«,öç~ä©s?úzJÉå›Rý5ÏBïÎæþsǬ×:cUNYõßQ|!|…¼šSïÂõÅKŸ7… ê7Ì)ŒÏ¹v$JÚUºöœÝ®wÛྙ¶½)Ùü–’G{¤úÃXœëq¥:ήd³å‹p¨xž#ió×¢ÏwòT3ƒ×b3-¥SñG?ÆOãßwåË]¹¥ïQ >¿Cá’®r#_«Üø«‚S: /ãuê³Óu§þ)™›yµ÷5›¶ n<™ñvS¼ój"_;‚}S HÀj$£*³º„½ºŽkBøj(%ˆò-++e•ô°ó†{ezŒÒÜ!z_ Æxê±™J|wâ:•$< |¸;?”k]‡oj<ÊÓ¢ÇîßIÜîc6O,m“Ë&Ì!—boý Ýb9iRž»ñôå‡ A&…]œä÷Z’¢šÈuœW3ý»Ïg|Ô£ùƒ°°ã茮¡‹fNõÇKv›ƒ\ú\â’ÖˆàxÀÒoI9a÷gÃóYmð&µÄžU"´ÆÅ–ÅÙ+•"ÖqþM/šMco7Æ¿Š:E9±ê?ß ë^¦a1ýùæÔ¥–…MëÞa¤Tö¤=CÉÏìŸy÷búnsí)Ï´ßÓaPžTà×õq¯}'4Ñ£ 먎»×QÅÞ{Äæ0¹JÖ¢»ü@ö’^› ±ÇCn±y(ЂÅnRÊM^lV ÷РÁ/;¢k Î .+,±!Éa¾f€aÚÖL#*ÉÙCÞ÷îùýÔÄ{« F* ž¯¸œçg´Ò¶Þ¼U%& qäˆ&s2÷°7þ„ f²P¶ÓM*UÒÃZ9ùKÊg˜w:wnáÛ=ÜQh³©¬Ozý‘07¸Éyà;Þ­f…Í($#d•LŸF5Y¯ç4@`û¥ C6“1mœø~í§–MÀD|— ²¤îO†³r;a»E¯¥ÖÞ’ëô‚¦¾×ì2BÛ„€ü\¡š<ôÒAŠZ*ÁÈÁ{s¦‘gðGhW4ÜŽX:uiçµê÷ÉŠ<=b5ÕQlkÐ…˜è¼0ÑzÂâ¾¥-æÎp«òøZ™ ËØOéu³«Zn$Õþ“#– ýMA_\=vdy5Û±NÇX*i´!ž×¶¤ÏË$)ˆÖ†B²®‡o‡v[»ºwÐÌÅ,} SfZé³Â¡LtÓŽ‰.W—F›”Ÿp½#;r·’D1J,”oÅòÒŽ;ü²–̧é„D^Ûe­j…ÃF³XcO…”cI4ò[í<€è@5îžs‘ùô°P›\AEæ¦NTØ—"M‹ÂÄv‚ÞçŒÞ]aùªxK“áâ*)w$c­6ëù ·•&[³ó ‰?¿føèüéTA&¤V«Œ.WI£øÉ¢¹a³ŽMwÑäuCÛºòÊf9xÈTªYéq¥ª°–Ú·­KÓ#ýœ7¼"0%th(Y 1ñë†6„ÉB['¶ñ{'U,Öý×bþp@GìQq4‡Œ¿€œtôde€•RJbøÆY}¹ ŒäDîñÑe€tÈ☷þöµ81ŽlH4 üt‰:PáÁðàÝàÍ´²)ɤƒ*#â%$Neˆ KMíÅ™¥8>Ñ^ÂÖaŸ_§Ç=•¢Ø)Ӭ޿)Õ蹯4 ‘•qaY>¼`}Þ±ó>ˆ†¨šU*2wïž©²D©¿¹…g¸ü[«¹gNÓu¡o_ÐW²5ÏŒ¿MîÙÖ/>è”ë—¤wtiØ3¶^·èí³§È­öiÄ[ &L°ØgÞ!ß$!þôRžPyXî˜Y«YÂ.Ä¥ŽÇqGÖ«)Ø­Q=€Ö³þÙŸ#Á$­5™cSèj5i·ASx³¢èörpk•1Ë{ ÑžùÄË1%8ÿ"àQãØLóì+‚@)ÛÞ/›¹ã.ýá[7kÉV¯¾G+¶~Èy*C™fÒ\u…ã,Ä‘8P'«¸ŠžÀv8<€E¦u_‘˜•? ì·¯³$¸2¿ý!ëU’7.xöÔD‹O„†äùSF`hÛÏ 9:²6ûÎŒ‘þ±zP«€ÞA|…½üò¦¨õ¦ö„™Ç´ÿa{9¨Ãažµ¨Ó»ý„Ñ¥óF«aÂ3hÄ~Âþ©ŒÖÜ×ýÛ$Á~Š«Ì[Óô‘Fu …JKåcËMl9OK{M)D¶¶(bEéRªn:GÓ$Ð;½oîŸtâÂõ§]·ôÞ/ê^ “/ôxX|]{Ž:Ì`p$æ3ï?ì×¹¤5[À î[9"Œv¼“°µºaîÅf¢6DGJßÅy>Û¼I¢\ÁžUæt«~`rX=-§]”I#Õàç‚&‘ˆÃ?À‚“E êßõ¤áZ° C²ß%¨˜¡z_¡Òv’Ÿãɼ6Re™dÅú·ëœdâ é^‘J#ËÀRû³µé¾È§‡5ÛÌ&[çî,ý‡!ýdž=Äï]ZFýKñà}·¢Öõq¹iœPÀ¢}@jʉãïU º1güa‘àcgÑM÷ºh®–*Ú>á‡94,‚…þã3þb.…UK_gsÎö#XJÜË®ƒnG^Îfr(¨ öѤ3Þ”š ú¤ôàÀÝ/g¡[ƒ²M+˜Ã R¡Mô½ÉäÓAõóÜÑ\ÿåÒ¡â XL+o S.U T~YLÀɉ*œ€[¿{ëþõì{-U*Ö­KuN­‘Þ=Ÿ>&èY&Ç„¦F³´M´ñZl/ìéŽìqFk|ž H…ªò+3u—2²%µða·úë±—¯–ý>tXN½^ Å·Š`–«‹¼1ó®f›÷¬¿§/{-¾Ø\ëŽöq¡\ú¶i¾Õh{šK?\‹­5Ö™u#F9RÙ+Äkrªm°ÑSýXC_†Ÿ’|ĵW§?øŒ5ì§©Q‡Zþ¢ë·ÒùâÑòŽñ];üÐ%€*’+/Ý;ŽKG®®OÖÔmR˜Wyèæú°’Z…‹~‹Úêb¦›sxß6#æ±i(qçƒdâ½ý:—27Îù˜Õàzå¥8ÅÜàþç}œc¦IAQbskƒóØ6òæ[8ÎÇù%¸QªšM¼«8¹úÖ±9¼^äp—&Ø{6ÐÄñ¨ÅD5~¹àü)ÒbTpƒïux¾þ+!œ¥ÍÖéDÇ* ãzá<Gß~â†IàTß“¸ãðx¿Ùî2n¿ãÀ¢ÿäçØ÷¶ãº‡ÇˆþTñåf­/ÅlFÞYpT:Ÿo.zlŸ±Ø/ìœGòò¼¶Ú¶H¬Â’J©¹ŸÜ^:1%ó2G5w>3&ÃfÔQ&jú¹`¿¹_>_7Òê"lªý`¿p€hðaÌÛä fÇ“µMváŒ\ö‰s·uºâP¢D:ºíŠw¸³ùJöaùžík=bÊ»?Ú)ZÖ¢²ú:_kƒ‡xh¿6»)·lÉá@ZbðbÕê$RG±)—Ö/q0dtœ‡íÈ£¾gçC´†ˆpl—s$0Ü‘Óqê² z86Ýz„­wV §¾”ÇÓ:O{h„[úöKþóNÉÓ¸Z²ßÊSn=÷Ì ŸåB7Ƕ„—ªÙ=`¬i率#j2­ÁùÞºîÂëOY åd’Ñî$QÕ_Újšx¬Y‘›Å_|9BÛP=ÑÁw’zÆšµÅþ*æåðS.·EMÛÝRÌgKæo 6¦SpÓùaÊg1Oyï~·ÿ¸bFgÞèEjA¸WôED]½HýÊ=D…Gˆ÷tËèAQ5‘³›Ùã£-&?)N™~/}ÀýhŠî¯0wæ qZÔ]aÖ Hs—yüs:®J})rÔ‹NGŠ¾Ñ¢¡‚:+Ø7)Sœm>%bcµ·©LÅ“GL¤ç>C³¿Þ¤îü©;•; {Í“‘šc>MåëIúh™HäË[‰¯00[“¬ö5û­ M·…þZ}Ê+5klÖ†ÉûO,møöÐv^*ÖXv« ³çá€nŒe`†=>7«»€a@§ø•Î3gŠ[ÑéÏŸxô|Q²Ó/(߯íñÚ¾æŸ;æu¨¬ó<äÜàx·œdFn‹ÖÙš)a¹¾AØÄÔ桜—…7^^[ð À­&ÍÊyFdP÷åðr`+iUàüYŠ¢dlÚ67¯˜3©ÃF™ €¾ÈŽ5Ht4º‚'ñïÚ%£6yøîvû¯›¸M…p¥Ã_©ðD¹Îó}®ä¼]¦“ó‚Ø„P'oÇ?#P×ä—¶«8ZÚé½UKcŒ’<.بÁr(”N²§¹qFß;Yö^Hna+çV?12í§÷" è’üsœ÷²ê(Åôî ¥ÁVfXý¥ÜÄmî!’é`‚ FñE•Ô‰ŸÕ?áïGîi_ìï7h§„ŽÛ>Sj+*>ëSw+×81v­‹R~„MšÞP °ùå”›l_x±%wNF­Nª8-%P'9L!’½:Vh:­ CJ“Ã;ÅÝøtГֽÊé_l.D`¶Äõä¯Z^¿Üì÷¼Dj~½«ÒàzUŸ²{/‹“í¢¼Iõ³g3Jv¨šúܨÖtÉuŸ¡. RJpᣌ¿o¡  »Xvi:50#þ ³¸e®¹L¸¡qÆÿb‹ññû«Šo%A«ÂuP Ë'Y„>&—£3ßÜ<÷þ9ñš­³~{xˆÐ{ë8X&¡0a¼“‘æEâ†ø=W5”˜pp†û’eóKÈ6û–~i¼a_M{lÈGÔ©ÔÖœÐÈö=ÖïÑýëäÏíÒ˜wGŸô]©Ç%¢¼ø‡—7ŠN_—ë»òš­ÅU¾Íæ5} 賡uB8©Ó“J¥¨X™qE¹‹>tõLì–Jƒ•%Øt$bzª)àËØÇ›ÏX¿KÖwõåd¯?žá'ðÏÕ_ÚÙ£M­AÛ“Öð‚Yã¶ýna9 ƒõh® ßð(ë²}$yGâO0í¬|?I¤ZÊ$!ë{9ú½Ó[‘§…Fvï˜%m%R•€×û7X ëéUïòéHvÆ}Þ»=teü=>—°L¯Ë–KϬ¾kV_´j0ß ?ô óŽå¢úªkÀSó\eëóv*O¡”?ƒŒ¥¶,`äpä"Ký¬>抪B’Nh<ðôS²ñäÓN5©!¦¢» }³)|ùâÚ»Æm5þ¸»W1šäãS¦d~ïµÜM×<%¨ð"Ý¥Þ ß{–1[Zd¸DY*\€Çt ¯ÑZ©ÿ»7²¯/_ÿåNæÈ!ƒZ\÷\¢ïÈÉÄøî#¦ÅÕé=Ggn¦&=… ¨4^q]+R‘Xù=„Éá >ª–‚”^{IB¢ãªÕgöp€‚¯pÿé*6ûñÈÙÌOßê±ùÀ J⻤‘¡‘5€”D¾§Ô¦O<üF7Ñ;xªIÏæÔÉ\¶ÑW÷ÈöîÐt3Þû®ìz‹»ñ‹hÊŠüœt˜SȬW¹ÇÙ§c­¹†UÞ Óâée±¿"ü©=TÉÄ®Çõ áC3 /·|7ÜT}—œ[XUš›€ÃMr r¼^é³ûêÕq)à …’¸§£óQß›ÉâÈîD…u3h‡Éè[äF%Ë2X×ŰáÀ›Ó“ƒÚöwð’æ§×;/ìâÄmå:G˜‰úܤEN§’ÌSuxÈ}j ûœ¦ •n…ÎNC¸YLèøñ’¥iÔ|’ìJy$ØÁÊü¡EI§<Þå“çi  ³òwfQ••q­­‹hó»rVêfKò)ª’Ù\T¾s‹Í6ºëçò‹¨<%µ|ŒjÆl8±èŠo¸SÄ·Üþ¾ÑçØÊàxÔ e%×ÖûŠÊ'E/œ˜}cXÊív‹ W7ŸHÒ¥ißÊIþ”UÞ“}¤?÷ÖÞŒ¯ÖŸAT1ŒÓ¤D ¤SˆÆ•3Û°I‡xz¬ìž¿Û8×ÅcÈ ^h%ý‡' €¤£xÏVµ‡&'/tÔÄ‹H`ƒ_1öƒiÓn_µš½Ç{+ì¯ÒœŒÊìgß$ ‘">ô®Óq±Çgõ [´¨öºù6°ïö³³RØ QÂ7nÞºª¡åœæØ½#¢Š+B mÛÞ¼íW3_›Ûoðɽ¿ÛH>óÑóKˆ Õüä©U~Œ°“W,E ¬½C¦A»–ÕÇãô}”u'™—ùÛͲ.Vœ>Xgc:Žì•„[uK§ÑEÄ9^À™§ Áå¨mèƒßˆp—ì»W¥Šº½=bëñj¤TB§i#ùŽð$D6²íÊ̤ëYH?%ì2Ù¤bŽc2 TMþüÃÃ#îÁ6b-Ä›Q×eÎ|¯7”έý;  ÿûö8KKhPúý@Ú “ž2ÑOI³°\û{ý5¨'3:Ee«Ø,§^”ME}ëµÖéô×°Ü>Ì´¦äµï­#• gŸ­µÑ>çus?lÎéÑòó³’íç¾æ|t¸çaz%{‰mIÈ\žÃñ{Ä Ÿ„ Á œƒj&‰3X0çUMQ掠ÄýFI#Q­|öP§¸ÄuÚFóÎk™ã€ syÝg7„øéˆ²(ë×ï8,~·uTs±½Oå±W-RÍ›œ=ÿ:1I›ÆJëáp½Ä(±öX}ìÓ‡ËÄhç—ŒeÉ)Mœ®¾~é!½v”œÞk€Q«¨ŠÅîßP¢p¯†bvaȩ̈«7WÞ¼K‘I »9Äß<ââ¹”×ßò¤uÄ+] µŸí¨< £?‡¿ ºí+ÛY>ô ç×1r¯ÐXº{¼ñ'‘`q»‹o7¿hŸ®V{’»=×H7=ª»Í÷¤£ë„¢Ìf§ð‰†|Æ·’€' Ùûç„7ßç÷ÝøNó8 ÓØ±©;o6U©Æýs|·Z'RÞ¬:‘Òìàä]¤"и7Ã,ïÅLo¬Æà”Õp§?eúÁr×u…ÿâDÀ’³Ž÷Ê1ÊQL–W§^ׯš¹×Í?Õ lèaFHÊÌ~b «ŸœªÛ…ݾêCF¹ âTVöuIÅÜ¿ôÓ05LÇy÷ÅeâlË“Gú9*âú£¦_Òc[ñ†·G~_³Þ*‘NŸwõÚ·“¤¨(0_r[™¹ö"lèXtU*Y;ž`þiÇSá0ؾ4éI1 F½ë¯¾Iü³y'Õ@NêòÒH7#;/Z/Ôãâ¬L"ÈcHÙ ¦š »-`äìüîIP2>zztzáòÊ7NF€ö|7œCÝ¡èÓ¦}aÒë„ûZ­™–Ü®°óᦑ£®S*(m )Ê®Ò JȰ®äéd…ïMw©µiŸ°ãÊ&A²ˆ¬të—7ÜtœeÅàõ.Ñe 'ÑüqwW[Þ è7^ñž1E™Ìî †n úº$¸“R)?¾]$qõf€‰^G²“Cà’y­´hßÚØu3_ÿºožÎ…ÚR¥b—\óg =ÅXÚg}¯cÁaV‘ š5E¤sö…, «ñò||W]•ÝÊKF*»ÓUa±¿U}!æXÆöäkî~Æà¶p•ç†î½V³ƒZ416Îõä™—Íi_×kÀ‰qïžO°7’²ã’sŽÆ²D°9ã9—/ø™Ô»á&bÕC‚p9 ¤B'÷lDx›2Õ¶teôí:ttEf¿å…‘ŽÁ´IǧJözá=ÍlpYõè—“#ÆÊŸ×nÍÏs¤ÍbÈ~oÆjè"³Ó[y¨”Sïå”3“Ûˆ§M+Id6.8cKwD˜ÈÖ4TÕOöe/¬Ç~z+·M=áO|t‚©Óú¤=ÙÜÒDØÝ¨·—g-r w‘² RÜæ-;SWð­ uí7ÎK'ˆ[t,¼åO²©ÿ¹y°-h#“–†›e m‡­@?KIêó×™ÏEõIfÑ1½|»Az^(üF"û'Ò‹QtImž)ó…€O[Ç­tdšë<À)ŽªyBÛ*l“gk7Ouæé¨{8£u}©ãKu½ »ÙÓ¦jš ­°Åm$²¹.ã±ç7Ûð»íßÞéxó sÂ%FŸÛ÷¥´8ã>„ì*†=v’²ÚY‚‰½LïùÞ0J›¶ûD9wàX…Ç¢6¸â}5@â:ÍÓCZuk©G|øšZ¡z¯Œ(°ÿH·Gˆw%d­ l?óEuÜ^:¥èÊv\†í{—…êpà±Ãq@ìÛÇh+‰tÜQ™ÒÜq®™TÓAø±à5Ñ´•º6õåñÂQZº—Ko세ð9m}삾Q÷Y\‡€³…vn°ÄÕ2šSb¿ç=âºM±3[¾– dtýüˆ}¾SÂëº;ßo 8ã{!ÀÊV~òi¾½.ḡ}–šNú|áu0âX¿û\Î(ÀsbsÍR‘°å|ËšÂÜKÎÔ‚˜ÔϪÎöv–-n31}%‹^¡¬¥)§E­Ì$á°q§%ù2LÂvçFQ­¾„®üWK–~ÎE¯~W†ú_Ò¼juóÜÅÎäüòÆ/O/V/3±üãD·Ë[ݰ'©œ³ôpýE]”  w›ÃnAP­¥7&Zq£÷[·Z¶§÷>á¾TÝ»²ía§“é䯾Æ*볨A)V]}6–PøøA¿ÿ endstream endobj 325 0 obj << /Type /FontDescriptor /FontName /FNFDSB+CMTI12 /Flags 4 /FontBBox [-36 -251 1103 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle -14 /StemV 63 /XHeight 431 /CharSet (/I/R/a/e/g/n/s) /FontFile 324 0 R >> endobj 326 0 obj << /Length1 2575 /Length2 18254 /Length3 0 /Length 19737 /Filter /FlateDecode >> stream xÚŒ÷PغŠâw‚Ó¸»»ww§qw îî,8ÁÝ]ƒ;'8Á ÁogöìÉìó^Õ½ÕUt¿ëZ %U3 „ƒ½+ #3/@L^M…ÀÌÌÆÈÌÌ OA¡fåj ü/žBèìbå`Ïû/ 1g ±+ˆöÁØ$(ï`q³°°X8yY¸x™™¬ÌÌ<ÿtpæ|0v·2È3dì.ðbŽ^ÎV–® ?ÿý  6¥°ððpÑÿ¥±:[™Ûä]-v ¦Æ¶US+ «×ÿ˜ æ·tuuäebòðð`4¶satp¶¤¡xX¹ZT€.@gw àwÊc;àß©1ÂSÔ,­\þÃPu0wõ0v@[+S ½ HÅÍÞ è y¨JËöÿ–û=àïâXYþ1÷·öoCVö)›š:Ø9Û{YÙ[Ì­lE 9FWOWz€±½ÙoAc[¾±»±•­± Hà¯Ð"ÊcP†ççbêlåèêÂèbeû;G¦ßf@e·7s°³Ú»ºÀÿŽïƒ•3ÐTw/¦¿›kcïàaïó_dneofþ; 37G&u{+'7 ô‡¿e@$ø?4  +€ƒ™™™›t=M-™~;PórþÅdùMåàçãèà0¥ô³2‚¾à}\ŒÝWg7 ŸÏ¿ÿ‹àYXfV¦® …•=üë 2Ðü?Ôg+O€.3hüXÌ¿?ÿüÒM˜™ƒ½­×ñ¿Z̤®¡..#O÷wÊÿ0EE<> ìV66€“‡à÷¿VþÉÿ¿¹ÿEU2¶ú;¶Ù“¶7wðü'Píþ›†ûßsAý÷ÒÐþ׃‚hšê?ïÇÌÁl úÃòÿyþRùÿ7ù¿­ü¿ÿÿHÂÍÖö/>õþøÆvV¶^K€¦ÙÍ´ò ý°ÿ¿¢šÀÿ¬³<ÐÌÊÍîÿr¥]A"boaûO!­\$¬™+¯hi¬B¶Ž÷™°Ì7³jáÙ‰3ðIùðÃû>Ê‚'342 ºúÇS–#ÁÓ(¨OáÆþ­-éšQ w˜QRÚLk{ü:õÃEGEáCÉàØøâ“ź_§(óc¥úÙï"Å|‡ICÁ±t´1o‰PЭʡÀ}¿®‘è²PÉ”-oМLàWW jí}C‰ÿR,pW±«;A0¼ª_Kö1cBg¾OgÅkÜs´&¦>¼n$P“òƒnâü1X6%zÓ~û")AG¨’߃_wâVÏÀ¬ñÝ’5£áËTlþÚW)⦠ûƒXƒ“_Ãñcóò-ó´žv­‹ØÚÕ阂gëHŒÎû_Í}˜?ôúr WæâÓ?aªé¶ôžaüUª"µ9V+»i—cûÓ`Rs=à}ôƈQKáå‹Ä ÞÆE%á§ÆôüµÅÌ1¶ ÙÒØaÅ\ÂØj\"ëòOŠJÈQŒ|q 1RãtVaZu¹|~õI¿r1¬‡´µîÄ—Ý*‰;?sŒt8~K•î,Ù)ˆR`?—çs9*wŲ3›‚Ke.,²_ºéž!yhw ¤eåîbíÔu™O[ûÓ˜#dy›Õj’³óJ»JAo6\lEP E ÍŽä D% Ê¿*§‰+÷UŸ½.?1óP‰ñ¡©Èõê‚Yzi¾À—ìŽÉ›N:üæ¢sk®>ŠS+á·tì]ŒQ4\ðÙˆ¯jL`3Nxêë3Çu÷ m,)®âÓAs-…ÂH³…ïYp>×K¨¥1|JýtÝ_â„kCòAËbáqÈÚ[ÀÎT’Ÿ×ÊÖ#\¹«WËåýÍØûd–…à˜&²…q;óò&0ZÜ3H›ª}´âþ„#BÂÔ_ÀÞº›u·kfÉó(Áƒ1öù×Ä[€Iž´~xNTŸWk=oÜÄw$ó¥‚òõ“èäý“«’§2s‹3ŠÇ‚'~«+bE"j*ŸòøÅú¯È•¯ªªÀl*îoW_gñwX§§züˆî%ªDËæcÛ`@÷¥Ÿë”äÁ œ®¾Q¥&T…!ƒ+úÌJdDïdkŽ>ýšæãØÈ)R²Y¥Ë×X÷Þÿœ”mŠMŽcÄf † Ÿ§äO‰W[»×wò%Qÿ^E%»B¬X Ê †ã…‡ìVäÇЈè)ùáú͉pR=o)µ&Õ=d8Ø«èd".ƒsÒ„ZAXê"¶¶UJˆ(½Í'ȲCJTÿ©JqÒl·«ŽUííÇr£ A´Y#"°FêÔªy*»ÌGBY*ÙÝy$*Á<´ñm%z^ù#Ÿ(U6IVdaN½¼m!†ËEl­Xª€oGwþØŒN–Ð÷Úøy×O¶AÆe« Õꎓ¥FUU·»YòôBšñj:‘èû[ xt$½•CÁÆPí÷m[Àô#ª©ÅKWÚKEm¿7¢uM&]ÇÝä¡oü\Ú Ìø¹¼ *#rŒØB¦€ªÔfi;øY™¯Þ3û¥ŒéLñZ žÂˆòŒÀ'„Gvˆ—QìÌjR–§°ÇSjˆÃ}WüyÝÓƒ(b?>µý9*kþ6·Ôl×–ƒÊä«É†}šÔOF€brí÷М‚‚ý½Î ä54¬“Û$QËHÝ’| D÷mŸÅÓñ‚$#¬Ã´ƒ]iè;íÝ(ã=@LÇ__›àYÎëýPdÁΨÓ.|Dðf\ä÷„hˆ¹M_ýpQ}ѯsÐÁÐË æÖJ©ŸÖXzÜóäÁµžWD¬H4 n‚m8N†)³µ άˆV=n¾ú¾/Ãùæ.V­ôÞ“€ªÛŒ=6’Þ•U$é­|õ.ø,ÎHÃýY$ÇÕˆ.}Êádõ$å]uR@°7¦Ñ‰ï«•1mõ¤Ù¡:B, £«4¥Sâòk-3d¾Óy@{]@àaˆÖˆ:ÜÛ0ñhü6Ê`¢k³.›oì%‡33äM›ãðÊëÓ 7ìVªfÓ¹¡®Î8ŸõFõ˜É£f)ø¾Ë!H’2oÞL-9GRTÝ:ä!‘«`™+òSEܱEÛqñÃ:¨qàEïø¹¶|jä7Ñî5h(0ÐwŽlÆ×Ù‚CÎ2ÕŠžÅìýØ[tÞœGk}:œß÷©ë¼ñˆWä--HVï¸%²ó¬ n9à:uO2í|½ûTš›ò‘CïÆµÀ•a“xã×2ê=Õñ¯“ÌŒÉ=5q,›4fOØÑÁd7ãÒ0“|Júïѻƚ®Ú°UÀ{^SŸRÛ¥!éSHG…²?%þÜ3Í›ž}^æö]ÿ&9»¹q¡Ç×.…o?¼cʱUãI¬5ƒ™ÏB"Ä»µƒÖ–¶ŠíJF4°-DÑ6{Ÿj¥ÚÔõÎÊN‚…úÆ·,iÒ?œ!BZ3<†¾ I“¦úÎÙ»œÕ-aMmw£›_\¥’ÕÖÅ^¦—©Š|3N»úÜä˜^­-¢rÎH>æ½Í_È©¿†ühï‚)h£‘Ñ+]Í\ ±³ÅÀ¼M›;²JŸ‚8$?Nú¯ô·æ'¬Ñ„ f•èàQ{ú&.ÞT=£¼ûÓÆš"™‚ì8tð/%n[2Dj×UÉRXàÜeÚ;-Øö­3Ó>Ïu (¿ß庾Íù)=Ÿ¥¸b–Êx6¤r/Ϋ|Ûa|¯ç3nä¶ñ¦‹OÜTzKqÜÆÖÿÊÕ¯·èl¦ CÜtò=}ù’/Qeó¥¡úº[Ѻ'½ ¯zk퀮Vˆ·8ãR.¿¨‘MSñ+#í¦o¶BæJ[ãêk6wãY/Kß Œ™Œ ¶†|ã¨éP¶Ié„r2ÁEw›¹iËÌ|žscW ¿…íÇØ‹ôDíÙi@Õý+ýS3xሢCXŽE)—í §»u¬á¦ëÝöè  ‚ ·‹ïþ)/ÑKç¨~Tì¶©3)ûÂ5=†ŠÒ[m\¸ÙÓL> PÞ^ fΓ8žHæø]Äè\2[³KW¿B–ç{ïU?•ïQåáá{ûà¶š4Ï›Ú(™¼û8¶Ï\P×?ð«dÒOz¾Š$I-¸5Z¥‚|ž¾˜(¨ìŒ)ÿH¬èl7R<†»¯!säYÎCý>çŒ=}em>gÛª$\Ûh«¸¢¯Mët+ŸXDÛòéc;~¯÷z;ÿ¦W úØŒpXºöç0ü¼úí_·ìÜ>…Mq>ù)ãŠ3ª™4é -¶}ÌB3d‹Ò(l<Ç͇iÄgW9&'Ä.ªŸi:¹ÜAFF*w“IÓì£ìÁjóÕÔ¡~9™‘’ƒ>Ÿâ2Sø|0â¤fœx[³^õ>—×å=¬;-©<ÿ Q†×ñò®5‚´tÆ0G¬åâ ƒ^rÔÃw9"“¬>ú E{*n¬±çÑŠªj’÷xâ aT|„¯¡,؀𽰜q*Üca€í!AÙü—Ÿ\¤S&jsÂi¤Êø)ŽSÖÙXÉ‹–Z,÷ |Twe3Ð%N(üÓÔ7þ}’½!@nTÃã)|bC8³t:ÛJ5R"+ÎZCwg ÅoØ…aïÀÌaÒó‚*,ƒ·,˜2=; jf Ï«³ ][ˆc*Vb’9ÂûiKÃÊê= EÐwÏß‹d\¨(MÃ*ÙXñßkªï'% mŸE¸N)F$) gÙNÄÿTó¡ÕcVC˜$¢]ÛÏWÈG¬‚fNIwÄ}ûñ*wÙ˜¢ÕX‡´¶ùð!ÅXf_Ð8ݹ“}9yQ÷Á¬»"½/åн†³â¤=‡ˆ5øÁ\…®ÅT@É âÍ¥ò›V"7ákÖÂŒ]t@Ö7>ñª¹“Aý)ß*ÕäþÚºðÙÝhlOé寯„¥û‡µ½Ã(¶‡Èwõø™{€Ñû²ëUNd쇨ƒK`Ñy_ xÀ;Qm5 Ô (˜5˜:?lµ5㌩ˆ ˆ¼Êis¬ì‹¼’Ž…×K­C:×–V‘%dŸ­²_{¦Á˵ù‰•eÞJ´Ê_ËÓU—UöÍh‰m~¼_‰7Á° /Ç„ðèr3*…Ä!`ÞÂa+6ì±€d:ÚòW¾ºmp3¿Ý-„¿¢’†S€*ìØÃp²®¸Ê¤;Íš¯§Ëm.A™%œq.Üí(礔šIãY²s†öàr®G¿‘| à ¿–q~mæß¤®´4èlløXã©t c »»¹€û¾o[ûQ;ôÃ×dÒ_­)ä˜Bæ-\DékY[~hmIZ_¿;E²=çPíÒ©…}¹î>æyþâ‘èNZ‚O¤bºÁO\d¤Xí½³ƒçQpEÃ%L å êp³2=p™ü.àoªãÛ܇ M.6ª;Kdµ ¼ F˜#½{ªßîæÃcóIô–ØÑfÿ© »¢J 5ž!³Sš{Lóñ “"§ÔD·MQhàjˆ+OÅ#|«mD¼Šã³i®æ¾oßbµ4çy,DŠ•žYÔ‘ìí‹k ®²žÌ‰+¬Öv–›[Œ :„Z¶G¢‰/ÑÇÓÇ$þcÖ§^.\¿ÐÀ¼L¼b9­EÎÃ'&T*#^âé…«.ˆÆžÆÄ2¢vp¬+n‹ipò;IúÔ· y#/?É“’œ÷ãB4¦IëЛ7iYo\;²$Ü¢ã]q¶àcŒëˆwDÓØM‹nîð²-!ªB“Ì:ü„×ò¹â;K)HüZfÆ@Y$ƒ#Û-tp$ÈÝÛüv’mî±^Ì<‚¥¤D,Ç%?ôª€S_¤›U]ÐÆD¥ÕZbܯÑWGMÄp*6î¶ä¾UV÷gÌNŽ—]ðÊž`³Î{RÊ ™îÞW‡ÙCÁ—ÀˆÕ+öx£²‘ `¹É}F»P¥U±ç%b?íÎ$6ÜHxÇÇhù}1±ÛÂÈê”;æ9Rç,|—ì)U±êþ9¯qÄ'Ý…§~†òZ¹”My44iÁWìÅés0–p3²tžsÊLéxÈP²:ÀôEÜV³)m‡(8]YÖº„¦½Y˜¼ß´Š¶[¦‰dKP•{Ö¡©¡…¼ ‡ŽÃ Ãæw‚²¼†à9óü0Èï·~Hö .<¯4NFÐç¡æÉØ³°Ó‡çÆh‚ÌÈ[12ŽP`2r„)E9œÚ=feµ‚,{tý Gͤ;(¼çË'V²¦oì̹·¨u‡¢ÙJÑ)¦ˆý3Rù,RÛ¨ìÐHÆP´f›È²tÁéꃑ„oŒñzz¿‡v°GNþþËÈÅa¶IOJ‰¼,nº±‰ƒl¶ôý¬zˆC+¾Ç¢á5[Rßb¬o¢J·¡Úe%Õc9ʸêã’ƒô’†Þ ì7}«%5‹ÑèX]Ã-&Ã3ë0‚êϯ)E5eT Ü(ò°tâ¼î1ðQã¤!­óåþ;ÉÆ%žØ|ÓÚˆqF vˆ÷uSÃÀØë‹‹rR—m+'AúA<ûq²l¶ƒþàÌuqÅðŠÃS V'@€üLå¡å-¯éuýË#tMä® ¯©u[I9+¼BR/›˜XŸ"ê¸;)¿?öhƒˆ@ÏB¸qÒ<Ψæã£ü׎¨æŸ”~rönŸJüqŠÙ¿åièNlÓ1†šœ”‘»þ¬L`9alö[™ï3}®ñù^ÉÏŸí~v¿Þº…=á½tÎÿˆ0 v•6:óyŒgÂf§)4Ç$ȵ9s<ƒÜëx¦b©@ã  ¯™†Ó¿4· øyc2íΟX©H4©E“–PGll8;J1÷D50á8`Ñ8þ}{ÐÔRo;̾jHÇTê=ƒWdл…aìU†¾lÚ÷­ÒbÕñ>,£ma"Q[:C ßa«q©%ß!àÙg sîcvÆòXíql™ }xQ¸¯'&¢òëGBß§G¯·&M=Ótoð’Ÿ21wÏn+z  ¤_ “‚­ Fmî”Ô 2ý1ˆE™\®ÔëÙÚH)Ž“•ùvZo%@ò5=ÿÈ›7H×E~ò(¸5«ßXp(më^í¥t»úl3¯KäŠÖî=ëñoÖÌ´˜'­æX Q•û ÝçS"òâ'í/2ì6X.m—TäÎtÙ®Y/á\4!4[v”ÑršÊ H{r\É4U ?ZÖo'›I#z;ß̨âÙ/´»ð(µïåÇñrÔÜYãÙeg@"V4Q•@õ`²µybâóë:οWBGæãžÚ'ldº´ñæ¤Ëû ðˆ'µ`Î@LpÏnˆî¹ò¯i’6hº|ƒcKòëG <ø¨?­ ò2ûñ"nôI¢£×æmvv‚Íi(‚bžÙ¸é"ôxÖ´ÿñƒ²nK~[®Y²Fg­" è%ýÉq_Á¨©´ÅÄ )öS½/ñô2Z¦å0èÏB5’ r ´ºÁÔæˆ7’øG2ðÅ3}têg$m«Tâ Ò½YË:T‹ó›kÝ]òŽ0…Æ·as Ñ8ŸÒýͤ?K%£b0’¬ñ»™í†0Ϲl±2? Ëž© nÒ½Ó5_š)JL“+Q!´¡äMÈrË…½3’?|µŸöì0UÆÄ†(Ѥþ†8 eí*ÏþÎE·À×ÇsL 1=>À˜‘(¯ {)N«£˜„˜‚õ“?SäÉe›O­QÂ_šxtÀÝb=,Óßfš½¹ß;̣Â~ìê“)œ­áˆ¯¾ŸùÖw &vù+ÿ•À1ÑPØfUX…KuÍ5öœ¤èùã9íÚJv_„R>Xåèܲϑã;ZÇ=„ÇoN;Spòó½Cµë‘Ì|+AN£¿NíœiÓ£!¶6©6 ׈‚ðóòB»©¥í;±:œ¨¦ÂE毌DªôÚšÜoó}W½çÇ(*^ìœ! 4}Co‹›ºêýEù’̧II¯ù™#òC¥£¾¢S%Äù:æÕÇ$ì,©sƒ;D—TI­=Øéõ«Q:ÒcdMi&¬ÂæÎÂO¯è£–Ù)_н ÷¨BpæLÃJ•ý'EDפ…m¢÷Åø« ¯-Wløz#»‚î²û¨‰3/’¡ ¸5¬3úÖ©C¡°VkúÄà"¿Ê‰´^G‘f³U ÍCØûý:výà&DÒÛw˜Ë¼L—@^•j]"2Ë…4/ÝAŒæg;¦D%Ô?鱘Ñ6^¦½E͈Œò‘vt"Û†® -¤ÂÈN­< ({X½äyÅj¹‚™Åú”ø2#Šº€½ˆñóÉçý\¾¢¼›–‚ßÊýÝMfß)Ãù- ³ƒ}‡þ(pL8½P£Ö3„„%Õ"@#$àÖöŽfåŒôaöƒœ*˜ÞŒ¶Îö´º¦¹õX±@sò—³gŸÐôÏZfÁ;ýÃùªÞ>ǧ¥ÚrgÉb3ˆZCÙ=‚xz„½9þîic&£1+oÑ÷´Zà¨íÛD%7³ JÝb#pDGL2^$*9afè¢ædä ÷ö¥±;g¥}üù|a¬Sµ»p¿tÐl¿ûÞ‹gºæãåÑêWޯ崃ê±CÕ¦óÉW˜×SLçÍ’Aྰ¢‚†ÕáB|V²èùÿPM%Š×›ãZ|™7ò=¥¹­x¡#ÇUãéã)±d°°‡ÓÃuÐëáÇxpÜ#ñ1 •E1« N¯Zëú¡íýG·‰/գŒííYçJúO-¶/µ±Q.‚ÚЧæ³X%:YýýÃRveR0[ªûT·ãïrH>J¥Ó° ná³7ëkè5l±» Ò† ŽšÕ€™ÖÜá Nóû]ÄP4K|ER ’ÛI6!FòÙãMÿê@‹}D¿õXÙ:â}IV7áÀOx÷>lû¡ýA?E>^mãFi~Š+Pd˜0Š^\hðg'–Þk’9ˆ‰äârWmŸÌ§-Ò8¾Ê8Ô9ÏM³Ç¸‚ùBÉÜ„Œo:¦ ÚƒF5Äšº¯è"ÈcÈ?·©t'"!×úún¡/ïfL#é½µ³±RöÂ>Ûk§ô;×¹óÞ0åÙEân`²Û$ 3Äh#Þ³HªÌ«`64asÀùxá£T#7Âu³9ýiSû!9… “›GÅCÊ…LÄQØ+—(€ ÂψY6kXƒAº€ä§¤(½(#^mÇuëÿlvdª sëYþqÍÚœT ýå ø0Æj²ñáüì(å)+³· ?’¡##ã&f%ñ¨–m¯¹ø÷“‹Ü¸#äHojUk^M¯²¯;82"ß0qÑlE411’9¥v¸Ñe)…ñ< VœÒrŽì¾±kGÇT«—*í¾”,¿‹²"Nasù–vÁôX÷¦]qÁÚôªvɃ?y ó´v#z&ÈhžßrTã#9Yüë³–ßHV©øá,–Šçs«þ‚ÙUêÐz /c‰Ž©Ð u€x7_¨üc 1gÃ] ;õ–èÚ¾˜‹6­å;Û,z^5Ú`‰òð}ò:fYý°³DÈe^#cÆ#ùŽQ¥ƒ8£:ÏꡈAÝ7#ú=vcøwVЕi³Q¦¯?cb }P Îo!š>-3vžÊoÃÌáÂf›µDÄ2üü!ßGã³è&?„‡—¢V$¬œ£å`3L‡“¼z|™I²$âi©ƒ©gžË(úľ;/vÀLƒþÍ.”›Œ`gýþ[ã©]_O|¹C´ha¥‡fctë¨zŽÖ Qœ]šü«¬œø`SBÞ¾tK/ÒŠ¿²žðØ»Žl‰÷Œá 7ØÑ<“©Ãd1ìIkA,È6·—j'SÓxC{y±æ›¾«h²Á^R4¡†ŒÍâ¦GŸÖŠÙ+>ŽÎ±Ħ ¦,1¢öB.÷”‘ :“) æ®›ÌÐç:Lë˜@"|O‚'éµÕ{nÃîåÿ•Ÿ§­%{=âo¬æºJXuzP‚‘ºsݬŒ @ÉeCJV| ‡}VÉcF®Dµ(ù«ïÄ‘sv‘´ÙÝÒ,*…¾LŸ3Ø]1 77Ž5m¦@à°X]ž¾˜úÿ °|6¦Z¼~#ˆ(¥÷OHtÒ9÷åu^>{Í¿Ýì¢\¼âK{˜ÂñŠeäk^L‹ Ží^t¶þÒûéKE'ÍéPT$ÂjŽ_5ßA TÁ¬™8:Õ»ò.«ï×ì•?_ˆMot°šÎgTf+×uw:P“š¨6t¿‚8ä®6Ë›ê,9‡¶%ÆŠ²˜Žò¾›2P™{DÁ•–Þ"Äz˜*5ÑŸsn5¤ÜBhCFg&ÅS-Yé¤6²pCšQR2®ŸÈ”¹˜U«´\a9§QZÖóË·ÎC—ÇçBaàð¡‚Ppód A*»áp¾ä– çY¼G«©Ï–˜†¾a'W‰”¬‹ÝqCœ‹î†¿ž [Yb9÷¸Qê@ÃubÄDÌüŠ>ˆ¡ÙÂF[>•9ØÚ8]ÇåA­5[–E™¼'€Ò 8z* ~—¤`óc»7Xd„5"4:.ú:qòýU‹§9y•Àw§ˆ¨1X@‚ä¹tºd1øÞwâ(ƒñÉ¢l4{d‰Ú¾Ö$¨ªP†9Å)“™×ZxF¼X-¤u­žbDÀqøòè´ÓÃRü8xôÙ•:¥¼%eUض 6ÓZQ!±ÞÈKÉFøx€pç¯JæÐ±yÊÛ oå’UÕ2‚\ „ó˜ù…¯ †œwPD`åλàÞ‰8Us¥ Ë“]ÄÏŸü4¡$<¡ë_¸ ž­Kõä³™]ÎB&¶áDÅ!µ1ë~Î…L§L¨&æÙñò$#Ű̯`þˆÅã,A„ç¥I^eùÚ9[Ç‚èö%gž4\øtp!~vóz«¹€Ý2éÉ;)¤û·vèÀQ¨¤!ÏK–åäD2Ï:€à4—†w—Ö6×d.Ùò]6ÔžŒ/«` ÙW¦ :BöoBs^dè{0t¸¾%ú©[EÞï¿èN°•-èªö¢nÍN˜dø+"‚åH Ü2P†Ø)ˆÚz†w² ¦IG‘÷C~¥øÌj§5ÍjĬºq\båzõðÇG»#Ímų^°“24‰8ã”[|¹Õà½ár½ª`8™/CKŽÅ·1 Û‹;¬~qÓk{jYÄYÅ46ÿ\ë £'û±\y¦p†öµýÄÈBèŒÕà¿wr8õŠ_¤¸“f²ì͹åý6í¥†§íÛj펻­Èdöx®°S§Ú±Ðh ]0“2MÒWûW«ÈBØa~jSxù¯úèÃÇ"¿ÂcŠÌñeMÚ{éßCAo¦L„dIŸÌ³ð†…ûïе~V*Y!7~wwE®‚ŒÇ]Nµ.aÜž~»¤QEC)GKE άeÛ:W†z¶¬2á ƒÔË8¸™ÅÊÀ¼ÏŸð7Ç_bDdŸêe%ð:©ŸãœŽñÈë/FgªÇë¬"q%•Y›Ö°Ø²|ÆzY·¶–ˆ¡øßò¿zÐFЏ`¸HÍ(fHÓ8[™%fZŒ@hœ=¼»Qp¼‹ ~\%Xì2«dëK¬W@ïBM­òÆOç¢V(ÖåCüd ÕM–WB2‡È3æEo¶!|`û|]’éŒ'Ғ椑ºÆä_“ÏváKàÞñýM4F¢¦¾Äß`aæg¿˜_@j¢ºÌåe‹ ÊÇ ¼Ó¾_Ýt³^3‡1¹ž=†ù­~hÑÏx÷”a–¸­Gú·öTJªŠ¢CWð$" /ˆæZÚ¶–äJ¡niüú2=w¾6qLÒ¹P–¤Ÿð–{™¬Ò¿|b:5Ƙ¢®GVÂôåjoÍ`lH&ËÀ($ùv•\öbjdz^Ñz³c÷ú’¯%õ"Œ=wô©š ý¸ðÇE|j 8¦¬ki‹É©6 Þ»± ®¸ø!Uô¥.éò* ¹Z ¨mP[8“çCŒÃ*÷ ΙiG«o¦>‡.Ë[‰AÞzïîÈÄ5NÎ-Mï¯3/!_Ù@:/óÕ"­}k³çVU7òˆû©õ Ûï>ôʾX'êê Hîš14cÂEXµ²–Š¢t.—¿C33Ê1Á0Úü…ºWßû5_-í{þk0¡òÅüé@,wc ¾à'þöX¥Ùôvœ‚D¡Öå î¹ÐÒd« ; œÆÝÇõ…Ìa1Œ§Q,ó ah÷gäëÅæ¯ÚBpWÙµ`Âo£F'µåÅ´ 7Jeþ¶›Pßu69ÓS×­k ™ÅΫ¸³6~¼q¼Ï‘Nø^æVÐaÐtƒ3p…áˆ6VÓ;`ƒ•û¬ãÞ6Ö9ò‹Â[“¨ùa]F¦Mf˜ÃÂãæW«²`z¾ìžµû&Ü…¶‚GÀUð;Ã9‡I'}W×­±º“Iþd.íq<°Ï"þ'mÜØ[ÈZ-°}/-N®Txƒ‰£üiÑ äП{”.w÷Á‚õ½9žHu¦ãëP*?¹L]©¯„Õ­9]¼äžì{˜œ5°uçI²—Ò?{]­,Ô( ©µç¢¼l†M :v4µ<ÒZ®ØL¾‡ÎæU|û0g&ó&jKGýÜPê>Oߺ¾n ´²|Ô~¼øø8üȾ´çá8æ·™ç?`ŵb‰"µµkO!·õ‚þãÑ5Ì+I|ÏW¬†Õ`i6+“ÿ­¾™6#t'†3¦¡n™jRª©F4¹)¼H ™%úYR#°ƒMlxi,/Ü •,±H™ E›šÊ1°Ë¥joÒ6@½Ëx€Á?BþeÃÐ'½T׸™ÅŽÙ§$Øu‹ê«m³Ÿû) ÃõäåŒØªñü6í—0Ï=ýªùÈ—­ÞîÑ@/ú*[âï_e…” àŒ´-yxµx„ÚÁ%Û‹¨™ñó×4Sêç Y?àŽæ¡ó%ª½¦ál 6##¼Nß×8˜|­7¬Tnì¶{ºÑH9£ŸÑ :üÔL¢›·Q}m—'/*Ë£EÏ*u×+(Ò~åÁµ{Z"gÙ*k SIñcØ|{5òÔg9潦šM4„Õ®Ÿì…^3 ÎÏ7·µ8éˆâ€ä™å›q×±ÕÐ7§¾ÙÓ!°Z þ0ÿƃڌ«Æör³[»i¼M@•qG–¹I@ç÷”ZÃ[iÒ ·”š^þ%$Œ©y5kóGËÈ|?}¨"á/É6gÐ3¦ì:le.}#8o¥]ÔëéüW Ì‹›ìPܲÒ%QXô?´Œsdë5®N~i@.аíÍøÜu –ž¹0yÄœÎ>K]÷uwª`Ÿn*¹Y˜ò3?ÑAk5Ié±[9Þ»ÛŠÝ—-! <º¶–3oçæ ÓvS™Øiû$&n™ÿdçKºjþˆ æ2Í"TÄÒ> ÏeßwSÇ97ÇÌ_­Þ#°í‚_dÞn~•ôÓ©èu§Zö|Ó§úžvs£ˆùc»UÉÊZz‘)þ¡}Z ~€ûĄ̈ÞúŒuQZ¼]®ÿ .âz|§ ÷­ý…ì[ Tåç cü¥ùw(YÓb9(ð‡y Ä‹2ѽíÔcÊ6è¨)|…óÍÎ3nW°òá¸|¨ØîÂ=‡³ôzXk©K£×°? &𕟗†# =:í¿Ù[ßÓf`̆£ ®\¼pI "Ð8àTì'³™5r¨E|ÚÚq°/ž‡9liDTdú™« ¸ï Íû¯À±dUñ‰áKT¤ r¸üûR;69)2z:WÚ™*¬Ü%IVÎ#•?1ëBbÜ×ÎÉ(߃DZd59߃ír…z/,R­U_‡8T‘Ò~I–ØNà³"s k¿Á‡¨—¡öMemó 1ÏVªÈ»ñÆb~¹azYön†WÊêÔ[Ù¹ÄKÀ«^o“‹çA$Ýoáh§Z­¯2}Ì~ãsõ®è>ÄW.¶u)ZécD³]ã0a‡û6@ª`|/Jc×®Zóƒ}£†ý°Ë¤`!ÃÂyk§v:EË­t±ÂÊÔWfv.ß²ZêQËlUº…·fõ(å ±1ÓÂ{–VÝã… ®Ýš>Ærü n¶mϪáÞh›$p’`¨#YU8°÷Á ÀüžþëèùTô»d@òRÇ[CYÚOl‚ß¾à2Y¹¸=s•jiNËgQ“ÉDhqÛÐ^ œ¼]#‚d?ÏñÜÄùïp¥ÛPsß©ŽÏÃ:na€ÅdKWUÀs膈Mª{ÜZϧv~§’3H2$.z$d§è"ðì/U\F_ÌðRwçrøJªõX1›©ñ¥ìçȇ*ü"%ñÞÞx,¨>Ó†Δ”{µªÛŸc°ÜÇÎ^ÎcÚ,»ÍEÙƒÕ$øbn•ïóîÏy¿óÿârai–^$æ—mô}ɺ<ÇR¨iyÛ§¶(Gî|¬ÿ%´ù6%¡il\(¾6˜Çq›%¿‚äuÕå3†x»’~Û òåZ–{#Ú|.xp‘{÷ŠÒÍ‘Ù.ž"ºž/ƒ S€åh1Üå12#ŽO†aP>ÈFJŒìnMë77\TËË0"© BþL‚š® %÷,twM^ߨù&,f¿@B熞éÁQyw€x±/–YQú½Çþ6—õ`#´.;ŽÑTºKeÓ9WêÃ9 iá2¹£!Ýre—oN+„bÇEê5ÊL¤Ÿ€šñ”ŽAç³&åHgÖÇîþ\*ä :D­a†j¤—R†æË}ÊÚýÓèjð6àæèTÙ©QÌØ<†æÒ,1G'Ø/æ ˜YˆXlÕÿìr©™rîP¢\žùÔam½J—¼öäêÏ &&ç³lRhñCöæyƒtÐmB‡ª%Z¼†ù«\„iÓ"Uý ³Ïgû©®¼¸K;åÁýÀù6ã9Þ°÷µF¼Õýù=ì#bXætIk(Q—·h¼N}#yÏõ«1„îÂj¾Ë\Ö4l-"Åx;ï±0J˜D5LÚ™¡Ýß䵞¶OcÑ®z‚P£¿d<þ°©C=+R?·ÐGa *ýŽƒUmh#-ÿqHym?«7ññ”Õ©LbVéåÆ:œmÙ´p‰cì ô“×cWrØ$ܺ*¡ý8Œ:°À hÚjîÇÝL ¶r•œêª¨ñ‘bûÖ6_fûmÛš4M´$ÎNx[ÎpFÄ^`=Cô"|àözÁP_­ŒãÓš äôú&±Ø.°§2â¦à¬¯ ÉPõÁƒÝâÁ×½+tæÔv)7&Ì•¸X÷Øß‘H%©Û"¸ôUú _¨‹²Ú¨IðH±ÌUžC½¢HpÎÝÍ2O ²P™m!(»0Û7Àm8å…¨VÁ¥œ¤z,9¾5 N'32P¿L *&Êë€fý­_3+4<¡¦¾8 Ê·Ãÿ»›Ò8A´ÌÀF…L`°vqmÚ •èf8(骀mÄì6²\IΆé5ÎòeDöu_®†Å´EŽHi^2ÿ£¦÷ø¬¢½) ‰1D”—ìdF$y Ø‡ãXH*j*ÄÍŸžŸQ…ûã?aä "ÿðŠÓ‚¢(ÐŒS˜²1—FB]»•^=©®«Þ5ЫIð³ü¼8 °„ª"&ßQÆÞó¬ë8+–''C]õ¢ïÑzÛº®ÞSäD_×™ŸQ‡oˆ¯ÆÀõT/'†³æÑÇÁÒ|ÓÀ—p0°zÞ4=A)gÿq#0HÚVrB¦PaxY͹؀®D[jÝ÷t”åûÍ÷RWFsƒç}@Öîk8Pº;IðîÄá3õ¾;òAª˜äMyF¬é¥øü¾çeàÏçä@ÎØã)Š#ÉRñJ I¤&h½ÛË/í[ÕD_öõï¼°ü»!J/ •³kGqQ ÔΜÏ<:Þ…¡'¥âª[—XÉO\§½' Ü®È|(hñ¥¾¶Ö›n!x¹™%rÕQ£â]Bu„(çu|Ç*…l³g-¡•ôóžß¾Cƒã~u¤°µÇLá!£E}¾JâP½^õôâs…M·Xæ’´UßW Ñ¶5ýL 9±©9¤hj‰‹ÜvÇè€BÒ£‰§¯Ï·î1¸ÎþI÷nîɨ‹®÷SÃ{¥NYà‘'ëÞ‘É2…”g´Î9ÿÊË÷'Úk±øëÇÑ€g›—Ð×/ ì ™«§2«Ú™³óîu€"§vRÔM÷«ìŽ yÚãÝc~ý¨ä¾¤“;½áe$uŸúe_‰HhÛú×qÚ(”ºš%†Á¬DT¦äMê[xdîÏÝy æƼ$Hžô|0Šywï¨Ö]•º¼zˆôZ°£_iDùìÒÙ¾%”‰ƒ‘¹¬[<ºar}!(pùºÞøçé·2oMa"ò>áCPSk$%%× ó4µp³iò7…ç®·S!H©[ìO9ê3Xø«O?‡¶dž÷ÈvÝÇÑuÆ“\˜^[[ÉôBÏ×Ö5ÈÄe€6Ækgù\4ÉöïQÓÄÛ.ûg±]N6›~ž»ïwL†|5½ç„C/ìÕô„Dm’ƒÊš‰oYÖC™ßc¿ µvÄ Ï\)ýqöB=۵“Ù|âÃÓ‡G¹uå0‘höO:¿ª)—=sHƇqÏ“ï{WqÏüê“¡Ô™Ö*·v‘&¶æGëÙ%0šÏUÚÙ³]Y¤Á¥Ñã¯YE>‚¥òa¬–Pc+ñȧˆ„áÌ¡T8é0æ"QæÒ÷þéÅþÒ›/oär?w´¿1ÍUŠ<ϧ‚‰þÂÕr>%Ü ´ÈKD„%‘ WÄÔÉäÚ.:FUˆ«^8œ®š+{ëëAJüÜu¸ð”†hDnhM¾Z·4“4@Ѩ$‹{¸ó$°-gº”»¶ÂŒÞ_¼²äiþÒÅøÉû@Ï9GÆèÚŠ¤}‡â ØO5òmç³fÑ)ù¡#KR’ífW@q{V ÿÝ5*Ó\3®x^0[ä™ÜÈ2dt4ŠÐbÕíz%µ;4¾†‚Ï®,ˆï Pb üõ°øþ㔩É2«´¾›ÂÎñÙÉS7çÛ‚¾f[•ÏZOŠè~¹©6|?œÀœ§Ï•<$ž¨ä:f¬¦ƒ§Û®òi/¦#}´á^&Ѝ&´1’: ’|I´÷§§Q^vWLGG;Ý}óvMžB¢zÙ:wï'2‚o‘¿àil%XL|ÂÓuFÁ¹¸h((AÜÇIïK‹±ô㌴SZ ³V¤¡ ɯ&Ƽ•DÕ¯<މéX ¥Hyºïþ N®¿tF—0»0Å„=É`Be1ˆ[.¾P׳€M÷h.0¯“-o7àùaƒÖU®üš[ß7ÂÚ^ÈŸ9–¹gåV7qÌ\›'¿$ûˆé]ˆ\¹»Ô›õ7Ãm0ŸÀš©Ì%]£k·Ï6®îÇóGyš}ª¯ð•U•ÊqQvE~¾ÁÓ ÃsVè1bßÙZ l8ý n“ÁˆË äFq1ømcžÞ Î À>XQk {æ5fçS`-¡ÃµÅEGâJ‡2˜’ÇÁG'ƒ_Ó”?|”×Z£g‚£#ÐþÿQtÞk?5Î ~->ß5ý ’ü×CÕÙLZ¯}oÂ×}¦¦~×DLŽª‚^È¥ƒ+Çb®IÅ`9êK5‘ÈfðlûH ÿSWV->MìÀõúÐl/ùW§fÖâìAjVG0àdhØ£Ý;·2×(ìþ•‚Q®Ó÷üÚ(Åp yÆÿ=çàeæ*$‰Ðw霊 Ì¢Ô¸’2ëSå {²ªfë*±#¢ä]! à´‘ÀÉ/,VÕ§jwj“‘DÀwcPŒ‹Cc:¾³CwÝL¦Ð]pâu}F–╟Þx•Â?Qº§’“*Þ@dq|z8ø¼OÞ~Å MžÙ¤Å:aXV)h1ôÙg4ùƒeŒË3/ߨŒ–Ð<ÝÇ_gBr´Óô.èg«ãôzò”ð²Ì˜ Ô õFuÎÃà¿Ê,TºÎ±ÂX»»%êKmÖ .¤õ°AZP‚¬<1ðkºü´Q—šd…r¦›¡ùÊZoæw„i3£q¾m6½#èd^Y¯Z*l‡œN”iãèfIøÐoÆ=QVÒäâxSå#z“Õví¹¤*KÙi“~ÿó%PµÝ_íýæ=Ü®Y{{%ÎA€PY/²6RÊÍh3µ2ý8ÊX¿˜4vV‹)>+ºõçZ¶¨Õ¸Ýù°RCÿýè£V}ÒñkIt÷´ÿ'G ¸ô+Ô¹–Wb¦œˆâKãûÓ¸jI_(A8ú°hÒZ/„Š6%XGÌ:2ÿ⢠IÚ Q{™YG*Ý ÿ9í£"j‡í$¥C¾AŠËré¤&ºœ„è=âý“ŠNlî»ôW¼B{¼wÉtô=Ë‚´kü Ý£.3cG¨AZÿTÕ‰¡dZèØŠùm8)ý*Ç£ƒW…:ФÑâ+¢ IYÅyÒ´h5½? ~ jlcø30¬Çnªj¤®õVúŽÛ&5½ZXì”mà?ûêÏ÷@p)´þþtÛ8]èÏ<¯½·Cݨ«-jù2ê•Ô}‚d‰ax/ø:õi¶íC+hçŸÜÆU"C­Úó6…•¹* ±tîú/&Épä~¡Dô~DX '¬Í”=´­ûvW§|¿>ÓE7Ñ‚´™ –_YÆ÷=­Žþ96Ž&(Óºux&`²ÞÓKÓá=Àad€›0fšÖÊïhZÛž{Ù?RŽa¢áÀÞ²8’NÇ2eغGÌZ{¿À'ip‡ÇœY{ÈuK+ÍÓ4²ï½ÐAX×-,˜úv/ßÙ’we¼]Ššåöy¶(ãFC‡½ÓÜ‘û|CõÓ‰¶hº@¸7‘ Wc¿¥Qbȹý÷ î¬WLúN7*q­³C/D¸ ÍxHþŽãÎÌKÝçšgH§cªjþ0BkÄë( ÿ‘¯Î`úsÏ3»ö¯º_)$(h‚®¦Ê‡Ñj ‘ÛèdÍÜ9סí¹`¿VÂý¯¤—ÍšÊï’ ªÒSÒÞä—fŽŽê¡Cì vÀÖÓ;ªvËà™­aËÝuƬ AfRë$:–…µUìà<°%€öT``Ž<+ìïMføu¨ãäG¨¸u@-OOé·Üµ‰+_û‘Uòˆ’ùäÛtጆ=j€6”nÑ!Á‚g2Ö9uSº_ËB<ÛŠ³?‹´-(?Î,ÝhÓ02°TÀeVAKp]Ëvõ“Y’¦Î·]…™ª×jN+)“Y¸yp®Í;§–ÐF¹ 8抋g7FçVOîsuºÚG*áÚuæ'=èΪŀÑéHÚ)Ý´dHpã‚F Éû/Í%ÁTÜ•Òmuå-¦{ú¬'Ä®*^² òö¸l7á€Ûi”bxºbæBûiË%t/ ¿wÔÞè¾êhxgCbùk?„þwŠA•vtv´ó ÜJÑÛ¹ )œÒà ßÝ·)Qƒ?:3ØÈH˜bš ªV—.PÎðZËÓ; ŒÃ‘$ó]Bª”]4MÜðãG¦®4 ¦ì*ûôËŽDÐÂf)gÉ*}«dÜ^®å¹Fà ÷š¨ø²8†šÅʤ%%^„ÍÓÕ>þ:çoGeíÔmIÌÅv_§‹ó ’ˆäIWÉÎYBÇæéöè]]n6ÛËõ>ÚP /šæù¢“fiU€î¹3³þÔpí÷A0ågÿJ#Š·‰ûé)¤švK Ù¥ìÚN îf+ ¹×ZEb; Þˆ>lôq~þwø„󑜸 Ç3üÄ–z|ý+ÚT¦L±YâYùC¯³Åî’cÄ®‡¡[Ê¡«†¶²ïs}6À? ¼ï0€=†úÀ›Fú6-±Öôh 4+ô‡Ø€pëX‚B›“I¶zÔAÏÙ‹óî^^Ú Ã犘Ž%l7‡¥éf×ù¹¢+)MìÙIîˆÒö«EʹH$Ìõ¦º|pçtõ£×«ø À1^Ç/3LìèÊ:wêÊ1·Ž²å92‚¶J¥Rbck|ÖŠÜ®k°¬°mÌþ»ŽÛòS­<è Xö”ÌkT%‡áuÓŸ1‹4\/jC²;gïÞì¢T×fäã_®vàÅ7EŸXZ”Õ’“Ò XéÐРíÀo1ÂZºé9ÂM• ­{6¤-;‘š¥mà»Ãªô/Ýxäqr4†¨vØÕxz–C“æÿŒàÚ ô]7¡ Á^®)Qnp\Âfí‚,9mPQXï>Yf~PË:Î\Þè1jÛ»D—Eg>›cÚN"-Ýþpšäߊ)«ë ýlÙÉd·¯VVå/u6wþöcfð>J²‚E|èÅý©ÎÌëíâÕX±Jƒw¯¦âý9Ó„CÐÉG˜°ÂA8 ^F”Níac£Ä ÎkMòK|1Ÿ²õ4£4pÜÄü 5éØü’Fj2' шO!¿hÊ©FùQhHƒªKØýzæ⽬ºäW;\ðºµ]Q¼t °Ö¼Žöúxj£–èDh'qíùhÓè"|L."8xbJ_Jxœ¦챇K·z.£U×!¿{«¿‹ƒ:qx,UMU½‰w`!)Ú*Éøä˜ÇÔÛ©)Ñ¡ùkRsËO©n&o—@> ÜßF9ã DÜæ< !x·ŸLE¯¸+¨N¤(þÒjî.ƒ¨Á„ÛÏ™m}OÕüd@V^lö=ƒ¿Wù—ȱ°0vYgûmä'ÕM¬QçP7^,Ñ,oúøª lÑó^œ¡s Qß"«%èÅÆ‹© ÂŒ›ªÜ1eÖO.¸ôí¸Ã€ZÓúôʽ;¬¹ÍùBûflÏW˜‘k ¨r•ÎWj4Ù•&º#'Óèo ¿‰s™æðºC Y·¯wכ휕¦ã‚¼½'¥Ä”nÅ+ä¿V”òBDƒEÆA5¿+Ñ6$^Á.ø»¦ 9ÁÛB*ð?!•b¾’ÛÁ‹':…X`Û°ã÷ì™Þe¶c«µ¬qs|çj«W× ¸–A¯ù ‰ÚŽa˜ÙTމÚÏ:+1Œ P¿Ù5œP`5 ;}º™°m0§<”Ñ9sî×´G*…¸‡ó Ižù®L„m®^‹´EÿuÈšJ ¼¨á$èd>-îËO·Ç+±OŒS}]ìÞàa•|,Z¸ý÷¼ÅìÆ?DŽq€ä^Gº endstream endobj 327 0 obj << /Type /FontDescriptor /FontName /UVUEJM+CMTT10 /Flags 4 /FontBBox [-4 -233 537 696] /Ascent 611 /CapHeight 611 /Descent -222 /ItalicAngle 0 /StemV 69 /XHeight 431 /CharSet (/A/B/C/D/E/F/G/H/I/K/L/M/N/O/P/R/S/T/U/V/Y/a/ampersand/asterisk/b/bar/bracketleft/bracketright/c/colon/comma/d/dollar/e/eight/equal/f/five/four/g/greater/h/hyphen/i/j/k/l/less/m/n/nine/o/one/p/parenleft/parenright/period/plus/q/quotedbl/r/s/seven/six/t/three/two/u/underscore/v/w/x/y/zero) /FontFile 326 0 R >> endobj 137 0 obj << /Type /Font /Subtype /Type1 /BaseFont /QZFKIE+CMBX10 /FontDescriptor 305 0 R /FirstChar 44 /LastChar 119 /Widths 294 0 R >> endobj 126 0 obj << /Type /Font /Subtype /Type1 /BaseFont /TMQJLS+CMBX12 /FontDescriptor 307 0 R /FirstChar 46 /LastChar 121 /Widths 300 0 R >> endobj 201 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RXTILA+CMBXTI10 /FontDescriptor 309 0 R /FirstChar 82 /LastChar 115 /Widths 292 0 R >> endobj 127 0 obj << /Type /Font /Subtype /Type1 /BaseFont /JMTARB+CMR10 /FontDescriptor 311 0 R /FirstChar 11 /LastChar 122 /Widths 299 0 R >> endobj 125 0 obj << /Type /Font /Subtype /Type1 /BaseFont /NSPCWB+CMR12 /FontDescriptor 313 0 R /FirstChar 18 /LastChar 121 /Widths 301 0 R >> endobj 123 0 obj << /Type /Font /Subtype /Type1 /BaseFont /XOLCQR+CMR17 /FontDescriptor 315 0 R /FirstChar 65 /LastChar 117 /Widths 303 0 R >> endobj 130 0 obj << /Type /Font /Subtype /Type1 /BaseFont /RWBQFL+CMSLTT10 /FontDescriptor 317 0 R /FirstChar 33 /LastChar 125 /Widths 296 0 R >> endobj 131 0 obj << /Type /Font /Subtype /Type1 /BaseFont /EAXHAV+CMSS10 /FontDescriptor 319 0 R /FirstChar 82 /LastChar 82 /Widths 295 0 R >> endobj 155 0 obj << /Type /Font /Subtype /Type1 /BaseFont /GSKNIF+CMSY10 /FontDescriptor 321 0 R /FirstChar 102 /LastChar 103 /Widths 293 0 R >> endobj 128 0 obj << /Type /Font /Subtype /Type1 /BaseFont /DZXGTE+CMTI10 /FontDescriptor 323 0 R /FirstChar 11 /LastChar 120 /Widths 298 0 R >> endobj 124 0 obj << /Type /Font /Subtype /Type1 /BaseFont /FNFDSB+CMTI12 /FontDescriptor 325 0 R /FirstChar 73 /LastChar 115 /Widths 302 0 R >> endobj 129 0 obj << /Type /Font /Subtype /Type1 /BaseFont /UVUEJM+CMTT10 /FontDescriptor 327 0 R /FirstChar 34 /LastChar 124 /Widths 297 0 R >> endobj 132 0 obj << /Type /Pages /Count 6 /Parent 328 0 R /Kids [118 0 R 134 0 R 147 0 R 152 0 R 163 0 R 167 0 R] >> endobj 174 0 obj << /Type /Pages /Count 6 /Parent 328 0 R /Kids [171 0 R 176 0 R 180 0 R 184 0 R 191 0 R 196 0 R] >> endobj 219 0 obj << /Type /Pages /Count 6 /Parent 328 0 R /Kids [216 0 R 221 0 R 232 0 R 237 0 R 241 0 R 253 0 R] >> endobj 267 0 obj << /Type /Pages /Count 5 /Parent 328 0 R /Kids [264 0 R 269 0 R 274 0 R 278 0 R 283 0 R] >> endobj 328 0 obj << /Type /Pages /Count 23 /Kids [132 0 R 174 0 R 219 0 R 267 0 R] >> endobj 329 0 obj << /Type /Outlines /First 3 0 R /Last 115 0 R /Count 9 >> endobj 115 0 obj << /Title 116 0 R /A 113 0 R /Parent 329 0 R /Prev 111 0 R >> endobj 111 0 obj << /Title 112 0 R /A 109 0 R /Parent 329 0 R /Prev 107 0 R /Next 115 0 R >> endobj 107 0 obj << /Title 108 0 R /A 105 0 R /Parent 329 0 R /Prev 95 0 R /Next 111 0 R >> endobj 103 0 obj << /Title 104 0 R /A 101 0 R /Parent 95 0 R /Prev 99 0 R >> endobj 99 0 obj << /Title 100 0 R /A 97 0 R /Parent 95 0 R /Next 103 0 R >> endobj 95 0 obj << /Title 96 0 R /A 93 0 R /Parent 329 0 R /Prev 47 0 R /Next 107 0 R /First 99 0 R /Last 103 0 R /Count -2 >> endobj 91 0 obj << /Title 92 0 R /A 89 0 R /Parent 47 0 R /Prev 75 0 R >> endobj 87 0 obj << /Title 88 0 R /A 85 0 R /Parent 75 0 R /Prev 83 0 R >> endobj 83 0 obj << /Title 84 0 R /A 81 0 R /Parent 75 0 R /Prev 79 0 R /Next 87 0 R >> endobj 79 0 obj << /Title 80 0 R /A 77 0 R /Parent 75 0 R /Next 83 0 R >> endobj 75 0 obj << /Title 76 0 R /A 73 0 R /Parent 47 0 R /Prev 71 0 R /Next 91 0 R /First 79 0 R /Last 87 0 R /Count -3 >> endobj 71 0 obj << /Title 72 0 R /A 69 0 R /Parent 47 0 R /Prev 67 0 R /Next 75 0 R >> endobj 67 0 obj << /Title 68 0 R /A 65 0 R /Parent 47 0 R /Prev 63 0 R /Next 71 0 R >> endobj 63 0 obj << /Title 64 0 R /A 61 0 R /Parent 47 0 R /Prev 59 0 R /Next 67 0 R >> endobj 59 0 obj << /Title 60 0 R /A 57 0 R /Parent 47 0 R /Prev 55 0 R /Next 63 0 R >> endobj 55 0 obj << /Title 56 0 R /A 53 0 R /Parent 47 0 R /Prev 51 0 R /Next 59 0 R >> endobj 51 0 obj << /Title 52 0 R /A 49 0 R /Parent 47 0 R /Next 55 0 R >> endobj 47 0 obj << /Title 48 0 R /A 45 0 R /Parent 329 0 R /Prev 43 0 R /Next 95 0 R /First 51 0 R /Last 91 0 R /Count -8 >> endobj 43 0 obj << /Title 44 0 R /A 41 0 R /Parent 329 0 R /Prev 39 0 R /Next 47 0 R >> endobj 39 0 obj << /Title 40 0 R /A 37 0 R /Parent 329 0 R /Prev 7 0 R /Next 43 0 R >> endobj 35 0 obj << /Title 36 0 R /A 33 0 R /Parent 31 0 R >> endobj 31 0 obj << /Title 32 0 R /A 29 0 R /Parent 7 0 R /Prev 11 0 R /First 35 0 R /Last 35 0 R /Count -1 >> endobj 27 0 obj << /Title 28 0 R /A 25 0 R /Parent 11 0 R /Prev 23 0 R >> endobj 23 0 obj << /Title 24 0 R /A 21 0 R /Parent 11 0 R /Prev 19 0 R /Next 27 0 R >> endobj 19 0 obj << /Title 20 0 R /A 17 0 R /Parent 11 0 R /Prev 15 0 R /Next 23 0 R >> endobj 15 0 obj << /Title 16 0 R /A 13 0 R /Parent 11 0 R /Next 19 0 R >> endobj 11 0 obj << /Title 12 0 R /A 9 0 R /Parent 7 0 R /Next 31 0 R /First 15 0 R /Last 27 0 R /Count -4 >> endobj 7 0 obj << /Title 8 0 R /A 5 0 R /Parent 329 0 R /Prev 3 0 R /Next 39 0 R /First 11 0 R /Last 31 0 R /Count -2 >> endobj 3 0 obj << /Title 4 0 R /A 1 0 R /Parent 329 0 R /Next 7 0 R >> endobj 330 0 obj << /Names [(Doc-Start) 122 0 R (Item.1) 138 0 R (Item.2) 139 0 R (Item.3) 140 0 R (Item.4) 141 0 R (Item.5) 142 0 R] /Limits [(Doc-Start) (Item.5)] >> endobj 331 0 obj << /Names [(Item.6) 143 0 R (Item.7) 187 0 R (Item.8) 188 0 R (figure.1) 150 0 R (figure.2) 199 0 R (figure.3) 200 0 R] /Limits [(Item.6) (figure.3)] >> endobj 332 0 obj << /Names [(figure.4) 224 0 R (figure.5) 244 0 R (figure.6) 256 0 R (page.1) 121 0 R (page.10) 186 0 R (page.11) 193 0 R] /Limits [(figure.4) (page.11)] >> endobj 333 0 obj << /Names [(page.12) 198 0 R (page.13) 218 0 R (page.14) 223 0 R (page.15) 234 0 R (page.16) 239 0 R (page.17) 243 0 R] /Limits [(page.12) (page.17)] >> endobj 334 0 obj << /Names [(page.18) 255 0 R (page.19) 266 0 R (page.2) 136 0 R (page.20) 271 0 R (page.21) 276 0 R (page.22) 280 0 R] /Limits [(page.18) (page.22)] >> endobj 335 0 obj << /Names [(page.23) 285 0 R (page.3) 149 0 R (page.4) 154 0 R (page.5) 165 0 R (page.6) 169 0 R (page.7) 173 0 R] /Limits [(page.23) (page.7)] >> endobj 336 0 obj << /Names [(page.8) 178 0 R (page.9) 182 0 R (section.1) 2 0 R (section.2) 6 0 R (section.3) 38 0 R (section.4) 42 0 R] /Limits [(page.8) (section.4)] >> endobj 337 0 obj << /Names [(section.5) 46 0 R (section.6) 94 0 R (section.7) 106 0 R (section.8) 110 0 R (section.9) 114 0 R (subsection.2.1) 10 0 R] /Limits [(section.5) (subsection.2.1)] >> endobj 338 0 obj << /Names [(subsection.2.2) 30 0 R (subsection.5.1) 50 0 R (subsection.5.2) 54 0 R (subsection.5.3) 58 0 R (subsection.5.4) 62 0 R (subsection.5.5) 66 0 R] /Limits [(subsection.2.2) (subsection.5.5)] >> endobj 339 0 obj << /Names [(subsection.5.6) 70 0 R (subsection.5.7) 74 0 R (subsection.5.8) 90 0 R (subsection.6.1) 98 0 R (subsection.6.2) 102 0 R (subsubsection.2.1.1) 14 0 R] /Limits [(subsection.5.6) (subsubsection.2.1.1)] >> endobj 340 0 obj << /Names [(subsubsection.2.1.2) 18 0 R (subsubsection.2.1.3) 22 0 R (subsubsection.2.1.4) 26 0 R (subsubsection.2.2.1) 34 0 R (subsubsection.5.7.1) 78 0 R (subsubsection.5.7.2) 82 0 R] /Limits [(subsubsection.2.1.2) (subsubsection.5.7.2)] >> endobj 341 0 obj << /Names [(subsubsection.5.7.3) 86 0 R (table.1) 281 0 R (table.2) 287 0 R] /Limits [(subsubsection.5.7.3) (table.2)] >> endobj 342 0 obj << /Kids [330 0 R 331 0 R 332 0 R 333 0 R 334 0 R 335 0 R] /Limits [(Doc-Start) (page.7)] >> endobj 343 0 obj << /Kids [336 0 R 337 0 R 338 0 R 339 0 R 340 0 R 341 0 R] /Limits [(page.8) (table.2)] >> endobj 344 0 obj << /Kids [342 0 R 343 0 R] /Limits [(Doc-Start) (table.2)] >> endobj 345 0 obj << /Dests 344 0 R >> endobj 346 0 obj << /Type /Catalog /Pages 328 0 R /Outlines 329 0 R /Names 345 0 R /PageMode/UseOutlines /OpenAction 117 0 R >> endobj 347 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.10)/Keywords() /CreationDate (D:20131029202329-07'00') /ModDate (D:20131029202329-07'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-1.40.10-2.2 (TeX Live 2009/Debian) kpathsea version 5.0.0) >> endobj xref 0 348 0000000000 65535 f 0000000015 00000 n 0000005407 00000 n 0000254823 00000 n 0000000060 00000 n 0000000090 00000 n 0000005464 00000 n 0000254702 00000 n 0000000135 00000 n 0000000167 00000 n 0000005521 00000 n 0000254593 00000 n 0000000217 00000 n 0000000250 00000 n 0000007767 00000 n 0000254519 00000 n 0000000306 00000 n 0000000342 00000 n 0000011196 00000 n 0000254432 00000 n 0000000398 00000 n 0000000434 00000 n 0000011254 00000 n 0000254345 00000 n 0000000490 00000 n 0000000548 00000 n 0000017805 00000 n 0000254271 00000 n 0000000604 00000 n 0000000642 00000 n 0000022697 00000 n 0000254161 00000 n 0000000693 00000 n 0000000717 00000 n 0000022755 00000 n 0000254100 00000 n 0000000773 00000 n 0000000815 00000 n 0000028269 00000 n 0000254013 00000 n 0000000861 00000 n 0000000891 00000 n 0000031842 00000 n 0000253925 00000 n 0000000937 00000 n 0000000974 00000 n 0000032018 00000 n 0000253800 00000 n 0000001020 00000 n 0000001052 00000 n 0000044214 00000 n 0000253726 00000 n 0000001103 00000 n 0000001131 00000 n 0000044272 00000 n 0000253639 00000 n 0000001182 00000 n 0000001224 00000 n 0000046695 00000 n 0000253552 00000 n 0000001275 00000 n 0000001311 00000 n 0000046753 00000 n 0000253465 00000 n 0000001362 00000 n 0000001407 00000 n 0000046811 00000 n 0000253378 00000 n 0000001458 00000 n 0000001504 00000 n 0000053375 00000 n 0000253291 00000 n 0000001555 00000 n 0000001600 00000 n 0000053433 00000 n 0000253167 00000 n 0000001651 00000 n 0000001689 00000 n 0000053490 00000 n 0000253093 00000 n 0000001745 00000 n 0000001797 00000 n 0000057230 00000 n 0000253006 00000 n 0000001853 00000 n 0000001894 00000 n 0000063810 00000 n 0000252932 00000 n 0000001950 00000 n 0000001990 00000 n 0000063868 00000 n 0000252858 00000 n 0000002041 00000 n 0000002074 00000 n 0000070496 00000 n 0000252731 00000 n 0000002120 00000 n 0000002151 00000 n 0000070554 00000 n 0000252655 00000 n 0000002202 00000 n 0000002236 00000 n 0000070612 00000 n 0000252578 00000 n 0000002288 00000 n 0000002325 00000 n 0000073191 00000 n 0000252486 00000 n 0000002372 00000 n 0000002406 00000 n 0000078414 00000 n 0000252393 00000 n 0000002453 00000 n 0000002512 00000 n 0000079863 00000 n 0000252314 00000 n 0000002559 00000 n 0000002598 00000 n 0000005178 00000 n 0000005579 00000 n 0000002650 00000 n 0000005290 00000 n 0000005348 00000 n 0000250684 00000 n 0000251405 00000 n 0000250541 00000 n 0000250108 00000 n 0000250398 00000 n 0000251261 00000 n 0000251549 00000 n 0000250827 00000 n 0000250973 00000 n 0000251693 00000 n 0000008179 00000 n 0000007597 00000 n 0000005754 00000 n 0000007709 00000 n 0000249964 00000 n 0000007825 00000 n 0000007884 00000 n 0000007943 00000 n 0000008002 00000 n 0000008061 00000 n 0000008120 00000 n 0000010992 00000 n 0000013435 00000 n 0000011312 00000 n 0000010860 00000 n 0000008315 00000 n 0000011138 00000 n 0000017743 00000 n 0000017863 00000 n 0000013323 00000 n 0000011448 00000 n 0000017685 00000 n 0000251116 00000 n 0000014378 00000 n 0000014522 00000 n 0000014607 00000 n 0000014707 00000 n 0000014744 00000 n 0000014987 00000 n 0000019482 00000 n 0000019312 00000 n 0000018040 00000 n 0000019424 00000 n 0000022812 00000 n 0000022527 00000 n 0000019605 00000 n 0000022639 00000 n 0000024997 00000 n 0000024827 00000 n 0000022961 00000 n 0000024939 00000 n 0000251810 00000 n 0000026985 00000 n 0000026815 00000 n 0000025107 00000 n 0000026927 00000 n 0000028327 00000 n 0000028099 00000 n 0000027108 00000 n 0000028211 00000 n 0000032076 00000 n 0000031672 00000 n 0000028450 00000 n 0000031784 00000 n 0000031900 00000 n 0000031959 00000 n 0000036019 00000 n 0000033635 00000 n 0000033465 00000 n 0000032199 00000 n 0000033577 00000 n 0000040037 00000 n 0000044330 00000 n 0000035907 00000 n 0000033745 00000 n 0000044033 00000 n 0000044091 00000 n 0000044152 00000 n 0000250252 00000 n 0000036710 00000 n 0000036854 00000 n 0000036954 00000 n 0000037059 00000 n 0000037096 00000 n 0000037339 00000 n 0000040706 00000 n 0000040850 00000 n 0000040950 00000 n 0000041055 00000 n 0000041092 00000 n 0000041335 00000 n 0000048923 00000 n 0000046868 00000 n 0000046525 00000 n 0000044507 00000 n 0000046637 00000 n 0000251927 00000 n 0000053548 00000 n 0000048811 00000 n 0000046991 00000 n 0000053256 00000 n 0000053314 00000 n 0000049929 00000 n 0000050073 00000 n 0000050173 00000 n 0000050278 00000 n 0000050315 00000 n 0000050558 00000 n 0000055398 00000 n 0000055228 00000 n 0000053712 00000 n 0000055340 00000 n 0000059644 00000 n 0000057288 00000 n 0000057060 00000 n 0000055508 00000 n 0000057172 00000 n 0000063926 00000 n 0000059532 00000 n 0000057411 00000 n 0000063691 00000 n 0000063749 00000 n 0000060364 00000 n 0000060508 00000 n 0000060608 00000 n 0000060713 00000 n 0000060750 00000 n 0000060993 00000 n 0000066346 00000 n 0000070671 00000 n 0000066234 00000 n 0000064090 00000 n 0000070377 00000 n 0000070435 00000 n 0000067050 00000 n 0000067194 00000 n 0000067294 00000 n 0000067399 00000 n 0000067436 00000 n 0000067679 00000 n 0000073250 00000 n 0000073021 00000 n 0000070822 00000 n 0000073133 00000 n 0000252044 00000 n 0000074819 00000 n 0000074649 00000 n 0000073373 00000 n 0000074761 00000 n 0000078206 00000 n 0000076946 00000 n 0000076776 00000 n 0000074929 00000 n 0000076888 00000 n 0000078535 00000 n 0000078074 00000 n 0000077056 00000 n 0000078356 00000 n 0000078473 00000 n 0000079922 00000 n 0000079631 00000 n 0000078632 00000 n 0000079743 00000 n 0000080275 00000 n 0000079801 00000 n 0000080045 00000 n 0000080524 00000 n 0000080550 00000 n 0000080613 00000 n 0000080650 00000 n 0000080866 00000 n 0000080893 00000 n 0000081332 00000 n 0000081357 00000 n 0000081748 00000 n 0000082131 00000 n 0000082788 00000 n 0000083411 00000 n 0000083860 00000 n 0000084434 00000 n 0000084653 00000 n 0000084986 00000 n 0000100834 00000 n 0000101156 00000 n 0000116721 00000 n 0000117068 00000 n 0000125434 00000 n 0000125669 00000 n 0000148465 00000 n 0000148945 00000 n 0000161688 00000 n 0000161994 00000 n 0000170553 00000 n 0000170789 00000 n 0000189444 00000 n 0000189989 00000 n 0000197010 00000 n 0000197229 00000 n 0000204546 00000 n 0000204787 00000 n 0000220776 00000 n 0000221081 00000 n 0000229368 00000 n 0000229602 00000 n 0000249460 00000 n 0000252153 00000 n 0000252239 00000 n 0000254894 00000 n 0000255062 00000 n 0000255232 00000 n 0000255405 00000 n 0000255575 00000 n 0000255744 00000 n 0000255908 00000 n 0000256079 00000 n 0000256272 00000 n 0000256492 00000 n 0000256723 00000 n 0000256983 00000 n 0000257122 00000 n 0000257232 00000 n 0000257340 00000 n 0000257419 00000 n 0000257457 00000 n 0000257585 00000 n trailer << /Size 348 /Root 346 0 R /Info 347 0 R /ID [<67BBC62DD5A36D5F5BDC9243C535C6DA> <67BBC62DD5A36D5F5BDC9243C535C6DA>] >> startxref 257911 %%EOF IRanges/inst/doc/RleTricks.R0000644000126300012640000000365712234075662017256 0ustar00biocbuildphs_compbio### R code from vignette source 'RleTricks.Rnw' ################################################### ### code chunk number 1: options ################################################### options(width=60) ################################################### ### code chunk number 2: Rle-rollmean ################################################### rollmeanRle <- function (x, k) { n <- length(x) cumsum(c(Rle(sum(window(x, 1, k))), window(x, k + 1, n) - window(x, 1, n - k))) / k } ################################################### ### code chunk number 3: Rle-rollvar ################################################### rollvarRle <- function(x, k) { n <- length(x) means <- rollmeanRle(x, k) nextMean <- window(means, 2, n - k + 1) cumsum(c(Rle(sum((window(x, 1, k) - means[1])^2)), k * diff(means)^2 - (window(x, 1, n - k) - nextMean)^2 + (window(x, k + 1, n) - nextMean)^2)) / (k - 1) } ################################################### ### code chunk number 4: Rle-rollcov ################################################### rollcovRle <- function(x, y, k) { n <- length(x) meanX <- rollmeanRle(x, k) meanY <- rollmeanRle(y, k) nextMeanX <- window(meanX, 2, n - k + 1) nextMeanY <- window(meanY, 2, n - k + 1) cumsum(c(Rle(sum((window(x, 1, k) - meanX[1]) * (window(y, 1, k) - meanY[1]))), k * diff(meanX) * diff(meanY) - (window(x, 1, n - k) - nextMeanX) * (window(y, 1, n - k) - nextMeanY) + (window(x, k + 1, n) - nextMeanX) * (window(y, k + 1, n) - nextMeanY))) / (k - 1) } ################################################### ### code chunk number 5: Rle-rollsd ################################################### rollsdRle <- function(x, k) { sqrt(rollvarRle(x, k)) } ################################################### ### code chunk number 6: Rle-rollcor ################################################### rollcorRle <- function(x, y, k) { rollcovRle(x, y, k) / (rollsdRle(x, k) * rollsdRle(y, k)) } IRanges/inst/doc/RleTricks.Rnw0000644000126300012640000000372012227064501017602 0ustar00biocbuildphs_compbio\documentclass{article} % \VignetteIndexEntry{Rle Tips and Tricks} % \VignetteDepends{} % \VignetteKeywords{Rle} % \VignettePackage{IRanges} \usepackage{times} \usepackage{hyperref} \textwidth=6.5in \textheight=8.5in % \parskip=.3cm \oddsidemargin=-.1in \evensidemargin=-.1in \headheight=-.3in \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \newcommand{\Rcode}[1]{{\texttt{#1}}} \newcommand{\software}[1]{\textsf{#1}} \newcommand{\R}{\software{R}} \newcommand{\IRanges}{\Rpackage{IRanges}} \title{Rle Tips and Tricks} \author{Patrick Aboyoun} \date{\today} \begin{document} \maketitle <>= options(width=60) @ <>= rollmeanRle <- function (x, k) { n <- length(x) cumsum(c(Rle(sum(window(x, 1, k))), window(x, k + 1, n) - window(x, 1, n - k))) / k } @ <>= rollvarRle <- function(x, k) { n <- length(x) means <- rollmeanRle(x, k) nextMean <- window(means, 2, n - k + 1) cumsum(c(Rle(sum((window(x, 1, k) - means[1])^2)), k * diff(means)^2 - (window(x, 1, n - k) - nextMean)^2 + (window(x, k + 1, n) - nextMean)^2)) / (k - 1) } @ <>= rollcovRle <- function(x, y, k) { n <- length(x) meanX <- rollmeanRle(x, k) meanY <- rollmeanRle(y, k) nextMeanX <- window(meanX, 2, n - k + 1) nextMeanY <- window(meanY, 2, n - k + 1) cumsum(c(Rle(sum((window(x, 1, k) - meanX[1]) * (window(y, 1, k) - meanY[1]))), k * diff(meanX) * diff(meanY) - (window(x, 1, n - k) - nextMeanX) * (window(y, 1, n - k) - nextMeanY) + (window(x, k + 1, n) - nextMeanX) * (window(y, k + 1, n) - nextMeanY))) / (k - 1) } @ <>= rollsdRle <- function(x, k) { sqrt(rollvarRle(x, k)) } @ <>= rollcorRle <- function(x, y, k) { rollcovRle(x, y, k) / (rollsdRle(x, k) * rollsdRle(y, k)) } @ \end{document} IRanges/inst/doc/RleTricks.pdf0000644000126300012640000013123412234075662017617 0ustar00biocbuildphs_compbio%PDF-1.4 %ÐÔÅØ 1 0 obj << /S /GoTo /D [2 0 R /Fit ] >> endobj 4 0 obj << /Length 702 /Filter /FlateDecode >> stream xÚíX[oÓ0~߯ðcBg7¶7‘Hô ¦<4C‚^`êÖB»[…øïØñIs¿­Þ(§ñõ;ß¹ø8é›ðd8æÑaÔsQ¸@Œ;D†„ë“ÀõQ8CçÖ™M­«¹¹ãXá¥ìü²U}j}‘Í•”™î†ö(°6jÍÔfÂZÆ /ÂwÃ1 ¥$ð<ëq‰/ÂÌ'~À´š6Åx7R _b`.¡^µ±|¬ÕÐNý¬ocÕa‡¸ŽBã„\öAíWHk½q¾Q8žÅäPpš¶)”kŽÜG Š"¦C8cs!ÉÉW6ö·6 X¹äZÊÜNÝqãs½ü¥lbÝ\Èæ-¬š‚±—€¶ÒK>9žbõ åT(?ÊQ[ëHj±'5£^ò«fŽz£=p†ÆV4¾ïZK¢»¤PäA§`Éuä´ Ó´™zc?T±á<¡ÓI{ä>O ÜA+Kaå ¡’³^èÇ /@¢S \\|ˆKjjGv°9éªØŒ²íWA{±­/‘@c™Ã¦íu©OùœBÿÎpùÜýc•tò•T4sˆLpØ™¬æU~éYÑ'ORÑÛhG‡ÒŽþ_DIôJQöFéÆ`÷xQõUØtz®ÀI•±÷F»JÀ_¾6'¦Cj€SÞ{Ç|›ñžYNQû—×s¼VlÁìcú"Sœ~—âMª¡Ûe#¡'y#ÛïY·—È®$*r³=ã‘== vÝB+Ê¡޳¯1N‰ç{. ¢cœ¼ Oþ¸o endstream endobj 2 0 obj << /Type /Page /Contents 4 0 R /Resources 3 0 R /MediaBox [0 0 612 792] /Parent 11 0 R >> endobj 5 0 obj << /D [2 0 R /XYZ 63.8 705.06 null] >> endobj 6 0 obj << /D [2 0 R /XYZ 64.8 700.753 null] >> endobj 3 0 obj << /Font << /F31 7 0 R /F19 8 0 R /F38 9 0 R /F8 10 0 R >> /ProcSet [ /PDF /Text ] >> endobj 12 0 obj [500] endobj 13 0 obj [525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525 525] endobj 14 0 obj [272 326.4 272 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 489.6 272 272 272 761.6 462.4 462.4 761.6 734 693.4 707.2 747.8 666.2 639 768.3 734 353.2 503 761.2 611.8 897.2 734 761.6 666.2 761.6 720.6 544 707.2 734 734 1006 734 734 598.4 272 489.6 272 489.6 272 272 489.6 544 435.2 544 435.2 299.2 489.6 544 272 299.2 516.8 272 816 544 489.6 544 516.8 380.8 386.2 380.8 544 516.8 707.2 516.8 516.8] endobj 15 0 obj [680.5 510.9 667.6 693.3 693.3 954.5 693.3 693.3 563.1 249.6 458.6 249.6 458.6 249.6 249.6 458.6 510.9 406.4 510.9 406.4 275.8 458.6 510.9 249.6 275.8 484.7 249.6 772.1 510.9 458.6 510.9 484.7 354.1 359.4] endobj 16 0 obj << /Length1 1387 /Length2 5943 /Length3 0 /Length 6884 /Filter /FlateDecode >> stream xÚt4œíÖ6 (ÑëŒÞ¢½E:ŒŒÆèQ_%…D"zKA"DOÔ(AôÞ5щå›”÷œóžÿ_ëûÖ¬õ̽û}í½¯››ÃÈDXÅ퇢QXaˆXPÓ¿ `°¸,âæ6E`‘ð?j·9ã@£äþÃA ‡añ:uï§F:>H"@¤ä Òr`0 ËþíˆÆÈê0_„3 /è Qpo·Ú3ƒpuÃâËü}øœøˆ¬¬´Ð¯p@ÅŽA8ÁP€> ë÷ÀWt‚!´Ž øG >7,ÖSNTÔÏÏOæá-‚Ƹ*ò ~¬pî ÇøÂŸ€˜ü727`ê†ðþ­7A»`ý`8€W Np”7>Âå Çøâ€‰¶`è GývÖûí üé ü+ݟ蟉¨_Á0''´‡' €@¹.$0„ê‰`ý±B åüÓ†ôFããa¾0æˆwøusU1`x€ày;ažXooò'DÑŸið]Ö@9«¡=<à(¬7èçýÔ¸¾í¢¿'{…öCý\(g—Ÿ œ}ÿmÕÆÂðôPA¹"ÿÕF„7áw6B`Ü~ïÐßSÀ§G"Pp#´7âçcãö_6<áœnãoü¬~™àx>ý³¤Ê íü“xb’R ƒ€ð£ÇK’@ÏPg¸ÿ¯ÕDEPh,>Àà \ÐÐωJÈ¢ø'ë§ôÄN> žq¿F¯ú·ü‹Þp¸?Ü 4>‚v’t/¬?|¥rÍOx±÷Æ ÷¢ÅS~á qLƒÏñåKùËÒïÎböUw6_™š×àÛSž`? Z­©¸S›l\÷#øÄþáÍþÅ:ÐXý‡Où«*oÚXÉX„M•—‚O½‚ÍÃoÕ¾×áÎöò‘¹l”Ksèתéÿ¦ 7Ù=²h¼T&¥K~‚N4K° 1Äã˜1ÌÈI‚f% Þò§ÚÛ¤ÎútήóP²–(^tkNìÞÑpàôKS1ïF&.¦[Œ¬D{ÔÝýcV½fbz˜{=pŽ et gžãcÿ!'ïw¸óV!ƒ . &M=W¨ûê±YQu4–>Óé¶5“9[ò5Œ´²òÕ«4¥N&¥]é”UzrûîlbëÇïveü$ ì»7°Ÿµ&¨(å¥RkªC0º>¯â?ž™©#žÑWhaKÊûCöÙFÎî8±qÛÌzm†ÙÔÖ.IJørX§Ùh׿¾Ú|SvB÷aÉ)ž<ËZ¼£¯s¤Ÿe~Ù}ß7Hj–ñшÍa p“åÕùŒSœéÆÑ£ Ó+]‘)]ÆoüMB š]ºA°Xµ[ªš™ 6Ö€I¾Ëqº¼Ñ-b†àAó'¥RÚF\\È__V '3ÌY72®Á{:ãÛ™I™t»Gyĸ]9–Æèt3¥ ù ïè¿ke œñIJÍŽ’xV'𜲭™²¸ÿ\ö}oá¬Rkžî#z'~ÆŸ>Ûl¹faKx”Šæï}jýþEbºê×¼TÏ•íl`£V–ß;a¸?òI¹ÀBÌŸ}EÆ‹CÏy tþzõÎÄ\4¡Cõ†òëïÇëà¤&«tà×úQßA{wkÉûþN:¿Ï3ŸÅlѸ–Y ÔþTIÛí#•ÏJŽªÇ”„A®r™t,Å™´¨#@êànãÄ À ¥,ŒdÔCIšìøñ ¯¾*ËÔ <,”ýÆx£ƒ7i¯û´^ûÄÍà¸b$hÁ¸üB¤çë4ìAGŒ¨|ÞÈÓÁ©¿öÍ£U¹Êb8º„1¿ÄcÊ‘<þ”XàØáÙê¥ÖœäÙdQ—½– d·‘†XŽ›¹ ¿‰ªžè’Ž~C’§–©’7{”/ úØHÎw½vÌ’%Iâ$'xJ)ts tµ©Õ”oÁÞbë‚£ÊY¨n0ZŸÜžfdð‰ÅÕÙ3–‡ ” ú+çRaÅÙ¯í`ØLvReCÈjŽht›ýÑ[ñ¶ë©óNTúú£}šm·N§­‰<^ž×~J€†’Q#qGÅœÍ:Š¥ð‹cæª÷-TYB–Íù\œ2é˜D0 ål†Ï¼Ø¼IM_M_ÐPMl'Â5eˆ¬4è]ìó?¼øœÑÞº×Ò<ö*Cûîwãì2JS£ó=߈ì#¼K(Éól‚9ê–|\ìC¿ý 2ÁAÄLz7>y`¯ì %ά5kóíd2롳•ÕCûáV1„M·ÐžH]v__°ÝÑ3,Z>h×M^b,N¿bn.?–Sß;x™’ºÔPÄ0s!T/#S<±ÖåšuÃæÆœ2'tîXzhšãøãéÃwæá÷|H×Ò¦Œ Ç’ÄiŽêÜpÊðG›Ï§G0 cëî;@±ì/ó‚êÝ@’·Ýíõ\oç{i¨Ë›H/•ä-ç˰èe2ÙÞ»º…ÃÇäâ"| ÔßÅëkJËrië!Îx’UÆ\¯}F!¥ctÈîC +wtÉWzò 難0vùF'‡Î sy–+­G+xÇ{ ,&ú#xsÁáºÀÝ3Qb|À‡Ì1“¹Y $ÓÞ¨¢U0œ%N Ù±Îö¯ù2…¨ø”à2(‰XK䙌‰9ú=t°EùpfF7õîòiò6ÎT¶; Åò‚Òž6ù~þLÔV_4AvÓ’¥=S+ÉtÔ,YöS5)š•Ÿ·¾†ñ±©P «hú7 S2>"»>‚óãœÇ»Šò[B¡ýÜ t]Ùl¶?Qø©÷Ý«#LÔ¨ÿ§¡•'³€ë™ÇÃÄJó€½Ê‰«ýœ¶×ï0>yáé»ÓD™Áý0u¬­P£*ûªÚJ­D rÜŠÅ9+_?(”!è»m3¯ûŠ0{P>¯ñÛP22zÌGB>–`°÷œP~îsóÙËæë„I%WNfêã><Ïy<ßFIƒ#òn|.«P©yŸRMÃ!Êük®Û\Cg+7qr/´mÔÐú¥ÿjD(îAg¿¸xý‘ì¨ìÚ­DoÙB^‡ù6Ê5̄őœÁ£‚µïÁ½öGUìÊ$.év¬ÓQçèåêmôÔ™K¸ßf¿¬w(GOÁóýEêj*$ EpÍ´ ™•c‘ÎÖ”·‚.½í…¾ìŸíËUK»b²¢¿‹)ùÕ“’\ø¶[¿7ÓbIËãaÎ÷¥LÆ0ºús\‘J/Bɬ”LlïlGe]H-9B¢UG¾¾L&cOÉðå­TÅAÝ¥˜ž=Þ(Ò˜…YÇÞu94ò—ӊʦ þvÉâ¤B~R“m„öŠ §¸êwÉñÝ“¥ÃÏZ6œƒÅÖ$‡”ÞÔu'IƒCYœ§¢˜´Nêén¥·(ÑFÜ[W¾ïEþtÆB—±ŠÖ¥_dz’5½ÛªÃåØorÉÚJÑòÄ{”ò#*™â|;¿º7ï[ÆëµÞTµc½© C¾_õcŸ=j•!W.©ÿ¢ìâìÒÆ$ífÜ%š{u%T•×B ˆºçG͵çp„Ì8<ÚXUç±` ëÀ-Œ[Öp‘h;X¦êÆjç—Ô“…v ‹Œ[±l+¡èŠ1)W쿯¡¦Â›I)ßžÌcU ˆ…õ(Q)ñO”ˆígèíì£&]i“*ïdÒ¸/ŸèÀöªo½PW5ffK Þú¶iнìa5HñÑ ò½±çÃhæâÜÐAþÆè·G•;¢‰ò—L˜x)ìjöä°u^»+£õ/~¡ÁÖì’ï­¥›4öºp¯¨ýÑmSÞš­Ì+ò™ ¼®¡Æ|±H=5H²e+ ÙÃüäõp´Õk  \i!¾/¢f"ØÈ’gi¹Ãï¼`"ÖC.^¬“¢?ÑùÉ·=XÉEÊV ï4^õð4Ô•&´8…Çó·LŽÍÀâ´RJænÕ –Iø$š…¼ok]nù^HBkôs|L±z¼öàˆcˆP›tÈj±p0‹I—{Å©@£¬zíGÚ ÕñnmÛka&$àúî`íU·ËÝÖÆÑzn8+áÅ»wL0g0I@ßÈJ³h¸OžMöb"‹íÅ¢~+úø(eɰ¤éÙ~>fÐaúCEòŒ–ˆªNu-÷˜Ü+óÞtº»þS) %‘fʼn¾‘²²œO·Ÿ”N [åyRÊ®+,O<{µÀïÒ¿ Ls¨j¯RÊ×v"P6ÑâIQ8'®OÚ¸÷EÈЄg@ï²ØÌ›¿Æ‰·íÂJT8êçå¶i38òü·ˆSî:~Ò?ù볨KˆølJÚêÇçíóœšE)WK–y]ô½û/ ±[Z˜†œìWVU[µV&Ú‘‡ r»÷´sh½ÛŒ7Ô:'íì¹Çnô6^~%¦¼w'ôájßœËåá¶S×A\ã—pT“¼jnJá’© ‘&Œ§¬uë_5m+'—0f=ƒ½¬¦MU uŠ‹þŠD[VèóíÜ'ÁT½¸>é0Ú‡² rŸtF^ðe-u¨åÕFfŸ†Î½æX¬8ÉÙ4jîZ z”K¢QötóF¯'lÅŽ<|ÌmÕð6‘CFÕFÚ¼çá1E‰ŒOÀf'ez÷±È%ÄÉ«EP²)àÇé´ípÆñµÃƵËfB%„ï°ÙüK9­ìw†Q­“|¥öpÃð¯¬Pówg^}$ôŠ/}VæZ…5åb?o·FdF¥iݲá¾o¶î;ÖHÀFÙ8oÇ8÷Q51€;ÌÀôKõ[ñŒ¥–«sJõ´:I‡ôƒâ‘¬ˆùQ-å©á.Ÿ"NoWßYMÛ;õå k÷¡æí1™oV¯ëGœ°3J'ÓçRXí¨½)ióøZi÷¶LÓGÒ^3íÒaå8äù*¬hÂùÙ\b÷—-МÄ_¯!%¨XûêŠ!ž$‚K.8WY7.ÖãÂ6B[åMý#‡1»MÝ}yÉb’|¿öÕº‹ Ú¯M•Bq•»³VW>/Ú§Zvú7ר­0W¾²ªïíËÝOœpf»t³€hHVÁ^¥XÆ=¢åÿR ÃåwÖº}ù$k=ôÂçœÔd™QV7‰)òj«©nÌ’kÁϵ3ù­a„õ— þñ×¼Ú#ò.jó¥œ×»_‘Ô{Óntª vckäz¨þ…ÆìSó¿:«DÁ†Ó—·äz7—[?å·¥CÞïT"CÇá×Ú |•/0_|¹ÆN72»RñìƒÝ„Ôµ ÑÌ€þ°­êç”qÖe½qWÞukdæ5û17¯ÁØ®Qä.!vô`‘ Ô!î]¯–;•äÅ-†´…úS-mZ¼%¾”ºˆŠñ¾÷Œ¸t¹ ©t«(p7þqu¼bõ²Ì:»§°^?OGÞ¢M]EÀ¡¢»Ù!%wcú}§7N©Ö÷cÝ;›“¿’èFN»>8ºD NÖ¿›‰ÌDs’%Ž¿0#«ìßuýæÚ[¸÷À§šÝŸªÐBcy0]{ÙwáX þB‡ëþ¹„’¥˜mó‰B­g=¹i£;Ïìšú¼ôàèòô§fë»w( ’’ú¤×ø?äï¦j¡d^¨-,Q‘æü¤}SAT {ªßÖþýÈ{ñyØÛ²Ú–ß“\òŠÒû‰¾œ:ý!H3þÜRcíEÊ•‘oŸ9ûZ8t&M¤/7NX±•‘²¬oºOR²ò Œ«¬èP/ž¯©#¥ž ¾±—b³È%å[nÂljuõ¯ë“Œ¥zOÎ%z_l,+¥|âÝ_;h9 …28›kê .Ó{Ó½Ô<ËŸ³­.òªh¹Ø¹Oè–ÐFõòèèÛËÀHõ"¬2…øœúYZÖŠþ˜²¢;¿‚…›Ã‚~}¬âùhnçùÏð¹usuáà'µµ–T!ý/Ô0q L;T:VÈ]O/<ÍKzd"OÇ9X¯»?x½÷¡ivÕeèÁ±Í2óéÝP2+3¹|*Yc𷛀ºMë]J-Ÿ!©sã¶Ó¾§¼ÆâŽòþ׫ﱋﲛtËáܯ®OrWcu^UìÊ1<ßHgŘτ73ùÛ¾ª!©Wäÿ²™ÕTi†Ì8"’D¿»b½œÓ•¿"dÀSÈKƒ(гym`ܤ½£5Ôó½½QÉTn]y ºÉ°lpN~ÉIJiüZá%ÛœÅIxƒ„K T½Êíþ¤ÈØÓ üv&ÄýÂlQ(¿S!òØ[Õt}j„ßËÈ­ÈoÃ+›‡ö·Äël@oǰëggVŸ%î3@ïØ§ù7%F™eÇóZ&U¶ÇDj*S™\‘Ò&·aO\žÚW<‘ë4·ÿq¡Sqø¹¬€68„~°Ò†3hŒŽtSÜl"ðÃv§Ï4Ý…¨{Kו`è ×f¶(0Y4Šï)UÁiòF´Ò·N3¼éèÖØëÓ2’nb(c[·Z°è.‡v—ØÕŨÖKùÍy´åPåhð¿£?ZÞÖ”Œ¬]!¡,H˜qf:&ï~<V¨µSêüì0°À|`=r#/_«û–DJ(È0¶T÷=½/Ú¢SCÛìÖc ±> ép{(ÄntþÀßu'чµLnN}F*‘LºUG7ÓuÐ×Ó[eaÑ8•¦MhÊ­¸+‰)ÈwJ"˜ÿ¦ø+AD‘WqÐY£H Poô„¤ñó¹¡RÙ5ëÌ‹ˆ9:¢c+1? ¨»Œå åX´ª¨Âhóø+rކ£!½Uwê&Þ~u §!°ª . K‘?†"î9út"Á…ðÊ ú2ÞF^ÝÓš°ªV›â ±2ÜÉÛ¼G¤ŒV í\ ƒ¤±ØïؾS©„t‰Z—éÀ©±­·_ã|š¿9©Óî.ÊÓ>;r$Yú~èèÆÕëOØå03Ûëýö\+‹nÈ®-^:ñ-!qi`°´â]¹”˜DÛ¨™$½ÿà\ endstream endobj 17 0 obj << /Type /FontDescriptor /FontName /SDXKYB+CMR10 /Flags 4 /FontBBox [-40 -250 1009 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 69 /XHeight 431 /CharSet (/one) /FontFile 16 0 R >> endobj 18 0 obj << /Length1 1691 /Length2 9278 /Length3 0 /Length 10362 /Filter /FlateDecode >> stream xÚ´Tj-L# ’’C7 Ý "HwK 0ÄÃÐÝ!ÝÝHJ#-‚HJ7Ò‚\ôœïx¾ïÿ׺wÍZ3³Ÿ|÷ûì祧VÓd—²t4=w„Àع8€Âe .nÈÃr£ÓÓkaö ¿Íèô: ¨ Ø"ü¯(È öh“5ƒ=Æ);BŠ®ö.¿0—€0à…þèÈš¹-ÊEGÈ^ÆÑÉ ¶¶=¶ùÏ_“3€KHH€íw:@Ê[˜AÊf0ÃcG 3{€¦£óü¯L¢60˜“0'§»»;‡™ƒ ‡#ÔZœ™ à†Ù4@. ¨Èð‹0@ÅÌô3tz€– Øå/»¦£ÌÝ <ìÁ ˆËc†+Ä<6h*(T@¿‚•þ `ü}7.®Êýý«ò;ÙÌÂÂÑÁÉ â †X¬Àö €ês%˜Œ `±ühfïâø˜oæf¶73 ø}r3Às)u€Ù#Á¿é¹X@ÁN0°ý/Šœ¿Ê<Þ²ÄRÆÑÁ¹ ÿ:Ÿ, ²x¼vOο&kqt‡xÿ ¬ÀK«_$,]8µ!`gW‚ìß!&ô?6k À„x gÈÆóWy-O'Ðo'×/ó#_o'G'€Õ# /Ø ôøƒîíbæÀ ® _ï;þ¡sq,Á0€9È AÿSýÑ ²ú ? öµÇþúüóÏøQ^–Ž{Ï?á¿çË©*£¤£­Åúã|ÒÒŽov^;7@HP Àøþw•øÿ‡ûo«šøï³ÿT€X9„þ¢ðxwÿ¡áö·*˜þÞfÀwPq|”2ÀôGùF@> Åã×ÿ³þ§üÿÉþW•ÿ›òÿ÷@Ï]íí»™~ûÿ?n3°½çßJv…=n…²ããn@þ7Tô×&+ƒ,Á®ÿëU€™=n‡ÄÚþŸk»<{€,ÕÀ0 ›¿$ôŸ)<–·C@jŽ.à_o € üßã¾YØ=¾'.³úí=®Ó·”ƒX8ZþÚ;n>~€jæ‰|”7À›ëqA-A¿• àä€8ÂSô|VŽPô_åçpJý2ýFBÒú œjÿ !§Ù$à4ÿƒó,þA¼¼èq_ÿDs=ê™ô/øØü/øXÚîäzì ùò=:!wñ/ÿc1Ç?Ý{;þ—û±=ô_À ûSí1fý‰¼YN˜»ã¿ºþÜžº=òöAÿ ÿ¯IX¸B¡/Ôï]yÓðïçòY /Ì9Zˆ„ØÖ‡t\×J‘¹³ï|›¦ßÑMgf÷^€vºÞb£¦0×d­A¿K¥Œôâ.oÉ1]J.RÝ{mmD oKRoÿás÷*Acr§}þÑàDñW©† 4rv-É]Ÿ{g@;ÄVø.Eú|gWAlµBük÷~y†Š¥±°¹õÝþ—wSì1ÚÑF¥3ôæ9³$4(0vŠ',OO ¡žÛ¼¯=T&Âz=–p ”*H_8|^vDÑŽõÐ] ñªÑÅÊè AS‹¶©EkgÀ¦uv½{àþŠõȲǰÂÌ©¢×T„Ûþ‹=ÁÉ…E–ã`×¥Ã3øú¦¦ ±½Ú¶”ÉT(w!ß3Ø%‰Üމ±ËòóÚ-F ©~ï[ÝRÌnÊcÎý˜^n؆Ò^EI¡Ù'vìyCÂwIè”|Ò¢‘§}Õr†Ï0ìh+ÃbLe_Ï*¯ÄO™„)Êíâ‹ñêµÂ=ì‘2ûÿ$þ)›L~dC4î…µ¦Oyñ”TënÚ™›öj>ôÌ:C-Ø'mŸ+s(ž>cè0CÿREt¡Ûç’òŠ¢h¬>1Ù3ÖÔÇ[#¨0†¿¿1w4M:-NÀVáŠ58<`8;ô¾ÁŒ ò®”ó!]R€CòŽð€—)‘¼ƒC þ`œÊ4wʆѩjj‹Õ#Åm\Ï7¬^âõžüž,…pZÉ»¸¦‚é¼x†VÞS§yè¦GÌÝ‘2?ÎÄ'ËNòTóÕX알½‰ ʘïâ;vg!ɶÉ5ÐÃ*šd]ûÏ7¨ùÍ>QîÊQÐ$ ¡55B¦í\Q;ÁvÔ‘” ¡œIEͼi‹/HÚùÞ¿@™ÛÑn"üÌöœÜgœe98:¿*ÊŒjÇ)›$XEó“!5Ã[düxò:ŸÙ+zq­Î »Ú'ûP×ÐZ}IeHT³ëG]Sz RuAŠ wykŠ€Ÿ"–%(-Ëö£Žh㤭Ü÷˜IÚç—®Ýü›é2s¯éIôµ.5.¢‡Hm§àòç¸(”+ ¾J?ãXáN’„U6qŽ™^I™Î›ŽÝ!„#ám‰m¬TDÇ‘Æ|=6LW©o6[û‚M*ÁßH¤ žüì\tU%퇛è?êŒü¶$,ÆY/,Z|c$ÎIø-}-¥Þ…[Ê讀/W£¼}¥TÍËÅêx*þ¼'©©ÆI=¸¬™·ëuö ¯ø ÏSŸ}ýijljÇ¢…ùŽ©ºÜ8·‡ŸOcžÝ°‡Iîí¡”"5‹02ˆEªð`¹h ÙàgŰœK£Êd´C£Å§ŠSŽ¥qÌðÞˆé³lqõ®p†V²Ô!ê¯c­^t쮈0;™²Z+g]ö…”û`~çHGT–t'VŽïÖ¶öùPJYÜG aîØÂé‚'Ùó jwÑïÎTÇØGµíÏ9”§±½IÊ7D2¥€[óÄj ·~|}•¬Šiƒ[5øü ùt‡Y?âE1<ŸÐ:á\MÔ"BHƒ/lk9´¶S0à.ÃIö*ñÂwfò¼êrä#„ºÇfhLˆßÞhàã{„ûP› à¼w—3ûlU7õm¤ìðÃËKÆi^­òpÈHšññåR/ÏN'ÞéÙ~]`¥ªÍ„¢ÔPFfC‡¸IéS!·¼éxO2TFXËtµ°¥ íqZPQ²Ò4Ù®™†G~uè%u§|r–DfËi>J`×¶Ðn>±fõ€¬%¾Ý|i¢9]í­ÎéPX… ,•×׆”°úB%Úÿâ­B ›j3*?ãzɳ <ûª°,ô‡0Õ’EZ38´QU­Ü':;ìíLÍÔŠMÍï=õÖÐ:˨k¼>/K~æxP~CˆÉw 7Á—$«ÔÈ÷ ºðbgÿ­³uPi '%ôKiîžõx}Òk@•åAWj·GþŒÔ½Å×ôѶ‰‚Â;}˦áÜkÇKÓˆÂB)å[5óè0vHqBø~ )ј¶©$rÐÞšadT–ög/՜ϒEU/«N[ËæöÙŠ½[—P;Ù+fø›™gctN2Y™ƒ_)pYǘZ”cÑf;Õ~è¼NTu*‚YȘ¶Íæo³bûëªùªô¥˜÷#¸31˜1Ikð“§ÅF!rN±±fÎx…QF57ŒÌ^ñ.P¼÷}©_PÃÚd9'nb±ªóšð)PÎ`Æ6|O€ÿŒ¹ üäP¥jx;ÇÁ{C”æûɲ;’æ±锤ê‘û «ö Þ–¢#P¸\:4i,t›aèWˆ^ÚÑ®W»Kô8õm4>Œ'õÝoÀšrˆ(–º©_q:¦û-¡õÞ%w–˜‰[lIS’gƬóï:£d–p¼Z/!xÞHû@Cíê®—§Ñäl ³‹ûdTµF¤ƒoã—·?r)I×VN<¥UÜ®‡o:é>ÿÙwÚBáDL $À}Ô U|Š—ðRÀ@I–Ƭ(åÂjW«Œ\bÆÖÇ8"(ÌÉ­+_·ˆŠ7ÚÄ5„ô,<K4˜µ ¾úpí‘;oøA,¢Ñ¿¦]¨kÇ«Oá=5Ò›ÁwP<¼J—žŠ“Td*/ж‹±¹ˆuòì“"N÷µÑmpžûL)kÜ6³›F“­×`–‹ðï*ßú äõYû\é\+ ëìϘ;Pf­I3ìåpÝ“š[zæBX¢ý.,ôì âdõ\© så1Z)͹•@o±v"Y@Ÿ?_¯5–ô<[¥öÒä šOSŒ4 Pò=Óä¦7p³z3zƒÉl'î´„¸HŽÕ’J¡5ï.Œµ|ú']^ëºÊQš_Äjã“Ï!dð+¤ÁSvY7Y?ûcž€fbØöbúg¯©¤ŠæžçÌÛ5rš]níÕ»)¬\íŽ 4c ¨?]}zž/[7spþÃîÚ%µÐFü]¦ihBžYL¹Z-“Ÿ-½ZuXËðˆ8z“¼®}ŠRà¤BFNøvÓÉÍ›ïH+ å =Q6®—p ”Rðat¸ÑA13ô·±BFj˜4òL4«˜›7÷—Ma‡È#Ý=)S¸p^¡HäÑyi¬4IÛd-‹-Á:›/¢2/Ÿ5ÅpÉ/æ]½ðˆÚÔÇéØ×ªŸªw‰gïsÒŒF©ì‘i¨ÏwFBòY kL{{ÉÔ!†·Ixª¶iÎqì²®kÑšÞ™ÒÌÑí²í¸¥²ÄwȃMêWöžixMŠYáEî§2_[ÛJ­$1z„›K«YŠÖl•˜LŲMSãô¸Íî8Ìc(R'Ô±ˆV×qjÖ# ÷"ˆ) ùêQ.iðlÜJq³ª[~¥Ùtƒ{Î&w™hxÌSðqÚ@E%H–Œb«÷ • at‘ÕÓ“—_Äù¦^sð1½Ü¸%œgE fåm÷œ•,#\EΉý$=ûÍPŸª¥#ù­Š‚Ýô/:%29át<º¤”ݧüRCGÊfI‡gsUé^ "Ík{sÄDÏaÊñý Ö„nJr:ì‘»÷½1µcÀxM.4rÖh!7Û«ªµ?ÂHÜ{ÝU]YT†®±íà<,¢r2tŠfz„ª^ô: ÖrOàñœ~<;ûì?›uQ̨™‰Â:L,É€Ó•`Ô?iÜc®»V@]¨²Zâ´@hÖ÷ ˜h×a·iŸF—“ÁltBÝ“ ŸÖžSàí̪ã"‰mÃ%ìlŽåè6‘! zS&8ÈhÏ7‹4«Ã~’måVG¬U<ųÌlôÑGTç¥Þ•%4MÌ#vÜÞ¹•þ`AïŸäw¿X¿wcÀ°ïïÖÈH yB¹"iú“GÏð$}Î@©Ð„ÔS)aÌA™Û`›*ýô‰ß~ˆwþAÁW+Hy |BŠ“ð};bùÀ†}cTIü,ãE~ô˜… 7Í'?²2™Þõ`ò‘dâh•Åcj×øº8g#Z˜«n)ˆe°hÿù±à %Ÿl³"…/¼D&#½8¹7Íü)ˆ_r$§Hh‘‹„ÌðÁ¡šÓ(Ú0뺱°ÃŒpÄZ{ôNq‰bk¯­©ƒã% ÔåÔDN,ßö¡Ðçsºèuté}s\W2Ôyø\è˜NrùGm¦ì&ÝœæDÉôBˆkK³¢áL7‡Ù1ÚõM«^¯¿Gi¹ O4ÝKüøÖ¤!æ§Ïšóµ)9¦cÅ;v—±½Îšž©Í͈ì¥a?†MT¿ÏªÁÖ«ÙV<¡\⌦WS´*†"Ì{\Aߌ´—)‚&'h³ì^ÓTj+þTsÝWgõ,aaƒET’©7ž~øž‰3·f÷JB¨¯VOÎüâu(…Ä^ëÑü òoT}TšxÍb¸¤RMßt"Ń[…¤~^ÉÙè…%NÓŒ|ͪÙ&4Ö´Þf b‘µ€eªoû±¢l‘zc蔾dƵI+ìÃþ¬Z¼.àÁêô‚’”·Bt1²º’0 4gB¼å1·CÓòÝí3‘7ñ¦³„*‹3”û,y›“þgJL£ogô–<•<>øúÊ“$§Ï:5_Ã{!èk5Â>ª¢¾zW¾É §ß"æ'w2N6ækZÎ!ÍüÅsº?jIƒk“@Z:Õ£ ô>Á‚'Aq@Û?ˆùnÐ&´Ss¾x`bðuöxöÔNšÙK(ø¶ü;r3£û™¾¦>Fnþ¥z_´éÑiG «¨vVqk¬7£×B|òkUg }êç†åÏ-&(»èÛ(e ÃJGg¨¤TcùäË0ôTæéÉë"-²Q¬=®Yët­åeHóCn焱—Þ9…†ÈÅTÖÚ Â¢Á Û‰î…5baºJ‚ÿ{@0-qÓûr d>é ¸Ç; zO'0TL³Dµwˆ« –ÎNgûHy¸ƒ¥'±€â|a›g9óg½[Uðç4Ü3eýã\+'‡ó™ÔàEj?÷FXä]Éöð=b#s6ï$ñlÓù[U†OCLQÃ4’8A\²Ó?ç…d¹·{žæ“/Ø5Ä{­/¨_:B+Ù€nQ¶9ÅlRr’žŒV¿`»ÛÏv@À]!].h¸Ä„”ƒü^ÝœÜËoù G܆gå凸ÕuÞ1lÒ6JBžûµ„=,DbS&!2Ã67q®Û”1©ŽüzÓß^¤+î›Û©R¸õW1ãˆ8MÚ\¬îÖÖ†À(¯Tmyc_( ˜9­Duðg~}Åñî ™7ñêKຈ¦`}¸8óXÌ4_‘ųÁМk’Mâ÷‘F´¥Ú BEO.ï%O¨%ß}VḆg·¬<ÒPg`fem^|·¯¼w[D,åbMY~c/' ö¦Qø‚«2é^Tm‹Ýù‚ò¾"ÞBézð0G†íˆâ{††“€k=o”ýÐøÄ¹Õ+$y€FuÆœ¼ß³Ü„“€ðÒ‡ø=ý"¥ ÕÎkßIFm”ßÊú¨2³7c½v!kù/EEæksùÌð\£Ô‚[âq¾†íhn´X§'&LÞa‹à9NL± ¿¾­?N=}%’rü¨õFê¹[7.}ôÃ?>Âä“£¨mR…ÇOØ<ñÑ_ÎÛÕy!Œ§S6Ä—q5“¿D.%œ]ómÜ"0ˆOìà {Ð…°Ççº#ó'íãcû¾=®]N¸>;Õrƒ±¡þøãkJú7¨µÛ-ÆpÌβƒ·L*¢:E+i –0Q>ˆ¸å_’Ú3Ky.ÜUŽj0 +åÏðÜX9ÅwzîSQ ðs(áIu=Ç~u8§±±§0 e%O«•Ïî³ËФƒ ´H·“¢fú|‰öðO¶UÒ;u~ƒa¥¹¾Î4df§¼žAö—.‚Î[¹¨‚ëê[›htUž›ïk¢:gh ÈáÆ›¡j”£fBÈØP.Ã{,öÉÉ?F‹˱’3çX#”"±žÁÆTÈÇ’²ˆV÷‚M ›»¾ÎøÓI1–îR`“CKÝ_Ý…CKE4Çg#.j(Í¿DBóÔNÿQØçÇM²Bê*a˜yUý¬äÅ+ ¯¼ŽzäqQùÜéˆ`ÿ¿¾yñÝFÞ iÎNÙ’v(wÿͲQc…´n·yt@И÷ƒú–“!w~ÈŠÝ¡VÀWfËŽ”ýÍõ±HFœMeîC¹¨=_úÄöRsÉšÎjGàë+¢œè„‚*¸¼øsc¥ªX~Ú¹lVtJ ­„ÎL|O¬ÀGæP­nûò4.nIív”36yÞ»À«žé«:^jÜ`[FhKIq ‘ºXí`µBêUx­òÕ:Q$¶]ŽäˆÜQ= úÆ22AÓJæsA²Æßh+H öYÂ{¢4•89¡'[Y‚À c4ì{Ň'­ ~E~VͼäÑ’·˜sÜ6Р {â± ™ ÆÞÉ·ºõ„KÎc^D5¥  Û º—!òÁöµ2Ç‚75¤| t“eä*êFõôoJðJÐQ^‹ñ™m&^úE欈Eg’$œÄ“2Ø’Ìœœ&ƒiǽ2—lds±ŽpüàA!QSvpÏÆ ýñ‚³¶–g.&ãÉžì-غªpYm}’‚ìô.n~1+3¢¿Œ_Å…:JŽc¼+å?z:(¦Œ!åÉÿööÂzV…iÛK°×¦µ´Ãå%X)„™m¥Ñ^U,ÌðƒåPâÛÊeVª;.Ü&W·Aûüuƒ@ÂWOþ iÂ*9òûÒ‰VîÉzcŠÍViÕ@qÏþn粆c—µÞ*NŒ’Òn´Ÿ!húÕç[ÒŒU²[0~ÆV•ɸˆÞ6Ô7 Ï,} 6KnÅ(Ä’-«™Äæ ¾0SØ?Wì%ò¦‰´$¯ª*bÔ•Ë$²ÿð³Tkèu]tpA—Ö­¾Ë›H±¹ó«8 4ðj8çY†EÚÙAIƒ®¿õî©(ëbÉô._ ªóbM}e•Y›öÇ\/O8«S›yÍïߎÐô¬€å²¾cvÞÅxÉ¢h&a©øovûv]±æx~ÌÄY­!⌞9FCjwÔ„Õ<{ mX €Lå«G$sÌ5å[îe=%WSO_¼È’ÌdPÏ|uüÓžiœí ÒïÈ×£åòYüáX‰nbp 1%Ó²ʾ϶·R0°¬¯¦ 3ÖÌ%rô£ §¤sõµä—¤àñ¼ýãgÅ{G’Š%Ïq±@»xùMu½zèÝ jœ‡V&CTìázѪçÂÅ(%uuY?Û4*ÈÓ8‚ˆHB•ÔÌc”†K‹O(‚ãU ظ#¦Ä-´îãÖè}gO¯˜ýe8ONàY5ü~x(ƒÔ¹nVzÊ)·‚(‰(žÕ~lr<:dÛÈVMþ2D¹X>›QYhTU´ÒúüÓ< ­òÆ ªàJ§8•,¿X„—QõÂÐ"}ãT™©ÐŽƒZ-²(mvT•óÖËa6©¹õ“ìÎnÙœ± Lxô¯G•RØ‘²OJ8qÂKC’e핞 ù‡'S*“5ÍZµ¿,ÍEÔõÏ”jƒŠ¦ƒ¢^¦ÄÒnµ,QêªfX¾ñæ¼Xe¸ì[xê#½› O·Ù~>_‚JÄɃc%ÍæV¾/wàDµx¢Øžµ?’©ã~Xéï˱DLïÔhîb˜”w '£'+Ö{wÅ0Þ.FöК}r”òtO;HæfeFæ@ß%îϺ¯ßiú™vÐ1†2'k¶nUVQr@F&À c½Tà5•¤á•m*™îäÐI*Þ×*ñ¾Bp<ËÐõÉbÇaFæõìJÌÙáÊIl$„Þj¶VðÃÃu4:à“tBÊ»Ð%‡Êb|5›ÛCñpÖŒŽš×± ,í$§Æ “®z'™,Ÿhy| u-F%¤Þ¸Ñª¿ãHa)Qk¥&ç¿[n]“ŒD'“Q£…oÈŽì|Hç 96$fŸäÑ­ ØÑñ“ì>ïVJ¬ËCq¦ºŸ_=ÕλRqàµÞam¬¼4mÒùa'*ync‡\y÷OTÆ—o8÷n4áÉ$pŠhèµQ¦özNópÞ6(æw?ßî£ ºÃ­ˆQ${ç…Hç!âáß"%~š2C†œK¶ayŸîS“ºÚs-NbøÀª‚äŒuÝVjLÀêr·džÂjIRºsø)#ó ñ1Ž}ã}E“îÿ·¼íå endstream endobj 19 0 obj << /Type /FontDescriptor /FontName /OCLVUT+CMR12 /Flags 4 /FontBBox [-34 -251 988 750] /Ascent 694 /CapHeight 683 /Descent -194 /ItalicAngle 0 /StemV 65 /XHeight 431 /CharSet (/A/O/P/a/b/c/comma/e/i/k/n/nine/o/one/r/t/three/two/u/y/zero) /FontFile 18 0 R >> endobj 20 0 obj << /Length1 1561 /Length2 8187 /Length3 0 /Length 9202 /Filter /FlateDecode >> stream xÚ¶TÞ-L§4Ò1”tƒtwwK3À3tHwƒ”t£tIwwI‡t(ÒòÐ_ÿ¿o­÷Ö¬ÅÌ>uÏ>wŸ» ¡PÕ`³€˜¥!`fv6~€„’:;€“……†FäbüÓŒB£ trAÀüÿ pšº<Û$M]žã” `€¼«€ÀþšŸ‡Ÿ ÀÁÆÆ÷W ĉ iê²(±ä!` 3 ÄÁÓ deíò|Ì_?tæôv>>¦ßé1{ ÈÜ P2u±Ú?ŸhnjЀ˜ƒ€.žÿ)A'híââÀÏÊêîîÎbjïÌq²¦g¸ƒ\¬ê@g “Ðð‹0@ÙÔø3€¦5Èù»ÄÒÅÝÔ x6ØÌ`çç W°Ð ð|8@CN âÿ¬øGàÏÙØYØÿ.÷gö¯B ðïdSssˆ½ƒ)ضX‚ì€iE&€)ØâW ©3ä9ßÔÍdgjöð»sS€´˜Àô™àŸôœÍ@.Î,Î »_Y•yž²ØBbo»8£üêOä4»'ë7k †¸ƒ½þ– °…å/®¬Z`£+PNòÏgÊ?6+  €›‡t=Ì­Y•×ôtþv²ÿ2?3ðñr€8,ŸI}@–Àç//gS7 ÀÅÉèãõoÇ ;;Àdî0ZÀ(ÿT6-ÿÀÏ—ïò°=kÀöëó÷/ÃgyY@Àvžÿ„ÿ¾_V =}M=IÆ?ÿí‡x¼˜99ÌÜl>.nÀç¿Uþæÿ÷ßVUSП½±ýSPl ðýAáyvÑpûStn =à¿'(Cž¥ Ðý£ü7lÜlæÏØÿŸõÿ;åÿOö¿ªüß”ÿ¿ I»ÚÙývÓýöÿܦö ;Ï?ž•ìêò¼JçÝÿo¨ðMVZ€\íÿ×+çbú¼b`+»¿Çr–y-TA.æÖHè¯[x.oU!Π_o €™í|Ïûfnûüž8?ßÕoðyþ{¤Øbñkï8¸_LœL=QØžåÅÁÍ ðb^P  ÇoeXYÀ—çÀ3=€%Ä å×òrXÕ™þ@\VÍ¿€ÕôÄ`5ÿýê•Õâ_À üä°‚þŸ+Ùþ òXíþìÏ¥Àÿ‚Ï-9ü >÷äô/ø\Ùù7üÏÌ]œžß‡ßJ}Ò_ø÷czÍQ–æ!æÁ6Ÿ‚Ûn«ÅˆÝ™w'„fhvuR陽–œÚ] #&ÓWe®;]‹%÷`®lKÑ]‰.“?z4×!†µ$ªµÞ{?Ç«Oí¶¢,~Ƙ,<«í'E&aÖýêýèè­` Û Ý)O“ëèÊ‹®šsëÞ'ãQÛ_úe,t~WíkÕkÔ‡Òiæ­è7E³4yfYs”.̤H ا³W×3Ø9“OäòñŒ(>‡1œ¼ô78bïæÞ®–kr8wRêÂ^aM½òß{/¿àUü1 ³‰e”#ÿQ>Ëð0eQž‚Îh׿×ËfB¡Qòðz#ò•0´}ôë¿Òé[é6‰:¤¨¯:!z2ÝB-öj$¤a,sLýëNïÛ9×#ù©¢t<™?Ú[ÇZsdìK§\:~mýìÒw>L®‹…ݧVùRýN½¼õâzXzèûëª3"É2Ëù¹˜ð_TÓx:0V3º¿¦›D#·µbÇ Û ÞFÏKk*mÝOj(V’…Ù¤ÚY˜òÔ—iO2?‹¦Ð¬ÖÝL¹ñ±²uäË’ÅÆ?DË¿òªxdó ¿¾ U9ºÃ}ßój[gnÿŠ+`ïšÁcËzºm+¬žTÎý½ÚH‚`¶$ïü©§6þž[úàTå£ËCÈäój¸Ö'C%éÞ¦‡õýÁŽè 3&ÍÚ9r³A$“5–MKâ×?°è,~È©óA‰ Ò—Î?üd &éÒˆN¼ñ¯c̱2XV?¦L<µ—ñÏ¢÷#™Ù¬Å *ï1ƒBÄé÷¨’‘¾a‘²:<Ÿ®;þ–1¡êüMÖÞª¦ª-sàxÙCJ#.-é²Ë'ŸÚê¨e³2x=cËô# ™I¯'“REÓfÔ=A-·åS3”«UÉŠ›ÓvûÕêY»êá+ˆódT“oÀy¤ÐÛCò ØÕ9»‹ø7¨ã½"e†nF"ï0„Ü–˜…‡Ñøp±°}E›£Ì1Ó Ç å‰Ö FcÛ넹PrÏÝA§ d²hEWéxÊÝa¦WR–'aQ‘ùÎYs’kH8˜“Ì^žFÉj-¸IÛö$äþîïdÐ¥ü6^ð·ïe¡xñw­¼¼’~k,çž;²hé/zÿuÃ߯âF0%N§JºÝ0T®zò²Ÿøî5ÖTÔ„³;Åd’,¶ ŸÒÈ4%LMž›8NôUeÿ¦0½eÑ{°¡ÅT\„ør-èg;8‡3iGÖF )ÚÅ•DL9XÃçåNˆ_I>Q!t+¶oŠ)Íd¹±Bµñ§’)|¤@¦á¶QL_8¾°m~¬V­·ÐeaÄ8npÕõíÛ ÄÅvBô­lþ¿öÀ±Ãw&$¤XT$93ÎD½]dCà‰¦I>»âÚvk‰fgóXr:¼Q’óbËx¡;*~NF¬ýú#¾àÃpkr±{‘ŽžfÏÚ@жÿ± Ź÷ì„õ#"ÓÔã"†®µ'w™Ÿ9'Í,ëô#â5&™°Æ«•TM×ð¦å…^5µdÚ ]9­Pq¾øÅhþ óÉÝ%Ó-Ök‡•Ib¥ý·¤{péÊÀÜ¡NX˜E›#^<óltù2þ†«gð`F¹ßhâˆ?YHt±\5éqU´­À‹uRîùeÙò½7ÞïŽ pwˆ7û”½ƒþ» ùA:™l £’¡šie¨µËÁ2ŸG/V4ç‚NRvloxzg™ó>þì‚ýY¯b™!N_«5%a)ÅËR‹&§Ãæµ¶5(3ûñ8$i¹G¼æ&rI¤ç4)‡é*nSv —¤®æÁ²JƒÆ†•ܹõ¦ “ÚÉïÌ!øk!6f-êS­“&¹)e”>†ïȱ‚#= »4h—8`ÈiU£Æb 'ÞÐRŸF> ž¼Sgó1XåɘÉ#ñ«Ú|Ó\ç,êK¾pçœÒÌÝÔÚäÁ›ñ’ûF®âx¥”¼T±b‚z+€>•nG”™Æóáµ1‡’þ+?jïÏ ´Ì­ãK¥ÇÂP™ê5^,äS…<ãNc' \‹`Mv‘ÚÊ"[Ïe¸ºP¯ÜgîRƒf-ûCŽâ·hÖ»xÝ”ÈÐïirnj‰iØÌùFõßXºèÛ…ÞX©f–'5žyÒÖcâ#70¼1è°ê¤ùœø%Š2â°ìû"ÒnâKÅ[EœÔ þ{ç"óö)„Ý¡~Oo(ý'BÆÊ± `~º1U¶°«O*ß Ÿõf ŸZ*vöóþ ®ÆˆHo’‡ÞQ³gÝ$¿dÜ›KËía£áµ¨†C\u80Ê.ís ßé¦3¯]`7Ì'ÁQšôt+ € úé {ç‰o|¦„Àí‹V˜ªvàÑ ~ÊÝOTO–ÝnÌYK"í‚9"„¦ ö"Ø€Àü%šM²x‡pl/6‹9jÑtÊX~†~•8¶ïòÀåâÄÆÀžnå,5bÛ²ýPÝ$»–k=O‘¬âÑ¥¥Ò\B7æíe£*9à‡ifbD؀Ƒ:í1ve2”YãÔ]~yÅ¥.ð‡tõjÓ°Q¦¹B×4Ë.º,'ïš.ÓÍÇ$ÃøäZáÄ‘fòo X%âol°UD¨)2 8õU]pŽ^L?W³í P=kð$?»…·ðRP·vå[rLGí¾\Ö7ó `ƒò”ÔYÁPoŠÁ˜åÆŒº 2¾ž›ïØâH{ :]Æ~]›•±sU ƒå5ÈrÕšeøª–ð}’v°oùÄt—žÅ ¡²lR£?²Zª›0Ýd….M6#IR÷nAç(o”ä;æ]°»LCŽ"êYääP‰ôÊ£²Èþà0­¹©1lƒÁœÚ¹»¦Àø[›qÝðƒ ùqÐËÆ=pT B8¨¥í4Õ¶B«NT¿1€n”„ÙÂÑ’p[åÐÚØèP¿Rž6k’O¶Tq 7¥°½Ù$Ž}‘PFàSê›ùš~üÁy¾ïµÑ¡Þ.pO·ºØ“ïŽ*zjÏ>øS¹”ÐøSQ®D9 7‡¹ŠÊV|e- ’¥óÞ•jžÇùÁE¡·€v(ån€^úˆžžìþ}¶èR$¦Gup2Mêp¿»í8é·O/KÖ±“ŠÂ’Ìá*+.a‘Äê„ûæRPÔ_æ¥ûñµÇ…Jh´*uÕ´\}ã ^F߃‡——ÅMÁš$’QÑâ²±¨h«µà–$Ù}£º ên,ãÜâOQmHRÎãI¹á°*+í¯PÿÄ]cçøž¨…¼ï*ú$XdnvavÆ 2½I¶õ‰¿yÅ>ìòbjÈg×ýJ4 c‘ìns7]&äq_›ÐZ.ù‡AÁáó8Lø¤£†gZÞi—ÂâA˜GRAîëB_à©mžÖ´ŽiÙ<úïHÂ÷æÙŠؘä’â¡ëzh6 ŒµÞØ=tÃA?é ƒ®ñFè”…èÆ¡Ý3½ ¢Ùg.M?ê} rU•ûrï'+¾£öî¾ã¼ßzï)´~9Ô—7÷ট(¥‹Ð1lµ -GðÃ2úû…îÇV%«#_ƒmÝÆ§C 1…{ ƒˆšyh™d“¿)íÅV÷ ´p|¶KåÌâ) ‘úæ eßtR¤QõÒ‚‚Jñ›{WÞm¨<š®#–f:Å‘æÛEOý‘EG_"ÑT›X’FfoªVe$rûðì ’xÔš™ìØ”´ÃP"TGÉð±0éêSà:S¬²B¿Øê RS¼ƒ·Xld‹”¿Q…_Iðøƒ«…_Ï ©‹U‚z‘•u@8óÖ£¬‡C>ƒ¾`¢ºœ‹TTß`ýX†bϲZücÕ¡7#Îc}Ë£L#ÆÞcÂæ¨xû•Ó¦u}=$©Oس±ÎPÿ«ˆÅ´ÙPòcÜ6HL©¹f1 îAÍ+ä…ŸbÊðÃW±ØœFÑÑky·+&ÀƒdWí4µñœGs¬Æ[Öj÷þ©˜ÒH\½Mt;¨ƒÛü´ß-ëʨo Ÿ:µ+‚ æ´´®JU_³#o7Dº}ÛiäJB$ïp tU C[{1¯ÒqÌäòMNò$(‡„ýó·os„³Þcok\_”rÓãMœ¦zêȳҵÓ9WÀ©3¶ÕãgHV&—6ÎeÇÖ;Ä4Š*j.ïÕõP¯S¿€ëëàH² 7\I¬T¹Þ¨')QÐønQ}ïB‚9P9= ,/éÕ'j‰M7¼ì2@5Y‘‰/Ç_CN¶y"ƒÈ4ÉŠÖ㨇¤^ L#Ü3eÓ› ˜ÎÐ^DâíÚGáFµ42 ?}ßÞ§B±_#$»Z±Ž‡7{Hë´Õ8`ÉØy+õÄ*ô¾ÕÈÔémC¡ ú{²Ç×¹e¯ãIfÁ'}ë]xÆ=IŒ$µB7êõˆöøm9˜Ÿ.Ø#€åf•A3>9IàVéÐ89çǯÂG®å5hEX+ð¨Î¼ªÞª²ÛzV¡‹'´8?2tœ¨­] ¸hè –‚OøyÞâc°ÇMÕ ¥åíŸìí¸|ƒºsé‘ù¹fú®Aÿ8½Õ~Ù ¿P%­&sz¶pÆœ~É—ë—„yé¾/7ªÒÎ@ãû’&uŽjî–ÅïÛ¥K¿4Ý•RÑÉLjÒÂú|î:'£0y8£?*è°| Pa…Øt‹¸À°‰¨ûæÿ üžýaÆ~ù¸¢Ƙ3x&"@"£jÝs7J„|@ƒ }ªÙ_C?ºÀtP(k3©ÓO–G÷éüG¾t9c¶-ÿÃ83OzSRw®€^Ö «øµ‰À§ðŒÆ[ûÍb7!bS‡´ëÁ")ÔZP€2è]K®8µîQÔ;ß}x*%3`±ã›(i^–ÛÕèWìæ"¡Tø‘+âB5—?¶– ñÂøGàexÁ?ê$“¶” pJgÕåÍ0'Ò+43fê_ôÚXž®éQ_µÓ²+R ¡ò3ì’ÄJ?1_ÏDŒggM|# ôȻǗí b‚¯è!ˆ¤/l ÛÏ1PÓ +c­5½ç˜•Lp0yŠ0œt¹å~¡7Qu9ãæÕ:]¿À ­ÑcçëÅÈ™ûáæ‡áím_¶öéîǤµÅ¥èZé5ß͵> pUSëUxnJ th_püAƒWÚv”X‚†½Ní×CnʨG')·¥Ýpªt$ËÖgy™}š]vš˜òº -|ií¤ò¾)?¸ÄÃχJS=m , ‡–|³«)Ô^ž¸8òª¶v¹ž¡^ɯzŽïW% ˜Ò§YJŽ@¦½¥3b‘B³hŒYsy`^5èJ^OUøîñgÔ;ð¨Ö-®‰TÇ k­Yžô„ |L;¥Ùµ0Ã%ÙwÔÍvŽ’ÕÛI¨Ùˆ¸ÀŒÍ¶×F¯Ç b$ î$É ñS*€uZ-µjébÄ1Ä£“Ï<0?¬­ ·RN?i y¶&mŽc›ð 5ˆ]’+Š—Q±L"™î·ägšSAwÂ岕.ФxðÆãe¥’9\<$(Q=ÂjÈã8œÛ'éT§fŠRM-ÆÿÔy«Š+VŠš³;`ØPàëni8Š8£ÃîS>y}:8fÖÉe¤j’Â@¸±7X ‹1B™Ÿ¦yT7,²¤=r–Ÿì—è»î$ï€ãúðåg¢kÞÔ¬ë•ÜÙâüòKr…П('¡G e¨¡­x£Á=… n´„KÅ1—/Ó¬*xŸëô°¡žÒ¿rxkq!­xõ3ûÙùÿ[™LWgðÕˆQh€"åôMÚøa¯¯º\öÕ¾´äb$êÆ{“eò-(–¸'‰®T˜•kýPdád#äË>l…4lAD bùòMPÉÇ-åÒ¥>a(5{7̶¢TAù2àñ ìQuû“YëWÃ_•¤ß@%«ÍÒõk`dÔžÀÒ£žv ¾w>yŠlâϦ›±DØwÁÞžÙÌ|‹ŽléZ÷ÜÇܾ—jgÀ{”%–NÁ5æ¾6Eg©52’íqýY“ÞQGGqԔʵÁ‹pƒ]²ÐGš²() ·Œ2ñDï°žÿ¶=[ÇÑg\˜¸,Vݶ@|-‰6¡Å¦ >ðæ®íŒeÕ3ec†©, ¡Ïºã ý#ðsØ×[O[¿“ÛÁóW9 ¥³gNèÑ\}±H“MWC«BF5ªœãŽUÒÄ£ËqØÊB·w¶¤ÞíoúÉ-ùY×ëS ¯Ê§æ½ÇÄv•’1˜Fñ u’fº(© TF‘®éˆ³´°!/{‚d"§Œ¥­xvlëÃEš  Ë/˜ÅÇúµf®$%tz¥Ž}ÙòqÝņ¤=Q¹Âóz½B¸•o'àΤ“œ­×9ûû móc:> Ìúý¾Þл˜sˆ‡c„H¯,‘éHƒÐ–v—4I¨[4N Þå¥Ê,‘ŒûsdEîxE&0¢E–)‹¯Sß.3àÔxâ±…åâ°¥îs¬pi ar©™ö¦±VH¹ðçÚ8@~:E&Y÷‘$~»¹ÐÁÀd³ ã½®nyŒ•º’•<7­¨`K+¢ÅBæö©/^¾Hˆ'JRb“ä:çúS´Ã{ ûQÎ?ÉÂ,ƒéø…ag $4R:s[b1äù0" l‘´ñ´ÐŒn4óLªŠæýdipÃ`j7f’óeú Wçïøyø¶(( &"“„ë´8²½ëvëkêÙ’0¹.ß­rY:м¯Vq‡Ž /ä =‡/r2žëóyõÈÆÄt1*ݶ [ß¿÷\ýNE V¤™€º"&.hláQM¼•@b)~úd”.ÀŸ@RÝÓ§zl‰oÀ[ÍÓN$Ð}T³«ÅzE“39˾7™±¨9ÚEà¦!à±û‘ÕOð[ÇBeÀ.%-°ókþJCÑ©šÆÄýâu ¡ÿ÷P 6®ÀóM“Ôx‚б"ïò¯½œ.ÆçÒÉ…Ã:Hßµ»P úÚÛTõÆË·WÎ2ûæôÅCƒ+#š˜Q©ß6ÖÐ’­+61ÊèmD˜ÄéeÖ]Œ_«Øí¤M cŠ¢ÕJå›ô!•Lͱk1s*@2f‘Qlû}õGtóþ‰‡ØW…]PÇÑç×7VêYMü¬²ñ.º0;pœØ$ªËVïKý†,K*G4âTB¡Yñîð,yõßú:쉵Bâʦ,^&0–?=ØÜ…ËaH~éˆÕ3|®²äìÍÆ)½¾©E±tQg3zr¯Û§rêoåðqDz EàÞ}tX±xì6s€je†ëp‚{ žHùÜÆBá8øMÞ ®€E_Áx¶Âq£WÕƒ©Z_ñ ‚ö…Ã;3‹ûnª¼Xç¨aâ,S!~¦LâÁÀìâ>®$åÖÌ„md&3jY²N‡ú8ïÞs¥ûÆcÂû§17üùºoÃ|± M?”íþ¤ªVžK7¢@ì˜þï6ÙµzØèëÌÕ6*E†T™…&Ø.ç¿ldËùõ©·['7™ŠªÚVÂ/H`}†îo̦ø‹ ùî²;Ñ5>šÝ¾zÄìR pgqH@G.ωžµ ©Ce>-kº@¢Âì~ÇÑA¹›ö½BPÖS¤˜ë¡˜têci…2qÚþlßÇ{¥ÁÏTŽ— v×Ã÷µZMú@|š=Ϻ٣îË\+2Á´rùZ,µÅ =Åyq±i2%k‘¬«|~°"}>º])wï ˆêB÷ÅGy YDé™»Üô–óqU¹C­ÉJîù·(ïkÜä¨ÂKTÐIëDù‹ð#§—Bä¿„k"p_LrÍ^šíX}Ç¿k7qÁ)¼_…ÔÇ(šØkq–;s‹­•†ñvyÉZÞ04Ìã£¨×æß4\ùÏÙ#ÆÓa]C• MM‰&˜yS}h›\X4ÄŸ§^†"–`Úrê{}IߥRÿˆÖ®Æpبoš—”“7}\Ž [ÕpJ›yã™L™ûr–DwEš§rT@k°¡v¡ôÒHbh¢8®«Ó ]œ|gú!çkü SØXûæ±côYA4(…mÏCËÃúusØŽ&éÃý²þÍÇjµåê‰u.¸Zi+»Ù)y* "!(Ç×ýîš6G;Üž‘/T¬ÝãÛbîó© ¶¿•§‹N¡ Xæ°ð›GÄpˆ{»ÃñÁE ³,,JÄ·m>r¨ÜvºpTEÐŽlß–i¸ÓPûh%Þ ™”§»ó_W6%ZGþx¡>Ø´‚þúÚÝß‹0@L,²–lööª‡ÂÛIÇŸÍäfY2þu\ßú­wp—ØØrÕŽE_̵Žûl~ ä–’x´˜Áâ©3¤»×Tæs‰[Ÿ J#ÇŠ?D¹nØçwq˜›Ûƒ2O¤•³Œ’¶PŽÈ«¸"ieáÛ÷$IK†Å¦#ÝoaÌÓ笳~âÁ£èÔÌqŽ¨Ñ¨ëÕõŠlÞøéäÍ„ 7aîFÏï8'êã•<&º,F²žöøÀ×¥MEñá¥Ò²n1Äâëf:7–Œ3ÏÙTÙ™½6οÌ9ª÷XtÖÝX?‡ˆPçêþá”êÈ endstream endobj 21 0 obj << /Type /FontDescriptor /FontName /CYZTYD+CMR17 /Flags 4 /FontBBox [-33 -250 945 749] /Ascent 694 /CapHeight 683 /Descent -195 /ItalicAngle 0 /StemV 53 /XHeight 430 /CharSet (/R/T/a/c/d/e/i/k/l/n/p/r/s) /FontFile 20 0 R >> endobj 22 0 obj << /Length1 2108 /Length2 12297 /Length3 0 /Length 13574 /Filter /FlateDecode >> stream xÚ¶uTÚòŠC±"Å-@qww)î—@/w—"…¢-ÐâÅÝ­w+w—âZä¥çž{zîï½?Þb­™ùF¾Ù3{‡ŽZC›M äd–wr„²q±s dTµUtt¸8œœ<윜Üètt:¨=øî5ØÅâä(ü/ŒŒ …édPTÕÉ äfàâpñ s sr¸99…þ trÈÝ! €*;@ÉÉìŠN'ãäìå±¶Â2ý÷+€Ñ’ À%$$Àú—;@Êì±:TP°,£%Рíd C½þ'£¨ ê,ÌÁáááÁtpewr±gbx@ 6-°+ØÅ ü¦ P:€ÿ!ÇŽNб¸þǤídõº€0…=Äìè srs]°ümE€º3Øñ?`•ÿX·ÀÅÎõO¸¿½‚8þå ´´trp:zA­V{0@]^…ê eA¿@{W'˜?бZÀÈKi€0Ž3tµt8C]Ù]!ö¿Yrük´œ#HÆÉÁìuEÿ]Ÿ,Äl ë¼Ç?GlçèäáèóG¶‚8‚¬~S¹9sè:BÞ¸eÿFÁTètÖ`(€““Sv°à7°§¥ Çï$:^Î࿌\¿Õ0~>ÎNÎ+°Ä û‡îã t .n`?ŸþWB熖P€Øâˆþ':L ¶ú ›ˆ'Àˆ6„\Îßÿ|3ÍÈÉÑÞëü¯ƒæx%'§'§ÈòéÌÒÒNž6nN7€ŸKÀ/Äðûß@ÿ´à¿ôÿÒj!—÷¯€ŠŽVN¡ÿ°€µï¿LÜÿÆ¿·‡ ð¿Ôœ`c 0þÙcN>NKØ×ÿï]øËåÿk~Gùÿ±ÿ·&y7{û¿Œÿ…ü¿@ˆ½×ߨ`»AaK¢ê[Çÿ Õÿg·UÁ ˆ›Ãÿµ*B°e‘r´† <›;/ÿÔWyˆ'¤ZÚü5<ÿ=X{ˆ#XÃÉòû°qý÷Pþ±Á6ÐÒvɸÂí/¶`ÿ›UÎÑÒ ô{¹ùø@ :'lÔ¸ùø>\°•=ÿšr»£æ€1ôX9¹ ÿ>Z‡êoÕ_’ 7€Cë$àÐÿ# 8 þ‘„`~À?/Lrµ„@,!.–nÿèy¹ëa …¸Úý£äâæpX¸-Áö`+è¿Ô|«ÿ3;ÿÄæúÚ ý¼Ï?úÿã+ÔòO °Ò`÷•ßb·™ô/–ü/V³Õ¿DXëD~˜Ñú÷C›‘?X ›? a4l¼œm`·ëLù—kÞ¿úÁ ë³ýŸ°êìù;ŒÐŸžrÁVŸã_±a× ‡ÓŸì0,ìYú#ÃÀΰ‡ÀñzÇËõ·ö;Ç ãêlïö¯Ô°wãÍ¿DÓç‚Ñúæ…±rµºÚü Ààø6ÃP§™anÿa}pÿ—£âñ¯ñ€y{þK„QðúKüŸ}°tsÑ‚þuuÁ–å¿ò_Ïì ¶DŸ›q² µ­m½©”"ó`Ûåéâ×½zr£âEµ‡ß`Gø¦FlWDÆ›})˜œ)«1d#^n„¨ŠþŽL.VÀÃNHº? A!Šô½FTMóqü”³‹4!†8õÓžŒW¯Â1uÉ•¸Ìžv¸AÅáÎîu2ʒܲgê»3LB„wÁ?Õìý5…Q¾´ËrÚG¤b(uÔOÜ2(bÔ^ã—µá™OÏtKcñ|…­>± 3(néླiS–l‡ÿÊšý™açœ5àzN1ÑŸö¥˜‹€&aK4Àí[R¬üÌÑwó¥b¬º‰³‡øØwæPáÌ4ÛgVAù6 ?ã¼³Šù§?áMv@&‡Íi·>©½% ÏV|!3«=f½§&ÕÔpHrõdŸ°%ÏŸ`jVKòÌà~:©ºŠÞ¨£ôºd÷̊삨.Û9e® 4Ê%?òegü0´«¼6óÂ_N^ÇH°•« è™´Á0—;-lÙ=énbxÒYº]î^3¦:ÁÅ’P¤ï}8Q@é>Æc,UFòØòR,GÊd|~‡ä{åÝ锸¬ƒ‡²Y·Þ¥ÃuptŒÙ3¥ï×dØ ÷T,5ÌèÕŠ$^Ža™ZŠÎ"±};‰Z` ·œ5zaL ZzˆÚÃÑI4ãÔ'+šçœÆ½ŠMŸóx³rÀNKèËp´Ÿ/_xœ=FXІ…]ÇNŒŒº=‰åµ¯ãK]YêiœÚ[KÕÂÆœO]Ç@¾é[»…#„Ó‰= !ŒN:Þå1@Šá!­$Cá>d©7Y,ã•à8>Cb!¡NÈ·¢3‡w¼±­˜]=?%íá'ôÖx}}(ú…ºCM_Cûâ8òë‹ ìÛrE“}'±d˯º—&SßûÙI舵ÙAßí]ûT^¦µ·àÅæ|< ¦,bм,gÃÛZõ¶Æwãá;n¥±æ%uIÔM$sé ´¼ª>ØJ-G)ôAä#~VÞpxÇñª'YØÐAçNÓDF•û³JFj>’úÇ gHö»b×!4Æfl»F)RJ&Uvl“›Î-Ó)zÛÏr¼k“”_ßÕd® Ü7Z»¤Œ¤] »ƒt5p7LÝž%ä,=± CS Òt“ù»‚!÷ä ~ov©é…/ *øØ(=â6÷j ’p°ŒÙ¡¥:øuÉUvnþÇZÈMø®’_I«¸¹Ó£<¨[ÿŸÅû¾̵P€,#Ý9S£Ùמĉ/ÄH×:Þ®·=*,z:Wkkj%Ϩ,îäC+ˆŒq¥MsãȆ7¶js¶y‹íb42Zúáxÿ|8ÿ¼º¦V‡36Tˆ•ù(ŒŠLIè|(–:ŸƒFŒàJ§ÏŠbµ÷>ðàJ3ôlâ ¾€Ô©!¸ƒýtÇnM‹4 Õ;¾“;}ŸËÿHzÄàb³:ºVMóy5né}Üù.H‘ëyÜnŒµ‡!¢Ùœ†”f“ †Tºøk«¶½ô²¾÷´7ò±…+@Å—º2^bÏ;ë‘Î “°…,_©pé]Иæ’  ^qÑî?—À!ŠS2¶;/·žÍë÷=®ÜôÖ®¥©/¶¤z’¤g¼dËçeBš0¸>`÷–b&~ð®÷nÖÝR7þVïµnÜ;¥»ŽÑ×íãâØUEœÓÆÜX k*‰ù‡/ëK6Jò¼‡Õµ¯‘Þøa¤j^âfªI7üñË“r‚òñWÝ–7/ÊõªtÎSTqzŸçM8¤DOtICªîÑuòØ«[„ Ìò%vc=>Þ*´SíÉ©fÄ4žgÑÕO÷JÛo³§vN³4ð¶#ÐãŸ<µ¹7sE¯#_ µº×žÌØ©G6Ží5`© ¨ù™È¥ú&íç û¦}»oÒÑ2åžaN?4ÛžÂÉ‘iu¦#¨´È>÷¾d¨q÷|кåÁª`},h¦‹Ó°é(YÅ9}ïæ(‡I~Ví5á¼êÙ©ÈGÃV`a2ïÕ)¶Çœçl²h7«Œ8ë­ªnaì€Ï‹mY²¨ÂÁ Ê4id}9YñÑ&âC9[2âÏ7Ÿât ÄÇz®WöxÂŒà|>à?®‘~¾[]2Uv§£=0”çŒ+W ëFuZå‰ëì7†g¥aμÎé´¥~VÀ]‡f O}[KïËòÖó6Hî|h¬³,ý+ARaÎ¥PPigÞô|]·Ë©¦É¶~÷„wF6ü¬ú8qUsÖH{Ffܹ8MÒŠ‚¬X9wÇ®….ë¬\õÚWõ­SSr¡ÅÝDü†Öi¦þ‚€3j׿WŸ}8WîYR8Â]Ū¢æöåÖêŸgãèã~ ¢ÌyoµUƒ½G;›%£Çÿ‘gÊôKlö‘j7˜5¤Éq4,–›Õ„X›†d7±§eLœ§–áœleíù±¤oÓ1®ùÊ H½9iƒ´øT:èŒÃèbìX'¢ÃïÁ8þð¡ö›F¾yíÞÃ\ ‘Fó©TÉ]/µ!Êk¶w5rX@¢&½t]dz‘ÚTãU¹tèÄÖ·K²°i¢ eµÏ¾[tßy÷‘¦ß]ÉÚzðbÅfÕ/KoC)k"OD{Œç¶«Þ˜µ!”á7Uj,½Iúý$~ÇÇÜQpsŒäyÄíËŠHùê°“i½™Pa^ܳhGã+/{¯!ßK#sˆÐ•„=;Æ ò¤~¦ÂtG²ö-ÆñSì¡ÿ8[æ%ºC€CHóæ>6K¢‚ïHIb_5«Í,1Ù§ðé­‘©™ñ‹’¼Ž”&ù¤‹%²w›c¼ïp•P_QcÍ»m–h¤[iq_‹d–t6f²<ã¥ÊšËŽž^2Âå ç ¶½.Ñp|Î’»~79«©o© ÅHýŒ(‘`MÆ-À#€®Ç“€Æi½5¸Sxˆusš“3+I—æJšå2ìpÀ¹ØÀ%ϱœ«Žo}îy…![O¢wãjñƒoùUp‹ÁÔ?“.Û âõx;GJƒa®s®ú¡’½þ¥ò×GüHzö ËG‹«B(ES4fwu0Ly™åp1¡üþá"y"ü¦m¤FŒ¨ñ[‹LHüu+áIɯ;IͲ¼à](•y’ q¾/ŸÜÅQGchå@ËápäöÌh–æ“•&ƒq7ÃU{bÔ‹é©9~ßúd[J(#Þ¾}‘¼Á*òÅÚDZ²èû3ÖUÁæ™ ¦s6£³_ˆåœp™yÔ*pºÊSÃò €õLàΦl„?<­ç΋ܵP¤ñ`‹/hýKré×oÀ¾Ð›X)’ž÷gïs’:VPÝé¾›ƒkª^vaPÿùH¨IÕ¤xTËøµ·ë³:ÕÑ|O–†:ÉDŽ—«i!Ǫˆ‰ÄÎãëœÁÊ»!¡Sz^34À{ðD63‹è³¤KqYî¢ü  Ûo“ìïùð~ä÷Xü½öR/eä$,­ô Œãt^ÄÁÁquoñšÒÉ>¨4{OÖbb ?B ÷féžmŠ[I‚ïû 0´‰ÎC<Ò‘ZÝ6«ö%Â>Ó+n,n*®|ö9¤›bY°ÁÚ7Ç%R\ß“™Ù ¹>4çÍ>všvœ½W±¹Ñ×o@Îòöoþ:È-,ÓFú8<:róÚúéTüYs–1’˜ao+†Æ%O~„^–îô¡áå/GÚ,5f\?£òÆSçåñî)"ðlÃûp¦„JüÎÝZùKÛ*xqƒÆ"Ü=bB›±STL1ø_yOv¤ÈÑü5ó³ïÇ~tï,i¼œJ¦¡Û¦JÑ8M*%Ky0<ƒ™•ôεǵ7Y 夞q÷¿n[õû©î5«-à²eY´Z(¡ðtþ"‚ ÿ;Yd<Ï/ÆoN¾&ºÈ°V¹g îbŸ¾g!S½BpW޽q8—²wK/^I,¡¬ª‹uyèªÙ׿ØËFZ‡NþxÁ̦§fð=1Ý©4Ði‹vÉ쬯«é©‚™˜|úGH›ììÄÊ”ú«a±t]Z¤ÙQ¤È#^%ª?OK~GJ¢“/=ˆuÝvyx ¥%àâ"Ÿ*¥ï5¾ K'âZÑ¿£+:‹suÛ°žlœ|W“xèçºÿ Ë,Õ¥ôRM­0°íÃ÷tGkÑùÇ|- °¸fÚáR€“T„}=¿(#§ìðáÕ‡¨vùnCÀˆgø/¢ÐwÁ‘*O;œtŸØ½ÄU›q¦ª¼fi¶J æbÃÚ‚þ†Œ±·£‚‹ì_ÖyüÓ¦§(:»¿±,+5Ô9E,† ?™dÚͱÔ?±µúØH)ŠU 刨*œÐ ±‰ÛŸ*Q¸O)Ô}ªÌ—Zá ÛFÒèÓ›6âDõÍâ=ÔWb r»!2DŸ6ä e&è…gûÏh‚ÔÄù:¹>, =YDaÌÙ¢EBý“(Â8)f–ß}r-¡r$â¹_g-ojç«?RkÊVBšœ¥n,>x¿²OêX91y"·5sO°W-Õv@&O–?mLy¿¼èšˆ¶ˆV¡l;S3˜ ]‡:`÷Õ:ñdˇ…ߣgQž?U‘­]º‰”=‘ýâ¥Q\*A`*ýPúmo~×;RP¹a÷†:žéè#1[TA¢ Ù78Ã=â$ˆ„$ñ *†Mî=‹­4µâ)_ñ°äWŠÞ½Ñ<ð~­Ðþšô5+«Èga°'0ÔV[RÓ¾ñ¼•†mŸ*mÜ‹[ °æp³p¬7€ë“blí!P’Þí½5öÊI1H¾jÔ”y,‘ƒw}¦ÿõòvÔs]{djïñN„Ä Õ[•{ÞË=‚Y\)Q)©”*e]HÆÔñ.nÀ/æúWи WA'…£õؠ臭#û¼AÏFO¶½UЇN´q¢Æl8?º‘8ŽNMÖÎ+\9ÊÀäñ=›?Q}Þ}ÀXÍÕŠ›^YšgÃ÷ÅØHÿ j㈼€b‡-ƒ$ 3®WÕ¬':©0ç*Ÿ ®îI”ŽT9饓{ #¼éMÛ”ëo–ëÆãÝ-úx1û"˜HÁcèvFYŽv>@ŠiûE¡Nï…HâkŒ’¸ jý.ãD}Ž öΨäíù²!AùÏ~w=‹ñKt˜\Á|¦Qî½Aë*æot‡³`¿.KB4·GÄ2É=N4áWÊÙv:ð‰£PÛ¡æuþž‚Lô‡´|üØD BJ‰&³ ‚U)VÄ6ó Ū‹ùכ䜔vˆ¨òÖ©7¯Â4U¥1œÚ¬¶$èŸ$ßÜÊ‹¨˜¼ (ãÒ0¡º;›Ʋu ;³{ÖHd˜cUÈ_Tà’«&íù5Ï•Uɱ´T`´MbMFzââöð2d÷èø¹éRô‰ [FxøRxâÞO¤E\´{U9KCwÕqã\wW8ùTí6Úwfœ#eàÃÚÚ.gGˆí§µJ](žŒ,9Š5•fû Œ§½FèÐÖÖcÄ&møè|5«…ÚZžòýßár#ú:³´ž‚"ËòÞ¾É åí<@Ìš°±~5¹-KêÙ.-ÐNõS^ª¬ %gÈíá:Ÿzk^ÄÑcUŸóaÉ#Y^‘ ¤yÅÍšÿ}#Ä)Ll'+‰Tl¿E²…¹¯“x"ž©GVŸj;„ëmµè=öpÿ~ýñŽÐŠ6Ε r+~ `òΖýÐ8K»S"fç4âƒ<³ØVkßã¡û'e¡Ä ´ð‚Š9Î[®ÊŒ ŸÊ7p&­¯0ƒƒÍÎXâØ×„GŠ©ÐQϬÐò^ðñ=Cï“òÈÿúìþ¹øôÖ¹ö&º`bÂ1 Of"E•B|‰öÌ)«ºkïøÝëg˜¿Šd®KçÏÆÕnd·…ûº}×ò‹äjóå÷ÎûüåIGtïŽM~Fõ7V´Æ||Ç{à•4/ì0.ò2Îß ¾u33Ïi¼zô ‹Pä‹–$¤õ‡®[ÿ¡õ·Ðq=EÍpÈ£¥y1½·›_Y‹ñcˆb™—r²ëm`úØÈv}}%hÝóer¹!hãÇ9 O ²ˆ†ÿâ|*èÒ±ó}ðY£íŒæ üBTzUñº¥b*¶^}dæêUðÜâk3Áé¡W²p/α Eí±šßׯŒ×èZ-¯Ò”š©è}8ÄKÿØ\‰àE¤•.ºTÜ÷‚ke:‘A8ÎhÈM(9wŸ\ÙIzú:ŸŽ^pSe-;‹ ¹¦«ˆÊæž3zíÅÌƯN‚W“ì4ëÙº·/31}zBâôA³ýáëŸÑ0/VG·4Å+Ä߉”zaG0°ôh†÷“·½¡G n¿r!Íšßů˜FÔpðpeã6Éx×mJjŸ²:jV Òð×à©-U°ªµññçÈ¡×yÄÄÒ–$îù²®·NÖàÍ®«Åtö¼·‹è 4Ryb¨@¹õÞ[°zÙþr±ýË×=­Ê]ßJd G¶HpÃQ¡ÛÔ.D=˜*¶t[‰ÈdPHk(=qŠ $ãMS-ieò¹ÅŠX4пB·pE¬f6ï5]~D)>ëN—ÁB#ÿ¤RbF¨¤%íeÿ‘ TGu¼—JV€ê”~Q‡BŽÙjåË¿,ŒQd;ðK´wgÈQšöÙó)6ã½á%V6NYïv¨7ÑÆ¼34Zpd©ßÍ Wg¨Müc£¾b·ÌÙÀ9tÿìúTÓ]&ž*i±k`5¬[͉7NL4šàò7ÕuÛNªÈ#N4‹Ë¼ege¡uè ,G§Öá>G¶DäÂQÞJÙu:²k7• §6d‘Ež+ y`àlЖ ¾ÌÆcý¨Õ ÅLìû´çйáaüPqm·¶ñ+v”ó»Ï`zÜb(cX b¸\(_$)o8 â™Ç/wAMnÔêfÛ x®ÞZ'çˆ]¿¢ŒI- ¹zí³0„{3´2ZÑ-ùbT@¹H3FWÐ^­]q¿O•#cv?èkÉÈ¾šžØ ƒx%œU«÷™ŽÁ€«ø§k±²öpÐÞ€¡t4}6`I ¼ÛZÕ¡ÀuxµLÖ”/ɾþfÚrª¸™§J\ D¯ÁÒäꯖ¶ÄUêkÊP1×îu ½-—ÅËÓPQà t³ .21q“sçspþLD3LžÑ¢àrL@=Í5KØ%%ôѦÿ`®å(p»ÆØz"<˜"véá$*–$ûŒUlšŸÍA'±¹1±å#–ë^Êž¾QˆÍjÉ¢ˆó%&P·ðW¢8!£NØËÖ¾{šáZ. úfõ'có=OȉDyEvâO¬ñGY×éÖÕÕ}—éAÿØ– w.éa²If[zrCši c+ÒójYÕžGÊ*¤ìGôŽHçŤ=¾•£\Ÿ Ìô—%cuïÏ@ QïÍbP  øBGq2캋̄|»z&3ä(WŽ u.VOК¦=ç®ÄAfï±W®D´–þ ú"ÄY3,L–ÅÇôV¾§žaé\j¬¿{Ô‘+o–š!çmòœƒŠê·ÞþQ?½~„ü/©×|jcÚ 0ÿ¬ºŽÈªSKü<ãz¥]²C¼Ale¥F'÷˜SñÉ嘇cR ÿ…òý;Þ¤z»“D5âÔÔ£$Í2.ßÊ%”{¤*¹Ùb]Þ)Ô»èmù=Ͷ§Ï1×8Hk(_¨DÉ0ë+_ +r7|~´ ®„J¼Íƒô~~€Ïý櫚¼zšæÛ†pœ2J²T ÑåÛL–ÚJÔ€7étΞ٫@ñ¸¤#ŽôkîdÍW–_Û­i²YŠ ²ÍJ=Ÿ‚?ÕpÁ;Ó¼BoT¸GæbáÔ3Ín’¦ØÒG`ì¯~½;c49ìüH‹V’ÓÖ)l)7¹Çî²ÁÝózW'ÍC1É_¸Ò±ÕÚŠ×ÐÆ2‰ìeÀ³F³¹qÄÌ”Lwž—›¸tQ1©~ÐJ„~áÍž`…LB¥QE±FŸ-#Æ›w‘ªëüÒ-è}5©åÞŽ ¥•YÓ`d½ÀÖjÌvF»y.͹uw@ CÏ‹W­ë2,{XoÂl²í¾çÈîå=¤œø,U3krÎu<Ÿ¨¦o°¡ IM egŠêFfAGêÞýÖC~¢–¬‰þi¶i<éCVÃ:™àAÖm§£­·^ï9jWx=%ýÛEêÃØÀPLPÔˆÙ’BKMEÙLoj Èó¼ÑÂØL«öÁ²ï•×ùç „Z¨ìeÏÇγoç~\Šd5ÿ(3‡«×€?ŸR~˜ÿÙXêGKküüø€Œ<$†IákÃû;L[Ùuß¹„Ÿ¥ª’|Éôfˆw$îB¡–¢C/•Ý=D6Ü/zõÏ|ª„5 ˜öCµnPúÇØ}­ê‰ þÒ–[š«m!%‘OrŸ.r¬‹±‹fHf#Œ¸ žŸT4ǸýôuëC ¬wÅCH]áŸ"£‹.* m+SN3rÈ”¼Ê5®t˜Þ—ŒÄ^kœ&ù(õ£6ü67ž™êŠæ*h žf•ñ8}JLæšœËË[øc¸ó™çg:¸I9ïô¯¿îÚ6…‹ÙúZ÷–?››‡`×9çŒ ~o~õü‘Œ·“gÏRª¹MYªhd&`´eĽë)éa“t½%5{ðXõÜù\neŸô‘?1S›H cØùp*ª8œ:ø.^N¤–ÙÅ︭âð0¡„.½/1@|lÃŒßêB_XöL¥ŽÎNVŠä®qþ{&íàT1”ç£8>(‚oWE`¦K¬àÌj:-€]1’š# ™³žv¥:¬…c!ŽÚ1"ë’T… êØ+QMàRÎVaß÷¼“}¨³§h1ÌŨE{©³ѵ‹z¡I&ñQ`ãZ}›"ŸëÛºvš½ÂÍÁq¥¿ãM ovͲ¥JÄH@ÄJû@hšæjwõ‡˜¡BT`ù™lV>œãªK‚Ô™0ÏTâ‘)9_³¢±kZ%»ÅåÙ–¯‘|³}ª[ƒ`i¿õ¢…Nsq g¶ kUœà†[G}·›r¢^–XÖܻR|†ÇP‰Ç­µéºQ%ëmÃc£å±?':±N=LݱõH¸Å&œ;ˆ›¹&‰lóRùëºÓýý*ªË !LdS}ÇBȸ©#M™è7j•ÉÏSªá^}óuTºá-×âP¬ïEÜRyø‘ú~ÎqJ>AÐÿ’+å%ê¿R9Àg,$¤' †«<¦-¶ós›“D‡ã¸(Ÿ“håú£â´™X™üª‹ü’Àå‡\Q3 ^"½,¿Öó¶-§üHv1ò/ëiCfðW?uëÕхǶ+Ó¨>À½TkrÏYñ[ûŽþKÚÈ×M4Ü.4ËjžŽ!³±Ä£_zÔ–tO†sŽäñ÷Ýq=o7@à[hä`ö눙|›™Ÿc¾o.’sqf4œ«ç´«÷ÊÌWRcT#N:ƒÃë|.Y·´{F¬èÛ!ÑD“Ï#/ÚÝ Ð{½êTÉ¿Óm/ÖTrËß÷aGó\Bž/+*¿=l/.«…þÈ®wÍ"#ÿ&wTÞ’ª¾ÓևĚEß4;ÉR ‚xØ>å0Ö3n“©òѱϨ)ÞúkUHZ¦²ÀO¶™Ä_³™ ežÌÝñ~²&äÞÂK{ЖH&®Îžÿ„~ÿ?÷€2àVxn¨ämàžYY»«v>Èû¼ûÛpëóà\ô<×°ûìêjβu€ …‘ͯΈ>Óÿá°ÉUõ™hŽ×Íœ³ŒùVq`Às_hQéÚ¹j3á²W× ¡±4ùó™¤ßWØùño%™×ÖåKo»G:¡Ôâ[ÑÀgsÂË «ƒªÍMÖøh I‘E@²ÅM#¹¯n‡ói:²2Áã(ú¯–½òž[¿Ì#U•dº-Òòî;Bôï<7<Û2¢ä63Ü~tV%*è’ç`i„H±Ö7Ë¢]õ÷ó‘ýô%ÈÙÙÃ~å{lkWzø(éùÆVÕö hΑœ°CÙ¢þ:•’R ¤ÀG›>{OyQ5*rÞ»tŠLËÊñ\&pCeݬŒ$dM[û\²ËA÷S™È» .|ÕÃÒ\VTxî x&òö_?úv&¹Üî¬ðã:ÆkêÉ* …OVZ-”ü‚N$£áÃÈa4Í¢¾^Ôvo âÌ–÷òQ£Ì}Syµ2ÕÂÓ¦zôÔ9ÛÞP1®¹!?^ R⤧BÙO„Sþ}Ð)ìê'î³ ¡y|*§Ey`·_™Ú6büû[y:NÒû†¾Üö5§k–­PÏ%&dÿéôuÙd=¼´Q`R<_\œ_Ëg—"Å¥®’pú(?78D ó8Îð+7W—Ìü*íÝë±#‰½1œÂß³ ßèöBÖ¿2{ _d4kPv|öó ŠÇ¡ý1nç½MZN36ÜEK¿1¨mç8£:"0Ä|®€ãì:=Y¬MœÄ ÂúÐTü!O´y÷m¾´¿x£îøž0<óÚ¹¤æèIš…ÓOéD­Þ#â@‚*Õ8tÎòiêÏ«ÞTäB΄hK̤ûÌ¡®|µµ£QBiPŸ5ø¨|zß©ÇТ2Šs‘¼Û7ݦÂ2 ­<(¯¶ðžc•䈌ÖåWDyWO16­zÓ7~¸­ž4u2Ù²-Ñæ‚~f–Ó—n¾W_ïñû-,ýj/Rûöóv+˱9½VÒû|*\(Q¾øÇX±ÛNzk¼›ß {ÊBÈr‹áÒ‰ÂÁ!ioAœÖRÃë^fÚ_˜\wãáóʸ}Ų*«¡ä['Ý>Ü~ðò9·.;Žîwšn¿£1»?™“)±„ß¼Bwæá£\A~òs|Þ³±X*Wi>i`‹M”rÂì—\tÂòjÝßÌ«}¤êuŒ~¬xzw» ÿ1&àlBŒÂSâÿºto~ñ `ýݴ—ªõ  9­"YÇ(/Æs>Ý[XàÖ”¡=Îz‡ËhpODÊ\Èt÷ÒÕ PÙ s¾#%·Ôn¬Yÿj(òöÍGϘm<¥'ðóú­üÈÓéZ!ÄBx=&väí­ÜÇnIIÄ©CŠÙ#sd´I¥N¯kV³\l…:aZÆ{ËÝ+ÙÝýÄ< Û¤U㈟mžå«’&Ј>™fš Fâ®ú:÷^¤!÷î‰Û36¼@Þ^DÛ¼–µíj³&~Šç$ÅIžùD†an¢µ'ÞyÉ]Á¾§Σ{…b4L ãù’)‡’9ð,€—ǹ"”!¦ßÿœ-BeœbýÓêEh8Ä»¬˜%ÉÆÇ:Èa aÉæ<ÈKréP­Æä`žµ^ÓqA2¥K»G^±niD#3êuB é0aíÙ·š~¼ðã‘’üŒÍeãF ª=hQʶi'Uƒ´ÿQÍódÙ”08††É `ڻÌ•ú¢õZDbʯhJŒÞ÷E:ϱ·åÆ4 c£ýÂȬDÑ}€´«ï'ÏéFɨ«­œp¨Ê¡6$*åc^sà¹^Y?Ä[ÉT¶)æW™¨OÊ…K=Æâ*‰ÉD4ùr¯Õ E*|¦Ü\ôi…Ëó@”ýb5Ù9§YVI='>uSRÖS˜N¥ÔJÜô{tçqÉûÔç¥ú@ÁulXkæ °/ÑÛ´Ò$èÊF SÄ„wABs¾µ&Ùñ‰«H“§GÞÁ÷¼ÌáØUÝŽö„Î ¹¸Eï’dùoúÍÁjèä_ó¹=š¿t˹U§íz”0“e¨Oý¥õCø7¿ò‹\JáPB»<$mÒ=½?-Å2ʈŒ'áÚµA¾þ¨¦|=BüÓ53óNyuñÚʨ!Ùé[xõ @ŸÉzLÝ^Óñåû".I^‰méÇ÷|’p+^=GCÚz¸Ù(Y/Õ;S5¿ÑºtL•N¹ŽèºÔú¿aëä¦}ÿ“¼¦©š»jqÑÏ>Ÿ§Š^p8ã•…¥w†¡é ¹‡2]u,Cõ¯5¨ _¿¶áîÊž©{{éáLã¬_ëý¨vø ö6Œ§=gIgGVjí4€)–Ûó—]nqÓ–(Àॵ݆OÉùÎ/ÑÛq{Ư…:Äû_&~xëÚ½[WÌ `„›è×+¤ü,üÒžþ&[úŧ‚]ïŠq2Ë-û‡Ìm”9üŒåhô›µa›í.Ož‰Õ©6vÚY˜ŒµÁßa9clFÐßYÐ8†º¨ÁÉ)œegN”>…=9ŽmvYŠX6À)ž¼®™ZžöçQ)³mì¦ßG;Æ ¿Ø*+yá66Â}› >ç¬jö„íÆŸ`ÿ%C'…Þ#dQ8I…?ƒÅ ^ñµIõH¼60ðž•~+‡²¬‚¥÷}xR'Ò ñ (M Ïë-t¤¨ê½Íâc“¼<ä±Ñàd–Lq§lú*s> endobj 10 0 obj << /Type /Font /Subtype /Type1 /BaseFont /SDXKYB+CMR10 /FontDescriptor 17 0 R /FirstChar 49 /LastChar 49 /Widths 12 0 R >> endobj 8 0 obj << /Type /Font /Subtype /Type1 /BaseFont /OCLVUT+CMR12 /FontDescriptor 19 0 R /FirstChar 44 /LastChar 121 /Widths 14 0 R >> endobj 7 0 obj << /Type /Font /Subtype /Type1 /BaseFont /CYZTYD+CMR17 /FontDescriptor 21 0 R /FirstChar 82 /LastChar 115 /Widths 15 0 R >> endobj 9 0 obj << /Type /Font /Subtype /Type1 /BaseFont /GEEWEI+CMSLTT10 /FontDescriptor 23 0 R /FirstChar 40 /LastChar 125 /Widths 13 0 R >> endobj 11 0 obj << /Type /Pages /Count 1 /Kids [2 0 R] >> endobj 24 0 obj << /Names [(Doc-Start) 6 0 R (page.1) 5 0 R] /Limits [(Doc-Start) (page.1)] >> endobj 25 0 obj << /Dests 24 0 R >> endobj 26 0 obj << /Type /Catalog /Pages 11 0 R /Names 25 0 R /PageMode/UseOutlines /OpenAction 1 0 R >> endobj 27 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.10)/Keywords() /CreationDate (D:20131029202330-07'00') /ModDate (D:20131029202330-07'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-1.40.10-2.2 (TeX Live 2009/Debian) kpathsea version 5.0.0) >> endobj xref 0 28 0000000000 65535 f 0000000015 00000 n 0000000844 00000 n 0000001058 00000 n 0000000063 00000 n 0000000949 00000 n 0000001003 00000 n 0000044107 00000 n 0000043968 00000 n 0000044246 00000 n 0000043829 00000 n 0000044388 00000 n 0000001159 00000 n 0000001181 00000 n 0000001543 00000 n 0000001972 00000 n 0000002194 00000 n 0000009197 00000 n 0000009416 00000 n 0000019897 00000 n 0000020171 00000 n 0000029492 00000 n 0000029732 00000 n 0000043426 00000 n 0000044446 00000 n 0000044541 00000 n 0000044577 00000 n 0000044682 00000 n trailer << /Size 28 /Root 26 0 R /Info 27 0 R /ID [ ] >> startxref 45007 %%EOF IRanges/inst/extdata/0000755000126300012640000000000012227064501016073 5ustar00biocbuildphs_compbioIRanges/inst/extdata/ce2chrM.bed0000644000126300012640000000027112227064501020032 0ustar00biocbuildphs_compbiochrM 13357 13651 trf 2 162.5 2 67 19 173 47 0 0 52 1.00 TA chrM 13436 13585 trf 7 23.9 7 66 28 61 46 0 0 53 1.00 ATTATAA chrM 13406 13658 trf 9 28.7 9 66 15 63 45 0 0 54 0.99 TATTATATT IRanges/inst/extdata/ce2chrM.fa.out0000644000126300012640000000714312227064501020501 0ustar00biocbuildphs_compbio SW perc perc perc query position in query matching repeat position in repeat score div. del. ins. sequence begin end (left) repeat class/family begin end (left) ID 210 19.5 0.0 7.2 chrM 433 515 (13279) + T-rich Low_complexity 2 78 (0) 1 28 6.1 0.0 0.0 chrM 543 591 (13203) + AT_rich Low_complexity 1 49 (0) 2 34 2.4 0.0 0.0 chrM 1345 1385 (12409) + AT_rich Low_complexity 1 41 (0) 3 26 8.2 0.0 0.0 chrM 2464 2524 (11270) + AT_rich Low_complexity 1 61 (0) 4 239 21.5 0.8 9.7 chrM 2566 2699 (11095) + T-rich Low_complexity 3 124 (0) 5 27 7.3 0.0 0.0 chrM 3922 3976 (9818) + AT_rich Low_complexity 1 55 (0) 6 37 5.7 0.0 3.3 chrM 4206 4296 (9498) + AT_rich Low_complexity 1 88 (0) 7 22 5.6 0.0 0.0 chrM 4759 4794 (9000) + AT_rich Low_complexity 1 36 (0) 8 28 2.9 0.0 0.0 chrM 5437 5471 (8323) + AT_rich Low_complexity 1 35 (0) 9 228 18.5 1.9 0.0 chrM 5538 5591 (8203) + T-rich Low_complexity 5 59 (0) 10 22 0.0 0.0 0.0 chrM 6584 6605 (7189) + AT_rich Low_complexity 1 22 (0) 11 36 9.7 0.0 0.0 chrM 6699 6811 (6983) + AT_rich Low_complexity 1 113 (0) 12 21 8.9 0.0 0.0 chrM 6978 7033 (6761) + AT_rich Low_complexity 1 56 (0) 13 26 8.8 0.0 0.0 chrM 7521 7588 (6206) + AT_rich Low_complexity 1 68 (0) 14 30 8.3 0.0 0.0 chrM 7794 7865 (5929) + AT_rich Low_complexity 1 72 (0) 15 21 0.0 0.0 0.0 chrM 8054 8074 (5720) + AT_rich Low_complexity 1 21 (0) 16 39 5.0 0.0 0.0 chrM 10561 10620 (3174) + AT_rich Low_complexity 1 60 (0) 17 207 16.8 6.6 4.7 chrM 10656 10761 (3033) + (TTTAA)n Simple_repeat 1 108 (0) 18 32 2.6 0.0 0.0 chrM 10947 10985 (2809) + AT_rich Low_complexity 1 39 (0) 19 25 0.0 0.0 0.0 chrM 11805 11829 (1965) + AT_rich Low_complexity 1 25 (0) 20 21 3.6 0.0 0.0 chrM 12027 12054 (1740) + AT_rich Low_complexity 1 28 (0) 21 24 3.2 0.0 0.0 chrM 12320 12350 (1444) + AT_rich Low_complexity 1 31 (0) 22 27 8.1 0.0 0.0 chrM 12727 12788 (1006) + AT_rich Low_complexity 1 62 (0) 23 22 9.9 0.0 0.0 chrM 12883 12953 (841) + AT_rich Low_complexity 1 71 (0) 24 60 7.2 0.0 1.9 chrM 13006 13161 (633) + AT_rich Low_complexity 1 153 (0) 25 28 9.1 0.0 0.0 chrM 13193 13269 (525) + AT_rich Low_complexity 1 77 (0) 26 468 6.9 9.4 0.0 chrM 13358 13516 (278) + (TA)n Simple_repeat 1 174 (0) 27 344 8.5 8.3 2.4 chrM 13491 13658 (136) + (TTATA)n Simple_repeat 2 179 (0) 28 IRanges/inst/extdata/hg18liftAll.lft0000644000126300012640000004065712227064501020675 0ustar00biocbuildphs_compbio0 1/NT_077402 167280 chr1 247249719 217280 1/NT_077911 40302 chr1 247249719 307582 1/NT_077912 153649 chr1 247249719 511231 1/NT_004350 2112849 chr1 247249719 2674080 1/NT_004321 1161048 chr1 247249719 3895128 1/NT_004547 1440092 chr1 247249719 5385220 1/NT_021937 7590365 chr1 247249719 13025585 1/NT_113791 116914 chr1 247249719 13192499 1/NT_077382 237250 chr1 247249719 13479749 1/NT_004873 3518496 chr1 247249719 17048245 1/NT_004610 12702424 chr1 247249719 29800669 1/NT_032977 73835825 chr1 247249719 103686494 1/NT_113792 157344 chr1 247249719 103893838 1/NT_019273 16604841 chr1 247249719 120548679 1/NT_086586 189539 chr1 247249719 120788218 1/NT_077389 398739 chr1 247249719 141476957 1/NT_113793 195588 chr1 247249719 141722545 1/NT_113794 186739 chr1 247249719 141959284 1/NT_113795 175055 chr1 247249719 142184339 1/NT_113796 201709 chr1 247249719 142436048 1/NT_113797 126477 chr1 247249719 142612525 1/NT_079485 194615 chr1 247249719 142857140 1/NT_079497 78698 chr1 247249719 142985838 1/NT_077932 127263 chr1 247249719 143163101 1/NT_077933 170669 chr1 247249719 143383770 1/NT_113798 38311 chr1 247249719 143522081 1/NT_004434 1022394 chr1 247249719 144594475 1/NT_034398 281532 chr1 247249719 144926007 1/NT_034400 1566655 chr1 247249719 146542662 1/NT_113799 185320 chr1 247249719 146777982 1/NT_079483 172789 chr1 247249719 147000771 1/NT_034401 220313 chr1 247249719 147271084 1/NT_034403 455185 chr1 247249719 147776269 1/NT_004487 56413061 chr1 247249719 204239330 1/NT_086602 259514 chr1 247249719 204548844 1/NT_021877 17265625 chr1 247249719 221864469 1/NT_004559 11394365 chr1 247249719 233308834 1/NT_004836 13665999 chr1 247249719 247024833 1/NT_032968 174886 chr1 247249719 50000 10/NT_077567 5577110 chr10 135374737 5677110 10/NT_077569 12337571 chr10 135374737 18064681 10/NT_008705 20794160 chr10 135374737 38908841 10/NT_024133 286100 chr10 135374737 41674941 10/NT_079540 191752 chr10 135374737 41916693 10/NT_033985 3830277 chr10 135374737 45896970 10/NT_031847 952205 chr10 135374737 46999175 10/NT_077570 263307 chr10 135374737 47412482 10/NT_077571 163231 chr10 135374737 47725713 10/NT_030772 989829 chr10 135374737 48865542 10/NT_017696 1941874 chr10 135374737 50857416 10/NT_035036 211435 chr10 135374737 51118851 10/NT_008583 30112613 chr10 135374737 81241464 10/NT_030059 44617998 chr10 135374737 125909462 10/NT_035040 2696597 chr10 135374737 128656059 10/NT_008818 4615335 chr10 135374737 133281394 10/NT_025835 246123 chr10 135374737 133577517 10/NT_017795 1797220 chr10 135374737 50000 11/NT_035113 1102759 chr11 134452384 1169335 11/NT_009237 49571094 chr11 134452384 50947429 11/NT_035158 503352 chr11 134452384 54450781 11/NT_033903 14395596 chr11 134452384 68848982 11/NT_078088 588129 chr11 134452384 69454899 11/NT_033927 17911127 chr11 134452384 87378026 11/NT_008984 8549206 chr11 134452384 95942794 11/NT_033899 38509590 chr11 134452384 16000 12/NT_009759 7043293 chr12 132349534 7132293 12/NT_009714 27615668 chr12 132349534 36142961 12/NT_029419 38648979 chr12 132349534 75041940 12/NT_019546 32815934 chr12 132349534 107914874 12/NT_009775 13091146 chr12 132349534 121156020 12/NT_009755 10116045 chr12 132349534 131317065 12/NT_024477 972469 chr12 132349534 17918000 13/NT_024524 67740325 chr13 114142980 85708325 13/NT_009952 25443670 chr13 114142980 111551995 13/NT_027140 1821999 chr13 114142980 113473994 13/NT_077627 184056 chr13 114142980 113758050 13/NT_024498 369930 chr13 114142980 18070000 14/NT_026437 88290585 chr14 106368585 18260000 15/NT_037852 1403478 chr15 100338915 19763478 15/NT_077631 334079 chr15 100338915 20197557 15/NT_078094 868737 chr15 100338915 21116294 15/NT_026446 3571299 chr15 100338915 24731593 15/NT_078095 438013 chr15 100338915 25270606 15/NT_010280 1108140 chr15 100338915 26478746 15/NT_078096 417989 chr15 100338915 26996735 15/NT_010194 53619965 chr15 100338915 80676700 15/NT_077661 2098777 chr15 100338915 82835477 15/NT_010274 13510195 chr15 100338915 96367672 15/NT_035325 3971243 chr15 100338915 0 16/NT_037887 8576922 chr16 88827254 8594422 16/NT_010393 25336229 chr16 88827254 34030651 16/NT_024773 1112651 chr16 88827254 44943302 16/NT_010498 42003582 chr16 88827254 86966884 16/NT_010542 1855370 chr16 88827254 0 17/NT_024972 296854 chr17 78774742 343376 17/NT_010718 21163833 chr17 78774742 21607209 17/NT_024862 579924 chr17 78774742 22287133 17/NT_010799 9412828 chr17 78774742 31799961 17/NT_078100 1629269 chr17 78774742 33529230 17/NT_010755 5072491 chr17 78774742 38701721 17/NT_010783 24793602 chr17 78774742 63585323 17/NT_010641 11472733 chr17 78774742 75211056 17/NT_024871 2103126 chr17 78774742 77379182 17/NT_010663 1275560 chr17 78774742 0 18/NT_010859 15400898 chr18 76117153 16764896 18/NT_010966 33548238 chr18 76117153 50360134 18/NT_025028 20074199 chr18 76117153 70462333 18/NT_025004 3388475 chr18 76117153 73872808 18/NT_010879 2244345 chr18 76117153 11000 19/NT_011255 7286004 chr19 63811651 7302004 19/NT_077812 1291194 chr19 63811651 8598198 19/NT_011295 15825424 chr19 63811651 32423622 19/NT_011109 31383029 chr19 63811651 0 2/NT_022327 1254071 chr2 242951149 1255071 2/NT_022221 2252116 chr2 242951149 3557187 2/NT_022139 1426129 chr2 242951149 5083316 2/NT_005334 11088087 chr2 242951149 16221403 2/NT_015926 4791168 chr2 242951149 21037571 2/NT_022184 68373980 chr2 242951149 89561551 2/NT_032994 397279 chr2 242951149 90958830 2/NT_034508 731068 chr2 242951149 94689898 2/NT_026970 2594449 chr2 242951149 97296847 2/NT_022171 12173457 chr2 242951149 109612304 2/NT_034485 736346 chr2 242951149 110498650 2/NT_077407 359898 chr2 242951149 111008548 2/NT_022135 38390280 chr2 242951149 149498828 2/NT_005403 84213157 chr2 242951149 233731985 2/NT_005120 5688986 chr2 242951149 239453971 2/NT_113800 12944 chr2 242951149 239496915 2/NT_022173 952154 chr2 242951149 240474069 2/NT_005416 2277080 chr2 242951149 8000 20/NT_011387 26259569 chr20 62435964 28033230 20/NT_025215 234339 chr20 62435964 29267569 20/NT_028392 5092930 chr20 62435964 34380499 20/NT_011362 26144333 chr20 62435964 60551882 20/NT_035608 71932 chr20 62435964 60733814 20/NT_011333 1702150 chr20 62435964 9719767 21/NT_029490 490233 chr21 46944323 13260000 21/NT_011512 28617429 chr21 46944323 41878628 21/NT_030188 1627105 chr21 46944323 43507092 21/NT_011515 3437231 chr21 46944323 14430000 22/NT_028395 647850 chr22 49691432 15227850 22/NT_011519 3661581 chr22 49691432 18939431 22/NT_011520 23276302 chr22 49691432 42227733 22/NT_011521 830225 chr22 49691432 43107958 22/NT_011523 4248192 chr22 49691432 47366250 22/NT_011525 1384186 chr22 49691432 48767136 22/NT_019197 320440 chr22 49691432 49089176 22/NT_113818 17927 chr22 49691432 49126803 22/NT_011526 464629 chr22 49691432 0 22_h2_hap1/NT_113959 63661 chr22_h2_hap1 63661 35000 3/NT_022517 66080833 chr3 199501827 66375833 3/NT_022459 24211711 chr3 199501827 94987544 3/NT_005612 100530253 chr3 199501827 195537797 3/NT_005535 1299866 chr3 199501827 196864663 3/NT_029928 2582164 chr3 199501827 0 4/NT_037622 1413146 chr4 191273063 1464146 4/NT_006081 2419310 chr4 191273063 3963456 4/NT_006051 4820284 chr4 191273063 8933740 4/NT_006316 22487426 chr4 191273063 31492166 4/NT_022794 976586 chr4 191273063 32527752 4/NT_016297 7445039 chr4 191273063 39992791 4/NT_006238 9040907 chr4 191273063 49183698 4/NT_037645 171176 chr4 191273063 52354874 4/NT_022853 7074452 chr4 191273063 59479326 4/NT_022778 9796115 chr4 191273063 69375441 4/NT_077444 2161413 chr4 191273063 71711854 4/NT_006216 3929449 chr4 191273063 75671303 4/NT_016354 92123751 chr4 191273063 167825054 4/NT_022792 23438009 chr4 191273063 63000 5/NT_006576 46378398 chr5 180857866 49441398 5/NT_006713 42230486 chr5 180857866 91711884 5/NT_023148 5878002 chr5 180857866 97612886 5/NT_034772 41199371 chr5 180857866 138817257 5/NT_029289 16301663 chr5 180857866 155123020 5/NT_023133 25714846 chr5 180857866 0 5_h2_hap1/NT_113801 1146088 chr5_h2_hap1 1794870 1186088 5_h2_hap1/NT_113802 608782 chr5_h2_hap1 1794870 5000 6/NT_034880 9194728 chr6 170899992 9249728 6/NT_007592 48945890 chr6 170899992 58245618 6/NT_033172 642507 chr6 170899992 61938125 6/NT_033948 248423 chr6 170899992 62236548 6/NT_007299 33500716 chr6 170899992 95937264 6/NT_025741 61645385 chr6 170899992 157632649 6/NT_007422 10134273 chr6 170899992 167784922 6/NT_007302 2236975 chr6 170899992 170171897 6/NT_007583 725095 chr6 170899992 0 6_cox_hap1/NT_113891 4731698 chr6_cox_hap1 4731698 0 6_qbl_hap2/NT_113892 475847 chr6_qbl_hap2 4565931 635157 6_qbl_hap2/NT_113893 1999704 chr6_qbl_hap2 4565931 2686011 6_qbl_hap2/NT_113894 291112 chr6_qbl_hap2 4565931 3003554 6_qbl_hap2/NT_113895 266639 chr6_qbl_hap2 4565931 3322986 6_qbl_hap2/NT_113896 623992 chr6_qbl_hap2 4565931 3973953 6_qbl_hap2/NT_113897 591978 chr6_qbl_hap2 4565931 34000 7/NT_029998 293567 chr7 158821424 477567 7/NT_007819 47690382 chr7 158821424 48207949 7/NT_030008 2130176 chr7 158821424 50378125 7/NT_033968 6577293 chr7 158821424 57005418 7/NT_023629 1052855 chr7 158821424 61058273 7/NT_023603 256182 chr7 158821424 61364455 7/NT_077528 190137 chr7 158821424 61604592 7/NT_007758 12749068 chr7 158821424 74603660 7/NT_007933 64426257 chr7 158821424 139054917 7/NT_007914 14846650 chr7 158821424 154001567 7/NT_034885 736332 chr7 158821424 154817899 7/NT_007741 4003525 chr7 158821424 0 8/NT_023736 7462059 chr8 146274826 7562059 8/NT_077531 4537293 chr8 146274826 12199352 8/NT_030737 9464880 chr8 146274826 21681632 8/NT_023666 8051036 chr8 146274826 29798768 8/NT_007995 14159284 chr8 146274826 46958052 8/NT_023678 1291149 chr8 146274826 48309201 8/NT_008183 38454502 chr8 146274826 86851003 8/NT_008046 57155273 chr8 146274826 144106276 8/NT_023684 1290020 chr8 146274826 145403396 8/NT_037704 871430 chr8 146274826 0 9/NT_008413 39653686 chr9 140273252 39703686 9/NT_086745 261110 chr9 140273252 40014796 9/NT_078049 208233 chr9 140273252 40273029 9/NT_113811 142805 chr9 140273252 40465834 9/NT_078041 464507 chr9 140273252 40980341 9/NT_078042 152873 chr9 140273252 41183214 9/NT_113812 172579 chr9 140273252 41405793 9/NT_078043 1198158 chr9 140273252 42653951 9/NT_078055 549743 chr9 140273252 43253694 9/NT_078045 632871 chr9 140273252 43936565 9/NT_079529 680077 chr9 140273252 44666642 9/NT_078077 181647 chr9 140273252 44898289 9/NT_078051 291910 chr9 140273252 45240199 9/NT_078053 465318 chr9 140273252 45755517 9/NT_113813 350909 chr9 140273252 46156426 9/NT_086759 194609 chr9 140273252 46401035 9/NT_086755 498918 chr9 140273252 46949953 9/NT_078078 157546 chr9 140273252 65207499 9/NT_078052 450681 chr9 140273252 65708180 9/NT_113814 223855 chr9 140273252 65982035 9/NT_113815 162441 chr9 140273252 66194476 9/NT_078058 159539 chr9 140273252 66404015 9/NT_078059 199148 chr9 140273252 66653163 9/NT_078065 194491 chr9 140273252 66897654 9/NT_079533 158462 chr9 140273252 67106116 9/NT_078066 471702 chr9 140273252 67627818 9/NT_078067 376183 chr9 140273252 68054001 9/NT_078068 174765 chr9 140273252 68278766 9/NT_078069 289439 chr9 140273252 68618205 9/NT_078070 682157 chr9 140273252 69350362 9/NT_078071 158187 chr9 140273252 69558549 9/NT_113816 187806 chr9 140273252 69796355 9/NT_113817 178933 chr9 140273252 70025288 9/NT_023935 21507948 chr9 140273252 91583236 9/NT_079535 85380 chr9 140273252 91718616 9/NT_008470 40394265 chr9 140273252 132212881 9/NT_035014 3818133 chr9 140273252 136231014 9/NT_019501 2075804 chr9 140273252 138336818 9/NT_024000 1936434 chr9 140273252 0 M/NC_001807 16571 chrM 16571 0 X/NT_086925 34821 chrX 154913754 84821 X/NT_078115 86563 chrX 154913754 201384 X/NT_028413 766173 chrX 154913754 1017557 X/NT_086929 36556 chrX 154913754 1104113 X/NT_086931 80121 chrX 154913754 1274234 X/NT_033330 754004 chrX 154913754 2128238 X/NT_011757 34879939 chrX 154913754 37033177 X/NT_079573 12096764 chrX 154913754 49179941 X/NT_086939 680972 chrX 154913754 50040913 X/NT_011638 2371726 chrX 154913754 52462639 X/NT_011630 6136098 chrX 154913754 61598737 X/NT_011669 14971611 chrX 154913754 76590348 X/NT_011651 36813576 chrX 154913754 113473924 X/NT_028405 2122394 chrX 154913754 115616318 X/NT_011786 27718692 chrX 154913754 143365010 X/NT_011681 5427710 chrX 154913754 148832720 X/NT_011726 6081034 chrX 154913754 0 Y/NT_113967 34821 chrY 57772954 84821 Y/NT_113968 86563 chrY 57772954 201384 Y/NT_113969 766173 chrY 57772954 1017557 Y/NT_113970 36556 chrY 57772954 1104113 Y/NT_113971 80121 chrY 57772954 1274234 Y/NT_113972 754004 chrY 57772954 2128238 Y/NT_113973 581282 chrY 57772954 2709520 Y/NT_011896 6265435 chrY 57772954 9024955 Y/NT_086998 276367 chrY 57772954 9901322 Y/NT_011878 813231 chrY 57772954 11214553 Y/NT_087001 39401 chrY 57772954 11653954 Y/NT_113819 554624 chrY 57772954 12308578 Y/NT_011875 10002238 chrY 57772954 22360816 Y/NT_011903 4867933 chrY 57772954 57228749 Y/NT_025975 98295 chrY 57772954 57377044 Y/NT_091573 66393 chrY 57772954 57443437 Y/NT_113974 329517 chrY 57772954 0 1/NT_113870 145186 chr1_random 1663265 195186 1/NT_113871 197748 chr1_random 1663265 442934 1/NT_113872 183763 chr1_random 1663265 676697 1/NT_113873 51825 chr1_random 1663265 778522 1/NT_113874 136815 chr1_random 1663265 965337 1/NT_113875 114056 chr1_random 1663265 1129393 1/NT_113876 25994 chr1_random 1663265 1205387 1/NT_113877 208942 chr1_random 1663265 1464329 1/NT_113878 106433 chr1_random 1663265 1620762 1/NT_113879 42503 chr1_random 1663265 0 10/NT_113918 113275 chr10_random 113275 0 11/NT_113919 40524 chr11_random 215294 90524 11/NT_113920 35155 chr11_random 215294 175679 11/NT_113921 39615 chr11_random 215294 0 13/NT_113923 186858 chr13_random 186858 0 15/NT_113924 139260 chr15_random 784346 189260 15/NT_113925 168820 chr15_random 784346 408080 15/NT_113926 119514 chr15_random 784346 577594 15/NT_113927 111864 chr15_random 784346 739458 15/NT_113928 44888 chr15_random 784346 0 16/NT_113929 105485 chr16_random 105485 0 17/NT_113930 174588 chr17_random 2617613 224588 17/NT_113931 186078 chr17_random 2617613 460666 17/NT_113932 104495 chr17_random 2617613 615161 17/NT_113933 142595 chr17_random 2617613 807756 17/NT_113934 120350 chr17_random 2617613 978106 17/NT_113935 185449 chr17_random 2617613 1213555 17/NT_113936 163628 chr17_random 2617613 1427183 17/NT_113937 37443 chr17_random 2617613 1514626 17/NT_113938 45226 chr17_random 2617613 1609852 17/NT_113939 147354 chr17_random 2617613 1807206 17/NT_113940 19187 chr17_random 2617613 1876393 17/NT_113941 37498 chr17_random 2617613 1963891 17/NT_113942 117663 chr17_random 2617613 2131554 17/NT_113943 81310 chr17_random 2617613 2262864 17/NT_113944 182567 chr17_random 2617613 2495431 17/NT_113945 41001 chr17_random 2617613 2586432 17/NT_113946 31181 chr17_random 2617613 0 18/NT_113947 4262 chr18_random 4262 0 19/NT_113948 92689 chr19_random 301858 142689 19/NT_113949 159169 chr19_random 301858 0 2/NT_113880 185571 chr2_random 185571 0 21/NT_113950 28709 chr21_random 1679693 78709 21/NT_113951 152296 chr21_random 1679693 281005 21/NT_113952 184355 chr21_random 1679693 515360 21/NT_113953 131056 chr21_random 1679693 696416 21/NT_113954 129889 chr21_random 1679693 876305 21/NT_113955 178865 chr21_random 1679693 1105170 21/NT_113956 150002 chr21_random 1679693 1305172 21/NT_113957 166452 chr21_random 1679693 1521624 21/NT_113958 158069 chr21_random 1679693 0 22/NT_113960 40752 chr22_random 257318 90752 22/NT_113961 166566 chr22_random 257318 0 3/NT_113881 146010 chr3_random 749256 196010 3/NT_113882 172475 chr3_random 749256 418485 3/NT_113883 137703 chr3_random 749256 606188 3/NT_113884 143068 chr3_random 749256 0 4/NT_113885 189789 chr4_random 842648 239789 4/NT_113886 96249 chr4_random 842648 386038 4/NT_113887 3994 chr4_random 842648 440032 4/NT_113888 191469 chr4_random 842648 681501 4/NT_113889 161147 chr4_random 842648 0 5/NT_113890 143687 chr5_random 143687 0 6/NT_113898 1305230 chr6_random 1875562 1355230 6/NT_113899 520332 chr6_random 1875562 0 7/NT_113900 112804 chr7_random 549659 162804 7/NT_113901 182896 chr7_random 549659 395700 7/NT_113902 153959 chr7_random 549659 0 8/NT_113903 12854 chr8_random 943810 62854 8/NT_113904 50950 chr8_random 943810 163804 8/NT_113905 183161 chr8_random 943810 396965 8/NT_113906 46082 chr8_random 943810 493047 8/NT_113907 37175 chr8_random 943810 580222 8/NT_113908 13036 chr8_random 943810 643258 8/NT_113909 38914 chr8_random 943810 732172 8/NT_113910 211638 chr8_random 943810 0 9/NT_113911 36148 chr9_random 1146434 86148 9/NT_113912 185143 chr9_random 1146434 321291 9/NT_113913 154740 chr9_random 1146434 526031 9/NT_113914 90085 chr9_random 1146434 666116 9/NT_113915 187035 chr9_random 1146434 903151 9/NT_113916 173443 chr9_random 1146434 1126594 9/NT_113917 19840 chr9_random 1146434 0 X/NT_113962 217385 chrX_random 1719168 267385 X/NT_113963 24360 chrX_random 1719168 341745 X/NT_113964 204131 chrX_random 1719168 595876 X/NT_113965 1005289 chrX_random 1719168 1651165 X/NT_113966 68003 chrX_random 1719168 IRanges/inst/extdata/hs_b36v3_chrY.agp0000644000126300012640000003070512227064501021113 0ustar00biocbuildphs_compbio# # Homo sapiens chromosome Y, reference assembly, complete sequence # # This file provides assembly instructions for sequence NC_000024 # included in reference assembly of NCBI build 36 (HGSC Finished Genome v4.0). # #chrom chr_start chr_stop part_no part_type comp_id/gap_len comp_type/gap_type comp_end/linkage orientation/empty chrY 1 34821 1 F BX640545.2 1 34821 + chrY 34822 84821 2 N 50000 contig no chrY 84822 122592 3 F AL954722.18 1 37771 + chrY 122593 157464 4 F BX537334.4 1 34872 - chrY 157465 171384 5 F BX000483.7 1999 15918 + chrY 171385 201384 6 N 30000 contig no chrY 201385 232395 7 F AL954664.17 8190 39200 - chrY 232396 265528 8 F BX000476.5 208 33340 + chrY 265529 482251 9 F AL732314.18 2001 218723 + chrY 482252 550112 10 F BX004827.18 51695 119555 + chrY 550113 723877 11 F AL683871.15 2001 175765 + chrY 723878 837875 12 F AL672311.26 2001 115998 + chrY 837876 967557 13 F AL672277.20 2001 131682 + chrY 967558 1017557 14 N 50000 contig no chrY 1017558 1054113 15 F BX908402.3 1 36556 + chrY 1054114 1104113 16 N 50000 contig no chrY 1104114 1147822 17 F BX649635.3 1 43709 + chrY 1147823 1184234 18 F BX901949.9 1685 38096 + chrY 1184235 1274234 19 N 90000 contig no chrY 1274235 1307891 20 F BX908382.8 1 33657 + chrY 1307892 1390773 21 F BX649553.6 2001 84882 + chrY 1390774 1425289 22 F BX901885.7 1 34516 + chrY 1425290 1458955 23 F BX119906.16 2001 35666 + chrY 1458956 1618348 24 F AL683870.15 1001 160393 + chrY 1618349 1661433 25 F AL691415.17 1 43085 + chrY 1661434 1849259 26 F AL683807.22 1 187826 + chrY 1849260 1966556 27 F AL672040.10 1 117297 + chrY 1966557 2028238 28 F CR381640.8 2001 63682 + chrY 2028239 2128238 29 N 100000 contig no chrY 2128239 2165561 30 F CR856018.10 1 37323 + chrY 2165562 2202890 31 F CR381696.5 2000 39328 + chrY 2202891 2280454 32 F BX649443.16 2001 79564 + chrY 2280455 2333896 33 F BX119919.5 1 53442 - chrY 2333897 2514591 34 F AC079176.15 1 180695 - chrY 2514592 2593088 35 F AC097314.27 1 78497 - chrY 2593089 2709520 36 F AC006209.25 23323 139754 - chrY 2709521 2838553 37 F AC006040.3 57272 186304 + chrY 2838554 2845472 38 F AC074181.1 1 6919 + chrY 2845473 2999955 39 F AC006157.2 1 154483 + chrY 2999956 3170037 40 F AC006032.2 1 170082 + chrY 3170038 3247254 41 F AC006152.4 1 77217 + chrY 3247255 3316539 42 F AC011305.2 1 69285 + chrY 3316540 3471638 43 F AC009479.4 1 155099 + chrY 3471639 3567129 44 F AC019058.4 1 95491 + chrY 3567130 3650550 45 F AC024038.6 1 83421 + chrY 3650551 3827222 46 F AC012078.3 1 176672 + chrY 3827223 3945458 47 F AC010094.5 1 118236 + chrY 3945459 4015462 48 F AC010737.4 1 70004 + chrY 4015463 4164401 49 F AC010084.3 1 148939 + chrY 4164402 4316800 50 F AC010905.3 1 152399 + chrY 4316801 4335619 51 F AC010106.2 1 18819 + chrY 4335620 4367320 52 F AC024703.5 1 31701 + chrY 4367321 4576407 53 F AC012077.4 1 209087 + chrY 4576408 4712669 54 F AC010142.4 1 136262 + chrY 4712670 4829264 55 F AC019060.5 1 116595 + chrY 4829265 4917080 56 F AC023423.5 1 87816 + chrY 4917081 5077603 57 F AC010722.2 1 160523 + chrY 5077604 5237705 58 F AC010685.3 1 160102 + chrY 5237706 5281650 59 F AC010129.3 1 43945 + chrY 5281651 5445957 60 F AC012067.2 1 164307 + chrY 5445958 5520761 61 F AC012667.2 1 74804 + chrY 5520762 5697342 62 F AC010081.4 1 176581 + chrY 5697343 5811187 63 F AC010874.3 1 113845 + chrY 5811188 5947272 64 F AC010977.4 1 136085 + chrY 5947273 6015798 65 F AC016681.2 1 68526 + chrY 6015799 6163940 66 F AC010140.3 1 148142 + chrY 6163941 6386252 67 F AC006335.2 1 222312 + chrY 6386253 6441403 68 F AC010154.3 1 55151 + chrY 6441404 6607550 69 F AC010144.4 1 166147 + chrY 6607551 6623520 70 F AC010728.4 1 15970 + chrY 6623521 6823534 71 F AC013412.3 1 200014 + chrY 6823535 6877729 72 F AC011297.3 1 54195 + chrY 6877730 7044045 73 F AC012068.5 1 166316 + chrY 7044046 7154095 74 F AC010104.3 1 110050 + chrY 7154096 7233943 75 F AC010143.3 1 79848 + chrY 7233944 7405192 76 F AC007284.4 1 171249 + chrY 7405193 7521780 77 F AC007247.5 1 116588 + chrY 7521781 7638889 78 F AC007274.3 1 117109 + chrY 7638890 7808593 79 F AC007275.4 1 169704 + chrY 7808594 7883829 80 F AC010678.4 1 75236 + chrY 7883830 7997798 81 F AC010902.4 1 113969 + chrY 7997799 8184715 82 F AC016749.4 1 186917 + chrY 8184716 8278929 83 F AC051663.9 1 94214 + chrY 8278930 8370383 84 F AC025731.12 1 91454 + chrY 8370384 8544585 85 F AC016991.5 1 174202 + chrY 8544586 8634069 86 F AC064829.6 1 89484 + chrY 8634070 8774803 87 F AC009491.3 1 140734 + chrY 8774804 8962150 88 F AC007967.3 1 187347 + chrY 8962151 8972934 89 F AC068719.3 1 10784 + chrY 8972935 8974955 90 F AC079126.3 1 2021 + chrY 8974956 9024955 91 N 50000 clone no chrY 9024956 9030327 92 F AC079125.4 1 5372 + chrY 9030328 9178185 93 F AC009952.4 1 147858 + chrY 9178186 9190963 94 F AC025732.9 1 12778 + chrY 9190964 9301322 95 F AC006158.6 1 110359 + chrY 9301323 9901322 96 N 600000 clone no chrY 9901323 10013703 97 F AC006156.5 1 112381 + chrY 10013704 10088698 98 F AC025819.7 1 74995 + chrY 10088699 10250877 99 F AC017019.3 1 162179 + chrY 10250878 10283186 100 F AC010891.2 1 32309 + chrY 10283187 10456943 101 F AC006986.3 1 173757 + chrY 10456944 10622784 102 F AC006987.2 1 165841 + chrY 10622785 10714553 103 F AC010970.3 1 91769 + chrY 10714554 11214553 104 N 500000 clone no chrY 11214554 11253954 105 F AC069323.5 1 39401 + chrY 11253955 11653954 106 N 400000 centromere no chrY 11653955 11738549 107 F AC140113.3 71061 155655 - chrY 11738550 11861114 108 F AC134878.3 33249 155813 - chrY 11861115 12003063 109 F AC134882.2 10706 152654 - chrY 12003064 12208578 110 F AC134879.3 1 205515 - chrY 12208579 12308578 111 N 100000 centromere no chrY 12308579 12468100 112 F AC011293.5 1 159522 + chrY 12468101 12581699 113 F AC012502.3 1 113599 + chrY 12581700 12759636 114 F AC011302.3 1 177937 + chrY 12759637 12838587 115 F AC013735.5 1 78951 + chrY 12838588 12911566 116 F AC004772.2 40021 112999 + chrY 12911567 12936024 117 F AC005942.2 1 24458 - chrY 12936025 13059669 118 F AC002992.1 2001 125645 + chrY 13059670 13234892 119 F AC004617.2 1 175223 + chrY 13234893 13319390 120 F AC004810.1 1 84498 - chrY 13319391 13515290 121 F AC002531.1 2001 197900 + chrY 13515291 13619376 122 F AC004474.1 44195 148280 + chrY 13619377 13664255 123 F AC006565.4 1 44879 - chrY 13664256 13879980 124 F AC005820.1 1 215725 - chrY 13879981 13952171 125 F AC010877.3 64839 137029 + chrY 13952172 14123978 126 F AC006376.2 1 171807 + chrY 14123979 14159738 127 F AC007004.3 1 35760 + chrY 14159739 14264748 128 F AC006383.2 1 105010 + chrY 14264749 14466902 129 F AC006371.2 1 202154 + chrY 14466903 14639848 130 F AC006370.2 1 172946 + chrY 14639849 14742756 131 F AC018677.3 1 102908 + chrY 14742757 14779500 132 F AC010720.4 1 36744 + chrY 14779501 14953720 133 F AC010723.3 1 174220 + chrY 14953721 14981864 134 F AC019191.4 1 28144 + chrY 14981865 15158188 135 F AC010726.4 1 176324 + chrY 15158189 15267382 136 F AC010979.3 1 109194 + chrY 15267383 15447103 137 F AC010879.2 1 179721 + chrY 15447104 15512578 138 F AC011903.4 1 65475 + chrY 15512579 15557501 139 F AC017032.3 1 44923 + chrY 15557502 15714967 140 F AC006989.3 1 157466 + chrY 15714968 15795304 141 F AC011289.4 1 80337 + chrY 15795305 15909741 142 F AC010972.3 1 114437 + chrY 15909742 15967360 143 F AC007007.3 1 57619 + chrY 15967361 16111420 144 F AC006998.3 1 144060 + chrY 16111421 16274030 145 F AC006382.3 1 162610 + chrY 16274031 16413824 146 F AC006462.3 1 139794 + chrY 16413825 16509580 147 F AC006336.4 1 95756 + chrY 16509581 16528817 148 F AC016671.3 1 19237 + chrY 16528818 16695020 149 F AC017020.4 1 166203 + chrY 16695021 16899873 150 F AC011749.2 1 204853 + chrY 16899874 16926987 151 F AC053516.10 1 27114 + chrY 16926988 17103738 152 F AC010135.3 1 176751 + chrY 17103739 17166324 153 F AC010128.3 1 62586 + chrY 17166325 17345839 154 F AC011751.2 1 179515 + chrY 17345840 17488621 155 F AC016678.4 1 142782 + chrY 17488622 17510633 156 F AC015979.4 1 22012 + chrY 17510634 17659631 157 F AC007034.4 1 148998 + chrY 17659632 17766833 158 F AC007043.3 1 107202 + chrY 17766834 17879511 159 F AC006999.2 1 112678 + chrY 17879512 17886218 160 F AC007042.3 1 6707 + chrY 17886219 17923463 161 F AC091329.3 1 37245 + chrY 17923464 18051552 162 F AC007972.4 1 128089 + chrY 18051553 18230132 163 F AC015978.4 1 178580 + chrY 18230133 18244934 164 F AC068704.4 1 14802 + chrY 18244935 18443908 165 F AC007742.4 1 198974 + chrY 18443909 18474219 166 F AC095381.1 1 30311 + chrY 18474220 18653273 167 F AC009976.4 1 179054 + chrY 18653274 18698502 168 F AC095380.1 1 45229 + chrY 18698503 18861991 169 F AC024183.4 1 163489 + chrY 18861992 19023659 170 F AC007241.3 1 161668 + chrY 19023660 19090333 171 F AC069130.6 1 66674 + chrY 19090334 19096847 172 F AC073962.5 1 6514 + chrY 19096848 19134213 173 F AC068541.7 1 37366 + chrY 19134214 19290370 174 F AC022486.4 1 156157 + chrY 19290371 19464252 175 F AC007379.2 1 173882 + chrY 19464253 19623962 176 F AC009235.4 1 159710 + chrY 19623963 19808739 177 F AC007244.2 1 184777 + chrY 19808740 19871998 178 F AC021210.4 1 63259 + chrY 19871999 20023872 179 F AC010133.4 1 151874 + chrY 20023873 20066067 180 F AC012062.4 1 42195 + chrY 20066068 20189568 181 F AC010137.3 1 123501 + chrY 20189569 20221039 182 F AC009977.4 1 31471 + chrY 20221040 20400963 183 F AC010889.3 1 179924 + chrY 20400964 20472584 184 F AC010151.3 1 71621 + chrY 20472585 20667823 185 F AC009233.3 1 195239 + chrY 20667824 20778857 186 F AC079157.3 1 111034 + chrY 20778858 20829067 187 F AC079261.2 1 50210 + chrY 20829068 20846452 188 F AC079156.4 1 17385 + chrY 20846453 20889975 189 F AC024250.6 1 43523 + chrY 20889976 20991065 190 F AC009240.6 1 101090 + chrY 20991066 21140390 191 F AC011745.4 1 149325 + chrY 21140391 21249363 192 F AC007678.3 1 108973 + chrY 21249364 21437477 193 F AC009494.2 1 188114 + chrY 21437478 21456819 194 F AC026061.8 1 19342 + chrY 21456820 21557572 195 F AC009489.3 1 100753 + chrY 21557573 21722251 196 F AC007876.2 1 164679 + chrY 21722252 21858422 197 F AC009239.3 1 136171 + chrY 21858423 22029157 198 F AC010086.4 1 170735 + chrY 22029158 22150215 199 F AC010141.2 1 121058 + chrY 22150216 22310816 200 F AC021107.3 1 160601 + chrY 22310817 22360816 201 N 50000 clone no chrY 22360817 22384194 202 F AC078938.3 1 23378 + chrY 22384195 22403616 203 F AC024236.5 1 19422 + chrY 22403617 22587631 204 F AC007322.4 1 184015 + chrY 22587632 22688058 205 F AC007359.3 1 100427 + chrY 22688059 22757212 206 F AC023342.3 1 69154 + chrY 22757213 22817822 207 F AC025227.6 1 60610 + chrY 22817823 23005516 208 F AC007320.3 1 187694 + chrY 23005517 23210553 209 F AC008175.2 1 205037 + chrY 23210554 23230057 210 F AC016694.2 1 19504 + chrY 23230058 23386813 211 F AC010080.2 1 156756 + chrY 23386814 23417437 212 F AC016911.6 1 30624 + chrY 23417438 23583695 213 F AC006366.4 201 166458 - chrY 23583696 23691182 214 F AC010088.4 1 107487 + chrY 23691183 23794414 215 F AC053490.2 1 103232 + chrY 23794415 23811321 216 F AC007039.6 1 16907 + chrY 23811322 23991466 217 F AC006983.4 1 180145 + chrY 23991467 24140496 218 F AC009947.2 1 149030 + chrY 24140497 24157833 219 F AC016707.2 1 17337 + chrY 24157834 24324069 220 F AC016752.2 1 166236 + chrY 24324070 24353833 221 F AC025246.6 1 29764 + chrY 24353834 24474584 222 F AC073649.3 1 120751 + chrY 24474585 24538834 223 F AC073893.4 1 64250 + chrY 24538835 24614390 224 F AC068601.8 1 75556 + chrY 24614391 24751872 225 F AC023274.2 1 137482 + chrY 24751873 24941229 226 F AC012005.4 1 189357 + chrY 24941230 24948693 227 F AC013465.4 1 7464 + chrY 24948694 25102779 228 F AC016698.3 1 154086 + chrY 25102780 25206726 229 F AC010153.3 1 103947 + chrY 25206727 25291998 230 F AC025735.4 1 85272 + chrY 25291999 25395154 231 F AC010089.4 1 103156 + chrY 25395155 25397101 232 F AC006982.3 1 1947 + chrY 25397102 25572891 233 F AC006338.6 1 175790 + chrY 25572892 25724743 234 F AC016728.4 1 151852 + chrY 25724744 25888772 235 F AC006386.4 1 164029 + chrY 25888773 26066341 236 F AC006328.5 1 177569 + chrY 26066342 26203218 237 F AC007562.4 1 136877 + chrY 26203219 26348595 238 F AC010682.3 1 145377 + chrY 26348596 26443316 239 F AC017005.7 1 94721 + chrY 26443317 26625199 240 F AC007965.3 1 181883 + chrY 26625200 26798241 241 F AC006991.3 1 173042 + chrY 26798242 26906387 242 F AC024067.4 1 108146 + chrY 26906388 27086206 243 F AC013734.4 1 179819 + chrY 27086207 27194539 244 F AC019099.6 1 108333 + chrY 27194540 27228749 245 F AC073880.5 1 34210 + chrY 27228750 57228749 246 N 30000000 heterochromatin no chrY 57228750 57327044 247 F AC068123.5 1 98295 + chrY 57327045 57377044 248 N 50000 clone no chrY 57377045 57443437 249 F AC025226.4 101674 168066 - chrY 57443438 57614293 250 F AJ271735.1 69145 240000 + chrY 57614294 57772954 251 F AJ271736.1 1 158661 + IRanges/inst/include/0000755000126300012640000000000012227064500016063 5ustar00biocbuildphs_compbioIRanges/inst/include/IRanges_defines.h0000644000126300012640000000514712227064500021270 0ustar00biocbuildphs_compbio/***************************************************************************** IRanges C interface: typedefs and defines ----------------------------------------- The IRanges C interface is split in 2 files: 1. IRanges_defines.h (this file): contains the typedefs and defines of the interface. 2. IRanges_interface.h (in this directory): contains the prototypes of the IRanges C routines that are part of the interface. Please consult IRanges_interface.h for how to use this interface in your package. *****************************************************************************/ #ifndef IRANGES_DEFINES_H #define IRANGES_DEFINES_H #include #include /* Hash table -- modified from R_HOME/src/main/unique.c */ struct htab { int K, M; unsigned int Mminus1; int *buckets; }; /* * Auto-Extending buffers used for temporary storage of incoming data whose * size is not known in advance: * * o IntAE: Auto-Extending buffer of ints; * o IntAEAE: Auto-Extending buffer of Auto-Extending buffers of ints; * o RangeAE: Auto-Extending buffer of integer ranges; * o RangeAEAE: Auto-Extending buffer of Auto-Extending buffers of integer * ranges; * o CharAE: Auto-Extending buffer of chars; * o CharAEAE: Auto-Extending buffer of Auto-Extending buffers of chars. * * Some differences between AE buffers and SEXP: (a) AE buffers auto-extend * i.e. they automatically reallocate when more room is needed to add a new * element, (b) they are faster, and (c) they don't require any * PROTECT/UNPROTECT mechanism. */ typedef struct int_ae { int buflength; int *elts; int _nelt; int _AE_malloc_stack_idx; } IntAE; typedef struct int_aeae { int buflength; IntAE *elts; int _nelt; int _AE_malloc_stack_idx; } IntAEAE; typedef struct range_ae { IntAE start; IntAE width; int _AE_malloc_stack_idx; } RangeAE; typedef struct range_aeae { int buflength; RangeAE *elts; int _nelt; int _AE_malloc_stack_idx; } RangeAEAE; typedef struct char_ae { int buflength; char *elts; int _nelt; int _AE_malloc_stack_idx; } CharAE; typedef struct char_aeae { int buflength; CharAE *elts; int _nelt; int _AE_malloc_stack_idx; } CharAEAE; /* * cached_* structs. */ typedef struct cached_iranges { const char *classname; int is_constant_width; int offset; int length; const int *width; const int *start; const int *end; SEXP names; } cachedIRanges; typedef struct cached_compressedirangeslist { const char *classname; int length; const int *end; cachedIRanges cached_unlistData; } cachedCompressedIRangesList; #endif IRanges/inst/include/IRanges_interface.h0000644000126300012640000001617012227064500021611 0ustar00biocbuildphs_compbio/***************************************************************************** IRanges C interface: prototypes ------------------------------- The IRanges C interface is split in 2 files: 1. IRanges_defines.h (in this directory): contains the typedefs and defines of the interface. 2. IRanges_interface.h (this file): contains the prototypes of the IRanges C routines that are part of the interface. *****************************************************************************/ #include "IRanges_defines.h" /* * Low-level sorting utilities. * (see sort_utils.c) */ void sort_int_array( int *x, int nelt, int desc ); void get_order_of_int_array( const int *x, int nelt, int desc, int *out, int out_shift ); void get_order_of_int_pairs( const int *a, const int *b, int nelt, int desc, int *out, int out_shift ); void get_order_of_int_quads( const int *a, const int *b, const int *c, const int *d, int nelt, int desc, int *out, int out_shift ); /* * Hash table management. * (see hash_utils.c) */ struct htab new_htab(int n); int get_hbucket_val( const struct htab *htab, int bucket_idx ); void set_hbucket_val( struct htab *htab, int bucket_idx, int val ); /* * Low-level manipulation of the Auto-Extending buffers. * (see AEbufs.c) */ int get_new_buflength(int buflength); int IntAE_get_nelt(const IntAE *int_ae); int IntAE_set_nelt( IntAE *int_ae, int nelt ); void IntAE_set_val( const IntAE *int_ae, int val ); IntAE new_IntAE( int buflength, int nelt, int val ); void IntAE_insert_at( IntAE *int_ae, int at, int val ); void IntAE_append( IntAE *int_ae, const int *newvals, int nnewval ); void IntAE_delete_at( IntAE *int_ae, int at ); void IntAE_shift( const IntAE *int_ae, int shift ); void IntAE_sum_and_shift( const IntAE *int_ae1, const IntAE *int_ae2, int shift ); void IntAE_append_shifted_vals( IntAE *int_ae, const int *newvals, int nnewval, int shift ); void IntAE_qsort( const IntAE *int_ae, int desc ); void IntAE_delete_adjdups(IntAE *int_ae); SEXP new_INTEGER_from_IntAE(const IntAE *int_ae); IntAE new_IntAE_from_INTEGER(SEXP x); IntAE new_IntAE_from_CHARACTER( SEXP x, int keyshift ); int IntAEAE_get_nelt(const IntAEAE *int_aeae); int IntAEAE_set_nelt( IntAEAE *int_aeae, int nelt ); IntAEAE new_IntAEAE( int buflength, int nelt ); void IntAEAE_insert_at( IntAEAE *int_aeae, int at, const IntAE *int_ae ); void IntAEAE_eltwise_append( const IntAEAE *int_aeae1, const IntAEAE *int_aeae2 ); void IntAEAE_shift( const IntAEAE *int_aeae, int shift ); void IntAEAE_sum_and_shift( const IntAEAE *int_aeae1, const IntAEAE *int_aeae2, int shift ); SEXP new_LIST_from_IntAEAE( const IntAEAE *int_aeae, int mode ); IntAEAE new_IntAEAE_from_LIST(SEXP x); SEXP IntAEAE_toEnvir( const IntAEAE *int_aeae, SEXP envir, int keyshift ); int RangeAE_get_nelt(const RangeAE *range_ae); int RangeAE_set_nelt( RangeAE *range_ae, int nelt ); RangeAE new_RangeAE( int buflength, int nelt ); void RangeAE_insert_at( RangeAE *range_ae, int at, int start, int width ); int RangeAEAE_get_nelt(const RangeAEAE *range_aeae); int RangeAEAE_set_nelt( RangeAEAE *range_aeae, int nelt ); RangeAEAE new_RangeAEAE( int buflength, int nelt ); void RangeAEAE_insert_at( RangeAEAE *range_aeae, int at, const RangeAE *range_ae ); int CharAE_get_nelt(const CharAE *char_ae); int CharAE_set_nelt( CharAE *char_ae, int nelt ); CharAE new_CharAE(int buflength); CharAE new_CharAE_from_string(const char *string); void CharAE_insert_at( CharAE *char_ae, int at, char c ); void append_string_to_CharAE( CharAE *char_ae, const char *string ); void CharAE_delete_at( CharAE *char_ae, int at, int nelt ); SEXP new_RAW_from_CharAE(const CharAE *char_ae); SEXP new_LOGICAL_from_CharAE(const CharAE *char_ae); int CharAEAE_get_nelt(const CharAEAE *char_aeae); int CharAEAE_set_nelt( CharAEAE *char_aeae, int nelt ); CharAEAE new_CharAEAE( int buflength, int nelt ); void CharAEAE_insert_at( CharAEAE *char_aeae, int at, const CharAE *char_ae ); void append_string_to_CharAEAE( CharAEAE *char_aeae, const char *string ); SEXP new_CHARACTER_from_CharAEAE(const CharAEAE *char_aeae); /* * SEXP_utils.c */ const char *get_classname(SEXP x); /* * int_utils.c */ int check_integer_pairs( SEXP a, SEXP b, const int **a_p, const int **b_p, const char *a_argname, const char *b_argname ); /* * Low-level manipulation of Vector objects. * (see Vector_class.c) */ const char *get_List_elementType(SEXP x); void set_List_elementType(SEXP x, const char *type); int vector_memcmp( SEXP x1, int x1_offset, SEXP x2, int x2_offset, int nelt ); void vector_memcpy( SEXP out, int out_offset, SEXP in, int in_offset, int nelt ); /* * Low-level manipulation of IRanges objects. * (see IRanges_class.c) */ SEXP get_IRanges_start(SEXP x); SEXP get_IRanges_width(SEXP x); SEXP get_IRanges_names(SEXP x); int get_IRanges_length(SEXP x); cachedIRanges cache_IRanges(SEXP x); int get_cachedIRanges_length(const cachedIRanges *cached_x); int get_cachedIRanges_elt_width(const cachedIRanges *cached_x, int i); int get_cachedIRanges_elt_start(const cachedIRanges *cached_x, int i); int get_cachedIRanges_elt_end(const cachedIRanges *cached_x, int i); SEXP get_cachedIRanges_elt_name(const cachedIRanges *cached_x, int i); cachedIRanges sub_cachedIRanges(const cachedIRanges *cached_x, int offset, int length); void set_IRanges_names(SEXP x, SEXP names); void copy_IRanges_slots(SEXP x, SEXP x0); SEXP new_IRanges(const char *classname, SEXP start, SEXP width, SEXP names); SEXP new_IRanges_from_RangeAE(const char *classname, const RangeAE *range_ae); SEXP new_list_of_IRanges_from_RangeAEAE(const char *element_type, const RangeAEAE *range_aeae); SEXP alloc_IRanges(const char *classname, int length); /* * Low-level manipulation of Grouping objects. * (see Grouping_class.c) */ SEXP get_H2LGrouping_high2low(SEXP x); SEXP get_H2LGrouping_low2high(SEXP x); SEXP get_Partitioning_names(SEXP x); SEXP get_PartitioningByEnd_end(SEXP x); SEXP new_PartitioningByEnd(const char *classname, SEXP end, SEXP names); /* * Low-level manipulation of SimpleList objects. * (see SimpleList_class.c) */ SEXP new_SimpleList(const char *classname, SEXP listData); /* * Low-level manipulation of DataFrame objects. * (see DataFrame_class.c) */ SEXP new_DataFrame(const char *classname, SEXP vars, SEXP rownames, SEXP nrows); /* * Low-level manipulation of CompressedList objects. * (see CompressedList_class.c) */ SEXP new_CompressedList(const char *classname, SEXP unlistData, SEXP partitioning); /* * Low-level manipulation of CompressedIRangesList objects. * (see CompressedIRangesList_class.c) */ cachedCompressedIRangesList cache_CompressedIRangesList(SEXP x); cachedIRanges get_cachedCompressedIRangesList_elt(const cachedCompressedIRangesList *cached_x, int i); /* * Low-level manipulation of RangedData objects. * (see RangedData_class.c) */ SEXP new_RangedData(const char *classname, SEXP ranges, SEXP values); /* * Low-level manipulation of Rle objects. * (see Rle_class.c) */ SEXP seqselect_Rle(SEXP x, const int *start, const int *width, int length); IRanges/inst/include/_IRanges_stubs.c0000644000126300012640000003142012227064500021136 0ustar00biocbuildphs_compbio#include "IRanges_interface.h" #define DEFINE_CCALLABLE_STUB(retT, stubname, Targs, args) \ typedef retT(*__ ## stubname ## _funtype__)Targs; \ retT stubname Targs \ { \ static __ ## stubname ## _funtype__ fun = NULL; \ if (fun == NULL) \ fun = (__ ## stubname ## _funtype__) R_GetCCallable("IRanges", "_" #stubname); \ return fun args; \ } /* * Using the above macro when retT (the returned type) is void will make Sun * Studio 12 C compiler unhappy. So we need to use the following macro to * handle that case. */ #define DEFINE_NOVALUE_CCALLABLE_STUB(stubname, Targs, args) \ typedef void(*__ ## stubname ## _funtype__)Targs; \ void stubname Targs \ { \ static __ ## stubname ## _funtype__ fun = NULL; \ if (fun == NULL) \ fun = (__ ## stubname ## _funtype__) R_GetCCallable("IRanges", "_" #stubname); \ fun args; \ return; \ } /* * Stubs for callables defined in sort_utils.c */ DEFINE_NOVALUE_CCALLABLE_STUB(sort_int_array, (int *x, int nelt, int desc), ( x, nelt, desc) ) DEFINE_NOVALUE_CCALLABLE_STUB(get_order_of_int_array, (const int *x, int nelt, int desc, int *out, int out_shift), ( x, nelt, desc, out, out_shift) ) DEFINE_NOVALUE_CCALLABLE_STUB(get_order_of_int_pairs, (const int *a, const int *b, int nelt, int desc, int *out, int out_shift), ( a, b, nelt, desc, out, out_shift) ) DEFINE_NOVALUE_CCALLABLE_STUB(get_order_of_int_quads, (const int *a, const int *b, const int *c, const int *d, int nelt, int desc, int *out, int out_shift), ( a, b, c, d, nelt, desc, out, out_shift) ) /* * Stubs for callables defined in hash_utils.c */ DEFINE_CCALLABLE_STUB(struct htab, new_htab, (int n), ( n) ) DEFINE_CCALLABLE_STUB(int, get_hbucket_val, (const struct htab *htab, int bucket_idx), ( htab, bucket_idx) ) DEFINE_NOVALUE_CCALLABLE_STUB(set_hbucket_val, (struct htab *htab, int bucket_idx, int val), ( htab, bucket_idx, val) ) /* * Stubs for callables defined in AEbufs.c */ DEFINE_CCALLABLE_STUB(int, get_new_buflength, (int buflength), ( buflength) ) DEFINE_CCALLABLE_STUB(int, IntAE_get_nelt, (const IntAE *int_ae), ( int_ae) ) DEFINE_CCALLABLE_STUB(int, IntAE_set_nelt, (IntAE *int_ae, int nelt), ( int_ae, nelt) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_set_val, (const IntAE *int_ae, int val), ( int_ae, val) ) DEFINE_CCALLABLE_STUB(IntAE, new_IntAE, (int buflength, int nelt, int val), ( buflength, nelt, val) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_insert_at, (IntAE *int_ae, int at, int val), ( int_ae, at, val) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_append, (IntAE *int_ae, const int *newvals, int nnewval), ( int_ae, newvals, nnewval) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_delete_at, (IntAE *int_ae, int at), ( int_ae, at) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_shift, (const IntAE *int_ae, int shift), ( int_ae, shift) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_sum_and_shift, (const IntAE *int_ae1, const IntAE *int_ae2, int shift), ( int_ae1, int_ae2, shift) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_append_shifted_vals, (IntAE *int_ae, const int *newvals, int nnewval, int shift), ( int_ae, newvals, nnewval, shift) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_qsort, (const IntAE *int_ae, int desc), ( int_ae, desc) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAE_delete_adjdups, (IntAE *int_ae), ( int_ae) ) DEFINE_CCALLABLE_STUB(SEXP, new_INTEGER_from_IntAE, (const IntAE *int_ae), ( int_ae) ) DEFINE_CCALLABLE_STUB(IntAE, new_IntAE_from_INTEGER, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(IntAE, new_IntAE_from_CHARACTER, (SEXP x, int keyshift), ( x, keyshift) ) DEFINE_CCALLABLE_STUB(int, IntAEAE_get_nelt, (const IntAEAE *int_aeae), ( int_aeae) ) DEFINE_CCALLABLE_STUB(int, IntAEAE_set_nelt, (IntAEAE *int_aeae, int nelt), ( int_aeae, nelt) ) DEFINE_CCALLABLE_STUB(IntAEAE, new_IntAEAE, (int buflength, int nelt), ( buflength, nelt) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAEAE_insert_at, (IntAEAE *int_aeae, int at, const IntAE *int_ae), ( int_aeae, at, int_ae) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAEAE_eltwise_append, (const IntAEAE *int_aeae1, const IntAEAE *int_aeae2), ( int_aeae1, int_aeae2) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAEAE_shift, (const IntAEAE *int_aeae, int shift), ( int_aeae, shift) ) DEFINE_NOVALUE_CCALLABLE_STUB(IntAEAE_sum_and_shift, (const IntAEAE *int_aeae1, const IntAEAE *int_aeae2, int shift), ( int_aeae1, int_aeae2, shift) ) DEFINE_CCALLABLE_STUB(SEXP, new_LIST_from_IntAEAE, (const IntAEAE *int_aeae, int mode), ( int_aeae, mode) ) DEFINE_CCALLABLE_STUB(IntAEAE, new_IntAEAE_from_LIST, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(SEXP, IntAEAE_toEnvir, (const IntAEAE *int_aeae, SEXP envir, int keyshift), ( int_aeae, envir, keyshift) ) DEFINE_CCALLABLE_STUB(int, RangeAE_get_nelt, (const RangeAE *range_ae), ( range_ae) ) DEFINE_CCALLABLE_STUB(int, RangeAE_set_nelt, (RangeAE *range_ae, int nelt), ( range_ae, nelt) ) DEFINE_CCALLABLE_STUB(RangeAE, new_RangeAE, (int buflength, int nelt), ( buflength, nelt) ) DEFINE_NOVALUE_CCALLABLE_STUB(RangeAE_insert_at, (RangeAE *range_ae, int at, int start, int width), ( range_ae, at, start, width) ) DEFINE_CCALLABLE_STUB(int, RangeAEAE_get_nelt, (const RangeAEAE *range_aeae), ( range_aeae) ) DEFINE_CCALLABLE_STUB(int, RangeAEAE_set_nelt, (RangeAEAE *range_aeae, int nelt), ( range_aeae, nelt) ) DEFINE_CCALLABLE_STUB(RangeAEAE, new_RangeAEAE, (int buflength, int nelt), ( buflength, nelt) ) DEFINE_NOVALUE_CCALLABLE_STUB(RangeAEAE_insert_at, (RangeAEAE *range_aeae, int at, const RangeAE *range_ae), ( range_aeae, at, range_ae) ) DEFINE_CCALLABLE_STUB(int, CharAE_get_nelt, (const CharAE *char_ae), ( char_ae) ) DEFINE_CCALLABLE_STUB(int, CharAE_set_nelt, (CharAE *char_ae, int nelt), ( char_ae, nelt) ) DEFINE_CCALLABLE_STUB(CharAE, new_CharAE, (int buflength), ( buflength) ) DEFINE_CCALLABLE_STUB(CharAE, new_CharAE_from_string, (const char *string), ( string) ) DEFINE_NOVALUE_CCALLABLE_STUB(CharAE_insert_at, (CharAE *char_ae, int at, char c), ( char_ae, at, c) ) DEFINE_NOVALUE_CCALLABLE_STUB(append_string_to_CharAE, (CharAE *char_ae, const char *string), ( char_ae, string) ) DEFINE_NOVALUE_CCALLABLE_STUB(CharAE_delete_at, (CharAE *char_ae, int at, int nelt), ( char_ae, at, nelt) ) DEFINE_CCALLABLE_STUB(SEXP, new_RAW_from_CharAE, (const CharAE *char_ae), ( char_ae) ) DEFINE_CCALLABLE_STUB(SEXP, new_LOGICAL_from_CharAE, (const CharAE *char_ae), ( char_ae) ) DEFINE_CCALLABLE_STUB(int, CharAEAE_get_nelt, (const CharAEAE *char_aeae), ( char_aeae) ) DEFINE_CCALLABLE_STUB(int, CharAEAE_set_nelt, (CharAEAE *char_aeae, int nelt), ( char_aeae, nelt) ) DEFINE_CCALLABLE_STUB(CharAEAE, new_CharAEAE, (int buflength, int nelt), ( buflength, nelt) ) DEFINE_NOVALUE_CCALLABLE_STUB(CharAEAE_insert_at, (CharAEAE *char_aeae, int at, const CharAE *char_ae), ( char_aeae, at, char_ae) ) DEFINE_NOVALUE_CCALLABLE_STUB(append_string_to_CharAEAE, (CharAEAE *char_aeae, const char *string), ( char_aeae, string) ) DEFINE_CCALLABLE_STUB(SEXP, new_CHARACTER_from_CharAEAE, (const CharAEAE *char_aeae), ( char_aeae) ) /* * Stubs for callables defined in SEXP_utils.c */ DEFINE_CCALLABLE_STUB(const char *, get_classname, (SEXP x), ( x) ) /* * Stubs for callables defined in int_utils.c */ DEFINE_CCALLABLE_STUB(int, check_integer_pairs, (SEXP a, SEXP b, const int **a_p, const int **b_p, const char *a_argname, const char *b_argname), ( a, b, a_p, b_p, a_argname, b_argname) ) /* * Stubs for callables defined in Vector_class.c */ DEFINE_CCALLABLE_STUB(const char *, get_List_elementType, (SEXP x), ( x) ) DEFINE_NOVALUE_CCALLABLE_STUB(set_List_elementType, (SEXP x, const char *type), ( x, type) ) DEFINE_CCALLABLE_STUB(int, vector_memcmp, (SEXP x1, int x1_offset, SEXP x2, int x2_offset, int nelt), ( x1, x1_offset, x2, x2_offset, nelt) ) DEFINE_NOVALUE_CCALLABLE_STUB(vector_memcpy, (SEXP out, int out_offset, SEXP in, int in_offset, int nelt), ( out, out_offset, in, in_offset, nelt) ) /* * Stubs for callables defined in IRanges_class.c */ DEFINE_CCALLABLE_STUB(SEXP, get_IRanges_start, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(SEXP, get_IRanges_width, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(SEXP, get_IRanges_names, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(int, get_IRanges_length, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(cachedIRanges, cache_IRanges, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(int, get_cachedIRanges_length, (const cachedIRanges *cached_x), ( cached_x) ) DEFINE_CCALLABLE_STUB(int, get_cachedIRanges_elt_width, (const cachedIRanges *cached_x, int i), ( cached_x, i) ) DEFINE_CCALLABLE_STUB(int, get_cachedIRanges_elt_start, (const cachedIRanges *cached_x, int i), ( cached_x, i) ) DEFINE_CCALLABLE_STUB(int, get_cachedIRanges_elt_end, (const cachedIRanges *cached_x, int i), ( cached_x, i) ) DEFINE_CCALLABLE_STUB(SEXP, get_cachedIRanges_elt_name, (const cachedIRanges *cached_x, int i), ( cached_x, i) ) DEFINE_CCALLABLE_STUB(cachedIRanges, sub_cachedIRanges, (const cachedIRanges *cached_x, int offset, int length), ( cached_x, offset, length) ) DEFINE_NOVALUE_CCALLABLE_STUB(set_IRanges_names, (SEXP x, SEXP names), ( x, names) ) DEFINE_NOVALUE_CCALLABLE_STUB(copy_IRanges_slots, (SEXP x, SEXP x0), ( x, x0) ) DEFINE_CCALLABLE_STUB(SEXP, new_IRanges, (const char *classname, SEXP start, SEXP width, SEXP names), ( classname, start, width, names) ) DEFINE_CCALLABLE_STUB(SEXP, new_IRanges_from_RangeAE, (const char *classname, const RangeAE *range_ae), ( classname, range_ae) ) DEFINE_CCALLABLE_STUB(SEXP, new_list_of_IRanges_from_RangeAEAE, (const char *element_type, const RangeAEAE *range_aeae), ( element_type, range_aeae) ) DEFINE_CCALLABLE_STUB(SEXP, alloc_IRanges, (const char *classname, int length), ( classname, length) ) /* * Stubs for callables defined in Grouping_class.c */ DEFINE_CCALLABLE_STUB(SEXP, get_H2LGrouping_high2low, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(SEXP, get_H2LGrouping_low2high, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(SEXP, get_Partitioning_names, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(SEXP, get_PartitioningByEnd_end, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(SEXP, new_PartitioningByEnd, (const char *classname, SEXP end, SEXP names), ( classname, end, names) ) /* * Stubs for callables defined in SimpleList_class.c */ DEFINE_CCALLABLE_STUB(SEXP, new_SimpleList, (const char *classname, SEXP listData), ( classname, listData) ) /* * Stubs for callables defined in DataFrame_class.c */ DEFINE_CCALLABLE_STUB(SEXP, new_DataFrame, (const char *classname, SEXP vars, SEXP rownames, SEXP nrows), ( classname, vars, rownames, nrows) ) /* * Stubs for callables defined in CompressedList_class.c */ DEFINE_CCALLABLE_STUB(SEXP, new_CompressedList, (const char *classname, SEXP unlistData, SEXP partitioning), ( classname, unlistData, partitioning) ) /* * Stubs for callables defined in CompressedIRangesList_class.c */ DEFINE_CCALLABLE_STUB(cachedCompressedIRangesList, cache_CompressedIRangesList, (SEXP x), ( x) ) DEFINE_CCALLABLE_STUB(cachedIRanges, get_cachedCompressedIRangesList_elt, (const cachedCompressedIRangesList *cached_x, int i), ( cached_x, i) ) /* * Stubs for callables defined in RangedData_class.c */ DEFINE_CCALLABLE_STUB(SEXP, new_RangedData, (const char *classname, SEXP ranges, SEXP values), ( classname, ranges, values) ) /* * Stubs for callables defined in Rle_class.c */ DEFINE_CCALLABLE_STUB(SEXP, seqselect_Rle, (SEXP x, const int *start, const int *width, int length), ( x, start, width, length) ) IRanges/inst/unitTests/0000755000126300012640000000000012234041342016437 5ustar00biocbuildphs_compbioIRanges/inst/unitTests/test_AtomicList.R0000644000126300012640000002537412234041342021704 0ustar00biocbuildphs_compbiotest_AtomicList_constructors <- function() { subclasses <- c(logical="LogicalList", integer="IntegerList", #double="NumericList", numeric="NumericList", complex="ComplexList", character="CharacterList", raw="RawList", Rle="RleList") for (elt_type in names(subclasses)) { subclass <- subclasses[[elt_type]] constructor <- get(subclass) vec1 <- get(elt_type)(6) vec2 <- get(elt_type)(8) target <- list(A=vec1, B=vec2) for (compress in c(TRUE, FALSE)) { current <- constructor(A=vec1, B=vec2, compress=compress) checkTrue(is(current, subclass)) checkIdentical(compress, is(current, "CompressedList")) checkIdentical(elt_type, elementType(current)) checkIdentical(target, as.list(current)) checkIdentical(unname(target), as.list(current, use.names=FALSE)) } } } test_AtomicList_GroupGenerics <- function() { vec1 <- c(1L,2L,3L,5L,2L,8L) vec2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { for (type in c("IntegerList", "RleList")) { list1 <- do.call(type, list(one = vec1, vec2, compress = compress)) checkIdentical(as.list(list1 + list1), Map("+", list1, list1)) checkIdentical(as.list(log(list1)), lapply(list1, log)) checkIdentical(as.list(round(sqrt(list1))), lapply(list1, function(x) round(sqrt(x)))) checkIdentical(sum(list1), sapply(list1, sum)) } } } test_AtomicList_general <- function() { vec1 <- c(1L,2L,NA,3L,NA,5L,2L,8L) vec2 <- c(NA,15L,45L,20L,NA,1L,15L,100L,80L,5L,NA) for (compress in c(TRUE, FALSE)) { for (type in c("IntegerList", "RleList")) { list1 <- do.call(type, list(one = vec1, vec2, compress = compress)) checkIdentical(as.list(list1 %in% c(1L, 5L)), lapply(list1, "%in%", c(1L, 5L))) checkIdentical(lapply(list1 %in% IntegerList(one = vec1, vec2, compress = compress), as.vector), mapply("%in%", lapply(list1, as.vector), list(one = vec1, vec2))) checkIdentical(as.list(is.na(list1)), lapply(list1, is.na)) checkIdentical(as.list(match(list1, c(1L, 5L))), lapply(list1, match, c(1L, 5L))) checkIdentical(lapply(match(list1, IntegerList(one = vec1, vec2, compress = compress)), as.vector), mapply(match, lapply(list1, as.vector), list(one = vec1, vec2))) checkIdentical(as.list(sort(list1)), lapply(list1, sort)) checkIdentical(as.list(unique(list1)), lapply(list1, unique)) } } } test_AtomicList_logical <- function() { vec1 <- c(TRUE,NA,FALSE, NA) vec2 <- c(TRUE,TRUE,FALSE,FALSE,TRUE,FALSE,TRUE,TRUE,TRUE) for (compress in c(TRUE, FALSE)) { for (type in c("LogicalList", "RleList")) { list1 <- do.call(type, list(one = vec1, vec2, compress = compress)) checkIdentical(as.list(!list1), lapply(list1, "!")) checkIdentical(as.list(which(list1)), lapply(list1, which)) } } } test_AtomicList_numerical <- function() { vec1 <- c(1L,2L,NA,3L,NA,5L,2L,8L) vec2 <- c(NA,15L,45L,20L,NA,1L,15L,100L,80L,5L,NA) for (compress in c(TRUE, FALSE)) { for (type in c("IntegerList", "RleList")) { list1 <- do.call(type, list(one = vec1, vec2, compress = compress)) list2 <- endoapply(list1, rev) checkIdentical(as.list(diff(list1)), lapply(list1, diff)) checkIdentical(as.list(pmax(list1, list2)), mapply(pmax, list1, list2)) checkIdentical(as.list(pmin(list1, list2)), mapply(pmin, list1, list2)) checkIdentical(as.list(pmax.int(list1, list2)), mapply(pmax.int, list1, list2)) checkIdentical(as.list(pmin.int(list1, list2)), mapply(pmin.int, list1, list2)) checkIdentical(mean(list1, na.rm=TRUE), sapply(list1, mean, na.rm=TRUE)) checkIdentical(var(list1, na.rm=TRUE), sapply(list1, var, na.rm=TRUE)) checkIdentical(cov(list1, list2, use="complete.obs"), mapply(cov, list1, list2, MoreArgs = list(use="complete.obs"))) checkIdentical(cor(list1, list2, use="complete.obs"), mapply(cor, list1, list2, MoreArgs = list(use="complete.obs"))) checkIdentical(sd(list1, na.rm=TRUE), sapply(list1, sd, na.rm=TRUE)) checkIdentical(median(list1, na.rm=TRUE), sapply(list1, median, na.rm=TRUE)) checkIdentical(quantile(list1, na.rm=TRUE), sapply(list1, quantile, na.rm=TRUE)) checkIdentical(mad(list1, na.rm=TRUE), sapply(list1, mad, na.rm=TRUE)) checkIdentical(IQR(list1, na.rm=TRUE), sapply(list1, IQR, na.rm=TRUE)) vec3 <- (-20:20)^2 vec3[c(1,10,21,41)] <- c(100L, 30L, 400L, 470L) list3 <- do.call(type, list(one = vec3, rev(vec3), compress = compress)) checkIdentical(as.list(smoothEnds(list3)), lapply(list3, smoothEnds)) checkIdentical(as.list(runmed(list3, 7)), lapply(list3, function(x) { y <- runmed(x, 7) if (type != "RleList") y <- as.vector(y) y })) } } } test_AtomicList_character <- function() { txt <- c("The", "licenses", "for", "most", "software", "are", "designed", "to", "take", "away", "your", "freedom", "to", "share", "and", "change", "it.", "", "By", "contrast,", "the", "GNU", "General", "Public", "License", "is", "intended", "to", "guarantee", "your", "freedom", "to", "share", "and", "change", "free", "software", "--", "to", "make", "sure", "the", "software", "is", "free", "for", "all", "its", "users") for (compress in c(TRUE, FALSE)) { for (type in c("CharacterList", "RleList")) { list1 <- do.call(type, list(one = txt, rev(txt), compress = compress)) checkIdentical(as.list(nchar(list1)), lapply(list1, nchar)) checkIdentical(as.list(chartr("@!*", "alo", list1)), lapply(list1, chartr, old="@!*", new="alo")) checkIdentical(as.list(tolower(list1)), lapply(list1, tolower)) checkIdentical(as.list(toupper(list1)), lapply(list1, toupper)) checkIdentical(as.list(sub("[b-e]",".", list1)), lapply(list1, sub, pattern="[b-e]", replacement=".")) checkIdentical(as.list(gsub("[b-e]",".", list1)), lapply(list1, gsub, pattern="[b-e]", replacement=".")) } } } test_RleList_methods <- function() { x1 <- RleList(11:15, 15L, integer(0), 15:16, compress=FALSE) x2 <- RleList(11:15, 15L, integer(0), 15:16, compress=TRUE) checkIdentical(runValue(x1), runValue(x2)) checkIdentical(runLength(x1), runLength(x2)) checkIdentical(ranges(x1), ranges(x2)) ## na.rm x <- RleList(c(NA,1,1), c(1L,NA_integer_,1L), c(1,Inf,1,-Inf),compress=TRUE) target <- RleList(c(1,2), c(1L,1L), c(Inf,Inf,-Inf)) current <- runsum(x,2, na.rm = TRUE) checkIdentical(target, current) target <- RleList(c(NA,2), c(NA_integer_,NA_integer_), c(Inf,Inf,-Inf)) current <- runsum(x,2, na.rm = FALSE) checkIdentical(target, current) target <- RleList(c(2,4), c(2,2), c(Inf, Inf, -Inf)) current <- runwtsum(x,2, c(2,2), na.rm = TRUE) checkIdentical(target, current) target <- RleList(c(NA,4), c(NA_real_,NA_real_), c(Inf,Inf,-Inf)) current <- runwtsum(x,2, c(2,2), na.rm = FALSE) checkIdentical(target, current) target <- RleList(c(1,1), c(1,1), c(Inf,Inf,-Inf)) current <- runmean(x, 2, na.rm = TRUE) checkIdentical(target, current) target <- RleList(c(NA,1), c(NA_real_, NA_real_), c(Inf, Inf, -Inf)) current <- runmean(x, 2, na.rm = FALSE) checkIdentical(target, current) x <- RleList(c(NA,1,2), c(2L,NA_integer_,1L), c(1,Inf,1,-Inf),compress=TRUE) target <- RleList(c(1,2), c(2L,1L), c(Inf,Inf,1)) current <- runq(x, 2, 2, na.rm = TRUE) checkIdentical(target, current) target <- RleList(c(NA,2), c(NA_integer_, NA_integer_), c(Inf, Inf, 1)) current <- runq(x, 2, 2, na.rm = FALSE) checkIdentical(target, current) ## Binary operations between an RleList and an atomic vector: a1 <- Rle(1, 999722111) a2 <- 20 * a1 a <- RleList(a1, a2, compress=TRUE) b1 <- c(a1, a1) b2 <- 20 * b1 b <- RleList(b1, b2, compress=FALSE) ## FIXME: 'a1 <= 19:21' is taking forever and eats up all the memory in ## BioC <= 2.12! Seems like 'a1' is expanded to integer vector first, which ## is not good :-/ #for (y in list(8L, 8, 19:21)) { for (y in list(8L, 8)) { ## With a CompressedRleList target <- RleList(a1 <= y, a2 <= y, compress=TRUE) current <- a <= y checkIdentical(target, current) target <- RleList(a1 + y, a2 + y, compress=TRUE) current <- a + y checkIdentical(target, current) target <- RleList(a1 * y, a2 * y, compress=TRUE) current <- a * y checkIdentical(target, current) target <- RleList(a1 / y, a2 / y, compress=TRUE) current <- a / y checkIdentical(target, current) ## With a SimpleRleList target <- RleList(b1 <= y, b2 <= y, compress=FALSE) current <- b <= y checkIdentical(target, current) target <- RleList(b1 + y, b2 + y, compress=FALSE) current <- b + y checkIdentical(target, current) target <- RleList(b1 * y, b2 * y, compress=FALSE) current <- b * y checkIdentical(target, current) target <- RleList(b1 / y, b2 / y, compress=FALSE) current <- b / y checkIdentical(target, current) } } IRanges/inst/unitTests/test_DataFrame.R0000644000126300012640000003461412227064500021460 0ustar00biocbuildphs_compbiotest_DataFrame_construction <- function() { score <- c(X=1L, Y=3L, Z=NA) counts <- c(10L, 2L, NA) ## na in rn checkException(DataFrame(score, row.names = c("a", NA, "b")), silent = TRUE) ## invalid rn length checkException(DataFrame(score, row.names = "a"), silent = TRUE) ## dups in rn checkException(DataFrame(score, row.names = c("a", "b", "a")), silent = TRUE) DF <- DataFrame() # no args checkTrue(validObject(DF)) row.names <- c("one", "two", "three") DF <- DataFrame(row.names = row.names) # no args, but row.names checkTrue(validObject(DF)) checkIdentical(rownames(DF), row.names) DF <- DataFrame(score) # single, unnamed arg checkTrue(validObject(DF)) checkIdentical(DF[["score"]], score) DF <- DataFrame(score, row.names = row.names) #with row names checkTrue(validObject(DF)) checkIdentical(rownames(DF), row.names) DF <- DataFrame(vals = score) # named vector arg checkTrue(validObject(DF)) checkIdentical(DF[["vals"]], score) DF <- DataFrame(counts, vals = score) # mixed named and unnamed checkTrue(validObject(DF)) checkIdentical(DF[["vals"]], score) checkIdentical(DF[["counts"]], counts) DF <- DataFrame(score + score) # unnamed arg with invalid name expression checkTrue(validObject(DF)) checkIdentical(DF[["score...score"]], score + score) mat <- cbind(score) DF <- DataFrame(mat) # single column matrix with column name checkTrue(validObject(DF)) checkIdentical(DF[["score"]], unname(score)) mat <- cbind(score, counts) DF <- DataFrame(mat) # two column matrix with col names checkTrue(validObject(DF)) checkIdentical(DF[["score"]], unname(score)) checkIdentical(DF[["counts"]], counts) colnames(mat) <- NULL DF <- DataFrame(mat) # two column matrix without col names checkTrue(validObject(DF)) checkIdentical(DF[["V1"]], unname(score)) sw <- DataFrame(swiss, row.names = rownames(swiss)) # a data.frame checkIdentical(as.data.frame(sw), swiss) rownames(swiss) <- NULL # strip row names to make them comparable sw <- DataFrame(swiss) # a data.frame checkIdentical(as.data.frame(sw), swiss) sw <- DataFrame(swiss[1:3,], score = unname(score)) checkIdentical(as.data.frame(sw), data.frame(swiss[1:3,], score)) sw <- DataFrame(score = score, swiss = swiss[1:3,]) # named data.frame/matrix checkIdentical(as.data.frame(sw), data.frame(score = score, swiss = swiss[1:3,])) ## identity df <- DataFrame(A=I(list(1:3))) checkIdentical(as.data.frame(df), data.frame(A=I(list(1:3)))) ## recycling DF <- DataFrame(1, score) checkIdentical(DF[[1]], rep(1, 3)) checkIdentical(DF[[2]], score) } test_DataFrame_coerce <- function() { ## need to introduce character() dim names checkTrue(validObject(as(matrix(0L, 0L, 0L), "DataFrame"))) score <- c(X=1L, Y=3L, Z=NA) DF <- as(score, "DataFrame") checkTrue(validObject(DF)) checkIdentical(DF[[1]], score) } test_DataFrame_subset <- function() { data(swiss) sw <- DataFrame(swiss) rn <- rownames(swiss) checkException(sw[list()], silent = TRUE) # non-atomic checkException(sw[NA], silent = TRUE) # column indices cannot be NA checkException(sw[100], silent = TRUE) # out of bounds col checkException(sw[,100], silent = TRUE) checkException(sw[1000,], silent = TRUE) # out of bounds row options(warn=2) checkException(sw[1:3, drop=TRUE], silent = TRUE) # drop ignored checkException(sw[drop=TRUE], silent = TRUE) checkException(sw[foo = "bar"], silent = TRUE) # invalid argument ##options(warn=0) checkException(sw[,"Fert"], silent = TRUE) # bad column name sw <- DataFrame(swiss) checkIdentical(sw[], sw) # identity subset checkIdentical(sw[,], sw) checkIdentical(sw[NULL], DataFrame(swiss[NULL])) # NULL subsetting checkIdentical(sw[,NULL], DataFrame(swiss[,NULL])) checkIdentical(as.data.frame(sw[NULL,]), structure(data.frame(swiss[NULL,]), row.names = character())) rownames(sw) <- rn ## select columns checkIdentical(as.data.frame(sw[1:3]), swiss[1:3]) checkIdentical(as.data.frame(sw[, 1:3]), swiss[1:3]) ## select rows checkIdentical(as.data.frame(sw[1:3,]), swiss[1:3,]) checkIdentical(as.data.frame(sw[1:3,]), swiss[1:3,]) checkIdentical(as.data.frame(sw[sw[["Education"]] == 7,]), swiss[swiss[["Education"]] == 7,]) checkIdentical(as.data.frame(sw[Rle(sw[["Education"]] == 7),]), swiss[swiss[["Education"]] == 7,]) ## select rows and columns checkIdentical(as.data.frame(sw[4:5, 1:3]), swiss[4:5,1:3]) checkIdentical(as.data.frame(sw[1]), swiss[1]) # a one-column data frame checkIdentical(sw[,"Fertility"], swiss[,"Fertility"]) ## the same checkIdentical(as.data.frame(sw[, 1, drop = FALSE]), swiss[, 1, drop = FALSE]) checkIdentical(sw[, 1], swiss[,1]) # a (unnamed) vector checkIdentical(sw[[1]], swiss[[1]]) # the same checkIdentical(sw[["Fertility"]], swiss[["Fertility"]]) checkIdentical(sw[["Fert"]], swiss[["Fert"]]) # should return 'NULL' checkIdentical(sw[,c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE)], swiss[,c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE)]) checkIdentical(as.data.frame(sw[1,]), swiss[1,]) # a one-row data frame checkIdentical(sw[1,, drop=TRUE], swiss[1,, drop=TRUE]) # a list ## duplicate row, unique row names are created checkIdentical(as.data.frame(sw[c(1, 1:2),]), swiss[c(1,1:2),]) ## NOTE: NA subsetting not yet supported for XVectors ##checkIdentical(as.data.frame(sw[c(1, NA, 1:2, NA),]), # mixin some NAs ## swiss[c(1, NA, 1:2, NA),]) checkIdentical(as.data.frame(sw["Courtelary",]), swiss["Courtelary",]) subswiss <- swiss[1:5,1:4] subsw <- sw[1:5,1:4] checkIdentical(as.data.frame(subsw["C",]), subswiss["C",]) # partially matches ## NOTE: NA subsetting not yet supported for XVectors ##checkIdentical(as.data.frame(subsw["foo",]), # bad row name ## subswiss["foo",]) ##checkIdentical(as.data.frame(sw[match("C", row.names(sw)), ]), ## swiss[match("C", row.names(sw)), ]) # no exact match } test_DataFrame_dimnames_replace <- function() { data(swiss) cn <- paste("X", seq_len(ncol(swiss)), sep = ".") sw <- DataFrame(swiss) colnames(sw) <- cn checkIdentical(colnames(sw), cn) cn <- as.character(seq_len(ncol(swiss))) colnames(sw) <- cn colnames(swiss) <- cn checkIdentical(colnames(sw), colnames(swiss)) colnames(sw) <- cn[1] colnames(swiss) <- cn[1] checkIdentical(colnames(sw), colnames(swiss)) rn <- seq(nrow(sw)) rownames(sw) <- rn checkIdentical(rownames(sw), as.character(rn)) checkException(rownames(sw) <- rn[1], silent = TRUE) checkException(rownames(sw) <- rep(rn[1], nrow(sw)), silent = TRUE) rn[1] <- NA checkException(rownames(sw) <- rn, silent = TRUE) } test_DataFrame_replace <- function() { score <- c(1L, 3L, NA) counts <- c(10L, 2L, NA) DF <- DataFrame(score) # single, unnamed arg DF[["counts"]] <- counts checkIdentical(DF[["counts"]], counts) DF[[3]] <- score checkIdentical(DF[["X"]], score) DF[[3]] <- NULL # deletion DF[["counts"]] <- NULL DF$counts <- counts checkIdentical(DF$counts, counts) checkException(DF[[13]] <- counts, silent = TRUE) # index must be < length+1 checkException(DF[["tooshort"]] <- counts[1:2], silent = TRUE) sw <- DataFrame(swiss, row.names = rownames(swiss)) # a data.frame sw1 <- sw; swiss1 <- swiss sw1[] <- 1L; swiss1[] <- 1L checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[] <- 1; swiss1[] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["Education"] <- 1; swiss1["Education"] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[,"Education"] <- 1; swiss1[,"Education"] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["Courtelary",] <- 1; swiss1["Courtelary",] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[1:3] <- 1; swiss1[1:3] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[,1:3] <- 1; swiss1[,1:3] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[2:4,1:3] <- 1; swiss1[2:4,1:3] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[2:4,-c(2,4,5)] <- 1; swiss1[2:4,-c(2,4,5)] <- 1 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[,1:3] <- sw1[,2:4]; swiss1[,1:3] <- swiss1[,2:4] checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[2:4,] <- sw1[1:3,]; swiss1[2:4,] <- swiss1[1:3,] checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[2:4,1:3] <- sw1[1:3,2:4]; swiss1[2:4,1:3] <- swiss1[1:3,2:4] checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["NewCity",] <- NA; swiss1["NewCity",] <- NA checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[nrow(sw1)+(1:2),] <- NA; swiss1[nrow(swiss1)+(1:2),] <- NA checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["NewCol"] <- seq(nrow(sw1)); swiss1["NewCol"] <- seq(nrow(sw1)) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[ncol(sw1)+1L] <- seq(nrow(sw1)); swiss1[ncol(swiss1)+1L] <- seq(nrow(sw1)) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[,"NewCol"] <- seq(nrow(sw1)); swiss1[,"NewCol"] <- seq(nrow(sw1)) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["NewCity","NewCol"] <- 0 swiss1["NewCity","NewCol"] <- 0 checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["NewCity",] <- DataFrame(NA); swiss1["NewCity",] <- data.frame(NA) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[nrow(sw1)+(1:2),] <- DataFrame(NA) swiss1[nrow(swiss1)+(1:2),] <- data.frame(NA) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["NewCol"] <- DataFrame(seq(nrow(sw1))) swiss1["NewCol"] <- data.frame(seq(nrow(sw1))) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[ncol(sw1)+1L] <- DataFrame(seq(nrow(sw1))) swiss1[ncol(swiss1)+1L] <- data.frame(seq(nrow(sw1))) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1[,"NewCol"] <- DataFrame(seq(nrow(sw1))) swiss1[,"NewCol"] <- data.frame(seq(nrow(sw1))) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw; swiss1 <- swiss sw1["NewCity","NewCol"] <- DataFrame(0) swiss1["NewCity","NewCol"] <- data.frame(0) checkIdentical(as.data.frame(sw1), swiss1) sw1 <- sw mcols(sw1) <- DataFrame(id = seq_len(ncol(sw1))) sw1["NewCol"] <- DataFrame(seq(nrow(sw1))) checkIdentical(mcols(sw1, use.names=TRUE), DataFrame(id = c(seq_len(ncol(sw1)-1), NA), row.names = colnames(sw1))) } ## splitting and combining test_DataFrame_combine <- function() { data(swiss) sw <- DataFrame(swiss, row.names=rownames(swiss)) rn <- rownames(swiss) ## split swsplit <- split(sw, sw[["Education"]]) checkTrue(validObject(swsplit)) swisssplit <- split(swiss, swiss$Education) checkIdentical(as.list(lapply(swsplit, as.data.frame)), swisssplit) checkTrue(validObject(split(DataFrame(IRanges(1:26, 1:26), LETTERS), letters))) ## rbind checkIdentical(rbind(DataFrame(), DataFrame()), DataFrame()) score <- c(X=1L, Y=3L, Z=NA) DF <- DataFrame(score) checkIdentical(rbind(DF, DF)[[1]], c(score, score)) zr <- sw[FALSE,] checkIdentical(rbind(DataFrame(), zr, zr[,1:2]), zr) checkIdentical(as.data.frame(rbind(DataFrame(), zr, sw)), swiss) swissrbind <- do.call(rbind, swisssplit) rownames(swissrbind) <- NULL rownames(sw) <- NULL swsplit <- split(sw, sw[["Education"]]) checkIdentical(as.data.frame(do.call(rbind, as.list(swsplit))), swissrbind) DF <- DataFrame(A=I(list(1:3))) df <- as.data.frame(DF) checkIdentical(as.data.frame(rbind(DF, DF)), rbind(df, df)) ## combining factors df1 <- data.frame(species = c("Mouse", "Chicken"), n = c(5, 6)) DF1 <- DataFrame(df1) df2 <- data.frame(species = c("Human", "Chimp"), n = c(1, 2)) DF2 <- DataFrame(df2) df12 <- rbind(df1, df2) rownames(df12) <- NULL checkIdentical(as.data.frame(rbind(DF1, DF2)), df12) rownames(sw) <- rn checkIdentical(rownames(rbind(sw, DataFrame(swiss))), rownames(rbind(swiss, swiss))) swsplit <- split(sw, sw[["Education"]]) rownames(swiss) <- rn swisssplit <- split(swiss, swiss$Education) checkIdentical(rownames(do.call(rbind, as.list(swsplit))), unlist(lapply(swisssplit, rownames), use.names=FALSE)) checkException(rbind(sw[,1:2], sw), silent = TRUE) other <- sw colnames(other)[1] <- "foo" checkException(rbind(other, sw), silent = TRUE) } test_DataFrame_looping <- function() { data(iris) actual <- by(iris, iris$Species, nrow) ## a bit tricky because of the 'call' attribute attr(actual, "call")[[1]] <- as.name("by") iris <- DataFrame(iris, row.names=rownames(iris)) checkIdentical(actual, by(iris, iris$Species, nrow)) } test_DataFrame_annotation <- function() { df <- DataFrame(x = c(1L, 3L, NA), y = c(10L, 2L, NA)) mcols(df) <- DataFrame(a = 1:2) checkIdentical(mcols(df)[,1], 1:2) checkIdentical(mcols(df[2:1])[,1], 2:1) checkIdentical(mcols(cbind(df,df))[,1], rep(1:2,2)) df$z <- 1:3 checkIdentical(mcols(df, use.names=TRUE), DataFrame(a = c(1L, 2L, NA), row.names = c("x", "y", "z"))) } ## '[<-' setter test_DataFrame_Setter <- function() { .SingleBracket <- function(df0, df1, idx) { target <- df0 for (i in seq_len(length(df0))[idx]) target[[i]] <- df1[[i]] df <- df0 df[idx] <- df1[idx] stopifnot(identical(target, df)) df <- DataFrame(df0) df[idx] <- DataFrame(df1)[idx] if (!identical(DataFrame(target), df)) FALSE else TRUE } df0 <- data.frame(x=11:12, y=21:22, z=31:32) df1 <- data.frame(matrix(LETTERS[1:6], ncol=3)) checkTrue(.SingleBracket(df0, df1, c(FALSE, FALSE, TRUE))) checkTrue(.SingleBracket(df0, df1, c(TRUE, FALSE, TRUE))) checkTrue(.SingleBracket(df0, df1, c(TRUE, TRUE, TRUE))) checkTrue(.SingleBracket(df0, df1, TRUE)) target <- df0 target[] <- df1[] df <- DataFrame(df0) df[] <- DataFrame(df1)[] checkIdentical(DataFrame(target), df) for (i in c('a', 'c', 'e')) { DF <- DataFrame(A=1:5, row.names=letters[1:5]) df <- data.frame(A=1:5, row.names=letters[1:5]) DF[i, 'B'] <- df[i, 'B'] <- 1 checkIdentical(as.data.frame(DF), df) } } IRanges/inst/unitTests/test_DataFrameList.R0000644000126300012640000001635612227064500022317 0ustar00biocbuildphs_compbiotest_DataFrameList_construction <- function() { checkDFL2dfl <- function(DFL, dfl) { checkIdentical(lapply(as.list(DFL), as.data.frame), dfl) } data(airquality) data(swiss) checkDFL2dfl(DataFrameList(swiss, airquality), list(swiss, airquality)) } test_SplitDataFrameList_construction <- function() { checkDFL2dfl <- function(DFL, dfl) { checkIdentical(lapply(as.list(DFL), as.data.frame), dfl) } striprownames <- function(x) { lapply(x, function(y) { rownames(y) <- NULL y }) } data(airquality) data(swiss) aq <- DataFrame(airquality) sw <- DataFrame(swiss, row.names=rownames(swiss)) aqsplit1 <- split(aq, aq[["Month"]]) aqsplit2 <- SplitDataFrameList(lapply(split(airquality, airquality[["Month"]]), as, "DataFrame")) checkIdentical(aqsplit1, aqsplit2) swsplit1 <- split(sw, sw[["Education"]]) swsplit2 <- SplitDataFrameList(lapply(split(swiss, swiss[["Education"]]), as, "DataFrame")) checkIdentical(swsplit1, swsplit2) for (compress in c(TRUE, FALSE)) { airqualitysplit <- striprownames(split(airquality, airquality[["Month"]])) aqsplit <- SplitDataFrameList(as.list(split(aq, aq[["Month"]])), compress = compress) checkDFL2dfl(aqsplit, airqualitysplit) swisssplit <- split(swiss, swiss[["Education"]]) swsplit <- SplitDataFrameList(as.list(split(sw, sw[["Education"]])), compress = compress) checkDFL2dfl(swsplit, swisssplit) } } test_DataFrameList_subset <- function() { checkDFL2dfl <- function(DFL, dfl) { checkIdentical(lapply(as.list(DFL), as.data.frame), dfl) } data(airquality) data(swiss) DFL1 <- DataFrameList(swiss, airquality) dfl1 <- list(swiss, airquality) checkDFL2dfl(DFL1[], dfl1[]) checkDFL2dfl(DFL1[1], dfl1[1]) checkDFL2dfl(DFL1[2:1], dfl1[2:1]) checkIdentical(as.data.frame(DFL1[[2]]), airquality) checkException(DFL1[[3]], silent = TRUE) DFL2 <- DataFrameList(s = swiss, a = airquality) dfl2 <- list(s = swiss, a = airquality) checkDFL2dfl(DFL2[], dfl2[]) checkDFL2dfl(DFL2[1], dfl2[1]) checkDFL2dfl(DFL2["a"], dfl2["a"]) checkDFL2dfl(DFL2[c("a", "s")], dfl2[c("a", "s")]) checkIdentical(as.data.frame(DFL2[["a"]]), airquality) checkIdentical(DFL2[["z"]], NULL) } test_SplitDataFrameList_subset <- function() { checkDFL2dfl <- function(DFL, dfl) { checkIdentical(lapply(as.list(DFL), as.data.frame), dfl) } data(swiss) sw <- DataFrame(swiss, row.names = rownames(swiss)) for (compress in c(TRUE, FALSE)) { swsplit <- SplitDataFrameList(as.list(split(sw, sw[["Education"]])), compress = compress) swisssplit <- split(swiss, swiss[["Education"]]) checkDFL2dfl(swsplit[], swisssplit[]) checkDFL2dfl(swsplit[1], swisssplit[1]) checkDFL2dfl(swsplit[2:1], swisssplit[2:1]) checkIdentical(as.data.frame(swsplit[[2]]), swisssplit[[2]]) checkIdentical(swsplit[["A"]], NULL) checkException(swsplit[[30]], silent = TRUE) checkIdentical(as.list(swsplit[,1]), split(swiss[[1]], swiss[["Education"]])) checkIdentical(as.list(swsplit[,"Examination"]), split(swiss[["Examination"]], swiss[["Education"]])) } } test_SplitDataFrameList_as_data.frame <- function() { checkDFL2dfl <- function(DFL, dfl) { df <- data.frame(name = factor(rep(seq_len(length(dfl)), unlist(lapply(dfl, nrow), use.names = FALSE)), labels = names(dfl)), do.call(rbind, dfl)) rownames(df) <- unlist(lapply(dfl, row.names), use.names = FALSE) checkIdentical(as.data.frame(DFL), df) } data(swiss) sw <- DataFrame(swiss, row.names = rownames(swiss)) for (compress in c(TRUE, FALSE)) { swsplit <- SplitDataFrameList(as.list(split(sw, sw[["Education"]])), compress = compress) swisssplit <- split(swiss, swiss[["Education"]]) checkDFL2dfl(swsplit, swisssplit) } } test_DataFrameList_replace <- function() { checkDFL2dfl <- function(DFL, dfl) { checkIdentical(lapply(as.list(DFL), as.data.frame), dfl) } data(airquality) data(swiss) DFL1 <- DataFrameList(swiss, airquality) dfl1 <- list(swiss, airquality) DFL1[] <- DFL1[1] dfl1[] <- dfl1[1] checkDFL2dfl(DFL1, dfl1) DFL1 <- DataFrameList(swiss, airquality) dfl1 <- list(swiss, airquality) DFL1[2] <- DFL1[1] dfl1[2] <- dfl1[1] checkDFL2dfl(DFL1, dfl1) DFL1 <- DataFrameList(swiss, airquality) dfl1 <- list(swiss, airquality) DFL1[[1]][[1]] <- DFL1[[1]][[1]] + 1L dfl1[[1]][[1]] <- dfl1[[1]][[1]] + 1L checkDFL2dfl(DFL1, dfl1) } test_SplitDataFrameList_replace <- function() { checkDFL2dfl <- function(DFL, dfl) { checkIdentical(lapply(as.list(DFL), as.data.frame), dfl) } striprownames <- function(x) { lapply(x, function(y) { rownames(y) <- NULL y }) } data(airquality) data(swiss) swiss2 <- swiss rownames(swiss2) <- NULL sw2 <- DataFrame(swiss2) for (compress in c(TRUE, FALSE)) { swiss2split <- striprownames(split(swiss2, swiss2[["Education"]])) sw2split <- SplitDataFrameList(as.list(split(sw2, sw2[["Education"]])), compress = compress) swiss2split[] <- swiss2split[1] sw2split[] <- sw2split[1] checkDFL2dfl(sw2split, swiss2split) swiss2split <- striprownames(split(swiss2, swiss2[["Education"]])) sw2split <- SplitDataFrameList(as.list(split(sw2, sw2[["Education"]])), compress = compress) swiss2split[c(2, 4, 5)] <- swiss2split[1] sw2split[c(2, 4, 5)] <- sw2split[1] checkDFL2dfl(sw2split, swiss2split) swiss2split <- striprownames(split(swiss2, swiss2[["Education"]])) swiss2split <- lapply(swiss2split, function(x) {x[["Examination"]] <- x[["Examination"]] + 1L; x}) sw2split <- SplitDataFrameList(as.list(split(sw2, sw2[["Education"]])), compress = compress) sw2split[,"Examination"] <- sw2split[,"Examination"] + 1L checkDFL2dfl(sw2split, swiss2split) swiss2split <- striprownames(split(swiss2, swiss2[["Education"]])) swiss2split <- lapply(swiss2split, function(x) { x[["Examination"]][x[["Examination"]] > 22] <- x[["Examination"]][x[["Examination"]] > 22] + 1L x }) sw2split <- SplitDataFrameList(as.list(split(sw2, sw2[["Education"]])), compress = compress) sw2split[sw2split[, "Examination"] > 22, "Examination"] <- sw2split[sw2split[, "Examination"] > 22,"Examination"] + 1L checkDFL2dfl(sw2split, swiss2split) } } IRanges/inst/unitTests/test_DataTable.R0000644000126300012640000000176412227064500021455 0ustar00biocbuildphs_compbiotest_DataTable_basic <- function() { x <- DataFrame(a = 1:10, b = 11:20) y <- as.data.frame(x) checkIdentical(x[,1], y[,1]) checkIdentical(as.data.frame(x[,2:1]), y[,2:1]) # checkIdentical(as.data.frame(cbind(x,x)), cbind(y,y)) checkIdentical(dim(x), dim(y)) checkIdentical(nrow(x), nrow(y)) checkIdentical(ncol(x), ncol(y)) checkIdentical(as.data.frame(head(x)), head(y)) checkIdentical(as.data.frame(rbind(x,x)), rbind(y,y)) # checkIdentical(as.data.frame(tail(x)), tail(y)) } test_DataTable_subset <- function() { y <- airquality rownames(y) <- as.character(seq_len(nrow(y))) x <- as(y, "DataFrame") checkIdentical(as.data.frame(subset(x, Temp > 80, select = c(Ozone, Temp))), subset(y, Temp > 80, select = c(Ozone, Temp))) checkIdentical(as.data.frame(subset(x, Day == 1, select = -Temp)), subset(y, Day == 1, select = -Temp)) checkIdentical(as.data.frame(subset(x, select = Ozone:Wind)), subset(y, select = Ozone:Wind)) } IRanges/inst/unitTests/test_FilterRules.R0000644000126300012640000001206212227064500022065 0ustar00biocbuildphs_compbiotest_FilterRules_construct <- function() { ## as a simple character vector filts <- c("peaks", "promoters") parsedFilts <- list(peaks = expression(peaks), promoters = expression(promoters)) filters <- FilterRules() checkTrue(validObject(filters)) checkIdentical(as.list(filters), list()) filters <- FilterRules(filts) checkTrue(validObject(filters)) checkIdentical(as.list(filters), parsedFilts) checkIdentical(active(filters), structure(rep(TRUE, 2), names=filts)) ## with functions and expressions filts <- c(parsedFilts, list(find_eboxes = function(rd) rep(FALSE, nrow(rd)))) filters <- FilterRules(filts, active = FALSE) checkTrue(validObject(filters)) filts$find_eboxes <- new("FilterClosure", filts$find_eboxes) checkIdentical(as.list(filters), filts) checkIdentical(active(filters), structure(rep(FALSE, 3), names=names(filts))) ## direct, quoted args (character literal parsed) filters <- FilterRules(under_peaks = peaks, in_promoters = "promoters") filts <- list(under_peaks = expression(peaks), in_promoters = expression(promoters)) checkTrue(validObject(filters)) checkIdentical(as.list(filters), filts) ## mix them up filters <- FilterRules(filts, diffexp = de) checkTrue(validObject(filters)) checkIdentical(as.list(filters), c(list(diffexp = expression(de)), filts)) filts <- as.list(filters) checkException(FilterRules(c(filts, 1)), silent = TRUE) checkException(FilterRules(filts, active = filts), silent = TRUE) checkException(FilterRules(list(find_eboxes = function() NULL)), silent = TRUE) } test_FilterRules_append <- function() { filts <- c("peaks", "promoters") filts2 <- c("introns", "exons") filters <- FilterRules(filts) filters2 <- FilterRules(filts2, active=FALSE) both <- append(filters, filters2) checkTrue(validObject(both)) bothFilts <- structure(list(quote(peaks), quote(promoters), quote(introns), quote(exons)), names = c(filts, filts2)) checkIdentical(unlist(as.list(both)), bothFilts) bothActive <- structure(c(TRUE, TRUE, FALSE, FALSE), names = names(bothFilts)) checkIdentical(active(both), bothActive) both <- c(filters, filters2) checkTrue(validObject(both)) checkIdentical(unlist(as.list(both)), bothFilts) checkIdentical(active(both), bothActive) filters[["cons"]] <- "cons" filts <- list(peaks = quote(peaks), promoters = quote(promoters)) filts <- c(filts, cons = quote(cons)) checkIdentical(unlist(as.list(filters)), filts) filters[["cons"]] <- quote(cons) checkIdentical(unlist(as.list(filters)), filts) filters[["cons"]] <- expression(cons) checkIdentical(unlist(as.list(filters)), filts) fun <- function(rd) rep(FALSE, nrow(rd)) filters[[4]] <- fun filts <- c(filts, X = new("FilterClosure", fun)) checkIdentical(unlist(as.list(filters)), filts) checkException(filters[[]] <- "threeprime", silent = TRUE) checkException(filters[[1]] <- 2, silent = TRUE) checkException(filters[[1]] <- list(quote(foo), quote(bar)), silent = TRUE) } test_FilterRules_subset <- function() { filts <- c("peaks", "promoters", "introns") filters <- FilterRules(filts) checkIdentical(sapply(unlist(filters[1:2]), deparse), structure(filts[1:2], names = filts[1:2])) checkIdentical(sapply(unlist(filters[]),deparse), structure(filts, names = filts)) checkException(filters[1,2], silent = TRUE) } test_FilterRules_active <- function() { filts <- c("peaks", "promoters", "introns") filters <- FilterRules(filts) ## set the active state directly active(filters) <- FALSE checkIdentical(active(filters), structure(rep(FALSE, 3), names = filts)) active(filters) <- TRUE checkIdentical(active(filters), structure(rep(TRUE, 3), names = filts)) active(filters) <- c(FALSE, FALSE, TRUE) checkIdentical(active(filters), structure(c(FALSE, FALSE, TRUE), names = filts)) active(filters)["promoters"] <- TRUE checkIdentical(active(filters), structure(c(FALSE, TRUE, TRUE), names = filts)) checkException(active(filters) <- rep(FALSE, 2), silent = TRUE) checkException(active(filters) <- rep(FALSE, 5), silent = TRUE) checkException(active(filters)["introns"] <- NA, silent = TRUE) ## toggle the active state by name or index active(filters) <- c(NA, 2) # NA's are dropped checkIdentical(active(filters), structure(c(FALSE, TRUE, FALSE), names = filts)) active(filters) <- c("peaks", NA) checkIdentical(active(filters), structure(c(TRUE, FALSE, FALSE), names = filts)) checkException(active(filters) <- "foo", silent = TRUE) checkException(active(filters) <- 15, silent = TRUE) } test_FilterRules_annotation <- function() { filts <- c("peaks", "promoters") filters <- FilterRules(filts) mcols(filters) <- DataFrame(a = 1:2) checkIdentical(mcols(filters)[,1], 1:2) checkIdentical(mcols(filters[2:1])[,1], 2:1) checkIdentical(mcols(c(filters,filters))[,1], rep(1:2,2)) checkIdentical(mcols(append(filters,filters))[,1], rep(1:2,2)) } IRanges/inst/unitTests/test_Hits.R0000644000126300012640000001453312227064500020541 0ustar00biocbuildphs_compbiotest_Hits_as_matrix <- function() { ## sparse query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree) checkIdentical(as.matrix(result), cbind(queryHits = c(1L, 1L, 3L), subjectHits = 1:3)) ## dense query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2), c(5, 4)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree) checkIdentical(as.matrix(result), cbind(queryHits = rep(1:2, each=2), subjectHits = rep(1:2, 2))) } test_Hits_matched <- function() { ## sparse query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree) checkIdentical(as.vector(as.table(result)), c(2L, 0L, 1L)) checkIdentical(as.vector(as.table(t(result))), c(1L, 1L, 1L)) ## dense query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2), c(5, 4)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree) checkIdentical(as.vector(as.table(result)), c(2L, 2L, 0L)) } test_remapHits <- function() { query_hits0 <- c(1L, 1L, 2L, 3L, 3L) subject_hits0 <- c(1L, 2L, 5L, 2L, 4L) hits0 <- new("Hits", queryHits=query_hits0, subjectHits=subject_hits0, queryLength=3L, subjectLength=6L) ## No remapping (i.e. map is missing or is the identity function). checkIdentical(remapHits(hits0), hits0) query.map1 <- seq_len(queryLength(hits0)) new.queryLength1 <- queryLength(hits0) subject.map1 <- seq_len(subjectLength(hits0)) new.subjectLength1 <- subjectLength(hits0) hits10 <- remapHits(hits0, query.map=query.map1, new.queryLength=new.queryLength1) checkIdentical(hits10, hits0) hits01 <- remapHits(hits0, subject.map=subject.map1, new.subjectLength=new.subjectLength1) checkIdentical(hits01, hits0) hits11 <- remapHits(hits0, query.map=query.map1, new.queryLength=new.queryLength1, subject.map=subject.map1, new.subjectLength=new.subjectLength1) checkIdentical(hits11, hits0) ## With maps that add a fixed offset to the query hits, and a fixed offset ## to the subject hits. query.map2 <- query.map1 + 20L new.queryLength2 <- new.queryLength1 + 20L subject.map2 <- subject.map1 + 30L new.subjectLength2 <- new.subjectLength1 + 30L hits20 <- remapHits(hits0, query.map=query.map2, new.queryLength=new.queryLength2) expected_hits20 <- new("Hits", queryHits=query_hits0 + 20L, subjectHits=subject_hits0, queryLength=23L, subjectLength=6L) checkIdentical(hits20, expected_hits20) hits02 <- remapHits(hits0, subject.map=subject.map2, new.subjectLength=new.subjectLength2) expected_hits02 <- new("Hits", queryHits=query_hits0, subjectHits=subject_hits0 + 30L, queryLength=3L, subjectLength=36L) checkIdentical(hits02, expected_hits02) hits22 <- remapHits(hits0, query.map=query.map2, new.queryLength=new.queryLength2, subject.map=subject.map2, new.subjectLength=new.subjectLength2) expected_hits22 <- new("Hits", queryHits=query_hits0 + 20L, subjectHits=subject_hits0 + 30L, queryLength=23L, subjectLength=36L) checkIdentical(hits22, expected_hits22) ## With injective and non-ascending maps. query.map3 <- 100L * rev(query.map1) + query.map1 new.queryLength3 <- 400L subject.map3 <- 100L * rev(subject.map1) + subject.map1 new.subjectLength3 <- 700L hits30 <- remapHits(hits0, query.map=query.map3, new.queryLength=new.queryLength3) expected_hits30 <- new("Hits", queryHits=c(103L, 103L, 202L, 301L, 301L), subjectHits=c(2L, 4L, 5L, 1L, 2L), queryLength=400L, subjectLength=6L) checkIdentical(hits30, expected_hits30) hits03 <- remapHits(hits0, subject.map=subject.map3, new.subjectLength=new.subjectLength3) expected_hits03 <- new("Hits", queryHits=query_hits0, subjectHits=c(502L, 601L, 205L, 304L, 502L), queryLength=3L, subjectLength=700L) checkIdentical(hits03, expected_hits03) hits33 <- remapHits(hits0, query.map=query.map3, new.queryLength=new.queryLength3, subject.map=subject.map3, new.subjectLength=new.subjectLength3) expected_hits33 <- new("Hits", queryHits=c(103L, 103L, 202L, 301L, 301L), subjectHits=c(304L, 502L, 205L, 502L, 601L), queryLength=400L, subjectLength=700L) checkIdentical(hits33, expected_hits33) ## With non-injective maps (as factors). query.map4 <- factor(c("B", "A", "B"), levels=c("A", "B")) subject.map4 <- factor(c("a", "b", "a", "b", "a", "b"), levels=c("a", "b")) hits40 <- remapHits(hits0, query.map=query.map4) expected_hits40 <- new("Hits", queryHits=c(1L, 2L, 2L, 2L), subjectHits=c(5L, 1L, 2L, 4L), queryLength=2L, subjectLength=6L) checkIdentical(hits40, expected_hits40) hits04 <- remapHits(hits0, subject.map=subject.map4) expected_hits04 <- new("Hits", queryHits=c(1L, 1L, 2L, 3L), subjectHits=c(1L, 2L, 1L, 2L), queryLength=3L, subjectLength=2L) checkIdentical(hits04, expected_hits04) hits44 <- remapHits(hits0, query.map=query.map4, subject.map=subject.map4) expected_hits44 <- new("Hits", queryHits=c(1L, 2L, 2L), subjectHits=c(1L, 1L, 2L), queryLength=2L, subjectLength=2L) checkIdentical(hits44, expected_hits44) } IRanges/inst/unitTests/test_HitsList.R0000644000126300012640000000043412227064500021370 0ustar00biocbuildphs_compbiotest_HitsList_as_matrix <- function() { x <- RangedData(IRanges(start=c(1,6), end=c(5,10)), space=c("chr1","chr2")) y <- RangedData(IRanges(start=8, end=10), space="chr2") checkIdentical(as.matrix(findOverlaps(x, y)), cbind(queryHits = 2L, subjectHits = 1L)) } IRanges/inst/unitTests/test_IRanges-class.R0000644000126300012640000000333512227064500022263 0ustar00biocbuildphs_compbiotest_IRanges_names <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) checkIdentical(names(range1), NULL) nms <- c("a", NA, "b") names(range1) <- nms checkIdentical(names(range1), nms) checkTrue(validObject(nms)) names(range1) <- NULL checkTrue(validObject(nms)) checkIdentical(names(range1), NULL) names(range1) <- "a" checkTrue(validObject(range1)) checkIdentical(names(range1), c("a", NA, NA)) checkException(names(range1) <- c("a", "b", "c", "d"), silent = TRUE) } test_IRanges_combine <- function() { range <- IRanges(start=c(1,2,3,1), end=c(5,2,8,3)) srange <- split(range, start(range) == 1) checkIdentical(srange, as(RangesList(`FALSE` = range[2:3], `TRUE` = range[c(1,4)]), "CompressedIRangesList")) checkIdentical(do.call(c, unname(as.list(srange))), IRanges(c(2,3,1,1), c(2,8,5,3))) ir1 <- IRanges(1, 10) ir2 <- IRanges(c(1, 15), width=5) mcols(ir2) <- DataFrame(score=1:2) checkIdentical(mcols(c(ir1, ir2)), DataFrame(score = c(NA, TRUE, TRUE))) ## Combining multiple IRanges object with varying mcols mcols(ir1) <- DataFrame(gc=0.78) checkException(c(ir1, ir2), silent=TRUE) checkIdentical(mcols(c(ir1, ir2, ignore.mcols=TRUE)), NULL) } test_IRanges_subset <- function() { # by range query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(6, 8, 10), c(7, 12, 14)) checkIdentical(subsetByOverlaps(query, subject), query[2:3]) } test_IRanges_annotation <- function() { range <- IRanges(c(1, 4), c(5, 7)) mcols(range) <- DataFrame(a = 1:2) checkIdentical(mcols(range)[,1], 1:2) checkIdentical(mcols(range[2:1])[,1], 2:1) checkIdentical(mcols(c(range,range))[,1], rep(1:2,2)) } IRanges/inst/unitTests/test_IntervalForest.R0000644000126300012640000004737612227064500022614 0ustar00biocbuildphs_compbiotest_IntervalForest_construction <- function() { query <- IRanges(c(1, 3, 9), c(5, 7, 10)) qpartition <- factor(c("a","a","b")) query <- split(query, qpartition) subject <- IRanges(c(2, 10), c(2, 12)) spartition <- factor(c("a","b")) subject <- split(subject, spartition) forest <- IntervalForest(subject) checkTrue(validObject(forest)) checkIdentical(length(forest), 2L); checkIdentical(names(forest), c("a","b")) checkIdentical(sum(elementLengths(forest)), 2L) forest <- IntervalForest(IRangesList()) checkTrue(validObject(forest)) forest <- IntervalForest(IRangesList(a=IRanges(1, 0))) checkIdentical(as.list(start(forest)), list(a=1L)) checkIdentical(names(forest), c("a")) checkTrue(validObject(forest)) forest <- IntervalForest(split(IRanges(c(1, 1), c(1, 0)), factor(c("a","b")))) checkIdentical(as.list(width(forest)), list(a=1L, b=0L)) checkIdentical(names(forest), c("a","b")) checkTrue(validObject(forest)) forest <- IntervalForest(IRangesList(a=IRanges(1:10,width=1))) checkIdentical(as.list(start(forest)), list(a=as.integer(1:10))) checkIdentical(as.list(width(forest)), list(a=rep(1L,10))) checkTrue(validObject(forest)) checkException(IntervalForest(), silent = TRUE) checkException(IntervalForest(subject, query), silent = TRUE) checkException(IntervalForest(NULL, NULL), silent = TRUE) } test_CompressedHitsList <- function() { query <- IRanges(c(1, 4, 9), c(5, 7, 10)) qpartition <- factor(c("a","b","a")) ql <- split(query, qpartition) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) spartition <- factor(c("a","a","b")) sl <- split(subject, spartition) olaps <- findOverlaps(ql, sl) rngs1 <- as(ranges(olaps, ql, sl),"CompressedIRangesList") hits <- new2("Hits", queryHits=queryHits(olaps), subjectHits=subjectHits(olaps), queryLength=nobj(ql@partitioning), subjectLength=nobj(sl@partitioning)) hl <- CompressedHitsList(hits, sl) rngs2 <- ranges(hl@unlistData, ql@unlistData, sl@unlistData) checkIdentical(rngs1@unlistData, rngs2) checkIdentical(rngs1@partitioning, hl@partitioning) } test_IntervalForest_findOverlaps <- function() { ## a ..... ## b .... ## a .. ## a x ## b xx ## a xxx query <- IRanges(c(1, 4, 9), c(5, 7, 10)) qpartition <- factor(c("a","b","a")) qlist <- split(query, qpartition) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) spartition <- factor(c("a","a","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) result <- findOverlaps(qlist, forest, select = "first") expected <- new2("CompressedIntegerList", unlistData=c(1L, NA, NA), partitioning=PartitioningByEnd(c(1,1,2), names=c("a","b"), NG=2)) checkIdentical(result, expected) query <- IRanges(c(1, 4, 9), c(5, 7, 10)) qpartition <- factor(c("a","a","b")) qlist <- split(query, qpartition) result <- findOverlaps(qlist, forest, select = "first") expected <- new2("CompressedIntegerList", unlistData= c(1L, NA, 3L), partitioning=PartitioningByEnd(c(1,1,2), names=c("a","b"), NG=2)) checkIdentical(result, expected) result <- findOverlaps(qlist, forest, select = "last") expected@unlistData <- c(2L, NA, 3L) checkIdentical(result, expected) result <- findOverlaps(qlist, forest, select = "arbitrary") checkIdentical(result, expected) checkOverlap <- function(a, q, s, r, c) { mat <- cbind(queryHits = as.integer(q), subjectHits = as.integer(s)) checkIdentical(as.matrix(a), mat) checkIdentical(queryLength(a), as.integer(r)) checkIdentical(subjectLength(a), as.integer(c)) } result <- findOverlaps(qlist, forest) checkOverlap(result, c(1, 1, 3), c(1, 2, 3), 3, 3) ## with 'maxgap' result <- findOverlaps(qlist, forest, 1) checkOverlap(result, c(1, 1, 2, 3), c(1, 2, 2, 3), 3, 3) ## with 'minoverlap' result <- findOverlaps(qlist, forest, minoverlap = 3L) checkOverlap(result, integer(0), integer(0), 3, 3) result <- findOverlaps(qlist, forest, minoverlap = 2L) checkOverlap(result, 1, 2, 3, 3) result <- findOverlaps(qlist, forest, minoverlap = 2L, select = "first") expected <- new2("CompressedIntegerList", unlistData=c(2L, NA, NA), partitioning=PartitioningByEnd(c(1,1,2),names=c("a","b"), NG=2)) checkIdentical(result, expected) result <- findOverlaps(qlist, forest, minoverlap = 2L, select = "last") expected@unlistData <- c(2L, NA, NA) checkIdentical(result, expected) result <- findOverlaps(qlist, forest, minoverlap = 2L, select = "arbitrary") expected@unlistData <- c(2L, NA, NA) checkIdentical(result, expected) ## empty query range #subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) #spartition <- factor(c("a","a","b")) query <- IRanges(c(1, 4, 9, 10), c(5, 7, 10, 9)) qpartition <- factor(c("a","a","b","b")) qlist <- split(query, qpartition) result <- findOverlaps(qlist, forest) checkOverlap(result, c(1, 1, 3), c(1, 2, 3), 4, 3) ## empty subject range subject <- IRanges(c(2, 2, 2, 10), c(2, 1, 3, 12)) spartition <- factor(c("a","a","a","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) result <- findOverlaps(qlist, forest) checkOverlap(result, c(1, 1, 3), c(1, 3, 4), 4, 4) ## ..... ## .... ## .. ## xxxx ## xxx query <- IRanges(c(1, 4, 9), c(5, 7, 10)) qpartition <- factor(c("a","b","a")) qlist <- split(query, qpartition) subject <- IRanges(c(2, 2), c(5, 4)) spartition <- factor(c("a","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) result <- findOverlaps(qlist, forest) checkOverlap(result, c(1, 3), c(1, 2), 3, 2) ## check case of identical subjects ## ..... ## ..... ## .. ## xxxx ## xxxx ## xx ## xxx ## xx query <- IRanges(c(1, 9, 4), c(5, 10, 7)) qpartition <- factor(c("a","a","b")) qlist <- split(query, qpartition) subject <- IRanges(c(2, 2, 6, 6, 6), c(5, 5, 7, 8, 7)) spartition <- factor(c("a","a","b","b","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) result <- findOverlaps(qlist, forest) checkOverlap(result, c(1, 1, 3, 3, 3), c(1, 2, 3, 4, 5), 3, 5) # on unsorted query query <- IRanges(c(10, 7, 9, 5, 3), c(15, 10, 12, 7, 7)) qpartition <- factor(c("a","a","a","b","b")) qlist <- split(query, qpartition) result <- findOverlaps(qlist, forest) checkOverlap(result, c(4, 4, 4, 5, 5, 5), c(3, 4, 5, 3, 4, 5), 5, 5) # query with partition level not in subject query <- IRanges(c(10, 7, 9, 5, 3), c(15, 10, 12, 7, 7)) qpartition <- factor(c("a","a","a","b","c")) qlist <- split(query, qpartition) subject <- IRanges(c(2, 2, 6, 6, 6), c(5, 5, 7, 8, 7)) spartition <- factor(c("b","b","b","b","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) result <- findOverlaps(qlist, forest) checkOverlap(result, c(4, 4, 4, 4, 4), c(1, 2, 3, 4, 5), 5, 5) ## check other types of matching ## .. ## .. ## .... ## ...... ## xxxx ## xxxx ## xxxxx ## xxxx query <- IRanges(c(1, 5, 3, 4), width=c(2, 2, 4, 6)) qpartition <- factor(c("a","a","a","a")) qlist <- split(query, qpartition) subject <- IRanges(c(1, 3, 5, 6), width=c(4, 4, 5, 4)) spartition <- factor(c("a","a","a","a")) slist <- split(subject, spartition) forest <- IntervalForest(slist) ## 'start' result <- findOverlaps(qlist, forest, type = "start") checkOverlap(result, c(1, 2, 3), c(1, 3, 2), 4, 4) ## non-zero maxgap result <- findOverlaps(qlist, forest, type = "start", maxgap = 1L) checkOverlap(result, c(1, 2, 2, 3, 4, 4), c(1, 3, 4, 2, 2, 3), 4, 4) ## minoverlap > 1L result <- findOverlaps(qlist, forest, type = "start", minoverlap = 3L) checkOverlap(result, 3, 2, 4, 4) ## combine minoverlap and maxgap result <- findOverlaps(qlist, forest, type = "start", maxgap = 1L, minoverlap = 3L) checkOverlap(result, c(3, 4, 4), c(2, 2, 3), 4, 4) ## 'end' result <- findOverlaps(qlist, forest, type = "end") checkOverlap(result, c(2, 3, 4, 4), c(2, 2, 3, 4), 4, 4) # ## ensure inverse is same as transpose # inverse <- findOverlaps(subject, query, type = "end") # tr <- as.matrix(t(result)) # checkIdentical(as.matrix(inverse), tr[order(tr[,1]),]) ## select = "first" result <- findOverlaps(qlist, forest, type = "end", select = "first") expected <- new2("CompressedIntegerList", unlistData=c(NA, 2L, 2L, 3L), partitioning=qlist@partitioning) checkIdentical(result, expected) ## 'within' result <- findOverlaps(qlist, forest, type = "within") checkOverlap(result, c(1, 2, 2, 3), c(1, 2, 3, 2), 4, 4) result <- findOverlaps(qlist, forest, type = "within", maxgap = 1L) checkOverlap(result, c(1, 2, 2, 2, 3, 4), c(1, 2, 3, 4, 2, 3), 4, 4) ## 'equal' result <- findOverlaps(qlist, forest, type = "equal") checkOverlap(result, 3, 2, 4, 4) ## self matching subject <- IRanges(c(2, 2, 6, 6, 6), c(5, 5, 7, 8, 7)) spartition <- factor(c("a","a","b","b","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) result <- findOverlaps(forest) checkOverlap(result, c(1, 1, 2, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5), c(1, 2, 1, 2, 3, 4, 5, 3, 4, 5, 3, 4, 5), 5, 5) # # checkException(findOverlaps(query, NULL), silent = TRUE) # checkException(findOverlaps(NULL, query), silent = TRUE) # check empty subject partition query <- IRanges(start=1:2,width=1) qpartition <- factor(c("a","b")) qlist <- split(query, qpartition) subject <- query[1] slist <- new2("CompressedIRangesList", unlistData=subject, partitioning=PartitioningByEnd(1L, NG=length(qlist@partitioning@end), names=qlist@partitioning@NAMES)) forest <- IntervalForest(slist) olaps1 <- findOverlaps(qlist, slist) olaps2 <- findOverlaps(qlist, forest) checkIdentical(as.matrix(olaps1), as.matrix(olaps2)) subject <- query[2] slist <- new2("CompressedIRangesList", unlistData=subject, partitioning=PartitioningByEnd(2L, NG=length(qlist@partitioning@end), names=qlist@partitioning@NAMES)) forest <- IntervalForest(slist) olaps1 <- findOverlaps(qlist, slist) olaps2 <- findOverlaps(qlist, forest) checkIdentical(as.matrix(olaps1), as.matrix(olaps2)) } test_IntervalForest_asRangesList <- function() { ranges <- IRanges(c(1, 4, 9), c(5, 7, 10)) partition <- factor(c("a","b","a")) rl <- split(ranges, partition) forest <- IntervalForest(rl) checkIdentical(as(forest, "CompressedIRangesList"), rl) ranges <- IRanges() partition <- factor() rl <- split(ranges,partition) tree <- IntervalForest(rl) checkIdentical(as(tree, "CompressedIRangesList"), rl) } test_IntervalForest_subset <- function() { ranges <- IRanges(c(1, 9, 4), c(5, 10, 7)) partition <- factor(c("a","a","b")) rlist <- split(ranges, partition) forest <- IntervalForest(rlist) checkIdentical(as(forest, "IRanges"), ranges) subforest <- forest[c(1,3)] subranges <- ranges[c(1,3)] subspaces <- space(forest)[c(1,3)] checkIdentical(as(subforest,"IRanges"), subranges) checkIdentical(space(subforest), subspaces) } test_IntervalForest_range <- function() { compress=TRUE rl1 <- IntervalForest(IRangesList(a = IRanges(c(1,2),c(4,3)), b = IRanges(c(4,6),c(10,7)), compress = compress)) rl2 <- IRangesList(c = IRanges(c(0,2),c(4,5)), a = IRanges(c(4,5),c(6,7)), compress = compress) ans <- IRangesList(a = IRanges(1,7), b = IRanges(4,10), c = IRanges(0,5), compress = compress) checkIdentical(as(range(rl1, rl2), "CompressedIRangesList"), ans) names(rl2) <- NULL ans <- IRangesList(IRanges(0,5), IRanges(4,10), compress = compress) checkIdentical(as(range(rl1, rl2), "CompressedIRangesList"), ans) } test_IntervalForest_reduce <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) range3 <- IRanges(start=c(3,-2,6,7,-10,-2,3), width=c(1,0,0,0,0,8,0)) range4 <- IRanges() collection <- IntervalForest(IRangesList(one=range1, range2, range3, range4, compress=TRUE)) for (with.mapping in c(FALSE, TRUE)) { for (drop.empty.ranges in c(FALSE, TRUE)) { if (!drop.empty.ranges || with.mapping) { checkException( current <- reduce(collection, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), silent=TRUE) } else { current <- reduce(collection, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping) target <- IRangesList(one=reduce(range1, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), reduce(range2, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), reduce(range3, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), reduce(range4, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), compress=TRUE) checkIdentical(target, as(current,"CompressedIRangesList")) } } } } test_IntervalForest_narrow <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) collection <- IntervalForest(IRangesList(range1, range2, compress = TRUE)) checkIdentical(as(narrow(collection, start=1, end=2),"CompressedIRangesList"), IRangesList(IRanges(c(2, 5), c(3, 6)), IRanges(1, 2), compress = TRUE)) checkException(narrow(collection, start=10, end=20), silent = TRUE) } test_IntervalForest_flank <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) collection <- IRangesList(range1, range2, compress = TRUE) checkIdentical(as(flank(collection, 2),"CompressedIRangesList"), IRangesList(IRanges(c(0, 3), c(1, 4)), IRanges(-1, 0), compress = TRUE)) checkIdentical(as(flank(collection, 2, FALSE),"CompressedIRangesList"), IRangesList(IRanges(c(4, 8), c(5, 9)), IRanges(4, 5), compress = TRUE)) checkIdentical(as(flank(collection, 2, LogicalList(c(FALSE, TRUE), FALSE)),"CompressedIRangesList"), IRangesList(IRanges(c(4, 3), c(5, 4)), IRanges(4, 5), compress = TRUE)) checkIdentical(as(flank(collection, IntegerList(c(2, -2), 2)),"CompressedIRangesList"), IRangesList(IRanges(c(0, 5), c(1, 6)), IRanges(-1, 0), compress = TRUE)) checkIdentical(as(flank(collection, 2, both = TRUE),"CompressedIRangesList"), IRangesList(IRanges(c(0, 3), c(3, 6)), IRanges(-1, 2), compress = TRUE)) checkIdentical(as(flank(collection, 2, FALSE, TRUE),"CompressedIRangesList"), IRangesList(IRanges(c(2, 6), c(5, 9)), IRanges(2, 5), compress = TRUE)) checkIdentical(as(flank(collection, -2, FALSE, TRUE),"CompressedIRangesList"), IRangesList(IRanges(c(2, 6), c(5, 9)), IRanges(2, 5), compress = TRUE)) checkException(flank(collection, 2, both = c(TRUE, FALSE, TRUE)), silent = TRUE) # not vectorized checkException(flank(collection, 2, LogicalList(c(FALSE, TRUE), NA)), silent = TRUE) checkException(flank(collection, NA), silent = TRUE) } test_IntervalForest_promoters <- function() { rl <- IntervalForest(IRangesList("A"=IRanges(5:7, width=1), "B"=IRanges(10:12, width=5))) current <- promoters(rl, 2, 0) checkIdentical(names(current), names(rl)) checkIdentical(unique(unlist(width(current))), 2L) } test_IntervalForest_resize <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) collection <- IRangesList(range1, range2, compress = TRUE) checkIdentical(as(resize(collection, width=10),"CompressedIRangesList"), IRangesList(IRanges(c(2, 5), width=10), IRanges(1, width=10), compress = TRUE)) checkIdentical(as(resize(collection, width=10, fix="end"),"CompressedIRangesList"), IRangesList(IRanges(c(-6, -2), width=10), IRanges(-6, width=10), compress = TRUE)) checkIdentical(as(resize(collection, width=10, fix="center"),"CompressedIRangesList"), IRangesList(IRanges(c(-2, 1), width=10), IRanges(-3, width=10), compress = TRUE)) checkIdentical(as(resize(collection, width=10, fix=CharacterList(c("start", "end"), "center")),"CompressedIRangesList"), IRangesList(IRanges(c(2, -2), width=10), IRanges(-3, width=10), compress = TRUE)) checkException(resize(collection, -1), silent = TRUE) } test_IntervalForest_restrict <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) collection <- IntervalForest(IRangesList(range1, range2, compress = TRUE)) checkIdentical(as(restrict(collection, start=2, end=5),"CompressedIRangesList"), IRangesList(IRanges(c(2, 5), c(3, 5)), IRanges(2, 3), compress = TRUE)) checkIdentical(as(restrict(collection, start=1, end=2),"CompressedIRangesList"), IRangesList(IRanges(2, 2), IRanges(1, 2), compress = TRUE)) checkException(restrict(collection, start=1, end=2, keep.all.ranges=TRUE), silent=TRUE) } test_IntervalForest_gaps <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) for (compress in c(TRUE)) { collection <- IntervalForest(IRangesList(one = range1, range2, compress = compress)) checkIdentical(as(gaps(collection),"CompressedIRangesList"), IRangesList(one = gaps(range1), gaps(range2), compress = compress)) } } test_IntervalForest_disjoin <- function() { f <- function(x) as(x, "CompressedIRangesList") r0 <- IRanges(10, 20) checkTrue(validObject(disjoin(IntervalForest(IRangesList())))) ## unnamed; incl. 0-length irl <- IntervalForest(IRangesList(IRanges())) checkIdentical(f(irl), f(disjoin(irl))) irl <- IntervalForest(IRangesList(r0, IRanges(), r0)) checkIdentical(f(irl), f(disjoin(irl))) irl <- IntervalForest(IRangesList(r0, IRanges(), IRanges(), r0)) checkIdentical(f(irl), f(disjoin(irl))) ## named; incl. 0-length irl <- IntervalForest(IRangesList(a=IRanges())) checkIdentical(f(irl), f(disjoin(irl))) irl <- IntervalForest(IRangesList(a=r0, b=IRanges(), c=r0)) checkIdentical(f(irl), f(disjoin(irl))) irl <- IntervalForest(IRangesList(a=r0, b=IRanges(), c=IRanges(), d=r0)) checkIdentical(f(irl), f(disjoin(irl))) ## no interference between separate elements r0 <- IRanges(10, c(15, 20)) dr0 <- disjoin(r0) irl <- IntervalForest(IRangesList(r0, r0)) checkIdentical(IRangesList(dr0, dr0), f(disjoin(irl))) irl <- IntervalForest(IRangesList(r0, IRanges(), r0)) checkIdentical(IRangesList(dr0, IRanges(), dr0), f(disjoin(irl))) ## 0-width ## 1-width r0 <- IRanges(c(1, 10), 10) irl <- IntervalForest(IRangesList(r0, IRanges())) checkIdentical(disjoin(r0), f(disjoin(irl))[[1]]) irl <- IntervalForest(IRangesList(IRanges(), r0)) checkIdentical(disjoin(r0), f(disjoin(irl))[[2]]) } IRanges/inst/unitTests/test_IntervalTree.R0000644000126300012640000001440012227064500022227 0ustar00biocbuildphs_compbiotest_IntervalTree_construction <- function() { query <- IRanges(c(1, 3, 9), c(5, 7, 10)) subject <- IRanges(c(2, 10), c(2, 12)) tree <- IntervalTree(subject) checkTrue(validObject(tree)) tree <- IntervalTree(IRanges()) checkTrue(validObject(tree)) tree <- IntervalTree(IRanges(1, 0)) checkIdentical(start(tree), 1L) checkTrue(validObject(tree)) tree <- IntervalTree(IRanges(c(1, 1), c(1, 0))) checkIdentical(width(tree), c(1L, 0L)) checkTrue(validObject(tree)) checkException(IntervalTree(), silent = TRUE) checkException(IntervalTree(subject, query), silent = TRUE) checkException(IntervalTree(NULL), silent = TRUE) } test_IntervalTree_findOverlaps <- function() { ## ..... ## .... ## .. ## x ## xx ## xxx query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree, select = "first") checkIdentical(result, c(1L, NA, 3L)) result <- findOverlaps(query, tree, select = "last") checkIdentical(result, c(2L, NA, 3L)) result <- findOverlaps(query, tree, select = "arbitrary") checkIdentical(result, c(2L, NA, 3L)) checkOverlap <- function(a, q, s, r, c) { mat <- cbind(queryHits = as.integer(q), subjectHits = as.integer(s)) checkIdentical(as.matrix(a), mat) checkIdentical(queryLength(a), as.integer(r)) checkIdentical(subjectLength(a), as.integer(c)) } result <- findOverlaps(query, tree) checkOverlap(result, c(1, 1, 3), c(1, 2, 3), 3, 3) ## with 'maxgap' result <- findOverlaps(query, tree, 1) checkOverlap(result, c(1, 1, 2, 3), c(1, 2, 2, 3), 3, 3) ## with 'minoverlap' result <- findOverlaps(query, tree, minoverlap = 3L) checkOverlap(result, integer(0), integer(0), 3, 3) result <- findOverlaps(query, tree, minoverlap = 2L) checkOverlap(result, 1, 2, 3, 3) result <- findOverlaps(query, tree, minoverlap = 2L, select = "first") checkIdentical(result, c(2L, NA, NA)) result <- findOverlaps(query, tree, minoverlap = 2L, select = "last") checkIdentical(result, c(2L, NA, NA)) result <- findOverlaps(query, tree, minoverlap = 2L, select = "arbitrary") checkIdentical(result, c(2L, NA, NA)) ## empty query range query <- IRanges(c(1, 4, 9, 10), c(5, 7, 10, 9)) result <- findOverlaps(query, tree) checkOverlap(result, c(1, 1, 3), c(1, 2, 3), 4, 3) ## empty subject range subject <- IRanges(c(2, 2, 2, 10), c(2, 1, 3, 12)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree) checkOverlap(result, c(1, 1, 3), c(1, 3, 4), 4, 4) ## ..... ## .... ## .. ## xxxx ## xxx query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2), c(5, 4)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree) checkOverlap(result, c(1, 1, 2, 2), c(1, 2, 1, 2), 3, 2) result <- findOverlaps(subject, query) checkOverlap(result, c(1, 1, 2, 2), c(1, 2, 1, 2), 2, 3) query <- IRanges(c(1, 4, 9, 11), c(5, 7, 10, 11)) result <- findOverlaps(query) checkOverlap(result, c(1, 1, 2, 2, 3, 4), c(1, 2, 1, 2, 3, 4), 4, 4) ## check case of identical subjects ## ..... ## ..... ## .. ## xxxx ## xxxx ## xx ## xxx ## xx query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2, 6, 6, 6), c(5, 5, 7, 8, 7)) tree <- IntervalTree(subject) result <- findOverlaps(query, tree) checkOverlap(result, c(1, 1, 2, 2, 2, 2, 2), c(1, 2, 1, 2, 3, 4, 5), 3, 5) subject <- IRanges(c(1, 6, 13), c(4, 9, 14)) # single points checkIdentical(findOverlaps(c(3L, 7L, 10L), subject, select = "first"), c(1L, 2L, NA)) checkIdentical(findOverlaps(c(3L, 7L, 10L), subject, select = "last"), c(1L, 2L, NA)) checkIdentical(findOverlaps(c(3L, 7L, 10L), subject, select = "arbitrary"), c(1L, 2L, NA)) checkIdentical(findOverlaps(IRanges(c(2,1),c(3,4)), subject), new("Hits", queryHits = 1:2, subjectHits = c(1L,1L), queryLength = 2L, subjectLength = 3L)) ## check other types of matching ## .. ## .. ## .... ## ...... ## xxxx ## xxxx ## xxxxx ## xxxx query <- IRanges(c(1, 5, 3, 4), width=c(2, 2, 4, 6)) subject <- IRanges(c(1, 3, 5, 6), width=c(4, 4, 5, 4)) tree <- IntervalTree(subject) ## 'start' result <- findOverlaps(query, tree, type = "start") checkOverlap(result, c(1, 2, 3), c(1, 3, 2), 4, 4) ## non-zero maxgap result <- findOverlaps(query, tree, type = "start", maxgap = 1L) checkOverlap(result, c(1, 2, 2, 3, 4, 4), c(1, 3, 4, 2, 2, 3), 4, 4) ## minoverlap > 1L result <- findOverlaps(query, tree, type = "start", minoverlap = 3L) checkOverlap(result, 3, 2, 4, 4) ## combine minoverlap and maxgap result <- findOverlaps(query, tree, type = "start", maxgap = 1L, minoverlap = 3L) checkOverlap(result, c(3, 4, 4), c(2, 2, 3), 4, 4) ## 'end' result <- findOverlaps(query, tree, type = "end") checkOverlap(result, c(2, 3, 4, 4), c(2, 2, 3, 4), 4, 4) ## ensure inverse is same as transpose inverse <- findOverlaps(subject, query, type = "end") tr <- as.matrix(t(result)) checkIdentical(as.matrix(inverse), tr[order(tr[,1]),]) ## select = "first" result <- findOverlaps(query, tree, type = "end", select = "first") checkIdentical(result, c(NA, 2L, 2L, 3L)) ## 'within' result <- findOverlaps(query, tree, type = "within") checkOverlap(result, c(1, 2, 2, 3), c(1, 2, 3, 2), 4, 4) result <- findOverlaps(query, tree, type = "within", maxgap = 1L) checkOverlap(result, c(1, 2, 2, 2, 3, 4), c(1, 2, 3, 4, 2, 3), 4, 4) ## 'equal' result <- findOverlaps(query, tree, type = "equal") checkOverlap(result, 3, 2, 4, 4) checkException(findOverlaps(query, NULL), silent = TRUE) checkException(findOverlaps(NULL, query), silent = TRUE) } test_IntervalTree_asRanges <- function() { ranges <- IRanges(c(1, 4, 9), c(5, 7, 10)) tree <- IntervalTree(ranges) checkIdentical(as(tree, "IRanges"), ranges) ranges <- IRanges() tree <- IntervalTree(ranges) checkIdentical(as(tree, "IRanges"), ranges) } test_IntervalTree_length <- function() { ranges <- IRanges(c(1, 4, 9), c(5, 7, 10)) tree <- IntervalTree(ranges) checkIdentical(length(tree), length(ranges)) } IRanges/inst/unitTests/test_List-class.R0000644000126300012640000002331412227064500021645 0ustar00biocbuildphs_compbio### NOTE: List is an abstract type, so we just test with IntegerList test_List_replace_names <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { collection <- IntegerList(int1, int2, compress=compress) names(collection) <- c("one", "two") checkIdentical(names(collection), c("one", "two")) names(collection) <- NULL checkIdentical(names(collection), NULL) names(collection) <- "one" checkIdentical(names(collection), c("one", NA)) checkException(names(collection) <- c("one", "two", "three"), silent=TRUE) } } test_List_extraction <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { collection <- IntegerList(int1, int2, compress=compress) checkException(collection[[]], silent=TRUE) checkException(collection[[1, 2]], silent=TRUE) checkException(collection[[numeric()]], silent=TRUE) checkException(collection[[NULL]], silent=TRUE) checkException(collection[[c(1,2)]], silent=TRUE) checkException(collection[[-1]], silent=TRUE) checkException(collection[[5]], silent=TRUE) checkIdentical(collection[[NA_integer_]], NULL) checkIdentical(collection[[1]], int1) checkIdentical(collection[[2]], int2) checkIdentical(collection[["1"]], NULL) checkIdentical(collection$foo, NULL) checkIdentical(IntegerList(one=int1, int2, compress=compress)[["one"]], int1) checkIdentical(IntegerList(one=int1, int2, compress=compress)$one, int1) } } test_List_subset <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { collection <- IntegerList(one=int1, int2, compress=compress) unnamed <- IntegerList(int1, int2, compress=compress) checkException(collection[1,2], silent=TRUE) if (compress) { checkException(collection[5], silent=TRUE) checkException(collection[c(NA, 2)], silent=TRUE) checkException(collection[c(TRUE, TRUE, TRUE)], silent=TRUE) checkException(unnamed["one"], silent=TRUE) } checkException(collection[c(-1,2)], silent=TRUE) empty <- IntegerList(compress=compress) names(empty) <- character(0) checkIdentical(collection[0], empty) checkIdentical(collection[numeric()], empty) checkIdentical(collection[logical()], empty) checkIdentical(collection[character()], empty) checkIdentical(collection[NULL], empty) checkIdentical(collection[], collection) checkIdentical(collection[FALSE], empty) checkIdentical(collection[c(FALSE, FALSE)], empty) checkIdentical(collection[list()], empty) checkIdentical(collection[TRUE], collection) checkIdentical(collection[c(TRUE, FALSE)], IntegerList(one=int1, compress=compress)) rl2 <- IntegerList(int2, compress=compress) names(rl2) <- "" checkIdentical(collection[2], rl2) checkIdentical(collection[c(2,1)], IntegerList(int2, one=int1, compress=compress)) checkIdentical(collection[-1], rl2) checkIdentical(collection["one"], IntegerList(one=int1, compress=compress)) } } test_List_replace <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { collection <- IntegerList(one=int1, int2, compress=compress) checkException(collection[1,2] <- 1L, silent=TRUE) checkException(collection[c(-1,2)] <- 1L, silent=TRUE) newcollection <- collection newcollection[list()] <- 1L checkIdentical(newcollection, collection) newcollection <- collection newcollection[] <- collection checkIdentical(newcollection, collection) newcollection1 <- newcollection2 <- collection newcollection1[2:1] <- collection checkIdentical(newcollection1, IntegerList(one=int2, int1, compress=compress)) newcollection2[] <- collection[2:1] checkIdentical(newcollection2, newcollection1) value <- IntegerList(1:10, compress=compress) newcollection <- collection newcollection[TRUE] <- value checkIdentical(newcollection, IntegerList(one=1:10, 1:10, compress=compress)) newcollection <- collection newcollection[c(TRUE, FALSE)] <- value checkIdentical(newcollection, IntegerList(one=1:10, int2, compress=compress)) newcollection <- collection newcollection["one"] <- value checkIdentical(newcollection, IntegerList(one=1:10, int2, compress=compress)) newcollection <- collection newcollection[list(6:5, TRUE)] <- list(-1:-2, -99:-100) checkIdentical(newcollection, IntegerList(one=c(1,2,3,5,-2,-1), rep(c(-99,-100), 4), compress=compress)) collection <- IntegerList(one=int1, two=int2, compress=compress) newcollection <- collection newcollection[c("two", "one")] <- collection checkIdentical(newcollection, IntegerList(one=int2, two=int1, compress=compress)) newcollection <- collection newcollection[list(two=6:5, one=TRUE)] <- list(-1:-2, -99:-100) checkIdentical(newcollection, IntegerList(one=rep(c(-99,-100), 3), two=c(15,45,20,1,-2,-1,80,5), compress=compress)) collection <- IntegerList(one=c(a=1,b=2), two=c(d=1,b=0,a=5), compress=compress) newcollection1 <- newcollection2 <- collection newcollection1[list(two=2, one=2:1)] <- list(99, 11:12) checkIdentical(newcollection1, IntegerList(one=c(a=12,b=11), two=c(d=1,b=99,a=5), compress=compress)) newcollection2[list(two="b", one=c("b", "a"))] <- list(99, 11:12) checkIdentical(newcollection2, newcollection1) } } test_List_combine <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { col1 <- IntegerList(one=int1, int2, compress=compress) col2 <- IntegerList(two=int2, one=int1, compress=compress) col3 <- IntegerList(int2, compress=compress) if (compress) checkException(append(col1, col2, c(1,2,3)), silent=TRUE) checkException(append(col1, col2, col3), silent=TRUE) checkIdentical(append(col1, col2), IntegerList(one=int1, int2, two=int2, one=int1, compress=compress)) checkIdentical(append(col1, col2, 1), IntegerList(one=int1, two=int2, one=int1, int2, compress=compress)) checkIdentical(append(col1, col2, 0), IntegerList(two=int2, one=int1, one=int1, int2, compress=compress)) checkIdentical(append(append(col1, col2), col3), IntegerList(one=int1, int2, two=int2, one=int1, int2, compress=compress)) ## for 'c' checkIdentical(c(col1, col2, col3), IntegerList(one=int1, int2, two=int2, one=int1, int2, compress=compress)) if (compress) { checkException(c(col1, int2), silent=TRUE) checkException(c(col1, col2, recursive=TRUE), silent=TRUE) } } } test_List_apply <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { col1 <- IntegerList(one=int1, int2, compress=compress) checkIdentical(lapply(col1, mean), list(one=mean(int1), mean(int2))) checkException(lapply(col1, 2), silent=TRUE) } } test_List_unlist <- function() { for (compress in c(TRUE, FALSE)) { x0 <- list(c(a=1L), 21:23, 33L) x <- IntegerList(x0, compress=compress) target <- unlist(x0) current <- unlist(x) checkIdentical(target, current) names(x0) <- names(x) <- LETTERS[1:3] target <- unlist(x0) names(target)[2:4] <- "B" # base::unlist() behaviour not what we want! current <- unlist(x) checkIdentical(target, current) names(x0)[2] <- names(x)[2] <- "" target <- unlist(x0) current <- unlist(x) checkIdentical(target, current) names(x0)[2] <- names(x)[2] <- NA target <- unlist(x0) names(target)[2:4] <- NA # base::unlist() behaviour not what we want! current <- unlist(x) checkIdentical(target, current) names(x0[[2]])[] <- names(x[[2]])[] <- NA target <- unlist(x0) current <- unlist(x) checkIdentical(target, current) names(x0[[2]]) <- names(x[[2]]) <- "b" target <- unlist(x0) current <- unlist(x) checkIdentical(target, current) names(x0[[2]])[] <- names(x[[2]])[] <- "a" target <- unlist(x0) current <- unlist(x) checkIdentical(target, current) names(x0)[2] <- names(x)[2] <- "A" target <- unlist(x0) current <- unlist(x) checkIdentical(target, current) } } test_List_unsplit <- function() { ir <- IRanges(1:5, 11:15) f <- factor(c("a", "b", "a", "b", "b"), c("b", "a", "c")) rl <- split(ir, f) checkIdentical(unsplit(rl, f), ir) rl <- split(ir, f, drop=TRUE) checkIdentical(unsplit(rl, Rle(f), drop=TRUE), ir) checkException(unsplit(rl, f, drop=FALSE), silent=TRUE) v <- 1:5 l <- seqsplit(v, f) checkIdentical(unsplit(l, Rle(f)), v) } test_List_annotation <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) for (compress in c(TRUE, FALSE)) { ilist <- IntegerList(int1, int2, compress=compress) mcols(ilist) <- DataFrame(a=1:2) checkIdentical(mcols(ilist)[,1], 1:2) checkIdentical(mcols(ilist[2:1])[,1], 2:1) checkIdentical(mcols(c(ilist,ilist))[,1], rep(1:2,2)) checkIdentical(mcols(append(ilist,ilist))[,1], rep(1:2,2)) } } IRanges/inst/unitTests/test_RDApplyParams.R0000644000126300012640000001777612227064500022325 0ustar00biocbuildphs_compbiotest_RDApplyParams_construct <- function() { fun <- function(rd) NULL ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) applyParams <- list(x = 2) excludePattern <- "[XY]" rd <- RangedData(ranges, filter) ## meaningless defaults checkTrue(validObject(RDApplyParams())) checkTrue(validObject(RDApplyParams(rd))) ## finally does something params <- RDApplyParams(rd, fun) checkTrue(validObject(params)) checkIdentical(rangedData(params), rd) checkIdentical(applyFun(params), fun) ## make sure function and parameters compatible ## applyFun needs 1 param checkException(applyFun(params) <- function() NULL, silent = TRUE) checkException(RDApplyParams(rd, function() NULL), silent = TRUE) ## needs 2 params checkException(RDApplyParams(rd, fun, applyParams), silent = TRUE) checkException(applyParams(params) <- applyParams, silent = TRUE) ## parameter name mismatch checkException(RDApplyParams(rd, function(rd, y) NULL, applyParams), silent = TRUE) applyFun(params) <- function(rd, y) NULL checkTrue(validObject(params)) checkException(applyParams(params) <- applyParams, silent = TRUE) ## ok with ... applyFun(params) <- function(...) NULL checkTrue(validObject(params)) checkIdentical(applyFun(params), function(...) NULL) applyParams(params) <- applyParams checkTrue(validObject(params)) checkIdentical(applyParams(params), applyParams) params <- RDApplyParams(rd, function(...) NULL, applyParams) checkTrue(validObject(params)) checkIdentical(applyParams(params), applyParams) ## check for duplicate params checkException(applyParams(params) <- rep(applyParams,2), silent = TRUE) checkException(RDApplyParams(rd, function(...) NULL, rep(applyParams,2)), silent = TRUE) ## exclude pattern -- length 1 character vector ## excludePattern(params) <- excludePattern ## checkTrue(validObject(params)) ## checkIdentical(excludePattern(params), excludePattern) ## params <- RDApplyParams(rd, function(...) NULL, ## excludePattern = excludePattern) ## checkTrue(validObject(params)) ## checkIdentical(excludePattern(params), excludePattern) ## checkException(RDApplyParams(rd, function(...) NULL, ## excludePattern = rep(excludePattern,2))) ## checkExcpetion(excludePattern(params)) <- rep(excludePattern, 2) ## filters filterRules <- FilterRules() filterRules(params) <- filterRules checkIdentical(filterRules(params), filterRules) params <- RDApplyParams(rd, function(...) NULL, filterRules = filterRules) checkTrue(validObject(params)) checkIdentical(filterRules(params), filterRules) filterRules <- FilterRules(list(basic = "filter", advanced = function(rd) NULL)) filterRules(params) <- filterRules checkTrue(validObject(params)) ## simplify -- length 1 logical simplify(params) <- TRUE checkTrue(validObject(params)) checkIdentical(simplify(params), TRUE) params <- RDApplyParams(rd, function(...) NULL, simplify = TRUE) checkTrue(validObject(params)) checkIdentical(simplify(params), TRUE) checkException(RDApplyParams(rd, function(...) NULL, simplify = rep(TRUE,2)), silent = TRUE) checkException(simplify(params) <- rep(FALSE, 2), silent = TRUE) ## reducer reducer <- function(rd) NULL ## oops, simplify is TRUE checkException(reducerFun(params) <- reducer, silent = TRUE) checkException(RDApplyParams(rd, function(...) NULL, simplify = TRUE, reducerFun = reducer), silent = TRUE) simplify(params) <- FALSE reducerFun(params) <- reducer checkTrue(validObject(params)) checkIdentical(reducerFun(params), reducer) params <- RDApplyParams(rd, function(...) NULL, reducerFun = reducer) checkTrue(validObject(params)) checkIdentical(reducerFun(params), reducer) reducerFun(params) <- NULL ## don't reduce checkTrue(validObject(params)) checkIdentical(reducerFun(params), NULL) ## reducer params ## NOTE: for some reason, new() becomes confused if we use 'applyParams' here reducerParams <- applyParams checkException(RDApplyParams(rd, function(...) NULL, ## oops, no reducer reducerParams = reducerParams), silent = TRUE) checkException(reducerParams(params) <- reducerParams, silent = TRUE) ## conflicts between reducer and its params ## needs 1 param checkException(reducerFun(params) <- function() NULL, silent = TRUE) checkException(RDApplyParams(rd, reducerFun = function() NULL), silent = TRUE) checkException(RDApplyParams(rd, fun, reducerFun = reducer, reducerParams = reducerParams), silent = TRUE) # needs 2 params reducerFun(params) <- function(rd) NULL checkException(reducerParams(params) <- reducerParams, silent = TRUE) ## parameter name mismatch checkException(RDApplyParams(rd, function(rd) NULL, reducerFun = function(rd, y) NULL, reducerParams = reducerParams), silent = TRUE) reducerFun(params) <- function(rd, y) NULL checkTrue(validObject(params)) checkException(reducerParams(params) <- reducerParams, silent = TRUE) ## ok with ... reducerFun(params) <- function(...) NULL checkTrue(validObject(params)) checkIdentical(reducerFun(params), function(...) NULL) reducerParams(params) <- reducerParams checkTrue(validObject(params)) checkIdentical(reducerParams(params), reducerParams) params <- RDApplyParams(rd, function(rd) NULL, reducerFun = function(...) NULL, reducerParams = reducerParams) checkTrue(validObject(params)) checkIdentical(reducerParams(params), reducerParams) checkException(reducerParams(params) <- rep(reducerParams,2), silent = TRUE) checkException(reducerParams(params) <- rep(reducerParams,2), silent = TRUE) checkException(RDApplyParams(rd, function(...) NULL, reducerFun = reducer, reducerParams = rep(reducerParams,2)), silent = TRUE) ## iteratorFun params <- RDApplyParams(rd, iteratorFun = lapply) checkTrue(validObject(params)) checkIdentical(iteratorFun(params), lapply) iteratorFun(params) <- sapply checkTrue(validObject(params)) checkIdentical(iteratorFun(params), sapply) checkException(iteratorFun(params) <- function(x) NULL, silent=TRUE) checkException(iteratorFun(params) <- function(x, simplify) NULL, silent=TRUE) } test_RDApplyParams_rdapply <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(2L, 0L, 1L) rd <- RangedData(ranges, filter, space = c("chr1","chr2","chr1")) fun <- function(rd) NULL countrows <- function(rd) nrow(rd) applyParams <- list(x = 2) excludePattern <- "[XY]" ## a single function params <- RDApplyParams(rd, fun) checkIdentical(rdapply(params), list(chr1 = NULL, chr2 = NULL)) ## with a parameter params <- RDApplyParams(rd, function(rd, x) x, list(x = 2)) checkIdentical(rdapply(params), list(chr1 = 2, chr2 = 2)) ## add a filter cutoff <- 0 cutoffFun <- function(rd) rd[["filter"]] > cutoff rules <- FilterRules(list(filter = cutoffFun)) params <- RDApplyParams(rd, countrows, filterRules = rules) checkIdentical(rdapply(params), list(chr1 = 2L, chr2 = 0L)) rules <- FilterRules(list(fun = function(rd) rd[["filter"]] < 2, filter = cutoffFun)) params <- RDApplyParams(rd, countrows, filterRules = rules) checkIdentical(rdapply(params), list(chr1 = 1L, chr2 = 0L)) active(filterRules(params))["filter"] <- FALSE checkIdentical(rdapply(params), list(chr1 = 1L, chr2 = 1L)) ## simplify params <- RDApplyParams(rd, countrows, simplify = TRUE) checkIdentical(rdapply(params), c(chr1 = 2L, chr2 = 1L)) ## reducing params <- RDApplyParams(rd, fun, reducerFun = unlist) checkIdentical(rdapply(params), NULL) params <- RDApplyParams(rd, countrows, reducerFun = unlist, reducerParams = list(use.names = FALSE)) checkIdentical(rdapply(params), c(2L, 1L)) } IRanges/inst/unitTests/test_RangedData.R0000644000126300012640000002573712227064500021634 0ustar00biocbuildphs_compbiotest_RangedData_construction <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) checkException(RangedData(c(1,2,3)), silent = TRUE) checkException(RangedData(ranges, c(1,2,3,4,5)), silent = TRUE) rd <- RangedData() checkTrue(validObject(rd)) rd <- RangedData(IRanges()) checkTrue(validObject(rd)) rd <- RangedData(IRangesList()) checkTrue(validObject(rd)) rd <- RangedData(IRangesList(IRanges())) checkTrue(validObject(rd)) rd <- RangedData(IRangesList(IRanges(), IRanges())) checkTrue(validObject(rd)) rd <- RangedData(IRangesList(IRanges(), IRanges(1,1))) checkTrue(validObject(rd)) rd <- RangedData(ranges) checkTrue(validObject(rd)) checkIdentical(unname(ranges(rd)), IRangesList(ranges)) rd <- RangedData(ranges, score) checkTrue(validObject(rd)) checkIdentical(rd[["score"]], score) rd <- RangedData(ranges, score = score) checkTrue(validObject(rd)) checkIdentical(rd[["score"]], score) rd <- RangedData(ranges, filter, score = score) checkTrue(validObject(rd)) checkIdentical(rd[["score"]], score) checkIdentical(rd[["filter"]], filter) rd <- RangedData(ranges, filter = filter, vals = score) checkTrue(validObject(rd)) checkIdentical(rd[["vals"]], score) checkIdentical(rd[["filter"]], filter) rd <- RangedData(ranges, score + score) checkTrue(validObject(rd)) checkIdentical(rd[["score...score"]], score + score) rd <- RangedData(ranges, universe = "hg18") checkTrue(validObject(rd)) checkIdentical(universe(rd), "hg18") range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) both <- c(ranges, range2) score <- c(score, c(0L, 3L, NA, 22L)) chrom <- paste("chr", rep(c(1,2), c(length(ranges), length(range2))), sep="") rd <- RangedData(both, score, space = chrom, universe = "hg18") checkTrue(validObject(rd)) checkIdentical(rd[["score"]], score) checkIdentical(rd[1][["score"]], score[1:3]) checkException(RangedData(ranges, universe = c("hg18", "mm9")), silent = TRUE) checkException(RangedData(ranges, universe = 1), silent = TRUE) checkException(RangedData(both, space = chrom[1:3]), silent = TRUE) } test_RangedData_extraction <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd <- RangedData(ranges, filter, score = score, space = c(1, 1, 2)) checkException(rd[[]], silent = TRUE) checkException(rd[[1, 2]], silent = TRUE) checkException(rd[[numeric()]], silent = TRUE) checkException(rd[[NULL]], silent = TRUE) checkException(rd[[c(1,2)]], silent = TRUE) checkException(rd[[-1]], silent = TRUE) checkException(rd[[5]], silent = TRUE) checkIdentical(rd[["vals"]], NULL) checkIdentical(rd$vals, NULL) checkIdentical(rd[[NA_integer_]], NULL) checkIdentical(rd[[1]], filter) checkIdentical(rd[[2]], score) checkIdentical(rd[["filter"]], filter) checkIdentical(rd[["score"]], score) checkIdentical(rd$score, score) checkIdentical(rd[1][[1]], filter[1:2]) } test_RangedData_values_replace <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd1 <- RangedData(ranges, filter, space = c(1, 2, 1)) values(rd1) <- split(DataFrame(filter=score), c(1, 2, 1)) rd2 <- RangedData(ranges, filter=score, space = c(1, 2, 1)) checkIdentical(rd1, rd2) rd1 <- RangedData(ranges, filter, space = c(1, 2, 1)) values(rd1) <- DataFrame(filter=score[c(1,3,2)]) rd2 <- RangedData(ranges, filter=score, space = c(1, 2, 1)) checkIdentical(rd1, rd2) } test_RangedData_ranges_replace <- function() { ranges1 <- IRanges(c(1,2,3),c(4,5,6)) ranges2 <- IRanges(c(3,2,1),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd1 <- RangedData(ranges1, filter, space = c(1, 2, 1)) ranges(rd1) <- split(ranges2, c(1, 2, 1)) rd2 <- RangedData(ranges2, filter, space = c(1, 2, 1)) checkIdentical(rd1, rd2) rd1 <- RangedData(ranges1, filter, space = c(1, 2, 1)) ranges(rd1) <- ranges2[c(1,3,2)] rd2 <- RangedData(ranges2, filter, space = c(1, 2, 1)) checkIdentical(rd1, rd2) } test_RangedData_data_column_replace <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd <- RangedData(ranges, filter, space = c(1, 2, 1)) filter <- filter[c(1, 3, 2)] score <- score[c(1, 3, 2)] checkException(rd[[]] <- score, silent = TRUE) checkException(rd[[1, 2]] <- score, silent = TRUE) checkException(rd[[numeric()]] <- score, silent = TRUE) checkException(rd[[NULL]] <- score, silent = TRUE) checkException(rd[[c(1,2)]] <- score, silent = TRUE) checkException(rd[[-1]] <- score, silent = TRUE) checkException(rd[[5]] <- score, silent = TRUE) checkException(rd[["score"]] <- numeric(), silent = TRUE) checkException(rd[["score"]] <- score[1:2], silent = TRUE) rd[["score"]] <- score checkTrue(validObject(rd)) checkIdentical(rd[["score"]], score) filter2 <- c(1L, 1L, 0L) rd[["filter"]] <- filter2 checkTrue(validObject(rd)) checkIdentical(rd[["filter"]], filter2) ##rd[["score"]] <- score[1] # no recycling yet ##checkTrue(validObject(rd)) ##checkIdentical(rd[["score"]], rep(score[1], 3)) rd[[2]] <- score checkTrue(validObject(rd)) checkIdentical(rd[[2]], score) rd[[2]] <- NULL checkTrue(validObject(rd)) checkIdentical(ncol(rd), 1L) rd$score2 <- score checkIdentical(rd$score2, score) } test_RangedData_subset <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd <- RangedData(ranges, filter, score = score, space = c(1, 2, 1)) filter <- filter[c(1, 3, 2)] score <- score[c(1, 3, 2)] checkException(rd[list()], silent = TRUE) checkException(rd[10], silent = TRUE) checkException(rd[c(NA, 2)], silent = TRUE) checkException(rd["one"], silent = TRUE) checkException(rd[c(TRUE, TRUE, TRUE, TRUE)], silent = TRUE) checkException(rd[c(-1,2)], silent = TRUE) erd <- new("RangedData") names(erd) <- character(0) frd <- RangedData(ranges[c(1,3)], filter = filter[1:2], score = score[1:2], space = 1) checkIdenticalRD <- function(a, b) { checkIdentical(as(ranges(a), "CompressedIRangesList"), as(ranges(b), "CompressedIRangesList")) checkIdentical(length(values(a)), length(values(b))) if (length(values(a)) > 0) checkIdentical(as.data.frame(values(a)), as.data.frame(values(b))) else TRUE } checkIdenticalRD(rd[numeric()], erd) checkIdenticalRD(rd[logical()], erd) checkIdenticalRD(rd[NULL], erd) checkIdenticalRD(rd[], rd) checkIdenticalRD(rd[FALSE], erd) checkIdenticalRD(rd[c(FALSE, FALSE)], erd) checkIdenticalRD(rd[TRUE], rd) checkIdenticalRD(rd[c(TRUE, FALSE)], frd) checkIdenticalRD(rd[1], frd) checkIdenticalRD(rd[c(1,2)], rd) checkIdenticalRD(rd[-2], frd) ## now test matrix-style checkException(rd[,100], silent = TRUE) # out of bounds col checkException(rd[1000,], silent = TRUE) # out of bounds row checkException(rd[foo = "bar"], silent = TRUE) # invalid argument checkException(rd["Sion",], silent = TRUE) # no subsetting by row name yet checkException(rd[,"Fert"], silent = TRUE) # bad column name checkIdenticalRD(rd[,], rd) # identity ## empty nocols <- RangedData(ranges, new("DataFrame", nrows=3L), space=c(1,2,1)) checkIdenticalRD(rd[,NULL], nocols) checkIdenticalRD(rd[NULL,], rd[FALSE,]) ## column subsetting onecol <- RangedData(ranges, filter=filter[c(1,3,2)], space=c(1,2,1)) checkIdenticalRD(rd[,1], onecol) checkIdenticalRD(rd[,1:2], rd) checkIdenticalRD(rd[,"filter"], rd[,1]) # by name firstrow <- RangedData(ranges[1], filter = filter[1], score = score[1], space = 1) checkIdenticalRD(rd[1,,drop=TRUE], firstrow) # row subsetting splitrow <- RangedData(ranges[1:2], filter = filter[c(1,3)], score = score[c(1,3)], space = c(1,2)) checkIdenticalRD(rd[c(1,3),], splitrow) # row subsetting checkIdenticalRD(rd[1:2, 1], onecol[1:2,]) # combined ## repeats repeated <- RangedData(ranges[c(1,3,1,2)], filter=filter[c(1:2,1,3)], space = c(1,1,1,2)) checkIdenticalRD(rd[c(1:2,1,3),1], repeated) } test_RangedData_combine <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd <- RangedData(ranges, score, space = filter) ## c() checkTrue(validObject(c(rd[1], rd[2]))) checkIdentical(ranges(c(rd[1], rd[2])), ranges(rd)) checkIdentical(as.data.frame(values(c(rd[1], rd[2]))), as.data.frame(values(rd))) checkException(c(rd[1], ranges), silent = TRUE) ## split() rd2 <- RangedData(ranges, score) checkIdentical(as.data.frame(unlist(split(rd2, filter))), as.data.frame(rd2[order(filter),])) checkException(split(rd2, filter[1:2]), silent = TRUE) ## rbind() ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd1 <- RangedData(ranges, score, space = filter) score2 <- c(15L, 10L, 3L) space2 <- c(0L, 1L, 0L) ranges2 <- IRanges(c(2,5,1), c(8, 6, 9)) rd2 <- RangedData(ranges2, score = score2, space = space2) rd <- RangedData(c(ranges, ranges2), score=c(score,score2), space=c(filter, space2)) checkIdentical(as.data.frame(rbind(rd1, rd2)), as.data.frame(rd)) rownames(rd1) <- letters[seq_len(nrow(rd1))] rownames(rd2) <- letters[seq_len(nrow(rd2))] checkTrue(validObject(rbind(rd1, rd2))) universe(rd2) <- "foo" checkException(rbind(rd1, rd2), silent=TRUE) } test_RangedData_lapply <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd <- RangedData(ranges, score, space = filter) checkIdentical(lapply(rd, `[[`, 1), list(`0` = 2L, `1` = c(10L, NA))) } test_RangedData_range <- function() { rd1 <- RangedData(IRanges(c(2,5,1), c(3,7,3))) rd2 <- RangedData(IRanges(c(5,2,0), c(6,3,1))) checkIdentical(range(rd1), IRangesList("1" = IRanges(1, 7))) checkIdentical(range(rd1, rd2), IRangesList("1" = IRanges(0, 7))) checkException(range(rd1, c(2,3)), silent = TRUE) } test_RangedData_dimnames <- function() { ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) rd <- RangedData(ranges, filter, score = score, space = c(1, 2, 1)) colnames(rd)[2] <- "foo" checkTrue(validObject(rd)) checkIdentical(colnames(rd), c("filter", "foo")) rownames(rd) <- c("a", "b", "c") checkTrue(validObject(rd)) checkIdentical(rownames(rd), c("a", "b", "c")) } test_RangedData_fromDataFrame <- function() { df <- data.frame(start = c(1, 2, 3), end = c(4, 2, 3)) rd <- RangedData(IRanges(c(1,2,3), c(4,2,3)), df[,NULL]) checkIdentical(as(df, "RangedData"), rd) checkException(as(df[,1,drop=FALSE], "RangedData"), rd, silent=TRUE) df <- data.frame(start = c(1, 2, 3), end = c(4, 2, 3), space = c(1, 1, 2), foo = c("a", "b", "c")) rd <- RangedData(IRanges(c(1,2,3), c(4,2,3)), df[,"foo",drop=FALSE], space = c(1,1,2)) checkIdentical(as(df, "RangedData"), rd) } IRanges/inst/unitTests/test_Ranges-comparison.R0000644000126300012640000000364612227064500023224 0ustar00biocbuildphs_compbiotest_Ranges_compare <- function() { x1 <- IRanges(6:16, width=4) y <- IRanges(11, 14) target <- c(-6:-4, -4L, -4L, 0L, 4L, 4L, 4:6) checkIdentical(target, compare(x1, y)) checkIdentical(-target, compare(y, x1)) x2 <- IRanges(4:16, width=6) target <- c(-6:-4, -4L, -4L, -3L, -2L, 1L, 4L, 4L, 4:6) checkIdentical(target, compare(x2, y)) checkIdentical(-target, compare(y, x2)) x3 <- IRanges(8:16, width=2) target <- c(-6:-4, -1L, 2L, 3L, 4:6) checkIdentical(target, compare(x3, y)) checkIdentical(-target, compare(y, x3)) ## Moving a 0-width range over a non 0-width range. ## Note that when the end of the 0-width range is equal to the start of ## the non 0-width range minus 1, returning code -5 (which describes ## a situation of adjacent ranges) seems appropriate. ## However, one could argue that returning code -1 (which describes a ## situation where one range is inside the other) would also be ## appropriate, because, in that case, the two ranges have the same start. ## So the question really is whether the 0-width range should be considered ## *outside* or *inside* the non 0-width range. ## It's an arbitrary choice and we chose the former. x0 <- IRanges(10:16, width=0) target <- c(-6:-5, 2L, 2L, 2L, 5:6) checkIdentical(target, compare(x0, y)) checkIdentical(-target, compare(y, x0)) ## Moving a 0-width range over a 0-width range. y0 <- IRanges(13, 12) target <- c(-6L, -6L, -6L, 0L, 6L, 6L, 6L) checkIdentical(target, compare(x0, y0)) checkIdentical(-target, compare(y0, x0)) } test_Ranges_order <- function() { ir1 <- IRanges(c(2,5,1,5), c(3,7,3,6)) ir1.sort <- IRanges(c(1,2,5,5), c(3,3,6,7)) ir1.rev <- IRanges(c(5,5,2,1), c(7,6,3,3)) checkIdentical(sort(ir1), ir1.sort) checkIdentical(sort(ir1, decreasing=TRUE), ir1.rev) checkException(sort(ir1, decreasing=NA), silent = TRUE) } IRanges/inst/unitTests/test_RangesList.R0000644000126300012640000001111412227064500021675 0ustar00biocbuildphs_compbiotest_RangesList_construction <- function() { empty <- RangesList() checkTrue(validObject(empty)) checkIdentical(length(empty), 0L) range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) named <- RangesList(one = range1, two = range2) checkTrue(validObject(named)) checkIdentical(length(named), 2L) checkIdentical(start(named), IntegerList(one = start(range1), two = start(range2), compress=FALSE)) checkIdentical(end(named), IntegerList(one = end(range1), two = end(range2), compress=FALSE)) checkIdentical(width(named), IntegerList(one = width(range1), two = width(range2), compress=FALSE)) checkIdentical(names(named), c("one", "two")) checkIdentical(range1, named[[1]]) unnamed <- RangesList(range1, range2) checkTrue(validObject(unnamed)) checkIdentical(length(unnamed), 2L) checkIdentical(range2, unnamed[[2]]) checkIdentical(names(unnamed), NULL) } test_RangesList_subset <- function() { ## by RangesList range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(1,15,20,45), end=c(5,15,100,80)) collection <- RangesList(one = range1, range2) checkIdentical(subsetByOverlaps(collection, RangesList()), RangesList(one=IRanges(), IRanges())) checkIdentical(subsetByOverlaps(collection, RangesList(IRanges(4, 6), IRanges(50, 70))), RangesList(one=IRanges(c(1,3),c(5,8)), IRanges(c(20,45),c(100,80)))) checkIdentical(subsetByOverlaps(collection, RangesList(IRanges(50, 70), one=IRanges(4, 6))), RangesList(one=IRanges(c(1,3),c(5,8)), IRanges())) } test_RangesList_as_list <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) checkIdentical(list(range1, range2), as.list(RangesList(range1, range2))) checkIdentical(list(a=range1, b=range2), as.list(RangesList(a=range1, b=range2))) } test_RangesList_as_data_frame <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) checkIdentical(data.frame(space=rep(c("1", "2"), c(3,4)), as.data.frame(c(range1,range2))), as.data.frame(RangesList(range1, range2))) checkIdentical(data.frame(space=rep(c("a", "b"), c(3,4)), as.data.frame(c(range1,range2))), as.data.frame(RangesList(a=range1, b=range2))) } test_IRangesList_construction <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) for (compress in c(TRUE, FALSE)) { named <- IRangesList(one = range1, two = range2, compress = compress) checkIdentical(length(named), 2L) checkIdentical(names(named), c("one", "two")) checkIdentical(range1, named[[1]]) unnamed <- IRangesList(range1, range2) checkTrue(validObject(unnamed)) checkIdentical(length(unnamed), 2L) checkIdentical(range2, unnamed[[2]]) checkIdentical(names(unnamed), NULL) } } test_IRangesList_annotation <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) for (compress in c(TRUE, FALSE)) { rl <- IRangesList(range1, range2, compress = compress) mcols(rl) <- DataFrame(a = 1:2) checkIdentical(mcols(rl)[,1], 1:2) checkIdentical(mcols(rl[2:1])[,1], 2:1) checkIdentical(mcols(c(rl,rl))[,1], rep(1:2,2)) checkIdentical(mcols(append(rl,rl))[,1], rep(1:2,2)) } } ## test_RangesList_overlap <- function() { ## rl1 <- RangesList(a = IRanges(c(1,2),c(4,3)), b = IRanges(c(4,6),c(10,7))) ## rl2 <- RangesList(b = IRanges(c(0,2),c(4,5)), a = IRanges(c(4,5),c(6,7))) ## overlap(rl1, rl2) ## overlap(rl1, rl2, select = "first") ## overlap(rl1, rl2, select = "first", drop = TRUE) ## names(rl2)[1] <- "c" ## overlap(rl1, rl2) ## overlap(rl1, rl2, select = "first") ## overlap(rl1, rl2, select = "first", drop = TRUE) ## names(rl2) <- NULL ## overlap(rl1, rl2) ## overlap(rl1, rl2, select = "first") ## overlap(rl1, rl2, select = "first", drop = TRUE) ## overlap(rl1, rl2[1]) ## overlap(rl1, rl2[1], select = "first") ## overlap(rl1, rl2[1], select = "first", drop = TRUE) ## overlap(rl1[1], rl2) ## overlap(rl1[1], rl2, select = "first") ## overlap(rl1[1], rl2, select = "first", drop = TRUE) ## } IRanges/inst/unitTests/test_Rle.R0000644000126300012640000007621712227064500020363 0ustar00biocbuildphs_compbiotest_Rle_construction <- function() { empty <- Rle() checkTrue(validObject(empty)) checkIdentical(Rle(), new("Rle")) checkIdentical(length(empty), 0L) x <- Rle(rep(6:10, 1:5)) checkTrue(validObject(x)) checkIdentical(x, Rle(6:10, 1:5)) y <- Rle(factor(rep(letters, 1:26))) checkTrue(validObject(y)) checkIdentical(y, Rle(factor(letters), 1:26)) checkIdentical(Rle(c(TRUE, TRUE, FALSE, FALSE, FALSE, NA, NA, NA)), Rle(c(TRUE, FALSE, NA), c(2, 3, 3))) checkIdentical(Rle(c(1L, 1L, 1L, 2L, 2L, NA, NA, NA)), Rle(c(1L, 2L, NA), c(3, 2, 3))) checkIdentical(Rle(c(1, 1, 1, 2, 2, NA, NA, NA)), Rle(c(1, 2, NA), c(3, 2, 3))) checkIdentical(Rle(c("a", "a", "b", "b", "b", NA, NA, NA)), Rle(c("a", "b", NA), c(2, 3, 3))) } test_Rle_replace <- function() { x <- Rle(1:26, 1:26) runValue(x) <- letters checkTrue(validObject(x)) checkIdentical(x, Rle(letters, 1:26)) runLength(x) <- 26:1 checkTrue(validObject(x)) checkIdentical(x, Rle(letters, 26:1)) } test_Rle_coercion <- function() { x <- rep(6:10, 1:5) xRle <- Rle(x) y <- c(TRUE,TRUE,FALSE,FALSE,TRUE,FALSE,TRUE,TRUE,TRUE) yRle <- Rle(y) checkIdentical(x, as.vector(xRle)) checkIdentical(as.integer(x), as.integer(xRle)) checkIdentical(as.numeric(x), as.numeric(xRle)) checkIdentical(as.complex(x), as.complex(xRle)) checkIdentical(as.factor(x), as.factor(xRle)) checkIdentical(y, as.vector(yRle)) checkIdentical(as.logical(y), as.logical(yRle)) checkIdentical(as.character(y), as.character(yRle)) checkIdentical(as.raw(y), as.raw(yRle)) checkIdentical(as.factor(y), as.factor(yRle)) } test_Rle_groupGeneric <- function() { set.seed(0) x <- sample(0:3, 50, replace = TRUE) xRle <- Rle(x) checkIdentical(numeric(0) + 1, as.vector(Rle(numeric(0)) + 1)) checkIdentical(x + 1, as.vector(xRle + 1)) checkIdentical(2 * x + 3, as.vector(2 * xRle + 3)) checkIdentical(x[(x > 0) & (x < 3)], as.vector(xRle[(xRle > 0) & (xRle < 3)])) checkIdentical(log(x), as.vector(log(xRle))) checkIdentical(range(x), range(xRle)) checkIdentical(sum(x), sum(xRle)) checkIdentical(prod(x), prod(xRle)) checkIdentical(cumsum(x), as.vector(cumsum(xRle))) checkIdentical(cumprod(x), as.vector(cumprod(xRle))) checkIdentical(round(x + .25), as.vector(round(xRle + .25))) checkIdentical(signif(x + .25), as.vector(signif(xRle + .25))) checkIdentical(Im(x + 5i), as.vector(Im(xRle + 5i))) } test_Rle_general <- function() { x <- rep(6:10, 1:5) xRle <- Rle(x) checkIdentical(unique(x), unique(xRle)) checkIdentical(x[c(3,2,4,6)], as.vector(xRle[c(3,2,4,6)])) checkIdentical(aggregate(xRle, IRanges(start = 3:6, end = 13:10), FUN = mean), aggregate(xRle, FUN = mean, start = 3:6, width = seq(11, 5, by = -2))) exp <- c(mean(x[3:13]), mean(x[4:12]), mean(x[5:11]), mean(x[6:10])) agg <- aggregate(xRle, FUN = function(x) x, start = 3:6, end = 13:10) checkEquals(exp, sapply(agg, mean)) checkEquals(exp, aggregate(xRle, FUN = mean, start = 3:6, end = 13:10)) checkEquals(as.vector(aggregate.ts(ts(x, frequency = 5), FUN = mean)), aggregate(xRle, FUN = mean, start = c(1, 6, 11), end = c(5, 10, 15))) checkIdentical(append(x,x), as.vector(append(xRle,xRle))) checkIdentical(append(x,x,3), as.vector(append(xRle,xRle,3))) checkIdentical(c(x,x) %in% c(7:9), as.vector(c(xRle,xRle)) %in% c(7:9)) checkIdentical(c(x, x), as.vector(c(xRle, xRle))) checkIdentical(findRange(c(1, 3, 5), xRle), IRanges(start = c(1,2,4), width = 1:3)) checkIdentical(head(x, 8), as.vector(head(xRle, 8))) checkIdentical(head(x, -3), as.vector(head(xRle, -3))) checkIdentical(is.na(c(NA, x, NA, NA, NA, x, NA)), as.vector(is.na(c(Rle(NA), xRle, Rle(NA, 3), xRle, Rle(NA))))) checkIdentical(is.unsorted(c(1,2,2,3)), is.unsorted(Rle(c(1,2,2,3)))) checkIdentical(is.unsorted(c(1,2,2,3), strictly = TRUE), is.unsorted(Rle(c(1,2,2,3)), strictly = TRUE)) checkIdentical(length(x), length(xRle)) checkIdentical(match(c(x,x), c(7:9)), as.vector(match(c(xRle,xRle), c(7:9)))) checkIdentical(rep(x, times = 2), as.vector(rep(xRle, times = 2))) checkIdentical(rep(x, times = x), as.vector(rep(xRle, times = x))) checkIdentical(rep(x, length.out = 20), as.vector(rep(xRle, length.out = 20))) checkIdentical(rep(x, each = 2), as.vector(rep(xRle, each = 2))) checkIdentical(rep(x, x, 20), as.vector(rep(xRle, x, 20))) checkException(rep(xRle, x, each = 2), silent = TRUE) checkIdentical(rep(x, 2, each = 2), as.vector(rep(xRle, 2, each = 2))) checkIdentical(rep(x, length.out = 20, each = 2), as.vector(rep(xRle, length.out = 20, each = 2))) checkIdentical(rep(x, x, 20, 2), as.vector(rep(xRle, x, 20, 2))) checkIdentical(rep.int(x, times = 2), as.vector(rep.int(xRle, times = 2))) checkIdentical(rev(x), as.vector(rev(xRle))) checkIdentical(as.vector(xRle[IRanges(start=1:3, width=1:3)]), x[c(1,2,3,3,4,5)]) z <- x z[] <- rev(z) zRle <- xRle zRle[] <- rev(zRle) checkIdentical(z, as.vector(zRle)) z <- x z[c(1,5,3)] <- 3:1 zRle <- xRle zRle[c(1,5,3)] <- 3:1 checkIdentical(z, as.vector(zRle)) z <- x z[1:5] <- 0L zRle <- xRle zRle[IRanges(start=1:3, width=1:3)] <- 0L checkIdentical(z, as.vector(zRle)) checkIdentical(sort(c(x,x)), as.vector(sort(c(xRle,xRle)))) checkException(split(Rle(1:26), integer()), silent = TRUE) checkException(split(Rle(1:26), Rle()), silent = TRUE) checkIdentical(lapply(as.list(split(Rle(1:26), letters)), as.vector), split(1:26, letters)) checkIdentical(lapply(as.list(split(Rle(1:26), Rle(letters))), as.vector), split(1:26, letters)) checkIdentical(lapply(as.list(split(Rle(1:26), letters[1:2])), as.vector), split(1:26, letters[1:2])) checkIdentical(lapply(as.list(split(Rle(1:26), Rle(letters[1:2]))), as.vector), split(1:26, letters[1:2])) checkIdentical(lapply(as.list(split(Rle(integer()), letters)), as.vector), split(integer(), letters)) checkIdentical(lapply(as.list(split(Rle(integer()), Rle(letters))), as.vector), split(integer(), letters)) checkIdentical(splitRanges(Rle(letters, 1:26)), split(IRanges(end = cumsum(1:26), width = 1:26), letters)) checkIdentical(as.vector(subset(xRle, rep(c(TRUE, FALSE), length.out = length(x)))), subset(x, rep(c(TRUE, FALSE), length.out = length(x)))) checkIdentical(summary(x), summary(xRle)) checkIdentical(tail(x, 8), as.vector(tail(xRle, 8))) checkIdentical(tail(x, -3), as.vector(tail(xRle, -3))) checkException(tapply(xRle), silent = TRUE) checkIdentical(tapply(x, x), tapply(xRle, xRle)) checkIdentical(tapply(x, x, mean), tapply(xRle, xRle, mean)) checkIdentical(tapply(xRle, x, mean), tapply(xRle, xRle, mean)) checkIdentical(tapply(x, x, mean, simplify = FALSE), tapply(xRle, xRle, mean, simplify = FALSE)) checkIdentical(tapply(xRle, x, mean, simplify = FALSE), tapply(xRle, xRle, mean, simplify = FALSE)) checkIdentical(as.vector(window(x, start = 3, end = 13)), as.vector(window(xRle, start = 3, end = 13))) checkIdentical(as.vector(window(x, start = 3, end = 13, frequency = 1/2)), as.vector(window(xRle, start = 3, end = 13, frequency = 1/2))) checkIdentical(as.vector(window(x, start = 3, end = 13, delta = 3)), as.vector(window(xRle, start = 3, end = 13, delta = 3))) z <- x z[3:13] <- 0L zRle <- xRle window(zRle, start = 3, end = 13) <- 0L checkIdentical(z, as.vector(zRle)) } test_Rle_logical <- function() { checkIdentical(logical(), as.vector(Rle(logical()))) x <- c(TRUE,TRUE,FALSE,FALSE,TRUE,FALSE,TRUE,TRUE,TRUE) xRle <- Rle(x) checkIdentical(!x, as.vector(!x)) checkIdentical(which(x), as.vector(which(x))) checkIdentical(as(xRle, "IRanges"), IRanges(start = c(1,5,7), width = c(2, 1, 3))) } test_Rle_numerical <- function() { checkIdentical(numeric(), as.vector(Rle(numeric()))) x <- cumsum(cumsum(1:10)) xRle <- Rle(x) checkIdentical(pmax(x, rev(x)), as.vector(pmax(xRle, rev(xRle)))) checkIdentical(pmin(x, rev(x)), as.vector(pmin(xRle, rev(xRle)))) checkIdentical(pmax.int(x, rev(x)), as.vector(pmax.int(xRle, rev(xRle)))) checkIdentical(pmin.int(x, rev(x)), as.vector(pmin.int(xRle, rev(xRle)))) checkIdentical(diff(x), as.vector(diff(xRle))) checkIdentical(diff(x, lag = 2), as.vector(diff(xRle, lag = 2))) checkIdentical(diff(x, differences = 2), as.vector(diff(xRle, differences = 2))) checkIdentical(diff(x, lag = 2, differences = 2), as.vector(diff(xRle, lag = 2, differences = 2))) x <- rep(c(1.2, 3.4, NA, 7.8, 9.0), 1:5) y <- x - rev(x) xRle <- Rle(x) yRle <- Rle(y) checkIdentical(mean(x), mean(xRle)) checkIdentical(mean(x, na.rm = TRUE), mean(xRle, na.rm = TRUE)) checkIdentical(var(x), var(xRle)) checkEqualsNumeric(var(x, na.rm = TRUE), var(xRle, na.rm = TRUE)) checkIdentical(var(x, y), var(xRle, yRle)) checkEqualsNumeric(var(x, y, na.rm = TRUE), var(xRle, yRle, na.rm = TRUE)) checkIdentical(cov(x, y), cov(xRle, yRle)) checkEqualsNumeric(cov(x, y, use = "complete"), cov(xRle, yRle, use = "complete")) checkIdentical(cor(x, y), cor(xRle, yRle)) checkEqualsNumeric(cor(x, y, use = "complete"), cor(xRle, yRle, use = "complete")) checkIdentical(sd(x), sd(xRle)) checkEqualsNumeric(sd(x, na.rm = TRUE), sd(xRle, na.rm = TRUE)) checkIdentical(median(x), median(xRle)) checkIdentical(median(x, na.rm = TRUE), median(xRle, na.rm = TRUE)) checkIdentical(quantile(x, na.rm = TRUE), quantile(xRle, na.rm = TRUE)) checkIdentical(mad(x), mad(xRle)) checkIdentical(mad(x, na.rm = TRUE), mad(xRle, na.rm = TRUE)) checkIdentical(IQR(x, na.rm = TRUE), IQR(xRle, na.rm = TRUE)) y <- (-20:20)^2 y[c(1,10,21,41)] <- c(100L, 30L, 400L, 470L) checkEqualsNumeric(smoothEnds(y), as.vector(smoothEnds(Rle(y)))) checkEqualsNumeric(runmed(y, 7), as.vector(runmed(Rle(y), 7))) checkEqualsNumeric(runmed(y, 11), as.vector(runmed(Rle(y), 11))) checkEqualsNumeric(runmed(y, 7, "keep"), as.vector(runmed(Rle(y), 7, "keep"))) checkEqualsNumeric(runmed(y, 11, "keep"), as.vector(runmed(Rle(y), 11, "keep"))) checkEqualsNumeric(runmed(y, 7, "constant"), as.vector(runmed(Rle(y), 7, "constant"))) checkEqualsNumeric(runmed(y, 11, "constant"), as.vector(runmed(Rle(y), 11, "constant"))) x <- rep(c(1.2, 3.4, 5.6, 7.8, 9.0), 1:5) y <- rep(1:5, c(4, 2, 5, 1, 3)) xRle <- Rle(x) yRle <- Rle(y) checkEqualsNumeric(sapply(1:13, function(i) sum(window(x, i, i + 2))), as.numeric(runsum(xRle, k = 3))) # checkEqualsNumeric(sapply(1:13, function(i) sum(window(rev(x), i, i + 2))), # as.numeric(runsum(rev(xRle), k = 3))) checkEqualsNumeric(sapply(1:13, function(i) sum(window(y, i, i + 2))), as.integer(runsum(yRle, k = 3))) checkEqualsNumeric(sapply(1:13, function(i) sum(window(rev(y), i, i + 2))), as.integer(runsum(rev(yRle), k = 3))) checkEqualsNumeric(sapply(1:13, function(i) mean(window(x, i, i + 2))), as.numeric(runmean(xRle, k = 3))) checkEqualsNumeric(sapply(1:13, function(i) mean(window(rev(x), i, i + 2))), as.numeric(runmean(rev(xRle), k = 3))) checkEqualsNumeric(sapply(1:13, function(i) mean(window(y, i, i + 2))), as.numeric(runmean(yRle, k = 3))) checkEqualsNumeric(sapply(1:13, function(i) mean(window(rev(y), i, i + 2))), as.numeric(runmean(rev(yRle), k = 3))) checkEqualsNumeric(sapply(1:13, function(i) sum(window(x, i, i + 2))), as.numeric(runwtsum(xRle, k = 3, wt = rep(1,3)))) checkEqualsNumeric(sapply(1:13, function(i) sum(window(x, i, i + 2)/3)), as.numeric(runwtsum(xRle, k = 3, wt = rep(1/3,3)))) checkEqualsNumeric(sapply(1:13, function(i) sum(window(y, i, i + 2))), as.numeric(runwtsum(yRle, k = 3, wt = rep(1,3)))) checkEqualsNumeric(sapply(1:13, function(i) sum(window(y, i, i + 2)/3)), as.numeric(runwtsum(yRle, k = 3, wt = rep(1/3,3)))) checkEqualsNumeric(sapply(1:13, function(i) min(window(x, i, i + 2))), as.numeric(runq(xRle, k = 3, i = 1))) checkEqualsNumeric(sapply(1:13, function(i) median(window(x, i, i + 2))), as.numeric(runq(xRle, k = 3, i = 2))) checkEqualsNumeric(sapply(1:13, function(i) max(window(x, i, i + 2))), as.numeric(runq(xRle, k = 3, i = 3))) checkIdentical(runq(xRle, k = 3, i = 2), rev(runq(rev(xRle), k = 3, i = 2))) checkEqualsNumeric(sapply(1:13, function(i) min(window(y, i, i + 2))), as.numeric(runq(yRle, k = 3, i = 1))) checkEqualsNumeric(sapply(1:13, function(i) median(window(y, i, i + 2))), as.numeric(runq(yRle, k = 3, i = 2))) checkEqualsNumeric(sapply(1:13, function(i) max(window(y, i, i + 2))), as.numeric(runq(yRle, k = 3, i = 3))) checkIdentical(runq(yRle, k = 3, i = 2), rev(runq(rev(yRle), k = 3, i = 2))) } test_Rle_character <- function() { checkIdentical(character(), as.vector(Rle(character()))) txt <- c("The", "licenses", "for", "most", "software", "are", "designed", "to", "take", "away", "your", "freedom", "to", "share", "and", "change", "it.", "", "By", "contrast,", "the", "GNU", "General", "Public", "License", "is", "intended", "to", "guarantee", "your", "freedom", "to", "share", "and", "change", "free", "software", "--", "to", "make", "sure", "the", "software", "is", "free", "for", "all", "its", "users") txt <- rep(txt, seq_len(length(txt))) txtRle <- Rle(txt) checkIdentical(nchar(txt), as.vector(nchar(txtRle))) checkIdentical(substr(txt, 3, 7), as.vector(substr(txtRle, 3, 7))) checkIdentical(substring(txt, 4, 9), as.vector(substring(txtRle, 4, 9))) checkIdentical(chartr("@!*", "alo", txt), as.vector(chartr("@!*", "alo", txtRle))) checkIdentical(tolower(txt), as.vector(tolower(txtRle))) checkIdentical(toupper(txt), as.vector(toupper(txtRle))) checkIdentical(sub("[b-e]",".", txt), as.vector(sub("[b-e]",".", txtRle))) checkIdentical(gsub("[b-e]",".", txt), as.vector(gsub("[b-e]",".", txtRle))) checkIdentical(paste(txt, rev(txt), sep = "|"), as.vector(paste(txtRle, rev(txtRle), sep = "|"))) modifyFactor <- function(x, FUN, ...) { levels(x) <- FUN(levels(x), ...) x } fac <- factor(txt) facRle <- Rle(fac) checkIdentical(modifyFactor(fac, substr, 3, 7), as.factor(substr(facRle, 3, 7))) checkIdentical(modifyFactor(fac, substring, 4, 9), as.factor(substring(facRle, 4, 9))) checkIdentical(modifyFactor(fac, chartr, old = "@!*", new = "alo"), as.factor(chartr("@!*", "alo", facRle))) checkIdentical(modifyFactor(fac, tolower), as.factor(tolower(facRle))) checkIdentical(modifyFactor(fac, toupper), as.factor(toupper(facRle))) checkIdentical(modifyFactor(fac, sub, pattern = "[b-e]", replacement = "."), as.factor(sub("[b-e]",".", facRle))) checkIdentical(modifyFactor(fac, gsub, pattern = "[b-e]", replacement = "."), as.factor(gsub("[b-e]",".", facRle))) checkTrue(is.factor(runValue(paste(facRle, rev(facRle), sep = "|")))) } test_Rle_factor <- function() { checkIdentical(factor(character()), as.factor(Rle(factor(character())))) x <- factor(rep(letters, 1:26)) xRle <- Rle(x) checkIdentical(levels(x), levels(xRle)) levels(x) <- LETTERS levels(xRle) <- LETTERS checkIdentical(levels(x), levels(xRle)) checkIdentical(nlevels(x), 26L) xRle[] <- xRle checkIdentical(Rle(x), xRle) checkIdentical(x, xRle[TRUE,drop=TRUE]) } ## --------------------------------------------- ## table() and sort() ## --------------------------------------------- test_Rle_sort <- function() { ## atomic ix <- c(NA, 3L, NA) nx <- c(2, 5, 1, 2, NA, 5, NA) cx <- c("c", "B", NA, "a") lx <- c(FALSE, FALSE, NA, TRUE, NA) checkIdentical(sort(nx), as.numeric(sort(Rle(nx)))) checkIdentical(sort(nx, na.last=TRUE), as.numeric(sort(Rle(nx), na.last=TRUE))) checkIdentical(sort(nx, na.last=FALSE), as.numeric(sort(Rle(nx), na.last=FALSE))) checkIdentical(sort(ix), as.integer(sort(Rle(ix)))) checkIdentical(sort(cx), as.character(sort(Rle(cx)))) checkIdentical(sort(lx), as.logical(sort(Rle(lx)))) checkIdentical(sort(numeric()), as.numeric(sort(Rle(numeric())))) checkIdentical(sort(character()), as.character(sort(Rle(character())))) ## factor nf <- factor(nx) checkIdentical(sort(nf), as.factor(sort(Rle(nf)))) checkIdentical(sort(nf, decreasing=TRUE, na.last=TRUE), as.factor(sort(Rle(nf), decreasing=TRUE, na.last=TRUE))) checkIdentical(sort(nf, na.last=FALSE), as.factor(sort(Rle(nf), na.last=FALSE))) checkIdentical(sort(factor()), as.factor(sort(Rle(factor())))) ## factor, unused levels nf <- factor(nx, levels=1:6) checkIdentical(levels(sort(nf)), levels(sort(Rle(nf)))) } test_Rle_table <- function() { ## atomic ix <- c(NA, 3L, NA) nx <- c(2, 5, 1, 2, NA, 5, NA) cx <- c("c", "B", NA, "a") lx <- c(FALSE, FALSE, NA, TRUE, NA) checkIdentical(table(ix), table("ix"=Rle(ix))) checkIdentical(table(nx), table("nx"=Rle(nx))) checkIdentical(table(cx), table("cx"=Rle(cx))) checkIdentical(table(lx), table("lx"=Rle(lx))) checkIdentical(table(numeric()), table(Rle(numeric()))) checkIdentical(table(character()), table(Rle(character()))) ## factor nf <- factor(nx) checkIdentical(table("nx"=nx), table("nx"=Rle(nx))) checkIdentical(table(factor()), table(Rle(factor()))) ## factor, unused levels nf <- factor(nx, levels=1:6) cf <- factor(cx, levels=c("a", "c", "B", "b")) checkIdentical(as.factor(table(nf)), as.factor(table(Rle(nf)))) checkIdentical(as.factor(table(cf)), as.factor(table(Rle(cf)))) } ## --------------------------------------------- ## runsum(), runmean(), runwtsum() ## --------------------------------------------- .naive_runsum <- function(x, k, na.rm=FALSE) sapply(0:(length(x)-k), function(offset) sum(x[1:k + offset], na.rm=na.rm)) checkIdenticalIfNaNsWereNAs <- function(x, y) { x[is.nan(x)] <- NA_real_ y[is.nan(y)] <- NA_real_ checkIdentical(x, y) } test_Rle_runsum_real <- function() { x0 <- c(NA, NaN, Inf, -Inf) x <- Rle(x0) ## na.rm = TRUE target1 <- .naive_runsum(x0, 4, na.rm=TRUE) target2 <- .naive_runsum(x, 4, na.rm=TRUE) checkIdenticalIfNaNsWereNAs(target1, target2) current <- as.vector(runsum(x, 4, na.rm=TRUE)) checkIdenticalIfNaNsWereNAs(target1, current) ## na.rm = FALSE target1 <- .naive_runsum(x0, 4, na.rm=FALSE) target2 <- .naive_runsum(x, 4, na.rm=FALSE) checkIdenticalIfNaNsWereNAs(target1, target2) current <- as.vector(runsum(x, 4, na.rm=FALSE)) checkIdenticalIfNaNsWereNAs(target1, current) x0 <- c(NA, Inf, NA, -Inf, Inf, -Inf, NaN, Inf, NaN, -Inf) x <- Rle(x0) for (k in 1:2) { target1 <- .naive_runsum(x0, k, na.rm=TRUE) target2 <- .naive_runsum(x, k, na.rm=TRUE) checkIdenticalIfNaNsWereNAs(target1, target2) current <- as.vector(runsum(x, k, na.rm=TRUE)) checkIdenticalIfNaNsWereNAs(target1, current) target1 <- .naive_runsum(x0, k, na.rm=FALSE) target2 <- .naive_runsum(x, k, na.rm=FALSE) checkIdenticalIfNaNsWereNAs(target1, target2) current <- as.vector(runsum(x, k, na.rm=FALSE)) checkIdenticalIfNaNsWereNAs(target1, current) } ## NOTE : Inconsistent behavior in base::sum() ## sum(x, y) and x + y: ## > sum(NaN, NA) ## [1] NA ## > NaN + NA ## [1] NaN ## also between sum(c(x, y)) and sum(x, y): ## This inconsistency only exists on linux, not Mac or Windows ## > sum(c(NaN, NA)) ## [1] NaN ## > sum(NaN, NA) ## [1] NA ## x0 <- c(NA, NaN, NA) ## x <- Rle(x0) ## target1 <- c(x0[1] + x0[2], x0[2] + x0[3]) ## target2 <- as.vector(c(x[1] + x[2], x[2] + x[3])) ## checkIdentical(target1, target2) ## current <- as.vector(runsum(x, k=2, na.rm=FALSE)) ## checkIdentical(target1, current) } test_Rle_runsum_integer <- function() { x0 <- c(NA_integer_, 1L, 1L) x <- Rle(x0) for (k in 1:3) { target1 <- .naive_runsum(x0, k, na.rm=TRUE) target2 <- .naive_runsum(x, k, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runsum(x, k, na.rm=TRUE)) checkIdentical(target1, current) target1 <- .naive_runsum(x0, k, na.rm=FALSE) target2 <- .naive_runsum(x, k, na.rm=FALSE) checkIdentical(target1, target2) current <- as.vector(runsum(x, k, na.rm=FALSE)) checkIdentical(target1, current) } x0 <- c(1L, NA_integer_, 1L) x <- Rle(x0) for (k in 1:3) { target1 <- .naive_runsum(x0, k, na.rm=TRUE) target2 <- .naive_runsum(x, k, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runsum(x, k, na.rm=TRUE)) checkIdentical(target1, current) target1 <- .naive_runsum(x0, k, na.rm=FALSE) target2 <- .naive_runsum(x, k, na.rm=FALSE) checkIdentical(target1, target2) current <- as.vector(runsum(x, k, na.rm=FALSE)) checkIdentical(target1, current) } } .naive_runmean <- function(x, k, na.rm=FALSE) sapply(0:(length(x)-k), function(offset) mean(x[1:k + offset], na.rm=na.rm)) test_Rle_runmean <- function() { x0 <- c(NA, 1, 1) x <- Rle(x0) for (k in 1:3) { target1 <- .naive_runmean(x0, k, na.rm=TRUE) target2 <- .naive_runmean(x, k, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runmean(x, k, na.rm=TRUE)) checkIdentical(target1, current) target1 <- .naive_runmean(x0, k, na.rm=FALSE) target2 <- .naive_runmean(x, k, na.rm=FALSE) checkIdentical(target1, target2) current <- as.vector(runmean(x, k, na.rm=FALSE)) checkIdentical(target1, current) } x0 <- c(0, NA, NaN, 0, NA, Inf, 0, NA, -Inf, 0, Inf, -Inf) x <- Rle(x0) for (k in 1:2) { target1 <- .naive_runmean(x0, k, na.rm=TRUE) target2 <- .naive_runmean(x, k, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runmean(x, k, na.rm=TRUE)) checkIdentical(target1, current) target1 <- .naive_runmean(x0, k, na.rm=FALSE) target2 <- .naive_runmean(x, k, na.rm=FALSE) checkIdentical(target1, target2) #current <- as.vector(runmean(x, k, na.rm=FALSE)) #checkIdentical(target1, current) } } .naive_runwtsum <- function(x, k, wt, na.rm=FALSE) sapply(0:(length(x)-k), function(offset) { xwt <- x[1:k + offset] * wt sum(xwt, na.rm=na.rm)}) test_Rle_runwtsum_real <- function() { x0 <- c(NA, NaN, Inf, -Inf) x <- Rle(x0) wt <- rep(1, 4) target1 <- .naive_runwtsum(x0, 4, wt, na.rm=TRUE) target2 <- .naive_runwtsum(x, 4, wt, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, 4, wt, na.rm=TRUE)) checkIdentical(target1, current) target1 <- .naive_runwtsum(x0, 4, wt, na.rm=FALSE) target2 <- .naive_runwtsum(x, 4, wt, na.rm=FALSE) checkIdentical(target1, target2) #current <- as.vector(runwtsum(x, 4, wt, na.rm=FALSE)) #checkIdentical(target1, current) x0 <- c(NA, Inf, NA, -Inf, Inf, -Inf, NaN, Inf, NaN, -Inf) x <- Rle(x0) for (k in 1:2) { if (k==1) wt <- 1 else wt <- c(1, 1) target1 <- .naive_runwtsum(x0, k, wt, na.rm=TRUE) target2 <- .naive_runwtsum(x, k, wt, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, k, wt, na.rm=TRUE)) checkIdentical(target1, current) target1 <- .naive_runwtsum(x0, k, wt, na.rm=FALSE) target2 <- .naive_runwtsum(x, k, wt, na.rm=FALSE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, k, wt, na.rm=FALSE)) checkIdentical(target1, current) } x0 <- c(1, NA, 1, NaN, 1, NA) x <- Rle(x0) for (k in 1:2) { if (k==1) wt <- 2 else wt <- c(1, 1) target1 <- .naive_runwtsum(x0, k, wt, na.rm=FALSE) target2 <- .naive_runwtsum(x, k, wt, na.rm=FALSE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, k, wt, na.rm=FALSE)) checkIdentical(target1, current) } } test_Rle_runwtsum_integer <- function() { x0 <- c(NA_integer_, 1L, 1L) x <- Rle(x0) iwt <- rep(2L, 3) for (k in 1:3) { wt <- iwt[1:k] target1 <- .naive_runwtsum(x0, k, wt, na.rm=TRUE) target2 <- .naive_runwtsum(x, k, wt, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, k, wt, na.rm=TRUE)) checkIdentical(as.numeric(target1), current) target1 <- .naive_runwtsum(x0, k, wt, na.rm=FALSE) target2 <- .naive_runwtsum(x, k, wt, na.rm=FALSE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, k, wt, na.rm=FALSE)) checkIdentical(as.numeric(target1), current) } x0 <- c(1L, NA_integer_, 1L) x <- Rle(x0) iwt <- rep(2L, 3) for (k in 1:3) { wt <- iwt[1:k] target1 <- .naive_runwtsum(x0, k, wt, na.rm=TRUE) target2 <- .naive_runwtsum(x, k, wt, na.rm=TRUE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, k, wt, na.rm=TRUE)) checkIdentical(as.numeric(target1), current) target1 <- .naive_runwtsum(x0, k, wt, na.rm=FALSE) target2 <- .naive_runwtsum(x, k, wt, na.rm=FALSE) checkIdentical(target1, target2) current <- as.vector(runwtsum(x, k, wt, na.rm=FALSE)) checkIdentical(as.numeric(target1), current) } } .naive_runq <- function(x, k, i, na.rm=FALSE) sapply(0:(length(x)-k), function(offset) { xsub <- x[1:k + offset] if (!na.rm) { ## Manually handle NA's because they are not allowed ## in 'x' of quantile(x, ...) when na.rm=FALSE. if (any(is.na(xsub))) NA else quantile(xsub, probs=i/k, na.rm=na.rm, names=FALSE, type=3) } else { ## If all NA's, just return first NA value. ## Not handled in quantile(). if (all(is.na(xsub))) { xsub[1] } else { xsub <- xsub[!is.na(xsub)] quantile(xsub, probs=i/k, na.rm=na.rm, names=FALSE, type=3) } } }, USE.NAMES=FALSE) test_Rle_runq_real <- function() { x0 <- c(NA_real_) x <- Rle(x0) k <- length(x); i <- 1 target1 <- as.numeric(.naive_runq(x0, k, i, na.rm=TRUE)) current <- as.numeric(runq(x, k, i, na.rm=TRUE)) checkIdentical(target1, current) x0 <- c(3, NA, 1, NaN, 4, Inf, 2, -Inf) x <- Rle(x0) k <- length(x) for (i in c(1, length(x))) { target1 <- as.numeric(.naive_runq(x0, k, i, na.rm=TRUE)) current <- as.numeric(runq(x, k, i, na.rm=TRUE)) checkIdentical(target1, current) target1 <- as.numeric(.naive_runq(x0, k, i, na.rm=FALSE)) current <- as.numeric(runq(x, k, i, na.rm=FALSE)) checkIdentical(target1, current) } x0 <- c(3, NA, 1, NaN, 4, Inf, 2, -Inf) x <- Rle(x0) i <- 1 ## NOTE : special case k=1, returns NA not NaN target1 <- c(3, NA, 1, NA, 4, Inf, 2, -Inf) current <- as.numeric(runq(x, k=1, i=1, na.rm=TRUE)) checkIdentical(target1, current) for (k in c(2:length(x))) { target1 <- as.numeric(.naive_runq(x0, k, i, na.rm=TRUE)) current <- as.numeric(runq(x, k, i, na.rm=TRUE)) checkIdentical(target1, current) target1 <- as.numeric(.naive_runq(x0, k, i, na.rm=FALSE)) current <- as.numeric(runq(x, k, i, na.rm=FALSE)) checkIdentical(target1, current) } x0 <- c(1, 2, 3, 4, 5) x <- Rle(x0) k <- length(x); i <- 4 target1 <- .naive_runq(x0, k, i, na.rm=TRUE) current <- as.vector(runq(x, k, i, na.rm=TRUE)) checkIdentical(target1, current) x0 <- c(1, 2, 3, NA, NA) x <- Rle(x0) k <- length(x); i <- 4 target1 <- .naive_runq(x0, k, i, na.rm=TRUE) current <- as.vector(runq(x, k, i, na.rm=TRUE)) checkIdentical(target1, current) } test_Rle_runq_integer <- function() { x0 <- c(NA_integer_) x <- Rle(x0) k <- length(x); i <- 1 target1 <- as.numeric(.naive_runq(x0, k, i, na.rm=TRUE)) current <- as.numeric(runq(x, k, i, na.rm=TRUE)) checkIdentical(target1, current) x0 <- NA_integer_ x <- Rle(x0) k <- i <- 1 target1 <- unlist(.naive_runq(x0, k, i, na.rm=TRUE)) target2 <- as.vector(do.call(c, (.naive_runq(x, k, i, na.rm=TRUE)))) checkIdentical(target1, target2) current <- as.vector(runq(x, k, i, na.rm=TRUE)) checkIdentical(as.integer(unname(target1)), current) x0 <- c(NA_integer_, 2L, 1L) x <- Rle(x0) k <- 3 for (i in 1:3) { target1 <- unlist(.naive_runq(x0, k, i, na.rm=TRUE)) current <- as.vector(runq(x, k, i, na.rm=TRUE)) checkIdentical(unname(target1), current) target1 <- unlist(.naive_runq(x0, k, i, na.rm=FALSE)) current <- as.integer(runq(x, k, i, na.rm=FALSE)) checkIdentical(as.integer(target1), current) } x0 <- c(3L, 2L, NA_integer_, NA_integer_, 1L, 2L) x <- Rle(x0) i <- 1 for (k in 1:6) { target1 <- unlist(.naive_runq(x0, k, i, na.rm=TRUE)) current <- as.vector(runq(x, k, i, na.rm=TRUE)) checkIdentical(target1, current) target1 <- unlist(.naive_runq(x0, k, i, na.rm=FALSE)) current <- as.integer(runq(x, k, i, na.rm=FALSE)) checkIdentical(as.integer(target1), current) } } test_Rle_Integer_overflow <- function() { x0 <- Rle(values=as.integer(c(1,(2^31)-1,1))) checkIdentical(NA_integer_, suppressWarnings(sum(x0))) testWarning <- NULL suppressWarnings(withCallingHandlers({sum(x0) }, warning=function(warn) { msg <- conditionMessage(warn) exp <- gettext("integer overflow - use runValue(.) <- as.numeric(runValue(.))", domain="R") if (msg == exp) testWarning <<- TRUE })) checkTrue(testWarning) x <- Rle(values=c(1,(2^31)-1,1)) checkIdentical(mean(x0), mean(x)) } IRanges/inst/unitTests/test_RleViews.R0000644000126300012640000001615612227064500021375 0ustar00biocbuildphs_compbiotest_RleViews <- function() { empty <- Views(Rle(), IRanges()) checkIdentical(empty, new("RleViews")) checkIdentical(list(), viewApply(empty, min)) checkIdentical(integer(0), viewMins(empty)) checkIdentical(integer(0), viewMaxs(empty)) checkIdentical(integer(0), viewSums(empty)) checkIdentical(numeric(0), viewMeans(empty)) checkIdentical(integer(0), viewWhichMins(empty)) checkIdentical(integer(0), viewWhichMaxs(empty)) checkIdentical(IRanges(), viewRangeMins(empty)) checkIdentical(IRanges(), viewRangeMaxs(empty)) x <- rep(c(1L, 3L, NA, 7L, 9L), 1:5) xRle <- Rle(x) xRleViewsUntrimmed <- Views(xRle, IRanges(start = c(1,1), width = c(0,20))) checkIdentical(c(Inf, 1), suppressWarnings(viewApply(xRleViewsUntrimmed, min, na.rm = TRUE))) checkIdentical(c(2147483647L, 1L), viewMins(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(viewMins(xRleViewsUntrimmed, na.rm = TRUE), min(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(-2147483647L, 9L), viewMaxs(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(viewMaxs(xRleViewsUntrimmed, na.rm = TRUE), max(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(0L, 80L), viewSums(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(viewSums(xRleViewsUntrimmed, na.rm = TRUE), sum(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(NaN, 20/3), viewMeans(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(viewMeans(xRleViewsUntrimmed, na.rm = TRUE), mean(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(NA_integer_, 1L), viewWhichMins(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(viewWhichMins(xRleViewsUntrimmed, na.rm = TRUE), which.min(xRleViewsUntrimmed)) checkIdentical(c(NA_integer_, 11L), viewWhichMaxs(xRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(viewWhichMaxs(xRleViewsUntrimmed, na.rm = TRUE), which.max(xRleViewsUntrimmed)) checkException(max(xRleViewsUntrimmed, xRleViewsUntrimmed, na.rm = TRUE), silent = TRUE) xRleViews <- Views(xRle, start = c(1, 3, 5, 7, 9), end = c(1, 13, 11, 10, 9), names = letters[1:5]) xList <- lapply(structure(seq_len(length(xRleViews)), names = letters[1:5]), function(i) window(x, start = start(xRleViews)[i], end = end(xRleViews)[i])) checkIdentical(letters[1:5], names(viewApply(xRleViews, min))) checkIdentical(letters[1:5], names(viewMins(xRleViews))) checkIdentical(letters[1:5], names(viewMaxs(xRleViews))) checkIdentical(letters[1:5], names(viewSums(xRleViews))) checkIdentical(letters[1:5], names(viewMeans(xRleViews))) checkIdentical(letters[1:5], names(viewWhichMins(xRleViews))) checkIdentical(letters[1:5], names(viewWhichMaxs(xRleViews))) checkIdentical(letters[1:5], names(viewRangeMins(xRleViews, na.rm = TRUE))) checkIdentical(letters[1:5], names(viewRangeMaxs(xRleViews, na.rm = TRUE))) checkEqualsNumeric(sapply(xList, min), viewMins(xRleViews)) checkEqualsNumeric(sapply(xList, min), viewApply(xRleViews, min)) checkEqualsNumeric(sapply(xList, min, na.rm = TRUE), viewMins(xRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(xList, min, na.rm = TRUE), viewApply(xRleViews, min, na.rm = TRUE)) checkEqualsNumeric(sapply(xList, max), viewMaxs(xRleViews)) checkEqualsNumeric(sapply(xList, max), viewApply(xRleViews, max)) checkEqualsNumeric(sapply(xList, max, na.rm = TRUE), viewMaxs(xRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(xList, max, na.rm = TRUE), viewApply(xRleViews, max, na.rm = TRUE)) checkEqualsNumeric(sapply(xList, sum), viewSums(xRleViews)) checkEqualsNumeric(sapply(xList, mean), viewMeans(xRleViews)) checkEqualsNumeric(sapply(xList, sum), viewApply(xRleViews, sum)) checkEqualsNumeric(sapply(xList, sum, na.rm = TRUE), viewSums(xRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(xList, mean, na.rm = TRUE), viewMeans(xRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(xList, sum, na.rm = TRUE), viewApply(xRleViews, sum, na.rm = TRUE)) y <- rep(c(1.2, 3.4, NA, 7.8, 9.0), 1:5) yRle <- Rle(y) yRleViewsUntrimmed <- Views(yRle, IRanges(start = c(1,1), width = c(0,20))) checkIdentical(c(Inf, 1.2), suppressWarnings(viewApply(yRleViewsUntrimmed, min, na.rm = TRUE))) checkIdentical(c(Inf, 1.2), viewMins(yRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(-Inf, 9), viewMaxs(yRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(0, 84.2), viewSums(yRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(NaN, 84.2/12), viewMeans(yRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(NA_integer_, 1L), viewWhichMins(yRleViewsUntrimmed, na.rm = TRUE)) checkIdentical(c(NA_integer_, 11L), viewWhichMaxs(yRleViewsUntrimmed, na.rm = TRUE)) yRleViews <- Views(yRle, start = c(1, 3, 5, 7, 9), end = c(1, 13, 11, 10, 9)) yList <- lapply(seq_len(length(yRleViews)), function(i) window(y, start = start(yRleViews)[i], end = end(yRleViews)[i])) checkEqualsNumeric(sapply(yList, min), viewMins(yRleViews)) checkEqualsNumeric(sapply(yList, min), viewApply(yRleViews, min)) checkEqualsNumeric(sapply(yList, min, na.rm = TRUE), viewMins(yRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(yList, min, na.rm = TRUE), viewApply(yRleViews, min, na.rm = TRUE)) checkEqualsNumeric(sapply(yList, max), viewMaxs(yRleViews)) checkEqualsNumeric(sapply(yList, max), viewApply(yRleViews, max)) checkEqualsNumeric(sapply(yList, max, na.rm = TRUE), viewMaxs(yRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(yList, max, na.rm = TRUE), viewApply(yRleViews, max, na.rm = TRUE)) checkEqualsNumeric(sapply(yList, sum), viewSums(yRleViews)) checkEqualsNumeric(sapply(yList, mean), viewMeans(yRleViews)) checkEqualsNumeric(sapply(yList, sum), viewApply(yRleViews, sum)) checkEqualsNumeric(sapply(yList, sum, na.rm = TRUE), viewSums(yRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(yList, mean, na.rm = TRUE), viewMeans(yRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(yList, sum, na.rm = TRUE), viewApply(yRleViews, sum, na.rm = TRUE)) z <- rep(c(1+1i, 3.4-1i, NA, 7.8+3i, 9.0-2i), 1:5) zRle <- Rle(z) zRleViews <- Views(zRle, start = c(1, 3, 5, 7, 9), end = c(1, 13, 11, 10, 9)) zList <- lapply(seq_len(length(zRleViews)), function(i) window(z, start = start(zRleViews)[i], end = end(zRleViews)[i])) checkEqualsNumeric(sapply(zList, sum), viewSums(zRleViews)) checkEqualsNumeric(sapply(zList, mean), viewMeans(zRleViews)) checkEqualsNumeric(sapply(zList, sum), viewApply(zRleViews, sum)) checkEqualsNumeric(sapply(zList, sum, na.rm = TRUE), viewSums(zRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(zList, mean, na.rm = TRUE), viewMeans(zRleViews, na.rm = TRUE)) checkEqualsNumeric(sapply(zList, sum, na.rm = TRUE), viewApply(zRleViews, sum, na.rm = TRUE)) } IRanges/inst/unitTests/test_RleViewsList.R0000644000126300012640000001302712227064500022223 0ustar00biocbuildphs_compbiotest_RleViewsList <- function() { x1 <- rep(c(1L, 3L, NA, 7L, 9L), 1:5) x1Rle <- Rle(x1) x1Ranges <- IRanges(start = c(1, 3, 5, 7, 9), end = c(1, 13, 11, 10, 9)) x2 <- rev(x1) x2Rle <- Rle(x2) x2Ranges <- IRanges(start = c(2, 4, 6, 8, 10), end = c(3, 9, 11, 13, 15)) checkIdentical(RleViewsList(Views(x1Rle, x1Ranges), Views(x2Rle, x2Ranges)), RleViewsList(rleList = RleList(x1Rle, x2Rle), rangesList = IRangesList(x1Ranges, x2Ranges))) xRleViewsList <- RleViewsList(a = Views(x1Rle, x1Ranges), b = Views(x2Rle, x2Ranges)) xList <- list(a = lapply(seq_len(length(xRleViewsList[[1]])), function(i) window(x1, start = start(x1Ranges)[i], end = end(x1Ranges)[i])), b = lapply(seq_len(length(xRleViewsList[[2]])), function(i) window(x2, start = start(x2Ranges)[i], end = end(x2Ranges)[i]))) checkIdentical(c("a", "b"), names(viewApply(xRleViewsList, min))) checkIdentical(c("a", "b"), names(viewMins(xRleViewsList))) checkIdentical(c("a", "b"), names(viewMaxs(xRleViewsList))) checkIdentical(c("a", "b"), names(viewSums(xRleViewsList))) checkIdentical(c("a", "b"), names(viewMeans(xRleViewsList))) checkIdentical(c("a", "b"), names(viewWhichMins(xRleViewsList))) checkIdentical(c("a", "b"), names(viewWhichMaxs(xRleViewsList))) checkIdentical(c("a", "b"), names(viewRangeMins(xRleViewsList, na.rm = TRUE))) checkIdentical(c("a", "b"), names(viewRangeMaxs(xRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(xList, lapply, min)), unlist(viewMins(xRleViewsList))) checkEqualsNumeric(unlist(lapply(xList, lapply, min)), unlist(viewApply(xRleViewsList, min))) checkEqualsNumeric(unlist(lapply(xList, lapply, min, na.rm = TRUE)), unlist(viewMins(xRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(xList, lapply, min, na.rm = TRUE)), unlist(viewApply(xRleViewsList, min, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(xList, lapply, max)), unlist(viewMaxs(xRleViewsList))) checkEqualsNumeric(unlist(lapply(xList, lapply, max)), unlist(viewApply(xRleViewsList, max))) checkEqualsNumeric(unlist(lapply(xList, lapply, max, na.rm = TRUE)), unlist(viewMaxs(xRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(xList, lapply, max, na.rm = TRUE)), unlist(viewApply(xRleViewsList, max, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(xList, lapply, sum)), unlist(viewSums(xRleViewsList))) checkEqualsNumeric(unlist(lapply(xList, lapply, mean)), unlist(viewMeans(xRleViewsList))) checkEqualsNumeric(unlist(lapply(xList, lapply, sum)), unlist(viewApply(xRleViewsList, sum))) checkEqualsNumeric(unlist(lapply(xList, lapply, sum, na.rm = TRUE)), unlist(viewSums(xRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(xList, lapply, mean, na.rm = TRUE)), unlist(viewMeans(xRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(xList, lapply, sum, na.rm = TRUE)), unlist(viewApply(xRleViewsList, sum, na.rm = TRUE))) y1 <- rep(c(1.2, 3.4, NA, 7.8, 9.0), 1:5) y1Ranges <- IRanges(start = c(1, 3, 5, 7, 9), end = c(1, 13, 11, 10, 9)) y1Rle <- Rle(y1) y2 <- rev(y1) y2Rle <- Rle(y2) y2Ranges <- IRanges(start = c(2, 4, 6, 8, 10), end = c(3, 9, 11, 13, 15)) checkIdentical(RleViewsList(Views(y1Rle, y1Ranges), Views(y2Rle, y2Ranges)), RleViewsList(rleList = RleList(y1Rle, y2Rle), rangesList = IRangesList(y1Ranges, y2Ranges))) yRleViewsList <- RleViewsList(Views(y1Rle, y1Ranges), Views(y2Rle, y2Ranges)) yList <- list(lapply(seq_len(length(yRleViewsList[[1]])), function(i) window(y1, start = start(y1Ranges)[i], end = end(y1Ranges)[i])), lapply(seq_len(length(yRleViewsList[[2]])), function(i) window(y2, start = start(y2Ranges)[i], end = end(y2Ranges)[i]))) checkEqualsNumeric(unlist(lapply(yList, lapply, min)), unlist(viewMins(yRleViewsList))) checkEqualsNumeric(unlist(lapply(yList, lapply, min)), unlist(viewApply(yRleViewsList, min))) checkEqualsNumeric(unlist(lapply(yList, lapply, min, na.rm = TRUE)), unlist(viewMins(yRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(yList, lapply, min, na.rm = TRUE)), unlist(viewApply(yRleViewsList, min, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(yList, lapply, max)), unlist(viewMaxs(yRleViewsList))) checkEqualsNumeric(unlist(lapply(yList, lapply, max)), unlist(viewApply(yRleViewsList, max))) checkEqualsNumeric(unlist(lapply(yList, lapply, max, na.rm = TRUE)), unlist(viewMaxs(yRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(yList, lapply, max, na.rm = TRUE)), unlist(viewApply(yRleViewsList, max, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(yList, lapply, sum)), unlist(viewSums(yRleViewsList))) checkEqualsNumeric(unlist(lapply(yList, lapply, mean)), unlist(viewMeans(yRleViewsList))) checkEqualsNumeric(unlist(lapply(yList, lapply, sum)), unlist(viewApply(yRleViewsList, sum))) checkEqualsNumeric(unlist(lapply(yList, lapply, sum, na.rm = TRUE)), unlist(viewSums(yRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(yList, lapply, mean, na.rm = TRUE)), unlist(viewMeans(yRleViewsList, na.rm = TRUE))) checkEqualsNumeric(unlist(lapply(yList, lapply, sum, na.rm = TRUE)), unlist(viewApply(yRleViewsList, sum, na.rm = TRUE))) } IRanges/inst/unitTests/test_coverage-methods.R0000644000126300012640000000155712227064500023070 0ustar00biocbuildphs_compbiotest_IRanges_coverage <- function() { ir <- IRanges(c(1, 8, 14, 15, 19, 34, 40), width = c(12, 6, 6, 15, 6, 2, 7)) checkIdentical(as.vector(coverage(ir)), rep(c(1L, 2L, 1L, 2L, 3L, 2L, 1L, 0L, 1L, 0L, 1L), c(7, 5, 2, 4, 1, 5, 5, 4, 2, 4, 7))) ir <- IRanges(start=c(-2L, 6L, 9L, -4L, 1L, 0L, -6L, 10L), width=c( 5L, 0L, 6L, 1L, 4L, 3L, 2L, 3L)) checkIdentical(as.vector(coverage(ir)), rep(c(3L, 1L, 0L, 1L, 2L, 1L), c(2, 2, 4, 1, 3, 2))) checkIdentical(as.vector(coverage(ir, shift=7)), rep(c(1L, 0L, 1L, 2L, 3L, 1L, 0L, 1L, 2L, 1L), c(3, 1, 2, 1, 2, 2, 4, 1, 3, 2))) checkIdentical(as.vector(coverage(ir, shift=7, width=27)), rep(c(1L, 0L, 1L, 2L, 3L, 1L, 0L, 1L, 2L, 1L, 0L), c(3, 1, 2, 1, 2, 2, 4, 1, 3, 2, 6))) } IRanges/inst/unitTests/test_expand.R0000644000126300012640000000367012227064500021111 0ustar00biocbuildphs_compbiotest_expand <- function(){ ## setup aa <- CharacterList("a", paste0("d", 1:2), paste0("b", 1:3), c(), "c") bb <- CharacterList(paste0("sna", 1:2),"foo", paste0("bar", 1:3),c(),"hica") df <- DataFrame(aa=aa, bb=bb, cc=11:15) ## tests ## test one col without dropping res1 <- expand(df, colnames="aa", keepEmptyRows=TRUE) checkTrue(dim(res1)[1]==8) checkTrue(dim(res1)[2]==3) checkIdentical(res1$aa,c("a","d1","d2","b1","b2","b3",NA,"c")) checkIdentical(res1$bb[[4]],c("bar1","bar2","bar3")) ## test one col with dropping res2 <- expand(df, colnames="aa", keepEmptyRows=FALSE) checkTrue(dim(res2)[1]==7) checkTrue(dim(res2)[2]==3) checkIdentical(res2$aa,c("a","d1","d2","b1","b2","b3","c")) checkIdentical(res2$bb[[4]],c("bar1","bar2","bar3")) ## test two columns no dropping res3 <- expand(df, colnames=c("aa","bb"), keepEmptyRows=TRUE) checkTrue(dim(res3)[1]==15) checkTrue(dim(res3)[2]==3) checkIdentical(res3$aa, c("a","a","d1","d2","b1","b1","b1","b2","b2","b2","b3","b3","b3",NA,"c")) checkIdentical(as.character(as.data.frame(res3[14,])), c(NA, NA, "14")) ## test two columns with dropping res4 <- expand(df, colnames=c("aa","bb"), keepEmptyRows=FALSE) checkTrue(dim(res4)[1]==14) checkTrue(dim(res4)[2]==3) checkIdentical(res4$aa, c("a","a","d1","d2","b1","b1","b1","b2","b2","b2","b3","b3","b3","c")) ## inverted order (different sorting of 2 cols, no dropping res5 <- expand(df, colnames=c("bb","aa"), keepEmptyRows=TRUE) checkTrue(dim(res5)[1]==15) checkTrue(dim(res5)[2]==3) checkIdentical(res5$aa, c("a","a","d1","d2","b1","b2","b3","b1","b2","b3","b1","b2","b3",NA,"c")) ## inverted order (different sorting of 2 cols, with dropping res6 <- expand(df, colnames=c("bb","aa"), keepEmptyRows=FALSE) checkTrue(dim(res6)[1]==14) checkTrue(dim(res6)[2]==3) checkIdentical(res6$aa, c("a","a","d1","d2","b1","b2","b3","b1","b2","b3","b1","b2","b3","c")) } IRanges/inst/unitTests/test_funprog-methods.R0000644000126300012640000000215412227064500022747 0ustar00biocbuildphs_compbio### NOTE: List is an abstract type, so we just test with IntegerList test_List_funprog <- function() { int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L) for (compress in c(TRUE, FALSE)) { collection <- IntegerList(int1, int2, int1, compress=compress) addcollect <- IntegerList(int2, int1, int1, compress=compress) checkIdentical(Reduce("+", collection), Reduce("+", list(int1, int2, int1))) checkIdentical(as.list(Filter(function(x) mean(x) > 10, collection)), Filter(function(x) mean(x) > 10, list(int1, int2, int1))) checkIdentical(Find(function(x) mean(x) > 10, collection), Find(function(x) mean(x) > 10, list(int1, int2, int1))) checkIdentical(Map("+", collection, addcollect), Map("+", list(int1, int2, int1), list(int2, int1, int1))) checkIdentical(mapply("+", collection, addcollect), mapply("+", list(int1, int2, int1), list(int2, int1, int1))) checkIdentical(Position(function(x) mean(x) > 10, collection), Position(function(x) mean(x) > 10, list(int1, int2, int1))) } } IRanges/inst/unitTests/test_inter-range-methods.R0000644000126300012640000002225712227064500023510 0ustar00biocbuildphs_compbiotest_Ranges_range <- function() { ir1 <- IRanges(c(2,5,1), c(3,7,3)) ir2 <- IRanges(c(5,2,0), c(6,3,1)) checkIdentical(range(ir1), IRanges(1, 7)) checkIdentical(range(ir1, ir2), IRanges(0, 7)) checkIdentical(range(IRanges()), IRanges()) checkException(range(ir1, c(2,3)), silent = TRUE) } test_RangesList_range <- function() { for (compress in c(TRUE, FALSE)) { rl1 <- IRangesList(a = IRanges(c(1,2),c(4,3)), b = IRanges(c(4,6),c(10,7)), compress = compress) rl2 <- IRangesList(c = IRanges(c(0,2),c(4,5)), a = IRanges(c(4,5),c(6,7)), compress = compress) ans <- IRangesList(a = IRanges(1,7), b = IRanges(4,10), c = IRanges(0,5), compress = compress) checkIdentical(range(rl1, rl2), ans) names(rl2) <- NULL ans <- IRangesList(IRanges(0,5), IRanges(4,10), compress = compress) checkIdentical(range(rl1, rl2), ans) ## must be same length checkException(range(rl2, rep.int(rl2, 2L)), silent=TRUE) } } test_IRanges_reduce <- function() { x <- IRanges() current <- reduce(x) checkIdentical(x, current) x <- IRanges(1:3, width=0) current <- reduce(x, with.mapping=TRUE) target <- x mcols(target) <- DataFrame(mapping=as(seq_along(target), "IntegerList")) checkIdentical(target, current) current <- reduce(x, drop.empty.ranges=TRUE, with.mapping=TRUE) target <- IRanges() mcols(target) <- DataFrame(mapping=as(seq_along(target), "IntegerList")) checkIdentical(target, current) x <- IRanges(c(1:4, 10:11, 11), width=c(0,1,1,0,0,0,1)) current <- reduce(x, with.mapping=TRUE) target <- IRanges(c(1:2, 10:11), width=c(0,2,0,1)) mcols(target) <- DataFrame(mapping=IntegerList(1,2:4,5,6:7)) checkIdentical(target, current) current <- reduce(x, drop.empty.ranges=TRUE, with.mapping=TRUE) target <- IRanges(c(2, 11), width=c(2,1)) mcols(target) <- DataFrame(mapping=IntegerList(2:3,7)) checkIdentical(target, current) x <- IRanges(start=c(1,2,3), end=c(5,2,8)) y <- reduce(x, with.mapping=TRUE) target <- IRanges(start=1, end=8) mcols(target) <- DataFrame(mapping=IntegerList(1:3)) checkIdentical(target, y) mcols(target)$mapping <- as(seq_along(target), "IntegerList") checkIdentical(target, reduce(y, with.mapping=TRUE)) x <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) y <- reduce(x, with.mapping=TRUE) target <- IRanges(start=c(1,15,20), end=c(5,15,100)) mcols(target) <- DataFrame(mapping=IntegerList(4, 1, 3:2)) checkIdentical(target, y) mcols(target)$mapping <- as(seq_along(target), "IntegerList") checkIdentical(target, reduce(y, with.mapping=TRUE)) x <- IRanges(start=c(7,3,-2,6,7,-10,-2,3), width=c(3,1,0,0,0,0,8,0)) ## Before reduction: ## start end width ==-10===-5====0===+5==+10=== ## [1] 7 9 3 ....:....:....:....:.xxx:... ## [2] 3 3 1 ....:....:....:..x.:....:... ## [3] -2 -3 0 ....:....:..[.:....:....:... ## [4] 6 5 0 ....:....:....:....:[...:... ## [5] 7 6 0 ....:....:....:....:.[..:... ## [6] -10 -11 0 ....[....:....:....:....:... ## [7] -2 5 8 ....:....:..xxxxxxxx....:... ## [8] 3 2 0 ....:....:....:..[.:....:... ## ---------------------==-10===-5====0===+5==+10=== ## After reduction: ## y1: ....[....:..xxxxxxxx.xxx:... ## y3: ....:....:..xxxxxxxx....:... y1 <- reduce(x) checkIdentical(y1, IRanges(start=c(-10,-2,7), end=c(-11,5,9))) checkIdentical(reduce(y1), y1) y2 <- reduce(x, with.inframe.attrib=TRUE) checkIdentical(start(attr(y2, "inframe")), c(9L,6L,1L,9L,9L,1L,1L,6L)) checkIdentical(width(attr(y2, "inframe")), width(x)) y3 <- reduce(x, drop.empty.ranges=TRUE) checkIdentical(y3, y1[width(y1) != 0L]) checkIdentical(reduce(y3), y3) y4 <- reduce(x, drop.empty.ranges=TRUE, with.inframe.attrib=TRUE) checkIdentical(attr(y4, "inframe"), attr(y2, "inframe")) y5 <- reduce(x, min.gapwidth=0) checkIdentical(y5, IRanges(start=c(-10,-2,-2,6,7,7), end=c(-11,-3,5,5,6,9))) y6 <- reduce(x, drop.empty.ranges=TRUE, min.gapwidth=0) checkIdentical(y6, y5[width(y5) != 0L]) y7 <- reduce(x, min.gapwidth=2) checkIdentical(y7, IRanges(start=c(-10,-2), end=c(-11,9))) y8 <- reduce(x, min.gapwidth=8) checkIdentical(y8, y7) y9 <- reduce(x, min.gapwidth=9) checkIdentical(y9, IRanges(start=-10, end=9)) } test_RangesList_reduce <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) range3 <- IRanges(start=c(3,-2,6,7,-10,-2,3), width=c(1,0,0,0,0,8,0)) range4 <- IRanges() for (compress in c(TRUE, FALSE)) { collection <- IRangesList(one=range1, range2, range3, range4, compress=compress) for (with.mapping in c(FALSE, TRUE)) { for (drop.empty.ranges in c(FALSE, TRUE)) { current <- reduce(collection, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping) target <- IRangesList(one=reduce(range1, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), reduce(range2, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), reduce(range3, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), reduce(range4, drop.empty.ranges=drop.empty.ranges, with.mapping=with.mapping), compress=compress) checkIdentical(target, current) } } } } test_IRanges_gaps <- function() { checkIdentical(gaps(IRanges()), IRanges()) checkIdentical(gaps(IRanges(), start=1, end=4), IRanges(start=1, end=4)) x <- IRanges(start=2, end=3) checkIdentical(gaps(x), IRanges()) checkIdentical(gaps(x, start=2), IRanges()) checkIdentical(gaps(x, start=4), IRanges()) checkIdentical(gaps(x, start=0), IRanges(start=0, end=1)) checkIdentical(gaps(x, end=3), IRanges()) checkIdentical(gaps(x, end=1), IRanges()) checkIdentical(gaps(x, end=5), IRanges(start=4, end=5)) checkIdentical(gaps(x, start=0, end=5), IRanges(start=c(0,4), end=c(1,5))) } test_RangesList_gaps <- function() { range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) for (compress in c(TRUE, FALSE)) { collection <- IRangesList(one = range1, range2, compress = compress) checkIdentical(gaps(collection), IRangesList(one = gaps(range1), gaps(range2), compress = compress)) } } test_Ranges_disjoin <- function() { checkIdentical(disjoin(IRanges()), IRanges()) ir <- IRanges(c(1, 1, 4, 10), c(6, 3, 8, 10)) checkIdentical(disjoin(ir), IRanges(c(1, 4, 7, 10), c(3, 6, 8, 10))) } test_CompressedIRangesList_disjoin <- function() { r0 <- IRanges(10, 20) checkTrue(validObject(disjoin(IRangesList()))) ## unnamed; incl. 0-length irl <- IRangesList(IRanges()) checkIdentical(irl, disjoin(irl)) irl <- IRangesList(r0, IRanges(), r0) checkIdentical(irl, disjoin(irl)) irl <- IRangesList(r0, IRanges(), IRanges(), r0) checkIdentical(irl, disjoin(irl)) ## named; incl. 0-length irl <- IRangesList(a=IRanges()) checkIdentical(irl, disjoin(irl)) irl <- IRangesList(a=r0, b=IRanges(), c=r0) checkIdentical(irl, disjoin(irl)) irl <- IRangesList(a=r0, b=IRanges(), c=IRanges(), d=r0) checkIdentical(irl, disjoin(irl)) ## no interference between separate elements r0 <- IRanges(10, c(15, 20)) dr0 <- disjoin(r0) irl <- IRangesList(r0, r0) checkIdentical(IRangesList(dr0, dr0), disjoin(irl)) irl <- IRangesList(r0, IRanges(), r0) checkIdentical(IRangesList(dr0, IRanges(), dr0), disjoin(irl)) ## 0-width ## 1-width r0 <- IRanges(c(1, 10), 10) irl <- IRangesList(r0, IRanges()) checkIdentical(disjoin(r0), disjoin(irl)[[1]]) irl <- IRangesList(IRanges(), r0) checkIdentical(disjoin(r0), disjoin(irl)[[2]]) } test_Ranges_isDisjoint <- function() { ir1 <- IRanges(c(2,5,1), c(3,7,3)) ir2 <- IRanges(c(2,9,5), c(3,9,6)) ir3 <- IRanges(1, 5) checkIdentical(isDisjoint(ir1), FALSE) checkIdentical(isDisjoint(ir2), TRUE) checkIdentical(isDisjoint(ir3), TRUE) ## Handling of zero-width ranges current <- sapply(11:17, function(i) isDisjoint(IRanges(c(12, i), width=c(4, 0)))) target <- rep(c(TRUE, FALSE, TRUE), c(2, 3, 2)) checkIdentical(target, current) } test_Ranges_disjointBins <- function() { checkIdentical(disjointBins(IRanges()), integer()) checkIdentical(disjointBins(IRanges(1, 5)), 1L) checkIdentical(disjointBins(IRanges(c(1, 3), c(5, 12))), c(1L, 2L)) checkIdentical(disjointBins(IRanges(c(1, 3, 10), c(5, 12, 13))), c(1L, 2L, 1L)) checkIdentical(disjointBins(IRanges(c(3, 1, 10), c(5, 12, 13))), c(2L, 1L, 2L)) } IRanges/inst/unitTests/test_intra-range-methods.R0000644000126300012640000002021512227064500023474 0ustar00biocbuildphs_compbiotest_Ranges_shift <- function() { ir1 <- IRanges(1:20, width=222000000) ## The returned object would have end values > INT_MAX checkException(shift(ir1, 1:20 * 99000000L)) } test_Ranges_narrow <- function() { ir1 <- IRanges(c(2,5,1), c(3,7,3)) checkIdentical(narrow(ir1, start=1, end=2), IRanges(c(2, 5, 1), c(3, 6, 2))) checkException(narrow(ir1, start=10, end=20), silent = TRUE) } test_RangesList_narrow <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) for (compress in c(TRUE, FALSE)) { collection <- IRangesList(range1, range2, compress = compress) checkIdentical(narrow(collection, start=1, end=2), IRangesList(IRanges(c(2, 5), c(3, 6)), IRanges(1, 2), compress = compress)) checkException(narrow(collection, start=10, end=20), silent = TRUE) } } test_Ranges_flank <- function() { ir1 <- IRanges(c(2,5,1), c(3,7,3)) checkIdentical(flank(ir1, 2), IRanges(c(0, 3, -1), c(1, 4, 0))) checkIdentical(flank(ir1, 2, FALSE), IRanges(c(4, 8, 4), c(5, 9, 5))) checkIdentical(flank(ir1, 2, c(FALSE, TRUE, FALSE)), IRanges(c(4, 3, 4), c(5, 4, 5))) checkIdentical(flank(ir1, c(2, -2, 2)), IRanges(c(0, 5, -1), c(1, 6, 0))) checkIdentical(flank(ir1, 2, both = TRUE), IRanges(c(0, 3, -1), c(3, 6, 2))) checkIdentical(flank(ir1, 2, FALSE, TRUE), IRanges(c(2, 6, 2), c(5, 9, 5))) checkIdentical(flank(ir1, -2, FALSE, TRUE), IRanges(c(2, 6, 2), c(5, 9, 5))) checkException(flank(ir1, 2, both = c(TRUE, FALSE, TRUE)), silent = TRUE) # not vectorized checkException(flank(ir1, 2, c(FALSE, TRUE, NA)), silent = TRUE) checkException(flank(ir1, NA), silent = TRUE) } test_RangesList_flank <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) for (compress in c(TRUE, FALSE)) { collection <- IRangesList(range1, range2, compress = compress) checkIdentical(flank(collection, 2), IRangesList(IRanges(c(0, 3), c(1, 4)), IRanges(-1, 0), compress = compress)) checkIdentical(flank(collection, 2, FALSE), IRangesList(IRanges(c(4, 8), c(5, 9)), IRanges(4, 5), compress = compress)) checkIdentical(flank(collection, 2, LogicalList(c(FALSE, TRUE), FALSE)), IRangesList(IRanges(c(4, 3), c(5, 4)), IRanges(4, 5), compress = compress)) checkIdentical(flank(collection, IntegerList(c(2, -2), 2)), IRangesList(IRanges(c(0, 5), c(1, 6)), IRanges(-1, 0), compress = compress)) checkIdentical(flank(collection, 2, both = TRUE), IRangesList(IRanges(c(0, 3), c(3, 6)), IRanges(-1, 2), compress = compress)) checkIdentical(flank(collection, 2, FALSE, TRUE), IRangesList(IRanges(c(2, 6), c(5, 9)), IRanges(2, 5), compress = compress)) checkIdentical(flank(collection, -2, FALSE, TRUE), IRangesList(IRanges(c(2, 6), c(5, 9)), IRanges(2, 5), compress = compress)) checkException(flank(collection, 2, both = c(TRUE, FALSE, TRUE)), silent = TRUE) # not vectorized checkException(flank(collection, 2, LogicalList(c(FALSE, TRUE), NA)), silent = TRUE) checkException(flank(collection, NA), silent = TRUE) } } test_promoters <- function() { ir <- IRanges(c(10, 10), width=c(0, 1)) checkIdentical(width(promoters(ir, 0, 0)), c(0L, 0L)) checkIdentical(width(promoters(ir, 1, 0)), c(1L, 1L)) checkIdentical(start(promoters(ir, 1, 0)), c(9L, 9L)) checkIdentical(width(promoters(ir, 0, 1)), c(1L, 1L)) checkIdentical(start(promoters(ir, 0, 1)), c(10L, 10L)) ir <- IRanges(c(5, 2, 20), width=1) checkIdentical(start(promoters(ir, 5, 2)), c(0L, -3L, 15L)) rl <- RangesList("A"=IRanges(5:7, width=1), "B"=IRanges(10:12, width=5)) current <- promoters(rl, 0, 0) checkIdentical(names(current), names(rl)) checkIdentical(start(current), start(rl)) current <- promoters(rl, 2, 0) checkIdentical(unique(unlist(width(current))), 2L) subject <- XInteger(10, 3:-6) view <- Views(subject, start=4:2, end=4:6) current <- promoters(view, 0, 0) checkIdentical(start(current), start(view)) current <- promoters(view, 2, 0) checkIdentical(unique(width(current)), 2L) cmp <- IRangesList("A"=IRanges(5:7, width=1), "B"=IRanges(10:12, width=5)) current <- promoters(rl, 0, 0) checkIdentical(names(current), names(rl)) checkIdentical(start(current), start(rl)) current <- promoters(rl, 2, 0) checkIdentical(unique(unlist(width(current))), 2L) } test_Ranges_reflect <- function() { ir1 <- IRanges(c(2,5,1), c(3,7,3)) bounds <- IRanges(c(0, 5, 3), c(10, 6, 9)) checkIdentical(reflect(ir1, bounds), IRanges(c(7, 4, 9), c(8, 6, 11))) checkException(reflect(ir1, IRanges()), silent = TRUE) } test_Ranges_resize <- function() { ir1 <- IRanges(c(2,5,1), c(3,7,3)) checkIdentical(resize(ir1, width=10), IRanges(c(2, 5, 1), width=10)) checkIdentical(resize(ir1, width=10, fix="end"), IRanges(c(-6, -2, -6), width=10)) checkIdentical(resize(ir1, width=10, fix="center"), IRanges(c(-2, 1, -3), width=10)) checkIdentical(resize(ir1, width=10, fix=c("start", "end", "center")), IRanges(c(2, -2, -3), width=10)) checkException(resize(ir1, -1), silent = TRUE) } test_RangesList_resize <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) for (compress in c(TRUE, FALSE)) { collection <- IRangesList(range1, range2, compress = compress) checkIdentical(resize(collection, width=10), IRangesList(IRanges(c(2, 5), width=10), IRanges(1, width=10), compress = compress)) checkIdentical(resize(collection, width=10, fix="end"), IRangesList(IRanges(c(-6, -2), width=10), IRanges(-6, width=10), compress = compress)) checkIdentical(resize(collection, width=10, fix="center"), IRangesList(IRanges(c(-2, 1), width=10), IRanges(-3, width=10), compress = compress)) checkIdentical(resize(collection, width=10, fix=CharacterList(c("start", "end"), "center")), IRangesList(IRanges(c(2, -2), width=10), IRanges(-3, width=10), compress = compress)) checkException(resize(collection, -1), silent = TRUE) } } test_Ranges_restrict <- function() { ir1 <- IRanges(c(2,5,1), c(3,7,3)) checkIdentical(restrict(ir1, start=2, end=5), IRanges(c(2, 5, 2), c(3, 5, 3))) checkIdentical(restrict(ir1, start=1, end=2), IRanges(c(2, 1), c(2, 2))) checkIdentical(restrict(ir1, start=1, end=2, keep.all.ranges=TRUE), IRanges(c(2, 3, 1), c(2, 2, 2))) } test_RangesList_restrict <- function() { range1 <- IRanges(start=c(2,5), end=c(3,7)) range2 <- IRanges(start=1, end=3) for (compress in c(TRUE, FALSE)) { collection <- IRangesList(range1, range2, compress = compress) checkIdentical(restrict(collection, start=2, end=5), IRangesList(IRanges(c(2, 5), c(3, 5)), IRanges(2, 3), compress = compress)) checkIdentical(restrict(collection, start=1, end=2), IRangesList(IRanges(2, 2), IRanges(1, 2), compress = compress)) checkIdentical(restrict(collection, start=1, end=2, keep.all.ranges=TRUE), IRangesList(IRanges(c(2, 3), c(2, 2)), IRanges(1, 2), compress = compress)) } } test_Ranges_zoom <- function() { ir <- IRanges(c(1,5), c(3,10)) checkIdentical(ir*1, ir) checkIdentical(ir*c(1,2), IRanges(c(1,6), c(3, 8))) checkIdentical(ir*-2, IRanges(c(-1,2), c(4, 13))) checkException(ir*NA_integer_, silent = TRUE) checkException(ir*numeric(), silent = TRUE) checkException(ir*c(1,2,1), silent = TRUE) checkException(ir[rep(1,3)]*c(1,2), silent = TRUE) } IRanges/inst/unitTests/test_nearest-methods.R0000644000126300012640000001077112227064500022734 0ustar00biocbuildphs_compbiocheckMatching <- function(a, q, s, r, c) { mat <- cbind(queryHits = as.integer(q), subjectHits = as.integer(s)) checkIdentical(as.matrix(a), mat) checkIdentical(c(queryLength(a), subjectLength(a)), as.integer(c(r, c))) } test_Ranges_adjacency <- function() { query <- IRanges(c(1, 3, 9), c(3, 7, 10)) subject <- IRanges(c(3, 10, 2), c(3, 12, 5)) checkIdentical(precede(query, subject), c(2L, 2L, NA)) checkIdentical(precede(IRanges(), subject), integer()) checkIdentical(precede(query, IRanges()), rep(NA_integer_, 3)) checkIdentical(precede(query), c(3L, 3L, NA)) checkIdentical(follow(query, subject), c(NA, NA, 3L)) checkIdentical(follow(IRanges(), subject), integer()) checkIdentical(follow(query, IRanges()), rep(NA_integer_, 3)) checkIdentical(follow(query), c(NA, NA, 2L)) checkMatching(precede(query, subject, select="all"), c(1, 2), c(2, 2), 3, 3) ## xxxx ## xxx ## xx ## xx ## xxx ## .. ## .. ## .. ## .. ## .. subject <- IRanges(c(1, 2, 9, 15, 15), width=c(4, 3, 2, 2, 3)) query <- IRanges(c(6, 11, 1, 13, 18), width=c(2, 2, 2, 2, 2)) checkMatching(precede(query, subject, select="all"), c(1, 2, 2, 3, 4, 4), c(3, 4, 5, 3, 4, 5), 5, 5) checkMatching(precede(subject, query, select="all"), c(1, 2, 3, 4, 5), c(1, 1, 2, 5, 5), 5, 5) checkMatching(follow(query, subject, select="all"), c(1, 1, 2, 4, 5), c(1, 2, 3, 3, 5), 5, 5) checkMatching(follow(subject, query, select="all"), c(3, 4, 5), c(1, 4, 4), 5, 5) checkMatching(precede(query, select="all"), c(1, 2, 3, 4), c(2, 4, 1, 5), 5, 5) checkMatching(precede(subject, select="all"), c(1, 2, 3, 3), c(3, 3, 4, 5), 5, 5) checkMatching(follow(query, select="all"), c(1, 2, 4, 5), c(3, 1, 2, 4), 5, 5) checkMatching(follow(subject, select="all"), c(3, 3, 4, 5), c(1, 2, 3, 3), 5, 5) } test_Ranges_nearest <- function() { query <- IRanges(c(1, 3, 9), c(2, 7, 10)) subject <- IRanges(c(3, 5, 12), c(3, 6, 12)) checkIdentical(nearest(query, subject), c(1L, 1L, 3L)) checkIdentical(nearest(query), c(2L, 1L, 2L)) checkIdentical(nearest(query, subject[c(2,3,1)]), c(3L, 3L, 2L)) ## xxxx ## xxx ## xx ## xx ## xxx ## .. ## .. ## .. ## .. ## .. subject <- IRanges(c(1, 2, 9, 15, 15), width=c(4, 3, 2, 2, 3)) query <- IRanges(c(6, 11, 1, 13, 18), width=c(2, 2, 2, 2, 2)) checkMatching(nearest(query, subject, select = "all"), c(1, 1, 1, 2, 3, 3, 4, 4, 5), c(1, 2, 3, 3, 1, 2, 4, 5, 5), 5, 5) checkMatching(nearest(subject, query, select = "all"), c(1, 2, 3, 4, 5, 5), c(3, 3, 2, 4, 4, 5), 5, 5) checkMatching(nearest(subject, select="all"), c(1, 2, 3, 3, 3, 3, 4, 5), c(2, 1, 1, 2, 4, 5, 5, 4), 5, 5) checkMatching(nearest(query, select="all"), c(1, 1, 2, 3, 4, 5), c(2, 3, 4, 1, 2, 4), 5, 5) } quiet <- suppressWarnings test_Ranges_distance <- function() { checkIdentical(quiet(distance(IRanges(), IRanges())), integer()) ## adjacent, overlap, separated by 1 query <- IRanges(c(1, 3, 9), c(2, 7, 10)) subject <- IRanges(c(3, 5, 12), c(3, 6, 12)) checkIdentical(quiet(distance(query, subject)), c(0L, 0L, 1L)) ## recycling checkIdentical(quiet(distance(query[1:2], subject)), c(0L, 0L, 9L)) ## zero-width target <- abs(-3:3) current <- sapply(-3:3, function(i) quiet(distance(shift(IRanges(4,3), i), IRanges(4,3)))) checkIdentical(target, current) checkIdentical(quiet(distance(IRanges(4,3), IRanges(3,4))), 0L) } test_Ranges_distanceToNearest <- function() { target <- new("Hits", queryHits=integer(), subjectHits=integer(), queryLength=0L, subjectLength=0L) current <- quiet(distanceToNearest(IRanges(), IRanges())) checkIdentical(queryHits(current), queryHits(target)) checkIdentical(subjectHits(current), subjectHits(target)) checkIdentical(queryLength(current), queryLength(target)) query <- IRanges(5, 10) subject <- IRanges(c(1, 1, 1), c(4, 5, 6)) current <- quiet(distanceToNearest(query, subject, select="all")) checkIdentical(subjectHits(current), c(2L, 3L)) current <- quiet(distanceToNearest(query, rev(subject), select="all")) checkIdentical(subjectHits(current), c(1L, 2L)) } IRanges/inst/unitTests/test_setops-methods.R0000644000126300012640000000706612227064500022613 0ustar00biocbuildphs_compbiotest_IRanges_union <- function() { x <- IRanges(c(1, 4, 9), c(5, 7, 10)) y <- IRanges(c(2, 2, 10), c(2, 3, 12)) ans <- union(x, y) ans0 <- IRanges(c(1, 9), c(7, 12)) checkIdentical(ans, ans0) } test_IRanges_intersect <- function() { x <- IRanges(c(1, 4, 9), c(5, 7, 10)) y <- IRanges(c(2, 2, 10), c(2, 3, 12)) ans <- intersect(x, y) ans0 <- IRanges(c(2,10),c(3,10)) checkIdentical(ans, ans0) } test_IRanges_setdiff <- function() { x <- IRanges(c(1, 4, 9), c(5, 7, 10)) y <- IRanges(c(2, 2, 10), c(2, 3, 12)) ans <- setdiff(x, y) ans0 <- IRanges(c(1,4,9), c(1,7,9)) checkIdentical(ans, ans0) ans <- setdiff(y, x) ans0 <- IRanges(c(11), c(12)) checkIdentical(ans, ans0) } test_IRanges_punion <- function() { x <- IRanges(start=c(1,11,21,31,41,51,61,71), end=c(5,10,25,35,40,55,65,75)) y <- IRanges(start=c(1, 8,18,35,43,48,63,78), end=c(4,15,22,36,45,50,62,79)) ans0 <- IRanges(start=c(1,8,18,31,41,48,61,71), end=c(5,15,25,36,45,55,65,79)) checkIdentical(punion(x, y, fill.gap=TRUE), ans0) checkIdentical(punion(y, x, fill.gap=TRUE), ans0) } test_IRanges_pintersect <- function() { x <- IRanges(start=c(22,22,22,22,22,22), end=c(28,28,28,28,21,21)) y <- IRanges(start=c(25,30,29,25,22,22), end=c(30,40,40,24,21,29)) ansMaxStart <- IRanges(start=c(25,30,29,25,22,22), end=c(28,29,28,24,21,21)) ansStartX <- IRanges(start=c(25,22,29,25,22,22), end=c(28,21,28,24,21,21)) ansStartY <- IRanges(start=c(25,30,29,25,22,22), end=c(28,29,28,24,21,21)) checkException(pintersect(x, y), silent = TRUE) checkException(pintersect(y, x), silent = TRUE) for (resolve.empty in c("none", "max.start", "start.x")) { checkIdentical(x, pintersect(x, x, resolve.empty = resolve.empty)) checkIdentical(y, pintersect(y, y, resolve.empty = resolve.empty)) } checkIdentical(pintersect(x[-c(2,3)], y[-c(2,3)]), ansMaxStart[-c(2,3)]) checkIdentical(pintersect(y[-c(2,3)], x[-c(2,3)]), ansMaxStart[-c(2,3)]) checkIdentical(pintersect(x, y, resolve.empty = "max.start"), ansMaxStart) checkIdentical(pintersect(y, x, resolve.empty = "max.start"), ansMaxStart) checkIdentical(pintersect(x, y, resolve.empty = "start.x"), ansStartX) checkIdentical(pintersect(y, x, resolve.empty = "start.x"), ansStartY) } test_IRanges_psetdiff <- function() { x <- IRanges(start=c(1,11,21,31,41,51,61,71), end=c(5,10,25,35,40,55,65,75)) y <- IRanges(start=c(1, 8,18,35,43,48,63,78), end=c(4,15,22,36,45,50,62,79)) ans <- psetdiff(x[-7], y[-7]) ans0 <- IRanges(start=c(5,11,23,31,41,51,71), end=c(5,10,25,34,40,55,75)) checkIdentical(ans, ans0) ans <- psetdiff(y[-2], x[-2]) ans0 <- IRanges(start=c(1,18,36,43,48,63,78), end=c(0,20,36,45,50,62,79)) checkIdentical(ans, ans0) } test_IRanges_pgap <- function() { x <- IRanges(start=c(1,11,21,31,41,51,61,71), end=c(5,10,25,35,40,55,65,75)) y <- IRanges(start=c(1, 8,18,35,43,48,63,78), end=c(4,15,22,36,45,50,62,79)) ans <- pgap(x, y) checkIdentical(width(ans), c(0L, 0L, 0L, 0L, 2L, 0L, 0L, 2L)) checkIdentical(start(ans)[width(ans) != 0L], c(41L, 76L)) } test_RangesList_setops <- function() { rl1 <- RangesList(IRanges(c(1,2),c(4,3)), IRanges(c(4,6),c(10,7))) rl2 <- RangesList(IRanges(c(0,2),c(4,5)), IRanges(c(4,5),c(6,7))) checkIdentical(union(rl1, rl2), RangesList(union(rl1[[1]], rl2[[1]]), union(rl1[[2]], rl2[[2]]))) checkIdentical(intersect(rl1, rl2), RangesList(intersect(rl1[[1]], rl2[[1]]), intersect(rl1[[2]], rl2[[2]]))) checkIdentical(setdiff(rl1, rl2), RangesList(setdiff(rl1[[1]], rl2[[1]]), setdiff(rl1[[2]], rl2[[2]]))) } IRanges/man/0000755000126300012640000000000012232576334014247 5ustar00biocbuildphs_compbioIRanges/man/Annotated-class.Rd0000644000126300012640000000162712227064476017567 0ustar00biocbuildphs_compbio\name{Annotated-class} \docType{class} \alias{Annotated} \alias{Annotated-class} % accessors \alias{metadata} \alias{metadata,Annotated-method} \alias{metadata<-} \alias{metadata<-,Annotated-method} \title{Annotated class} \description{The virtual class \code{Annotated} is used to standardize the storage of metadata with a subclass.} \details{ The \code{Annotated} class supports the storage of global metadata in a subclass. This is done through the \code{metadata} slot that stores a list object. } \section{Accessors}{ In the following code snippets, \code{x} is an \code{Annotated} object. \describe{ \item{}{\code{metadata(x)}, \code{metadata(x) <- value}: Get or set the list holding arbitrary R objects as annotations. May be, and often is, empty. } } } \author{P. Aboyoun} \seealso{\code{\linkS4class{Vector}} for example implementations} \keyword{methods} \keyword{classes} IRanges/man/AtomicList-class.Rd0000644000126300012640000004161512227064476017723 0ustar00biocbuildphs_compbio\name{AtomicList} \docType{class} % AtomicList classes \alias{class:AtomicList} \alias{AtomicList-class} \alias{AtomicList} \alias{class:CompressedAtomicList} \alias{CompressedAtomicList-class} \alias{CompressedAtomicList} \alias{class:SimpleAtomicList} \alias{SimpleAtomicList-class} \alias{SimpleAtomicList} \alias{class:LogicalList} \alias{LogicalList-class} \alias{LogicalList} \alias{class:CompressedLogicalList} \alias{CompressedLogicalList-class} \alias{CompressedLogicalList} \alias{class:SimpleLogicalList} \alias{SimpleLogicalList-class} \alias{SimpleLogicalList} \alias{class:IntegerList} \alias{IntegerList-class} \alias{IntegerList} \alias{class:CompressedIntegerList} \alias{CompressedIntegerList-class} \alias{CompressedIntegerList} \alias{class:SimpleIntegerList} \alias{SimpleIntegerList-class} \alias{SimpleIntegerList} \alias{class:NumericList} \alias{NumericList-class} \alias{NumericList} \alias{class:CompressedNumericList} \alias{CompressedNumericList-class} \alias{CompressedNumericList} \alias{class:SimpleNumericList} \alias{SimpleNumericList-class} \alias{SimpleNumericList} \alias{class:ComplexList} \alias{ComplexList-class} \alias{ComplexList} \alias{class:CompressedComplexList} \alias{CompressedComplexList-class} \alias{CompressedComplexList} \alias{class:SimpleComplexList} \alias{SimpleComplexList-class} \alias{SimpleComplexList} \alias{class:CharacterList} \alias{CharacterList-class} \alias{CharacterList} \alias{class:CompressedCharacterList} \alias{CompressedCharacterList-class} \alias{CompressedCharacterList} \alias{class:SimpleCharacterList} \alias{SimpleCharacterList-class} \alias{SimpleCharacterList} \alias{class:RawList} \alias{RawList-class} \alias{RawList} \alias{class:CompressedRawList} \alias{CompressedRawList-class} \alias{CompressedRawList} \alias{class:SimpleRawList} \alias{SimpleRawList-class} \alias{SimpleRawList} \alias{class:RleList} \alias{RleList-class} \alias{RleList} \alias{class:CompressedRleList} \alias{CompressedRleList-class} \alias{CompressedRleList} \alias{class:SimpleRleList} \alias{SimpleRleList-class} \alias{SimpleRleList} % coercion \alias{as.list,CompressedAtomicList-method} \alias{coerce,CompressedAtomicList,list-method} \alias{as.vector,AtomicList-method} \alias{coerce,vector,AtomicList-method} \alias{lapply,CompressedAtomicList-method} \alias{coerce,vector,CompressedLogicalList-method} \alias{coerce,vector,SimpleLogicalList-method} \alias{coerce,vector,CompressedIntegerList-method} \alias{coerce,vector,SimpleIntegerList-method} \alias{coerce,vector,CompressedNumericList-method} \alias{coerce,vector,SimpleNumericList-method} \alias{coerce,vector,CompressedComplexList-method} \alias{coerce,vector,SimpleComplexList-method} \alias{coerce,vector,CompressedCharacterList-method} \alias{coerce,vector,SimpleCharacterList-method} \alias{coerce,vector,CompressedRawList-method} \alias{coerce,vector,SimpleRawList-method} \alias{coerce,vector,CompressedRleList-method} \alias{coerce,vector,SimpleRleList-method} \alias{coerce,AtomicList,LogicalList-method} \alias{coerce,AtomicList,IntegerList-method} \alias{coerce,AtomicList,NumericList-method} \alias{coerce,AtomicList,ComplexList-method} \alias{coerce,AtomicList,CharacterList-method} \alias{coerce,AtomicList,RawList-method} \alias{coerce,AtomicList,RleList-method} \alias{RleList,AtomicList,RleList-method} \alias{coerce,CompressedRleList,CompressedIRangesList-method} \alias{Ops,CompressedAtomicList,CompressedAtomicList-method} \alias{Ops,SimpleAtomicList,SimpleAtomicList-method} \alias{Ops,SimpleAtomicList,CompressedAtomicList-method} \alias{Ops,CompressedAtomicList,SimpleAtomicList-method} \alias{Ops,AtomicList,atomic-method} \alias{Ops,atomic,AtomicList-method} \alias{Ops,CompressedAtomicList,atomic-method} \alias{Ops,atomic,CompressedAtomicList-method} \alias{Ops,SimpleAtomicList,atomic-method} \alias{Ops,atomic,SimpleAtomicList-method} \alias{Math,CompressedAtomicList-method} \alias{Math,SimpleAtomicList-method} \alias{Math2,CompressedAtomicList-method} \alias{Math2,SimpleAtomicList-method} \alias{Summary,AtomicList-method} \alias{Summary,CompressedRleList-method} \alias{Complex,CompressedAtomicList-method} \alias{Complex,SimpleAtomicList-method} \alias{sum,CompressedIntegerList-method} \alias{sum,CompressedLogicalList-method} \alias{sum,CompressedNumericList-method} \alias{is.na,CompressedAtomicList-method} \alias{is.na,SimpleAtomicList-method} \alias{is.na,CompressedRleList-method} \alias{is.na,SimpleRleList-method} \alias{duplicated,AtomicList-method} \alias{duplicated.AtomicList} \alias{duplicated,CompressedAtomicList-method} \alias{duplicated.CompressedAtomicList} \alias{unique.CompressedAtomicList} \alias{unique,CompressedAtomicList-method} \alias{unique,CompressedRleList-method} \alias{unique.CompressedRleList} \alias{unique,SimpleRleList-method} \alias{unique.SimpleRleList} \alias{match,CompressedAtomicList,atomic-method} \alias{match,SimpleAtomicList,atomic-method} \alias{match,CompressedRleList,atomic-method} \alias{match,SimpleRleList,atomic-method} \alias{match,CompressedAtomicList,AtomicList-method} \alias{match,SimpleAtomicList,AtomicList-method} \alias{match,CompressedRleList,AtomicList-method} \alias{match,SimpleRleList,AtomicList-method} \alias{\%in\%,CompressedAtomicList,atomic-method} \alias{\%in\%,SimpleAtomicList,atomic-method} \alias{\%in\%,CompressedRleList,atomic-method} \alias{\%in\%,SimpleRleList,atomic-method} \alias{\%in\%,CompressedAtomicList,AtomicList-method} \alias{\%in\%,SimpleAtomicList,AtomicList-method} \alias{\%in\%,CompressedRleList,AtomicList-method} \alias{\%in\%,SimpleRleList,AtomicList-method} \alias{table,SimpleAtomicList-method} \alias{table,CompressedAtomicList-method} \alias{sort,RleList-method} \alias{sort.RleList} \alias{drop,AtomicList-method} \alias{!,CompressedLogicalList-method} \alias{!,SimpleLogicalList-method} \alias{!,CompressedRleList-method} \alias{!,SimpleRleList-method} \alias{which,CompressedLogicalList-method} \alias{which,SimpleLogicalList-method} \alias{which,CompressedRleList-method} \alias{which,SimpleRleList-method} \alias{which.max,CompressedRleList-method} \alias{which.min,CompressedRleList-method} \alias{all,CompressedRleList-method} \alias{diff,IntegerList-method} \alias{diff,NumericList-method} \alias{diff,RleList-method} \alias{pmax,IntegerList-method} \alias{pmax,NumericList-method} \alias{pmax,RleList-method} \alias{pmin,IntegerList-method} \alias{pmin,NumericList-method} \alias{pmin,RleList-method} \alias{pmax.int,IntegerList-method} \alias{pmax.int,NumericList-method} \alias{pmax.int,RleList-method} \alias{pmin.int,IntegerList-method} \alias{pmin.int,NumericList-method} \alias{pmin.int,RleList-method} \alias{mean,AtomicList-method} \alias{var,AtomicList,missing-method} \alias{var,AtomicList,AtomicList-method} \alias{cov,AtomicList,AtomicList-method} \alias{cor,AtomicList,AtomicList-method} \alias{sd,AtomicList-method} \alias{median,AtomicList-method} \alias{quantile,AtomicList-method} \alias{mad,AtomicList-method} \alias{IQR,AtomicList-method} \alias{cumsum,CompressedAtomicList-method} \alias{cumprod,CompressedAtomicList-method} \alias{cummin,CompressedAtomicList-method} \alias{cummax,CompressedAtomicList-method} \alias{smoothEnds,CompressedIntegerList-method} \alias{smoothEnds,SimpleIntegerList-method} \alias{smoothEnds,NumericList-method} \alias{smoothEnds,RleList-method} \alias{runmed,CompressedIntegerList-method} \alias{runmed,SimpleIntegerList-method} \alias{runmed,NumericList-method} \alias{runmed,RleList-method} \alias{runmean,RleList-method} \alias{runsum,RleList-method} \alias{runwtsum,RleList-method} \alias{runq,RleList-method} \alias{nchar,CompressedCharacterList-method} \alias{nchar,SimpleCharacterList-method} \alias{nchar,CompressedRleList-method} \alias{nchar,SimpleRleList-method} \alias{chartr,ANY,ANY,CompressedCharacterList-method} \alias{chartr,ANY,ANY,SimpleCharacterList-method} \alias{chartr,ANY,ANY,CompressedRleList-method} \alias{chartr,ANY,ANY,SimpleRleList-method} \alias{tolower,CompressedCharacterList-method} \alias{tolower,SimpleCharacterList-method} \alias{tolower,CompressedRleList-method} \alias{tolower,SimpleRleList-method} \alias{toupper,CompressedCharacterList-method} \alias{toupper,SimpleCharacterList-method} \alias{toupper,CompressedRleList-method} \alias{toupper,SimpleRleList-method} \alias{sub,ANY,ANY,CompressedCharacterList-method} \alias{sub,ANY,ANY,SimpleCharacterList-method} \alias{sub,ANY,ANY,CompressedRleList-method} \alias{sub,ANY,ANY,SimpleRleList-method} \alias{gsub,ANY,ANY,CompressedCharacterList-method} \alias{gsub,ANY,ANY,SimpleCharacterList-method} \alias{gsub,ANY,ANY,CompressedRleList-method} \alias{gsub,ANY,ANY,SimpleRleList-method} \alias{runLength,RleList-method} \alias{runValue,RleList-method} \alias{runLength,CompressedRleList-method} \alias{runValue,CompressedRleList-method} \alias{ranges,RleList-method} \alias{ranges,CompressedRleList-method} \alias{show,AtomicList-method} \alias{show,RleList-method} \alias{showAsCell,AtomicList-method} \title{Lists of Atomic Vectors in Natural and Rle Form} \description{An extension of \code{\linkS4class{List}} that holds only atomic vectors in either a natural or run-length encoded form.} \details{ The lists of atomic vectors are \code{LogicalList}, \code{IntegerList}, \code{NumericList}, \code{ComplexList}, \code{CharacterList}, and \code{RawList}. There is also an \code{RleList} class for run-length encoded versions of these atomic vector types. Each of the above mentioned classes is virtual with Compressed* and Simple* non-virtual representations. } \section{Constructors}{ \describe{ \item{}{\code{LogicalList(..., compress = TRUE)}: Concatenates the \code{logical} vectors in \code{...} into a new \code{LogicalList}. If \code{compress}, the internal storage of the data is compressed.} \item{}{\code{IntegerList(..., compress = TRUE)}: Concatenates the \code{integer} vectors in \code{...} into a new \code{IntegerList}. If \code{compress}, the internal storage of the data is compressed.} \item{}{\code{NumericList(..., compress = TRUE)}: Concatenates the \code{numeric} vectors in \code{...} into a new \code{NumericList}. If \code{compress}, the internal storage of the data is compressed.} \item{}{\code{ComplexList(..., compress = TRUE)}: Concatenates the \code{complex} vectors in \code{...} into a new \code{ComplexList}. If \code{compress}, the internal storage of the data is compressed.} \item{}{\code{CharacterList(..., compress = TRUE)}: Concatenates the \code{character} vectors in \code{...} into a new \code{CharacterList}. If \code{compress}, the internal storage of the data is compressed.} \item{}{\code{RawList(..., compress = TRUE)}: Concatenates the \code{raw} vectors in \code{...} into a new \code{RawList}. If \code{compress}, the internal storage of the data is compressed.} \item{}{\code{RleList(..., compress = TRUE)}: Concatenates the run-length encoded atomic vectors in \code{...} into a new \code{RleList}. If \code{compress}, the internal storage of the data is compressed.} } } \section{Coercion}{ \describe{ \item{}{ \code{as(from, "CompressedSplitDataFrameList")}, \code{as(from, "SimpleSplitDataFrameList")}: Creates a \linkS4class{CompressedSplitDataFrameList}/\linkS4class{SimpleSplitDataFrameList} instance from an AtomicList instance. } \item{}{ \code{as(from, "IRangesList")}, \code{as(from, "CompressedIRangesList")}, \code{as(from, "SimpleIRangesList")}: Creates a \linkS4class{CompressedIRangesList}/\linkS4class{SimpleIRangesList} instance from a LogicalList or logical RleList instance. Note that the elements of this instance are guaranteed to be normal. } \item{}{ \code{as(from, "NormalIRangesList")}, \code{as(from, "CompressedNormalIRangesList")}, \code{as(from, "SimpleNormalIRangesList")}: Creates a \linkS4class{CompressedNormalIRangesList}/\linkS4class{SimpleNormalIRangesList} instance from a LogicalList or logical RleList instance. } \item{}{\code{as(from, "CharacterList")}, \code{as(from, "ComplexList")}, \code{as(from, "IntegerList")}, \code{as(from, "LogicalList")}, \code{as(from, "NumericList")}, \code{as(from, "RawList")}, \code{as(from, "RleList")}: Coerces an \code{AtomicList} \code{from} to another derivative of \code{AtomicList}. } \item{}{\code{as(from, "AtomicList")}: If \code{from} is a vector, converts it to an \code{AtomicList} of the appropriate type. } } } \section{Group Generics}{ AtomicList objects have support for S4 group generic functionality to operate within elements across objects: \describe{ \item{\code{Arith}}{\code{"+"}, \code{"-"}, \code{"*"}, \code{"^"}, \code{"\%\%"}, \code{"\%/\%"}, \code{"/"}} \item{\code{Compare}}{\code{"=="}, \code{">"}, \code{"<"}, \code{"!="}, \code{"<="}, \code{">="}} \item{\code{Logic}}{\code{"&"}, \code{"|"}} \item{\code{Ops}}{\code{"Arith"}, \code{"Compare"}, \code{"Logic"}} \item{\code{Math}}{\code{"abs"}, \code{"sign"}, \code{"sqrt"}, \code{"ceiling"}, \code{"floor"}, \code{"trunc"}, \code{"cummax"}, \code{"cummin"}, \code{"cumprod"}, \code{"cumsum"}, \code{"log"}, \code{"log10"}, \code{"log2"}, \code{"log1p"}, \code{"acos"}, \code{"acosh"}, \code{"asin"}, \code{"asinh"}, \code{"atan"}, \code{"atanh"}, \code{"exp"}, \code{"expm1"}, \code{"cos"}, \code{"cosh"}, \code{"sin"}, \code{"sinh"}, \code{"tan"}, \code{"tanh"}, \code{"gamma"}, \code{"lgamma"}, \code{"digamma"}, \code{"trigamma"}} \item{\code{Math2}}{\code{"round"}, \code{"signif"}} \item{\code{Summary}}{\code{"max"}, \code{"min"}, \code{"range"}, \code{"prod"}, \code{"sum"}, \code{"any"}, \code{"all"}} \item{\code{Complex}}{\code{"Arg"}, \code{"Conj"}, \code{"Im"}, \code{"Mod"}, \code{"Re"}} } See \link[methods]{S4groupGeneric} for more details. } \section{Other Basic Methods}{ The AtomicList objects also support a large number of basic methods. Like the group generics above, these methods perform the corresponding operation on each element of the list separately. The methods are: \describe{ \item{General}{\code{is.na}, \code{duplicated}, \code{unique}, \code{match}, \code{\%in\%}, \code{table}, \code{order}, \code{sort}} \item{Logical}{\code{!}, \code{which}, \code{which.max}, \code{which.min}} \item{Numeric}{\code{diff}, \code{pmax}, \code{pmax.int}, \code{pmin}, \code{pmin.int}, \code{mean}, \code{var}, \code{cov}, \code{cor}, \code{sd}, \code{median}, \code{quantile}, \code{mad}, \code{IQR}} \item{Running Window}{\code{smoothEnds}, \code{runmed}. \code{runmean}, \code{runsum}, \code{runwtsum}, \code{runq}} \item{Character}{\code{nchar}, \code{chartr}, \code{tolower}, \code{toupper}, \code{sub}, \code{gsub}} } } \section{RleList Methods}{ RleList has a number of methods that are not shared by other AtomicList derivatives. \describe{ \item{}{\code{runLength(x)}: Gets the run lengths of each element of the list, as an IntegerList. } \item{}{\code{runValue(x)}: Gets the run values of each element of the list, as an AtomicList. } \item{}{\code{ranges(x)}: Gets the run ranges as a \code{RangesList}. } } } \section{Specialized Methods}{ \describe{ \item{}{\code{drop(x)}: Checks if every element of \code{x} is of length one, and, if so, unlists \code{x}. Otherwise, an error is thrown. } } } \author{P. Aboyoun} \seealso{\code{\linkS4class{List}} for the applicable methods.} \examples{ int1 <- c(1L,2L,3L,5L,2L,8L) int2 <- c(15L,45L,20L,1L,15L,100L,80L,5L) collection <- IntegerList(int1, int2) ## names names(collection) <- c("one", "two") names(collection) names(collection) <- NULL # clear names names(collection) names(collection) <- "one" names(collection) # c("one", NA) ## extraction collection[[1]] # range1 collection[["1"]] # NULL, does not exist collection[["one"]] # range1 collection[[NA_integer_]] # NULL ## subsetting collection[numeric()] # empty collection[NULL] # empty collection[] # identity collection[c(TRUE, FALSE)] # first element collection[2] # second element collection[c(2,1)] # reversed collection[-1] # drop first collection$one ## replacement collection$one <- int2 collection[[2]] <- int1 ## combining col1 <- IntegerList(one = int1, int2) col2 <- IntegerList(two = int2, one = int1) col3 <- IntegerList(int2) append(col1, col2) append(col1, col2, 0) col123 <- c(col1, col2, col3) col123 ## revElements revElements(col123) revElements(col123, 4:5) ## group generics 2 * col1 col1 + col1 col1 > 2 sum(col1) # equivalent to (but faster than) 'sapply(col1, sum)' mean(col1) # equivalent to 'sapply(col1, mean)' } \keyword{methods} \keyword{classes} IRanges/man/DataFrame-class.Rd0000644000126300012640000002461712227064476017502 0ustar00biocbuildphs_compbio\name{DataFrame-class} \docType{class} \alias{class:DataFrame} \alias{DataFrame-class} % accessor \alias{nrow,DataFrame-method} \alias{ncol,DataFrame-method} \alias{rownames,DataFrame-method} \alias{colnames,DataFrame-method} \alias{rownames<-,DataFrame-method} \alias{colnames<-,DataFrame-method} % constructor \alias{DataFrame} % subsetting \alias{[,DataFrame-method} \alias{[<-,DataFrame-method} \alias{[[<-,DataFrame-method} % coercion \alias{as.data.frame.DataFrame} \alias{as.data.frame,DataFrame-method} \alias{as.matrix,DataFrame-method} \alias{coerce,matrix,DataFrame-method} \alias{coerce,vector,DataFrame-method} \alias{coerce,list,DataFrame-method} \alias{coerce,integer,DataFrame-method} \alias{coerce,Vector,DataFrame-method} \alias{coerce,data.frame,DataFrame-method} \alias{coerce,NULL,DataFrame-method} \alias{coerce,table,DataFrame-method} \alias{coerce,AsIs,DataFrame-method} \alias{coerce,DataFrame,data.frame-method} \alias{coerce,xtabs,DataFrame-method} \alias{coerce,ANY,DataFrame-method} \alias{coerce,SimpleList,DataFrame-method} \alias{coerce,ANY,AsIs-method} % splitting and combining \alias{cbind,DataFrame-method} \alias{rbind,DataFrame-method} \alias{mstack,DataFrame-method} % aggregation \alias{aggregate,formula-method} \title{External Data Frame} \description{ The \code{DataFrame} extends the \code{\linkS4class{DataTable}} virtual class and supports the storage of any type of object (with \code{length} and \code{[} methods) as columns. } \details{ On the whole, the \code{DataFrame} behaves very similarly to \code{data.frame}, in terms of construction, subsetting, splitting, combining, etc. The most notable exception is that the row names are optional. This means calling \code{rownames(x)} will return \code{NULL} if there are no row names. Of course, it could return \code{seq_len(nrow(x))}, but returning \code{NULL} informs, for example, combination functions that no row names are desired (they are often a luxury when dealing with large data). As \code{DataFrame} derives from \code{\linkS4class{Vector}}, it is possible to set an \code{annotation} string. Also, another \code{DataFrame} can hold metadata on the columns. For a class to be supported as a column, it must have \code{length} and \code{[} methods, where \code{[} supports subsetting only by \code{i} and respects \code{drop=FALSE}. Optionally, a method may be defined for the \code{showAsCell} generic, which should return a vector of the same length as the subset of the column passed to it. This vector is then placed into a \code{data.frame} and converted to text with \code{format}. Thus, each element of the vector should be some simple, usually character, representation of the corresponding element in the column. } \section{Accessors}{ In the following code snippets, \code{x} is a \code{DataFrame}. \describe{ \item{}{\code{dim(x)}: Get the length two integer vector indicating in the first and second element the number of rows and columns, respectively. } \item{}{\code{dimnames(x)}, \code{dimnames(x) <- value}: Get and set the two element list containing the row names (character vector of length \code{nrow(x)} or \code{NULL}) and the column names (character vector of length \code{ncol(x)}). } } } \section{Subsetting}{ In the following code snippets, \code{x} is a \code{DataFrame}. \describe{ \item{}{\code{x[i,j,drop]}: Behaves very similarly to the \code{\link{[.data.frame}} method, except \code{i} can be a logical \code{Rle} object and subsetting by \code{matrix} indices is not supported. Indices containing \code{NA}'s are also not supported. } \item{}{\code{x[i,j] <- value}: Behaves very similarly to the \code{\link{[<-.data.frame}} method. } \item{}{\code{x[[i]]}: Behaves very similarly to the \code{\link{[[.data.frame}} method, except arguments \code{j} and \code{exact} are not supported. Column name matching is always exact. Subsetting by matrices is not supported. } \item{}{\code{x[[i]] <- value}: Behaves very similarly to the \code{\link{[[<-.data.frame}} method, except argument \code{j} is not supported. } } } \section{Constructor}{ \describe{\code{DataFrame(..., row.names = NULL, check.names = TRUE)}: Constructs a \code{DataFrame} in similar fashion to \code{\link{data.frame}}. Each argument in \code{...} is coerced to a \code{DataFrame} and combined column-wise. No special effort is expended to automatically determine the row names from the arguments. The row names should be given in \code{row.names}; otherwise, there are no row names. This is by design, as row names are normally undesirable when data is large. If \code{check.names} is \code{TRUE}, the column names will be checked for syntactic validity and made unique, if necessary. To store an object of a class that does not support coercion to \code{DataFrame}, wrap it in \code{I()}. The class must still have methods for \code{length} and \code{[}. } } \section{Splitting and Combining}{ In the following code snippets, \code{x} is a \code{DataFrame}. \describe{ \item{}{\code{split(x, f, drop = FALSE)}: Splits \code{x} into a \code{\linkS4class{CompressedSplitDataFrameList}}, according to \code{f}, dropping elements corresponding to unrepresented levels if \code{drop} is \code{TRUE}. } \item{}{ \code{rbind(...)}: Creates a new \code{DataFrame} by combining the rows of the \code{DataFrame} objects in \code{...}. Very similar to \code{\link{rbind.data.frame}}, except in the handling of row names. If all elements have row names, they are concatenated and made unique. Otherwise, the result does not have row names. Currently, factors are not handled well (their levels are dropped). This is not a high priority until there is an \code{XFactor} class. } \item{}{ \code{cbind(...)}: Creates a new \code{DataFrame} by combining the columns of the \code{DataFrame} objects in \code{...}. Very similar to \code{\link{cbind.data.frame}}, except row names, if any, are dropped. Consider the \code{DataFrame} as an alternative that allows one to specify row names. } \item{}{ \code{mstack(..., .index.var = "name")}: Stacks the data frames passed as through \dots, using \code{.index.var} as the index column name. See \code{\link{stack}}. } } } \section{Aggregation}{ In the following code snippets, \code{data} is a \code{DataFrame}. \describe{ \item{}{\code{aggregate(x, data, FUN, ..., subset, na.action = na.omit)}: Aggregates the \code{DataFrame} \code{data} according to the formula \code{x} and the aggregating function \code{FUN}. See \code{\link{aggregate}} and its method for \code{formula}. } } } \section{Coercion}{ \describe{ \item{}{\code{as(from, "DataFrame")}: By default, constructs a new \code{DataFrame} with \code{from} as its only column. If \code{from} is a \code{matrix} or \code{data.frame}, all of its columns become columns in the new \code{DataFrame}. If \code{from} is a list, each element becomes a column, recycling as necessary. Note that for the \code{DataFrame} to behave correctly, each column object must support element-wise subsetting via the \code{[} method and return the number of elements with \code{length}. It is recommended to use the \code{DataFrame} constructor, rather than this interface. } \item{}{\code{as.list(x)}: Coerces \code{x}, a \code{DataFrame}, to a \code{list}. } \item{}{\code{as.data.frame(x, row.names=NULL, optional=FALSE)}: Coerces \code{x}, a \code{DataFrame}, to a \code{data.frame}. Each column is coerced to a \code{data.frame} and then column bound together. If \code{row.names} is \code{NULL}, they are retrieved from \code{x}, if it has any. Otherwise, they are inferred by the \code{data.frame} constructor. NOTE: conversion of \code{x} to a \code{data.frame} is not supported if \code{x} contains any \code{list}, \code{SimpleList}, or \code{CompressedList} columns. } \item{}{\code{as(from, "data.frame")}: Coerces a \code{DataFrame} to a \code{data.frame} by calling \code{as.data.frame(from)}. } \item{}{\code{as.matrix(x)}: Coerces the \code{DataFrame} to a \code{matrix}, if possible. } } } \author{ Michael Lawrence } \seealso{ \code{\linkS4class{DataTable}}, \code{\linkS4class{Vector}}, and \code{\linkS4class{RangedData}}, which makes heavy use of this class. } \examples{ score <- c(1L, 3L, NA) counts <- c(10L, 2L, NA) row.names <- c("one", "two", "three") df <- DataFrame(score) # single column df[["score"]] df <- DataFrame(score, row.names = row.names) #with row names rownames(df) df <- DataFrame(vals = score) # explicit naming df[["vals"]] # arrays ary <- array(1:4, c(2,1,2)) sw <- DataFrame(I(ary)) # a data.frame sw <- DataFrame(swiss) as.data.frame(sw) # swiss, without row names # now with row names sw <- DataFrame(swiss, row.names = rownames(swiss)) as.data.frame(sw) # swiss # subsetting sw[] # identity subset sw[,] # same sw[NULL] # no columns sw[,NULL] # no columns sw[NULL,] # no rows ## select columns sw[1:3] sw[,1:3] # same as above sw[,"Fertility"] sw[,c(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE)] ## select rows and columns sw[4:5, 1:3] sw[1] # one-column DataFrame ## the same sw[, 1, drop = FALSE] sw[, 1] # a (unnamed) vector sw[[1]] # the same sw[["Fertility"]] sw[["Fert"]] # should return 'NULL' sw[1,] # a one-row DataFrame sw[1,, drop=TRUE] # a list ## duplicate row, unique row names are created sw[c(1, 1:2),] ## indexing by row names sw["Courtelary",] subsw <- sw[1:5,1:4] subsw["C",] # partially matches ## row and column names cn <- paste("X", seq_len(ncol(swiss)), sep = ".") colnames(sw) <- cn colnames(sw) rn <- seq(nrow(sw)) rownames(sw) <- rn rownames(sw) ## column replacement df[["counts"]] <- counts df[["counts"]] df[[3]] <- score df[["X"]] df[[3]] <- NULL # deletion ## split sw <- DataFrame(swiss) swsplit <- split(sw, sw[["Education"]]) ## rbind do.call(rbind, as.list(swsplit)) ## cbind cbind(DataFrame(score), DataFrame(counts)) } \keyword{classes} \keyword{methods} IRanges/man/DataFrameList-class.Rd0000644000126300012640000001533412227064476020332 0ustar00biocbuildphs_compbio\name{DataFrameList-class} \docType{class} \alias{DataFrameList-class} \alias{SimpleDataFrameList-class} \alias{SplitDataFrameList-class} \alias{CompressedSplitDataFrameList-class} \alias{SimpleSplitDataFrameList-class} % accessors \alias{nrow,DataFrameList-method} \alias{ncol,DataFrameList-method} \alias{ncol,CompressedSplitDataFrameList-method} \alias{ncol,SimpleSplitDataFrameList-method} \alias{dim,DataFrameList-method} \alias{rownames,DataFrameList-method} \alias{colnames,DataFrameList-method} \alias{colnames,CompressedSplitDataFrameList-method} \alias{colnames,SimpleSplitDataFrameList-method} \alias{dimnames,DataFrameList-method} \alias{rownames<-,CompressedSplitDataFrameList-method} \alias{rownames<-,SimpleDataFrameList-method} \alias{colnames<-,CompressedSplitDataFrameList-method} \alias{colnames<-,SimpleDataFrameList-method} \alias{dimnames<-,DataFrameList-method} \alias{columnMetadata} \alias{columnMetadata<-} \alias{columnMetadata,SimpleSplitDataFrameList-method} \alias{columnMetadata<-,SimpleSplitDataFrameList-method} \alias{columnMetadata,CompressedSplitDataFrameList-method} \alias{columnMetadata<-,CompressedSplitDataFrameList-method} % constructor \alias{DataFrameList} \alias{SplitDataFrameList} % subsetting \alias{[,SimpleSplitDataFrameList-method} \alias{[,CompressedSplitDataFrameList-method} \alias{[<-,SplitDataFrameList-method} % coercion \alias{as.data.frame.DataFrameList} \alias{as.data.frame,DataFrameList-method} \alias{coerce,DataFrameList,DataFrame-method} \alias{coerce,SplitDataFrameList,DataFrame-method} \alias{coerce,ANY,CompressedSplitDataFrameList-method} \alias{coerce,ANY,SimpleSplitDataFrameList-method} \alias{coerce,List,CompressedSplitDataFrameList-method} \alias{coerce,List,SimpleSplitDataFrameList-method} \alias{stack,DataFrameList-method} % splitting and combining \alias{cbind,DataFrameList-method} \alias{rbind,DataFrameList-method} % show \alias{show,SplitDataFrameList-method} \title{List of DataFrames} \description{Represents a list of \code{\linkS4class{DataFrame}} objects. The \code{SplitDataFrameList} class contains the additional restriction that all the columns be of the same name and type. Internally it is stored as a list of \code{DataFrame} objects and extends \code{\linkS4class{List}}.} \section{Accessors}{ In the following code snippets, \code{x} is a \code{DataFrameList}. \describe{ \item{}{\code{dim(x)}: Get the two element integer vector indicating the number of rows and columns over the entire dataset.} \item{}{\code{dimnames(x)}: Get the list of two character vectors, the first holding the rownames (possibly \code{NULL}) and the second the column names. } \item{}{\code{columnMetadata(x)}: Get the \code{DataFrame} of metadata along the columns, i.e., where each column in \code{x} is represented by a row in the metadata. The metadata is common across all elements of \code{x}. Note that calling \code{mcols(x)} returns the metadata on the \code{DataFrame} elements of \code{x}. } \item{}{\code{columnMetadata(x) <- value}: Set the \code{DataFrame} of metadata for the columns. } } } \section{Subsetting}{ In the following code snippets, \code{x} is a \code{SplitDataFrameList}. In general \code{x} follows the conventions of \code{SimpleList}/\code{CompressedList} with the following addition: \describe{ \item{}{ \code{x[i,j,drop]}: If matrix subsetting is used, \code{i} selects either the list elements or the rows within the list elements as determined by the \code{[} method for \code{SimpleList}/\code{CompressedList}, \code{j} selects the columns, and \code{drop} is used when one column is selected and output can be coerced into an \code{AtomicList} or \code{RangesList} subclass. } \item{}{\code{x[i,j] <- value}: If matrix subsetting is used, \code{i} selects either the list elements or the rows within the list elements as determined by the \code{[<-} method for \code{SimpleList}/\code{CompressedList}, \code{j} selects the columns and \code{value} is the replacement value for the selected region. } } } \section{Constructor}{ \describe{ \item{}{\code{DataFrameList(...)}: Concatenates the \code{DataFrame} objects in \code{...} into a new \code{DataFrameList}.} \item{}{\code{SplitDataFrameList(..., compress = TRUE, cbindArgs = FALSE)}: If \code{cbindArgs} is \code{FALSE}, the \code{...} arguments are coerced to \code{DataFrame} objects and concatenated to form the result. The arguments must have the same number and names of columns. If \code{cbindArgs} is \code{TRUE}, the arguments are combined as columns. The arguments must then be the same length, with each element of an argument mapping to an element in the result. If \code{compress = TRUE}, returns a \code{CompressedSplitDataFrameList}; else returns a \code{SimpleSplitDataFrameList}.} } } \section{Combining}{ In the following code snippets, objects in \code{...} are of class \code{DataFrameList}. \describe{ \item{}{ \code{rbind(...)}: Creates a new \code{DataFrameList} containing the element-by-element row concatenation of the objects in \code{...}. } \item{}{ \code{cbind(...)}: Creates a new \code{DataFrameList} containing the element-by-element column concatenation of the objects in \code{...}. } } } \section{Coercion}{ In the following code snippets, \code{x} is a \code{DataFrameList}. \describe{ \item{}{\code{as(from, "DataFrame")}: Coerces a \code{DataFrameList} to an \code{DataFrame} by combining the rows of the elements. This essentially unsplits the \code{DataFrame}. Every element of \code{x} must have the same columns. } \item{}{\code{as(from, "SplitDataFrameList")}: By default, simply calls the \code{SplitDataFrameList} constructor on \code{from}. If \code{from} is a \code{List}, each element of \code{from} is passed as an argument to \code{SplitDataFrameList}, like calling \code{as.list} on a vector.} \item{}{\code{as.data.frame(x, row.names=NULL, optional=FALSE, ...)}: Unsplits the \code{DataFrame} and coerces it to a \code{data.frame}, with the rownames specified in \code{row.names}. The \code{optional} argument is ignored. } \item{}{\code{stack(x, index.var = "name")}: Unlists \code{x} and adds a column named \code{index.var} to the result, indicating the element of \code{x} from which each row was obtained. } } } \author{ Michael Lawrence } \seealso{ \code{\linkS4class{DataFrame}}, \code{\linkS4class{RangedData}}, which uses a \code{DataFrameList} to split the data by the spaces. } \keyword{methods} \keyword{classes} IRanges/man/DataTable-API.Rd0000644000126300012640000001670312227064476017000 0ustar00biocbuildphs_compbio\name{DataTable-API} \docType{class} \alias{DataTable-API} % DataTable class, functions and methods: \alias{class:DataTable} \alias{DataTable-class} \alias{DataTable} \alias{class:DataTableORNULL} \alias{DataTableORNULL-class} \alias{DataTableORNULL} \alias{NROW,DataTable-method} \alias{NCOL,DataTable-method} \alias{dim,DataTable-method} \alias{dimnames,DataTable-method} \alias{dimnames<-,DataTable-method} \alias{window<-,DataTable-method} \alias{window<-.DataTable} \alias{subset,DataTable-method} \alias{na.omit} \alias{na.omit,DataTable-method} \alias{na.exclude} \alias{na.exclude,DataTable-method} \alias{is.na,DataTable-method} \alias{complete.cases,DataTable-method} \alias{cbind,DataTable-method} \alias{rbind,DataTable-method} \alias{merge,DataTable,DataTable-method} \alias{merge,data.frame,DataTable-method} \alias{merge,DataTable,data.frame-method} \alias{aggregate,DataTable-method} \alias{by,DataTable-method} \alias{as.env,DataTable-method} \alias{duplicated,DataTable-method} \alias{duplicated.DataTable} \alias{unique,DataTable-method} \alias{unique.DataTable} \alias{show,DataTable-method} \alias{get_showHeadLines} \alias{get_showTailLines} \title{The DataTable API} \description{ DataTable is an API only (i.e. virtual class with no slots) for accessing objects with a rectangular shape like \link{DataFrame} or \link{RangedData} objects. It mimics the API for standard \link{data.frame} objects. } \section{Accessors}{ In the following code snippets, \code{x} is a \code{DataTable}. \describe{ \item{}{ \code{nrow(x)}, \code{ncol(x)}: Get the number of rows and columns, respectively. } \item{}{ \code{NROW(x)}, \code{NCOL(x)}: Same as \code{nrow(x)} and \code{ncol(x)}, respectively. } \item{}{ \code{dim(x)}: Length two integer vector defined as \code{c(nrow(x), ncol(x))}. } \item{}{ \code{rownames(x)}, \code{colnames(x)}: Get the names of the rows and columns, respectively. } \item{}{ \code{dimnames(x)}: Length two list of character vectors defined as \code{list(rownames(x), colnames(x))}. } } } \section{Subsetting}{ In the code snippets below, \code{x} is a DataTable object. \describe{ \item{}{ \code{x[i, j, drop=TRUE]}: Return a new DataTable object made of the selected rows and columns. For single column selection, the \code{drop} argument specifies whether or not to coerce the returned sequence to a standard vector. } \item{}{ \code{head(x, n=6L)}: If \code{n} is non-negative, returns the first n rows of the DataTable object. If \code{n} is negative, returns all but the last \code{abs(n)} rows of the DataTable object. } \item{}{ \code{tail(x, n=6L)}: If \code{n} is non-negative, returns the last n rows of the DataTable object. If \code{n} is negative, returns all but the first \code{abs(n)} rows of the DataTable object. } \item{}{ \code{subset(x, subset, select, drop=FALSE)}: Return a new DataTable object using: \describe{ \item{subset}{logical expression indicating rows to keep, where missing values are taken as FALSE.} \item{select}{expression indicating columns to keep.} \item{drop}{passed on to \code{[} indexing operator.} } } \item{}{ \code{\link[stats:na.fail]{na.omit}(object)}: Returns a subset with incomplete cases removed. } \item{}{ \code{\link[stats:na.fail]{na.exclude}(object)}: Returns a subset with incomplete cases removed (but to be included with NAs in statistical results). } \item{}{ \code{\link[base:NA]{is.na}(x)}: Returns a logical matrix indicating which cells are missing. } \item{}{ \code{\link[stats]{complete.cases}(x)}: Returns a logical vector identifying which cases have no missing values. } } } \section{Combining}{ In the code snippets below, \code{x} is a DataTable object. \describe{ \item{}{ \code{cbind(...)}: Creates a new \code{DataTable} by combining the columns of the \code{DataTable} objects in \code{...}. } \item{}{ \code{rbind(...)}: Creates a new \code{DataTable} by combining the rows of the \code{DataTable} objects in \code{...}. } \item{}{ \code{merge(x, y, ...)}: Merges two \code{DataTable} objects \code{x} and \code{y}, with arguments in \code{...} being the same as those allowed by the base \code{\link{merge}}. It is allowed for either \code{x} or \code{y} to be a \code{data.frame}. } } } \section{Looping}{ In the code snippets below, \code{x} is a DataTable object. \describe{ \item{}{ \code{aggregate(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE)}: Generates summaries on the specified windows and returns the result in a convenient form: \describe{ \item{\code{by}}{An object with \code{start}, \code{end}, and \code{width} methods.} \item{\code{FUN}}{The function, found via \code{match.fun}, to be applied to each window of \code{x}.} \item{\code{start}, \code{end}, \code{width}}{the start, end, or width of the window. If \code{by} is missing, then must supply two of the three.} \item{\code{frequency}, \code{delta}}{Optional arguments that specify the sampling frequency and increment within the window.} \item{\dots}{Further arguments for \code{FUN}.} \item{\code{simplify}}{A logical value specifying whether or not the result should be simplified to a vector or matrix if possible.} } } \item{}{ \code{by(data, INDICES, FUN, ..., simplify = TRUE)}: Apply \code{FUN} to each group of \code{data}, a \code{DataTable}, formed by the factor (or list of factors) \code{INDICES}. Exactly the same contract as \code{\link{as.data.frame}}. } } } \section{Utilities}{ \describe{ \item{}{\code{duplicated(x)}: Returns a logical vector indicating the rows that are identical to a previous row. } \item{}{\code{unique(x)}: Returns a new \code{DataTable} after removing the duplicated rows from \code{x}. } \item{}{ \code{show(x)}: By default the \code{show} method displays 5 head and 5 tail lines. The number of lines can be altered by setting the global options \code{showHeadLines} and \code{showTailLines}. If the object length is less than the sum of the options, the full object is displayed. These options affect GRanges, GAlignments, Ranges, DataTable and XString objects. } } } \section{Coercion}{ \describe{ \item{}{\code{as.env(x, enclos = parent.frame())}: Creates an environment from \code{x} with a symbol for each \code{colnames(x)}. The values are not actually copied into the environment. Rather, they are dynamically bound using \code{\link{makeActiveBinding}}. This prevents unnecessary copying of the data from the external vectors into R vectors. The values are cached, so that the data is not copied every time the symbol is accessed. } } } \seealso{ \link{DataTable-stats} for statistical functionality, like fitting regression models, \link{data.frame} } \examples{ showClass("DataTable") # shows (some of) the known subclasses } \keyword{methods} \keyword{classes} IRanges/man/DataTable-stats.Rd0000644000126300012640000000145412227064476017522 0ustar00biocbuildphs_compbio\name{DataTable-stats} \alias{DataTable-stats} \alias{xtabs,DataTable-method} \title{Statistical modeling with DataTable} \description{ A number of wrappers are implemented for performing statistical procedures, such as model fitting, with \code{\linkS4class{DataTable}} objects. } \section{Tabulation}{ \describe{ \item{}{\code{xtabs(formula = ~., data, subset, na.action, exclude = c(NA, NaN), drop.unused.levels = FALSE)}: Like the original \code{\link{xtabs}}, except \code{data} is a \code{DataTable}. } } } \seealso{ \code{\linkS4class{DataTable}} for general manipulation, \code{\linkS4class{DataFrame}} for an implementation that mimics \code{data.frame}. } \examples{ df <- DataFrame(as.data.frame(UCBAdmissions)) xtabs(Freq ~ Gender + Admit, df) } IRanges/man/FilterMatrix-class.Rd0000644000126300012640000000367712227064476020273 0ustar00biocbuildphs_compbio\name{FilterMatrix-class} \docType{class} \alias{FilterMatrix-class} % accessors \alias{filterRules,FilterMatrix-method} % subsetting \alias{[,FilterMatrix-method} % splitting and combining \alias{cbind,FilterMatrix-method} \alias{rbind,FilterMatrix-method} % constructor \alias{FilterMatrix} % utilities \alias{show,FilterMatrix-method} \alias{summary,FilterMatrix-method} \title{Matrix for Filter Results} \description{A \code{FilterMatrix} object is a matrix meant for storing the logical output of a set of \code{\linkS4class{FilterRules}}, where each rule corresponds to a column. The \code{FilterRules} are stored within the \code{FilterMatrix} object, for the sake of provenance. In general, a \code{FilterMatrix} behaves like an ordinary \code{\link{matrix}}. } \section{Accessor methods}{ In the code snippets below, \code{x} is a \code{FilterMatrix} object. \describe{ \item{}{\code{filterRules(x)}: Get the \code{FilterRules} corresponding to the columns of the matrix. } } } \section{Constructor}{ \describe{ \item{}{ \code{FilterMatrix(matrix, filterRules)}: Constructs a \code{FilterMatrix}, from a given \code{matrix} and \code{filterRules}. Not usually called by the user, see \code{\link{evalSeparately}}. } } } \section{Utilities}{ \describe{ \item{}{ \code{summary(object, discarded = FALSE, percent = FALSE)}: Returns a numeric vector containing the total number of records (\code{nrow}), the number passed by each filter, and the number of records that passed every filter. If \code{discarded} is \code{TRUE}, then the numbers are inverted (i.e., the values are subtracted from the number of rows). If \code{percent} is \code{TRUE}, then the numbers are percent of total. } } } \author{ Michael Lawrence } \seealso{ \code{\link{evalSeparately}} is the typical way to generate this object. } \keyword{classes} \keyword{methods} IRanges/man/FilterRules-class.Rd0000644000126300012640000002235212227064476020110 0ustar00biocbuildphs_compbio\name{FilterRules-class} \docType{class} \alias{FilterRules-class} % accessors \alias{active,FilterRules-method} \alias{active<-,FilterRules-method} % subsetting \alias{[,FilterRules-method} \alias{[[<-,FilterRules-method} \alias{subsetByFilter} \alias{subsetByFilter,ANY,FilterRules-method} % splitting and combining \alias{append,FilterRules,FilterRules-method} \alias{c,FilterRules-method} % evaluating \alias{eval,FilterRules,ANY-method} \alias{evalSeparately} \alias{evalSeparately,FilterRules-method} % constructor \alias{FilterRules} % general \alias{summary,FilterRules-method} % filter closures \alias{params} \alias{params,FilterClosure-method} \alias{show,FilterClosure-method} \title{Collection of Filter Rules} \description{A \code{FilterRules} object is a collection of filter rules, which can be either \code{expression} or \code{function} objects. Rules can be disabled/enabled individually, facilitating experimenting with different combinations of filters.} \details{ It is common to split a dataset into subsets during data analysis. When data is large, however, representing subsets (e.g. by logical vectors) and storing them as copies might become too costly in terms of space. The \code{FilterRules} class represents subsets as lightweight \code{expression} and/or \code{function} objects. Subsets can then be calculated when needed (on the fly). This avoids copying and storing a large number of subsets. Although it might take longer to frequently recalculate a subset, it often is a relatively fast operation and the space savings tend to be more than worth it when data is large. Rules may be either expressions or functions. Evaluating an expression or invoking a function should result in a logical vector. Expressions are often more convenient, but functions (i.e. closures) are generally safer and more powerful, because the user can specify the enclosing environment. If a rule is an expression, it is evaluated inside the \code{envir} argument to the \code{eval} method (see below). If a function, it is invoked with \code{envir} as its only argument. See examples. } \section{Accessor methods}{ In the code snippets below, \code{x} is a \code{FilterRules} object. \describe{ \item{}{\code{active(x)}: Get the logical vector of length \code{length(x)}, where \code{TRUE} for an element indicates that the corresponding rule in \code{x} is active (and inactive otherwise). Note that \code{names(active(x))} is equal to \code{names(x)}.} \item{}{\code{active(x) <- value}: Replace the active state of the filter rules. If \code{value} is a logical vector, it should be of length \code{length(x)} and indicate which rules are active. Otherwise, it can be either numeric or character vector, in which case it sets the indicated rules (after dropping NA's) to active and all others to inactive. See examples.} } } \section{Constructor}{ \describe{ \item{}{ \code{FilterRules(exprs = list(), ..., active = TRUE)}: Constructs a \code{FilterRules} with the rules given in the list \code{exprs} or in \code{...}. The initial active state of the rules is given by \code{active}, which is recycled as necessary. Elements in \code{exprs} may be either character (parsed into an expression), a language object (coerced to an expression), an expression, or a function that takes at least one argument. \strong{IMPORTANTLY}, all arguments in \code{...} are \strong{\code{quote()}}'d and then coerced to an expression. So, for example, character data is only parsed if it is a literal. The names of the filters are taken from the names of \code{exprs} and \code{...}, if given. Otherwise, the character vectors take themselves as their name and the others are deparsed (before any coercion). Thus, it is recommended to always specify meaningful names. In any case, the names are made valid and unique. } } } \section{Subsetting and Replacement}{ In the code snippets below, \code{x} is a \code{FilterRules} object. \describe{ \item{}{ \code{x[i]}: Subsets the filter rules using the same interface as for \code{\linkS4class{Vector}}. } \item{}{ \code{x[[i]]}: Extracts an expression or function via the same interface as for \code{\linkS4class{List}}. } \item{}{ \code{x[[i]] <- value}: The same interface as for \code{\linkS4class{List}}. The default active state for new rules is \code{TRUE}. } } } \section{Combining}{ In the code snippets below, \code{x} is a \code{FilterRules} object. \describe{ \item{}{\code{append(x, values, after = length(x))}: Appends the \code{values} \code{FilterRules} instance onto \code{x} at the index given by \code{after}. } \item{}{\code{c(x, ..., recursive = FALSE)}: Concatenates the \code{FilterRule} instances in \code{...} onto the end of \code{x}. } } } \section{Evaluating}{ \describe{ \item{}{ \code{eval(expr, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv())}: Evaluates a \code{FilterRules} instance (passed as the \code{expr} argument). Expression rules are evaluated in \code{envir}, while function rules are invoked with \code{envir} as their only argument. The evaluation of a rule should yield a logical vector. The results from the rule evaluations are combined via the AND operation (i.e. \code{&}) so that a single logical vector is returned from \code{eval}. } \item{}{ \code{evalSeparately(expr, envir = parent.frame(), enclos = if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv())}: Evaluates separately each rule in a \code{FilterRules} instance (passed as the \code{expr} argument). Expression rules are evaluated in \code{envir}, while function rules are invoked with \code{envir} as their only argument. The evaluation of a rule should yield a logical vector. The results from the rule evaluations are combined into a logical matrix, with a column for each rule. This is essentially the parallel evaluator, while \code{eval} is the serial evaluator. } \item{}{ \code{subsetByFilter(x, filter)}: Evaluates \code{filter} on \code{x} and uses the result to subset \code{x}. The result contains only the elements in \code{x} for which \code{filter} evaluates to \code{TRUE}. } \item{}{\code{summary(object, subject)}: Returns an integer vector with the number of elements in \code{subject} that pass each rule in \code{object}, along with a count of the elements that pass all filters. } } } \section{Filter Closures}{ When a closure (function) is included as a filter in a \code{FilterRules} object, it is converted to a \code{FilterClosure}, which is currently nothing more than a marker class that extends \code{function}. When a \code{FilterClosure} filter is extracted, there are some accessors and utilities for manipulating it: \describe{ \item{}{\code{params}: Gets a named list of the objects that are present in the enclosing environment (without inheritance). This assumes that a filter is constructed via a constructor function, and the objects in the frame of the constructor (typically, the formal arguments) are the parameters of the filter. } } } \author{ Michael Lawrence } \seealso{ \code{\link{rdapply}}, which accepts a \code{FilterRules} instance to filter each space before invoking the user function. } \examples{ ## constructing a FilterRules instance ## an empty set of filters filters <- FilterRules() ## as a simple character vector filts <- c("peaks", "promoters") filters <- FilterRules(filts) active(filters) # all TRUE ## with functions and expressions filts <- list(peaks = expression(peaks), promoters = expression(promoters), find_eboxes = function(rd) rep(FALSE, nrow(rd))) filters <- FilterRules(filts, active = FALSE) active(filters) # all FALSE ## direct, quoted args (character literal parsed) filters <- FilterRules(under_peaks = peaks, in_promoters = "promoters") filts <- list(under_peaks = expression(peaks), in_promoters = expression(promoters)) ## specify both exprs and additional args filters <- FilterRules(filts, diffexp = de) filts <- c("promoters", "peaks", "introns") filters <- FilterRules(filts) ## evaluation df <- DataFrame(peaks = c(TRUE, TRUE, FALSE, FALSE), promoters = c(TRUE, FALSE, FALSE, TRUE), introns = c(TRUE, FALSE, FALSE, FALSE)) eval(filters, df) fm <- evalSeparately(filters, df) identical(filterRules(fm), filters) summary(fm) summary(fm, percent = TRUE) fm <- evalSeparately(filters, df, serial = TRUE) ## set the active state directly active(filters) <- FALSE # all FALSE active(filters) <- TRUE # all TRUE active(filters) <- c(FALSE, FALSE, TRUE) active(filters)["promoters"] <- TRUE # use a filter name ## toggle the active state by name or index active(filters) <- c(NA, 2) # NA's are dropped active(filters) <- c("peaks", NA) } \keyword{classes} \keyword{methods} IRanges/man/GappedRanges-class.Rd0000644000126300012640000001311712227064476020207 0ustar00biocbuildphs_compbio\name{GappedRanges-class} \docType{class} % Classes: \alias{class:GappedRanges} \alias{GappedRanges-class} \alias{GappedRanges} % Generics and methods: \alias{length,GappedRanges-method} \alias{start,GappedRanges-method} \alias{end,GappedRanges-method} \alias{ngap} \alias{ngap,GappedRanges-method} \alias{names,GappedRanges-method} \alias{names<-,GappedRanges-method} \alias{coerce,CompressedNormalIRangesList,GappedRanges-method} \alias{coerce,CompressedIRangesList,GappedRanges-method} \alias{coerce,GappedRanges,CompressedNormalIRangesList-method} \alias{coerce,GappedRanges,NormalIRangesList-method} \alias{coerce,GappedRanges,CompressedIRangesList-method} \alias{coerce,GappedRanges,IRangesList-method} \alias{coerce,GappedRanges,RangesList-method} \alias{as.data.frame.GappedRanges} \alias{as.data.frame,GappedRanges-method} \alias{show,GappedRanges-method} \alias{elementLengths,GappedRanges-method} \alias{c,GappedRanges-method} \title{GappedRanges objects} \description{ The GappedRanges class is a vector-like container for storing a set of "gapped ranges". } \details{ A "gapped range" is conceptually the union of 1 or more non-overlapping (and non-empty) ranges ordered from left to right. More precisely, a "gapped range" can be represented by a normal IRanges object of length >= 1. In particular normality here ensures that the individual ranges are non-empty and are separated by non-empty gaps. The start of a "gapped range" is the start of its first range. The end of a "gapped range" is the end of its last range. If we ignore the gaps, then a GappedRanges object can be seen as a \link{Ranges} object. } \section{Constructor}{ No constructor function is provided for GappedRanges objects. The coercion methods described below can be used to create GappedRanges objects. } \section{Coercion}{ \describe{ \item{}{ \code{as(from, "GappedRanges")}: Turns a \link{CompressedNormalIRangesList} or \link{CompressedIRangesList} object into a GappedRanges object. } \item{}{ \code{as(from, "RangesList")}: Turns a GappedRanges object into a \link{RangesList} object (more precisely the result will be a \link{CompressedNormalIRangesList} object). } } } \section{Accessor methods}{ In the code snippets below, \code{x} is a GappedRanges object. \describe{ \item{}{ \code{length(x)}: Returns the number of "gapped ranges" in \code{x}. } \item{}{ \code{start(x), end(x)}: Returns an integer vector of length \code{length(x)} containing the start and end (respectively) of each "gapped range" in \code{x}. See Details section above for the exact definitions of the start and end of a "gapped range". } \item{}{ \code{width(x)}: Defined as \code{end(x) - start(x) + 1L}. } \item{}{ \code{ngap(x)}: Returns an integer vector of length \code{length(x)} containing the number of gaps for each "gapped range" in \code{x}. Equivalent to \code{elementLengths(x) - 1L}. } \item{}{ \code{names(x)}: \code{NULL} or a character vector of length \code{length(x)}. } } } \section{Subsetting and related operations}{ In the code snippets below, \code{x} is a GappedRanges object. \describe{ \item{}{ \code{x[i]}: Returns a new GappedRanges object made of the selected "gapped ranges". \code{i} can be a numeric, character or logical vector, or any of the types supported by the \code{[} method for \link{CompressedNormalIRangesList} objects. } \item{}{ \code{x[[i]]}: Returns the \link{NormalIRanges} object representing the i-th element in \code{x}. Equivalent to \code{as(from, "RangesList")[[i]]}. \code{i} can be a single numeric value or a single character string. } \item{}{ \code{elemenType(x)}: Returns the type of \code{x[[i]]} as a single string (always \code{"NormalIRanges"}). Note that the semantic of the \code{[[} method for GappedRanges objects is different from the semantic of the method for \link{Ranges} objects (the latter returns an integer vector). } \item{}{ \code{elementLengths(x)}: Semantically equivalent to \preformatted{sapply(seq_len(length(x)), function(i) length(x[[i]]))} but much faster. Note that the semantic of the \code{elementLengths} method for GappedRanges objects is different from the semantic of the method for \link{Ranges} objects (the latter returns the \code{width} of the \link{Ranges} object). } } } \section{Combining and related operations}{ In the code snippets below, \code{x} is a GappedRanges object. \describe{ \item{}{ \code{c(x, ...)}: Combine \code{x} and the GappedRanges objects in \code{...} together. The result is an object of the same class as \code{x}. } } } \author{H. Pages} \seealso{ \link{Ranges-class}, \link{CompressedNormalIRangesList-class} } \examples{ ## The 3 following IRanges objects are normal. Each of them will be ## stored as a "gapped range" in the GappedRanges object 'gr'. ir1 <- IRanges(start=c(11, 21, 23), end=c(15, 21, 30)) ir2 <- IRanges(start=-2, end=15) ir3 <- IRanges(start=c(-2, 21), end=c(10, 22)) irl <- IRangesList(ir1, ir2, ir3) gr <- as(irl, "GappedRanges") gr length(gr) start(gr) end(gr) width(gr) ngap(gr) gr[-1] gr[ngap(gr) >= 1] gr[[1]] as.integer(gr[[1]]) gr[[2]] as.integer(gr[[2]]) as(gr, "RangesList") start(as(gr, "RangesList")) # not the same as 'start(gr)' } \keyword{methods} \keyword{classes} IRanges/man/Grouping-class.Rd0000644000126300012640000003222612227064476017443 0ustar00biocbuildphs_compbio\name{Grouping-class} \docType{class} % Grouping objects: \alias{class:Grouping} \alias{Grouping-class} \alias{Grouping} \alias{nobj} \alias{grouplength} \alias{grouplength,Grouping-method} \alias{members} \alias{members,Grouping-method} \alias{vmembers} \alias{vmembers,Grouping-method} \alias{togroup} \alias{togroup,ANY-method} \alias{tofactor} \alias{togrouplength} \alias{togrouplength,Grouping-method} \alias{show,Grouping-method} % H2LGrouping and Dups objects: \alias{class:H2LGrouping} \alias{H2LGrouping-class} \alias{H2LGrouping} \alias{high2low} \alias{high2low,H2LGrouping-method} \alias{high2low,vector-method} \alias{high2low,Vector-method} \alias{low2high} \alias{low2high,H2LGrouping-method} \alias{length,H2LGrouping-method} \alias{nobj,H2LGrouping-method} \alias{grouplength,H2LGrouping-method} \alias{members,H2LGrouping-method} \alias{vmembers,H2LGrouping-method} \alias{togroup,H2LGrouping-method} \alias{grouprank} \alias{grouprank,H2LGrouping-method} \alias{togrouprank} \alias{togrouprank,H2LGrouping-method} \alias{length<-,H2LGrouping-method} \alias{class:Dups} \alias{Dups-class} \alias{Dups} \alias{duplicated,Dups-method} \alias{duplicated.Dups} \alias{show,Dups-method} % Partitioning objects: \alias{class:Partitioning} \alias{Partitioning-class} \alias{Partitioning} \alias{grouplength,Partitioning-method} \alias{names,Partitioning-method} \alias{names<-,Partitioning-method} \alias{class:PartitioningByEnd} \alias{PartitioningByEnd-class} \alias{PartitioningByEnd} \alias{end,PartitioningByEnd-method} \alias{length,PartitioningByEnd-method} \alias{nobj,PartitioningByEnd-method} \alias{start,PartitioningByEnd-method} \alias{width,PartitioningByEnd-method} \alias{coerce,Ranges,PartitioningByEnd-method} \alias{class:PartitioningByWidth} \alias{PartitioningByWidth-class} \alias{PartitioningByWidth} \alias{width,PartitioningByWidth-method} \alias{length,PartitioningByWidth-method} \alias{end,PartitioningByWidth-method} \alias{nobj,PartitioningByWidth-method} \alias{start,PartitioningByWidth-method} \alias{coerce,Ranges,PartitioningByWidth-method} \alias{relist,ANY,PartitioningByEnd-method} \title{Grouping objects} \description{ In this man page, we call "grouping" the action of dividing a collection of NO objects into NG groups (some of which may be empty). The Grouping class and subclasses are containers for representing groupings. } \section{The Grouping core API}{ Let's give a formal description of the Grouping core API: Groups G_i are indexed from 1 to NG (1 <= i <= NG). Objects O_j are indexed from 1 to NO (1 <= j <= NO). Every object must belong to one group and only one. Given that empty groups are allowed, NG can be greater than NO. Grouping an empty collection of objects (NO = 0) is supported. In that case, all the groups are empty. And only in that case, NG can be zero too (meaning there are no groups). If \code{x} is a Grouping object: \describe{ \item{}{ \code{length(x)}: Returns the number of groups (NG). } \item{}{ \code{names(x)}: Returns the names of the groups. } \item{}{ \code{nobj(x)}: Returns the number of objects (NO). Equivalent to \code{length(togroup(x))}. } } Going from groups to objects: \describe{ \item{}{ \code{x[[i]]}: Returns the indices of the objects (the j's) that belong to G_i. The j's are returned in ascending order. This provides the mapping from groups to objects (one-to-many mapping). } \item{}{ \code{grouplength(x, i=NULL)}: Returns the number of objects in G_i. Works in a vectorized fashion (unlike \code{x[[i]]}). \code{grouplength(x)} is equivalent to \code{grouplength(x, seq_len(length(x)))}. If \code{i} is not NULL, \code{grouplength(x, i)} is equivalent to \code{sapply(i, function(ii) length(x[[ii]]))}. } \item{}{ \code{members(x, i)}: Equivalent to \code{x[[i]]} if \code{i} is a single integer. Otherwise, if \code{i} is an integer vector of arbitrary length, it's equivalent to \code{sort(unlist(sapply(i, function(ii) x[[ii]])))}. } \item{}{ \code{vmembers(x, L)}: A version of \code{members} that works in a vectorized fashion with respect to the \code{L} argument (\code{L} must be a list of integer vectors). Returns \code{lapply(L, function(i) members(x, i))}. } } Going from objects to groups: \describe{ \item{}{ \code{togroup(x, j=NULL)}: Returns the index i of the group that O_j belongs to. This provides the mapping from objects to groups (many-to-one mapping). Works in a vectorized fashion. \code{togroup(x)} is equivalent to \code{togroup(x, seq_len(nobj(x)))}: both return the entire mapping in an integer vector of length NO. If \code{j} is not NULL, \code{togroup(x, j)} is equivalent to \code{y <- togroup(x); y[j]}. } \item{}{ \code{togrouplength(x, j=NULL)}: Returns the number of objects that belong to the same group as O_j (including O_j itself). Equivalent to \code{grouplength(x, togroup(x, j))}. } } Given that \code{length}, \code{names} and \code{[[} are defined for Grouping objects, those objects can be considered \link{List} objects. In particular, \code{as.list} works out-of-the-box on them. One important property of any Grouping object \code{x} is that \code{unlist(as.list(x))} is always a permutation of \code{seq_len(nobj(x))}. This is a direct consequence of the fact that every object in the grouping belongs to one group and only one. } \section{The H2LGrouping and Dups subclasses}{ [DOCUMENT ME] } \section{The Partitioning subclass}{ A Partitioning container represents a block-grouping, i.e. a grouping where each group contains objects that are neighbors in the original collection of objects. More formally, a grouping \code{x} is a block-grouping iff \code{togroup(x)} is sorted in increasing order (not necessarily strictly increasing). A block-grouping object can also be seen (and manipulated) as a \link{Ranges} object where all the ranges are adjacent starting at 1 (i.e. it covers the 1:NO interval with no overlap between the ranges). Note that a Partitioning object is both: a particular type of Grouping object and a particular type of \link{Ranges} object. Therefore all the methods that are defined for Grouping and \link{Ranges} objects can also be used on a Partitioning object. See \code{?Ranges} for a description of the \link{Ranges} API. The Partitioning class is virtual with 2 concrete subclasses: PartitioningByEnd (only stores the end of the groups, allowing fast mapping from groups to objects), and PartitioningByWidth (only stores the width of the groups). } \section{Constructors}{ \describe{ \item{}{ \code{H2LGrouping(high2low=integer())}: [DOCUMENT ME] } \item{}{ \code{Dups(high2low=integer())}: [DOCUMENT ME] } \item{}{ \code{PartitioningByEnd(x=integer(), NG=NULL, names=NULL)}: \code{x} must be either a list-like object or a sorted integer vector. \code{NG} must be either \code{NULL} or a single integer. \code{names} must be either \code{NULL} or a character vector of length \code{NG} (if supplied) or \code{length(x)} (if \code{NG} is not supplied). Returns the following PartitioningByEnd object \code{y}: \itemize{ \item If \code{x} is a list-like object, then the returned object \code{y} has the same length as \code{x} and is such that \code{width(y)} is identical to \code{elementLengths(x)}. \item If \code{x} is an integer vector and \code{NG} is not supplied, then \code{x} must be sorted (checked) and contain non-NA non-negative values (NOT checked). The returned object \code{y} has the same length as \code{x} and is such that \code{end(y)} is identical to \code{x}. \item If \code{x} is an integer vector and \code{NG} is supplied, then \code{x} must be sorted (checked) and contain values >= 1 and <= \code{NG} (checked). The returned object \code{y} is of length \code{NG} and is such that \code{togroup(y)} is identical to \code{x}. } If the \code{names} argument is supplied, it is used to name the partitions. } \item{}{ \code{PartitioningByWidth(x=integer(), NG=NULL, names=NULL)}: \code{x} must be either a list-like object or an integer vector. \code{NG} must be either \code{NULL} or a single integer. \code{names} must be either \code{NULL} or a character vector of length \code{NG} (if supplied) or \code{length(x)} (if \code{NG} is not supplied). Returns the following PartitioningByWidth object \code{y}: \itemize{ \item If \code{x} is a list-like object, then the returned object \code{y} has the same length as \code{x} and is such that \code{width(y)} is identical to \code{elementLengths(x)}. \item If \code{x} is an integer vector and \code{NG} is not supplied, then \code{x} must contain non-NA non-negative values (NOT checked). The returned object \code{y} has the same length as \code{x} and is such that \code{width(y)} is identical to \code{x}. \item If \code{x} is an integer vector and \code{NG} is supplied, then \code{x} must be sorted (checked) and contain values >= 1 and <= \code{NG} (checked). The returned object \code{y} is of length \code{NG} and is such that \code{togroup(y)} is identical to \code{x}. } If the \code{names} argument is supplied, it is used to name the partitions. } } Note that these constructors don't recycle their \code{names} argument (to remain consistent with what \code{`names<-`} does on standard vectors). } \author{H. Pages} \seealso{ \link{List-class}, \link{Ranges-class}, \link{IRanges-class}, \link{successiveIRanges}, \link[base]{cumsum}, \link[base]{diff} } \examples{ showClass("Grouping") # shows (some of) the known subclasses ## --------------------------------------------------------------------- ## A. H2LGrouping OBJECTS ## --------------------------------------------------------------------- high2low <- c(NA, NA, 2, 2, NA, NA, NA, 6, NA, 1, 2, NA, 6, NA, NA, 2) h2l <- H2LGrouping(high2low) h2l ## The Grouping core API: length(h2l) nobj(h2l) # same as 'length(h2l)' for H2LGrouping objects h2l[[1]] h2l[[2]] h2l[[3]] h2l[[4]] h2l[[5]] grouplength(h2l) # same as 'unname(sapply(h2l, length))' grouplength(h2l, 5:2) members(h2l, 5:2) # all the members are put together and sorted togroup(h2l) togroup(h2l, 5:2) togrouplength(h2l) # same as 'grouplength(h2l, togroup(h2l))' togrouplength(h2l, 5:2) ## The List API: as.list(h2l) sapply(h2l, length) ## --------------------------------------------------------------------- ## B. Dups OBJECTS ## --------------------------------------------------------------------- dups1 <- as(h2l, "Dups") dups1 duplicated(dups1) # same as 'duplicated(togroup(dups1))' ### The purpose of a Dups object is to describe the groups of duplicated ### elements in a vector-like object: x <- c(2, 77, 4, 4, 7, 2, 8, 8, 4, 99) x_high2low <- high2low(x) x_high2low # same length as 'x' dups2 <- Dups(x_high2low) dups2 togroup(dups2) duplicated(dups2) togrouplength(dups2) # frequency for each element table(x) ## --------------------------------------------------------------------- ## C. Partitioning OBJECTS ## --------------------------------------------------------------------- pbe1 <- PartitioningByEnd(c(4, 7, 7, 8, 15), names=LETTERS[1:5]) pbe1 # the 3rd partition is empty ## The Grouping core API: length(pbe1) nobj(pbe1) pbe1[[1]] pbe1[[2]] pbe1[[3]] grouplength(pbe1) # same as 'unname(sapply(pbe1, length))' and 'width(pbe1)' togroup(pbe1) togrouplength(pbe1) # same as 'grouplength(pbe1, togroup(pbe1))' names(pbe1) ## The Ranges core API: start(pbe1) end(pbe1) width(pbe1) ## The List API: as.list(pbe1) sapply(pbe1, length) ## Replacing the names: names(pbe1)[3] <- "empty partition" pbe1 ## Coercion to an IRanges object: as(pbe1, "IRanges") ## Other examples: PartitioningByEnd(c(0, 0, 19), names=LETTERS[1:3]) PartitioningByEnd() # no partition PartitioningByEnd(integer(9)) # all partitions are empty x <- c(1L, 5L, 5L, 6L, 8L) pbe2 <- PartitioningByEnd(x, NG=10L) stopifnot(identical(togroup(pbe2), x)) pbw2 <- PartitioningByWidth(x, NG=10L) stopifnot(identical(togroup(pbw2), x)) ## --------------------------------------------------------------------- ## D. RELATIONSHIP BETWEEN Partitioning OBJECTS AND successiveIRanges() ## --------------------------------------------------------------------- mywidths <- c(4, 3, 0, 1, 7) ## The 3 following calls produce the same ranges: ir <- successiveIRanges(mywidths) # IRanges instance. pbe <- PartitioningByEnd(cumsum(mywidths)) # PartitioningByEnd instance. pbw <- PartitioningByWidth(mywidths) # PartitioningByWidth instance. stopifnot(identical(as(ir, "PartitioningByEnd"), pbe)) stopifnot(identical(as(ir, "PartitioningByWidth"), pbw)) } \keyword{methods} \keyword{classes} IRanges/man/Hits-class.Rd0000644000126300012640000001553112227064476016560 0ustar00biocbuildphs_compbio\name{Hits-class} \docType{class} \alias{Hits-class} \alias{Hits} % accessors \alias{length,Hits-method} \alias{subjectHits} \alias{subjectHits,Hits-method} \alias{queryHits} \alias{queryHits,Hits-method} \alias{queryLength} \alias{subjectLength} \alias{queryLength,Hits-method} \alias{subjectLength,Hits-method} \alias{countQueryHits} \alias{countQueryHits,Hits-method} \alias{countSubjectHits} \alias{countSubjectHits,Hits-method} % coercion \alias{as.matrix,Hits-method} \alias{as.data.frame.Hits} \alias{as.data.frame,Hits-method} \alias{as.table,Hits-method} \alias{t,Hits-method} \alias{as.list,Hits-method} \alias{as.list.Hits} \alias{coerce,Hits,list-method} \alias{coerce,Hits,List-method} \alias{coerce,Hits,DataFrame-method} % setops \alias{match,Hits,Hits-method} % show \alias{show,Hits-method} \alias{remapHits} \title{Set of hits between 2 vector-like objects} \description{The \code{Hits} class stores a set of "hits" between the elements in one vector-like object (called the "query") and the elements in another (called the "subject"). Currently, \code{Hits} are used to represent the result of a call to \code{\link{findOverlaps}}, though other operations producing "hits" are imaginable.} \details{ The \code{as.matrix} and \code{as.data.frame} methods coerce a \code{Hits} object to a two column \code{matrix} or \code{data.frame} with one row for each hit, where the value in the first column is the index of an element in the query and the value in the second column is the index of an element in the subject. The \code{as.table} method counts the number of hits for each query element and outputs the counts as a \code{table}. To transpose a \code{Hits} \code{x}, so that the subject and query are interchanged, call \code{t(x)}. This allows, for example, counting the number of hits for each subject element using \code{as.table}. } \section{Coercion}{ In the code snippets below, \code{x} is a \code{Hits} object. \describe{ \item{}{\code{as.matrix(x)}: Coerces \code{x} to a two column integer matrix, with each row representing a hit between a query index (first column) and subject index (second column). } \item{}{ \code{as(from, "DataFrame")}: Creates a \code{DataFrame} by combining the result of \code{as.matrix(from)} with \code{mcols(from)}. } \item{}{\code{as.data.frame(x)}: Attempts to coerce the result of \code{as(from, "DataFrame")} to a \code{data.frame}. } \item{}{\code{as.table(x)}: counts the number of hits for each query element in \code{x} and outputs the counts as a \code{table}. } \item{}{\code{t(x)}: Interchange the query and subject in \code{x}, returns a transposed \code{Hits}.} \item{}{\code{as.list(x)}: Returns a list with an element for each query, where each element contains the indices of the subjects that have a hit with the corresponding query. } \item{}{\code{as(x, "List")}: Like \code{as.list}, above. } } } \section{Subsetting}{ \describe{ \item{}{\code{x[i]}: Subset the Hits object.} } } \section{Accessors}{ \describe{ \item{}{\code{queryHits(x)}: Equivalent to \code{as.data.frame(x)[[1]]}.} \item{}{\code{subjectHits(x)}: Equivalent to \code{as.data.frame(x)[[2]]}.} \item{}{\code{countQueryHits(x)}: Counts the number of hits for each query, returning an integer vector. } \item{}{\code{countSubjectHits(x)}: Counts the number of hits for each subject, returning an integer vector. } \item{}{\code{length(x)}: get the number of hits} \item{}{\code{queryLength(x)}, \code{nrow(x)}: get the number of elements in the query} \item{}{\code{subjectLength(x)}, \code{ncol(x)}: get the number of elements in the subject} } } \section{Other operations}{ \describe{ \item{}{\code{queryHits(x, query.map=NULL, new.queryLength=NA, subject.map=NULL, new.subjectLength=NA)}: Remaps the hits in \code{x} thru a "query map" and/or a "subject map" map. The query hits are remapped thru the "query map", which is specified via the \code{query.map} and \code{new.queryLength} arguments. The subject hits are remapped thru the "subject map", which is specified via the \code{subject.map} and \code{new.subjectLength} arguments. The "query map" is conceptually a function (in the mathematical sense) and is also known as the "mapping function". It must be defined on the 1..M interval and take values in the 1..N interval, where N is \code{queryLength(x)} and M is the value specified by the user via the \code{new.queryLength} argument. Note that this mapping function doesn't need to be injective or surjective. Also it is not represented by an R function but by an integer vector of length M with no NAs. More precisely \code{query.map} can be NULL (identity map), or a vector of \code{queryLength(x)} non-NA integers that are >= 1 and <= \code{new.queryLength}, or a factor of length \code{queryLength(x)} with no NAs (a factor is treated as an integer vector, and, if missing, \code{new.queryLength} is taken to be its number of levels). Note that a factor will typically be used to represent a mapping function that is not injective. The same apply to the "subject map". \code{remapHits} returns a Hits object where all the query and subject hits (accessed with \code{queryHits} and \code{subjectHits}, respectively) have been remapped thru the 2 specified maps. This remapping is actually only the 1st step of the transformation, and is followed by 2 additional steps: (2) the removal of duplicated hits, and (3) the reordering of the hits (first by query hits, then by subject hits). Note that if the 2 maps are injective then the remapping won't introduce duplicated hits, so, in that case, step (2) is a no-op (but is still performed). Also if the "query map" is strictly ascending and the "subject map" ascending then the remapping will preserve the order of the hits, so, in that case, step (3) is also a no-op (but is still performed). } } } \author{ Michael Lawrence } \seealso{ \code{\link{findOverlaps}}, which generates an instance of this class. \link{setops-methods} for set operations on Hits objects. } \examples{ query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) tree <- IntervalTree(subject) overlaps <- findOverlaps(query, tree) as.matrix(overlaps) as.data.frame(overlaps) as.table(overlaps) # hits per query as.table(t(overlaps)) # hits per subject hits1 <- remapHits(overlaps, subject.map=factor(c("e", "e", "d"), letters[1:5])) hits1 hits2 <- remapHits(overlaps, subject.map=c(5, 5, 4), new.subjectLength=5) hits2 stopifnot(identical(hits1, hits2)) } \keyword{methods} \keyword{classes} IRanges/man/HitsList-class.Rd0000644000126300012640000000722012227064476017410 0ustar00biocbuildphs_compbio\name{HitsList-class} \docType{class} \alias{HitsList-class} \alias{CompressedHitsList-class} % coercion \alias{as.matrix,HitsList-method} \alias{as.matrix,CompressedHitsList-method} \alias{as.table,HitsList-method} \alias{t,HitsList-method} % accessors \alias{space,HitsList-method} \alias{space,CompressedHitsList-method} \alias{ranges,HitsList-method} \alias{subjectHits,HitsList-method} \alias{subjectHits,CompressedHitsList-method} \alias{queryHits,HitsList-method} \alias{queryHits,CompressedHitsList-method} \alias{queryLength,CompressedHitsList-method} \alias{subjectLength,CompressedHitsList-method} % constructor \alias{CompressedHitsList} \title{List of Hits objects} \description{The \code{HitsList} class stores a set of Hits objects. It's typically used to represent the result of \code{findOverlaps} on two \code{\linkS4class{RangesList}} objects.} \details{ Roughly the same set of utilities are provided for \code{HitsList} as for \code{Hits}: The \code{as.matrix} method coerces a \code{HitsList} in a similar way to \code{Hits}, except a column is prepended that indicates which space (or element in the query \code{RangesList}) to which the row corresponds. The \code{as.table} method flattens or unlists the list, counts the number of hits for each query range and outputs the counts as a \code{table}, which has the same shape as from a single \code{Hits} object. To transpose a \code{HitsList} \code{x}, so that the subject and query in each space are interchanged, call \code{t(x)}. This allows, for example, counting the number of hits for each subject element using \code{as.table}. When the HitsList object is the result of a call to \code{\link{findOverlaps}} on two \code{\linkS4class{RangesList}} objects, the actual regions of intersection between the overlapping ranges can be obtained with the \code{ranges} accessor. } \section{Coercion}{ In the code snippets below, \code{x} is a \code{HitsList} object. \describe{ \item{}{\code{as.matrix(x)}: calls \code{as.matrix} on each \code{Hits}, combines them row-wise and offsets the indices so that they are aligned with the result of calling \code{unlist} on the query and subject. } \item{}{\code{as.table(x)}: counts the number of hits for each query element in \code{x} and outputs the counts as a \code{table}, which is aligned with the result of calling \code{unlist} on the query. } \item{}{\code{t(x)}: Interchange the query and subject in each space of \code{x}, returns a transposed \code{HitsList}.} } } \section{Accessors}{ \describe{ \item{}{\code{queryHits(x)}: Equivalent to \code{unname(as.matrix(x)[,1])}. } \item{}{\code{subjectHits(x)}: Equivalent to \code{unname(as.matrix(x)[,2])}. } \item{}{\code{space(x)}: gets the character vector naming the space in the query \code{RangesList} for each hit, or \code{NULL} if the query did not have any names. } \item{}{\code{ranges(x, query, subject)}: returns a \code{RangesList} holding the intersection of the ranges in the \code{RangesList} objects \code{query} and \code{subject}, which should be the same subject and query used in the call to \code{findOverlaps} that generated \code{x}. Eventually, we might store the query and subject inside \code{x}, in which case the arguments would be redundant. } } } \note{This class is highly experimental. It has not been well tested and may disappear at any time.} \author{ Michael Lawrence } \seealso{ \code{\link{findOverlaps}}, which generates an instance of this class. } \keyword{methods} \keyword{classes} IRanges/man/IRanges-class.Rd0000644000126300012640000001277412227064476017207 0ustar00biocbuildphs_compbio\name{IRanges-class} \docType{class} % IRanges objects: \alias{class:IRanges} \alias{IRanges-class} \alias{start,IRanges-method} \alias{width,IRanges-method} \alias{names,IRanges-method} \alias{start<-,IRanges-method} \alias{width<-,IRanges-method} \alias{end<-,IRanges-method} \alias{names<-,IRanges-method} \alias{isNormal,IRanges-method} \alias{update,IRanges-method} \alias{c,IRanges-method} % NormalIRanges objects: \alias{class:NormalIRanges} \alias{NormalIRanges-class} \alias{NormalIRanges} \alias{isEmpty,NormalIRanges-method} \alias{max,NormalIRanges-method} \alias{min,NormalIRanges-method} % Coercion: \alias{coerce,Ranges,IRanges-method} \alias{coerce,logical,IRanges-method} \alias{coerce,logical,NormalIRanges-method} \alias{coerce,integer,IRanges-method} \alias{coerce,integer,NormalIRanges-method} \alias{coerce,numeric,IRanges-method} \alias{coerce,numeric,NormalIRanges-method} \title{IRanges and NormalIRanges objects} \description{ The IRanges class is a simple implementation of the \link{Ranges} container where 2 integer vectors of the same length are used to store the start and width values. See the \link{Ranges} virtual class for a formal definition of \link{Ranges} objects and for their methods (all of them should work for IRanges objects). Some subclasses of the IRanges class are: NormalIRanges, \link{Views}, etc... A NormalIRanges object is just an IRanges object that is guaranteed to be "normal". See the Normality section in the man page for \link{Ranges} objects for the definition and properties of "normal" \link{Ranges} objects. } \section{Constructor}{ See \code{?`\link{IRanges-constructor}`}. } \section{Coercion}{ \describe{ \item{}{ \code{as(from, "IRanges")}: Creates an IRanges instance from a Ranges object, logical vector, or integer vector. When \code{from} is a logical vector, the resulting IRanges object contains the indices for the runs of \code{TRUE} values. When \code{from} is an integer vector, the elements are either singletons or "increase by 1" sequences. } \item{}{ \code{as(from, "NormalIRanges")}: Creates a NormalIRanges instance from a logical or integer vector. When \code{from} is an integer vector, the elements must be strictly increasing. } } } \section{Combining}{ \describe{ \item{}{ \code{c(x, ..., ignore.mcols=FALSE)} Combining \code{IRanges} objects is straightforward when they do not have any metadata columns. If only one of the \code{IRanges} object has metadata columns, then the corresponding metadata columns are attached to the other \code{IRanges} object and set to \code{NA}. When multiple \code{IRanges} object have their own \code{metadata columns}, the user must ensure that each such \code{linkS4class{DataFrame}} have identical layouts to each other (same columns defined), in order for the combination to be successful, otherwise an error will be thrown. The user can call \code{c(x, ..., ignore.mcols=TRUE)} in order to combine \code{IRanges} objects with differing sets of metadata columns, which will result in the combined object having NO metadata columns. } } } \section{Methods for NormalIRanges objects}{ \describe{ \item{}{ \code{max(x)}: The maximum value in the finite set of integers represented by \code{x}. } \item{}{ \code{min(x)}: The minimum value in the finite set of integers represented by \code{x}. } } } \author{H. Pages} \seealso{ \link{Ranges-class}, \link{IRanges-constructor}, \link{IRanges-utils}, \link{intra-range-methods} for intra range transformations, \link{inter-range-methods} for inter range transformations, \link{setops-methods} } \examples{ showClass("IRanges") # shows (some of) the known subclasses ## --------------------------------------------------------------------- ## A. MANIPULATING IRanges OBJECTS ## --------------------------------------------------------------------- ## All the methods defined for Ranges objects work on IRanges objects. ## See ?Ranges for some examples. ## Also see ?`IRanges-utils` and ?`setops-methods` for additional ## operations on IRanges objects. ## Combining IRanges objects ir1 <- IRanges(c(1, 10, 20), width=5) mcols(ir1) <- DataFrame(score=runif(3)) ir2 <- IRanges(c(101, 110, 120), width=10) mcols(ir2) <- DataFrame(score=runif(3)) ir3 <- IRanges(c(1001, 1010, 1020), width=20) mcols(ir3) <- DataFrame(value=runif(3)) some.iranges <- c(ir1, ir2) ## all.iranges <- c(ir1, ir2, ir3) ## This will raise an error all.iranges <- c(ir1, ir2, ir3, ignore.mcols=TRUE) stopifnot(is.null(mcols(all.iranges))) ## --------------------------------------------------------------------- ## B. A NOTE ABOUT PERFORMANCE ## --------------------------------------------------------------------- ## Using an IRanges object for storing a big set of ranges is more ## efficient than using a standard R data frame: N <- 2000000L # nb of ranges W <- 180L # width of each range start <- 1L end <- 50000000L set.seed(777) range_starts <- sort(sample(end-W+1L, N)) range_widths <- rep.int(W, N) ## Instantiation is faster system.time(x <- IRanges(start=range_starts, width=range_widths)) system.time(y <- data.frame(start=range_starts, width=range_widths)) ## Subsetting is faster system.time(x16 <- x[c(TRUE, rep.int(FALSE, 15))]) system.time(y16 <- y[c(TRUE, rep.int(FALSE, 15)), ]) ## Internal representation is more compact object.size(x16) object.size(y16) } \keyword{methods} \keyword{classes} IRanges/man/IRanges-constructor.Rd0000644000126300012640000001554512227064476020466 0ustar00biocbuildphs_compbio\name{IRanges-constructor} \alias{IRanges-constructor} \alias{IRanges} \alias{solveUserSEW0} \alias{solveUserSEW} \title{The IRanges constructor and supporting functions} \description{ The \code{IRanges} function is a constructor that can be used to create IRanges instances. \code{solveUserSEW0} and \code{solveUserSEW} are utility functions that solve a set of user-supplied start/end/width values. } \usage{ ## IRanges constructor: IRanges(start=NULL, end=NULL, width=NULL, names=NULL) ## Supporting functions (not for the end user): solveUserSEW0(start=NULL, end=NULL, width=NULL) solveUserSEW(refwidths, start=NA, end=NA, width=NA, rep.refwidths=FALSE, translate.negative.coord=TRUE, allow.nonnarrowing=FALSE) } \arguments{ \item{start, end, width}{ For \code{IRanges} and \code{solveUserSEW0}: \code{NULL}, or vector of integers (eventually with NAs). For \code{solveUserSEW}: vector of integers (eventually with NAs). } \item{names}{ A character vector or \code{NULL}. } \item{refwidths}{ Vector of non-NA non-negative integers containing the reference widths. } \item{rep.refwidths}{ \code{TRUE} or \code{FALSE}. Use of \code{rep.refwidths=TRUE} is supported only when \code{refwidths} is of length 1. } \item{translate.negative.coord, allow.nonnarrowing}{ \code{TRUE} or \code{FALSE}. } } \section{IRanges constructor}{ Return the IRanges object containing the ranges specified by \code{start}, \code{end} and \code{width}. Input falls into one of two categories: \describe{ \item{Category 1}{ \code{start}, \code{end} and \code{width} are numeric vectors (or NULLs). If necessary they are recycled to the length of the longest (NULL arguments are filled with NAs). After this recycling, each row in the 3-column matrix obtained by binding those 3 vectors together is "solved" i.e. NAs are treated as unknown in the equation \code{end = start + width - 1}. Finally, the solved matrix is returned as an \link{IRanges} instance. } \item{Category 2}{ The \code{start} argument is a logical vector or logical Rle object and \code{IRanges(start)} produces the same result as \code{as(start, "IRanges")}. Note that, in that case, the returned IRanges instance is guaranteed to be normal. } } Note that the \code{names} argument is never recycled (to remain consistent with what \code{`names<-`} does on standard vectors). } \section{Supporting functions}{ \describe{ \item{}{ \code{solveUserSEW0(start=NULL, end=NULL, width=NULL)}: } \item{}{ \code{solveUserSEW(refwidths, start=NA, end=NA, width=NA, rep.refwidths=FALSE, translate.negative.coord=TRUE, allow.nonnarrowing=FALSE)}: Use of \code{rep.refwidths=TRUE} is supported only when \code{refwidths} is of length 1. If \code{rep.refwidths=FALSE} (the default) then \code{start}, \code{end} and \code{width} are recycled to the length of \code{refwidths} (it's an error if one of them is longer than \code{refwidths}, or is of zero length while \code{refwidths} is not). If \code{rep.refwidths=TRUE} then \code{refwidths} is first replicated L times where L is the length of the longest of \code{start}, \code{end} and \code{width}. After this replication, \code{start}, \code{end} and \code{width} are recycled to the new length of \code{refwidths} (L) (it's an error if one of them is of zero length while L is != 0). From now, \code{refwidths}, \code{start}, \code{end} and \code{width} are integer vectors of equal lengths. Each row in the 3-column matrix obtained by binding those 3 vectors together must contain at least one NA (otherwise an error is returned). Then each row is "solved" i.e. the 2 following transformations are performed (\code{i} is the indice of the row): (1) if \code{translate.negative.coord} is TRUE then a negative value of \code{start[i]} or \code{end[i]} is considered to be a \code{-refwidths[i]}-based coordinate so \code{refwidths[i]+1} is added to it to make it 1-based; (2) the NAs in the row are treated as unknowns which values are deduced from the known values in the row and from \code{refwidths[i]}. The exact rules for (2) are the following. Rule (2a): if the row contains at least 2 NAs, then \code{width[i]} must be one of them (otherwise an error is returned), and if \code{start[i]} is one of them it is replaced by 1, and if \code{end[i]} is one of them it is replaced by \code{refwidths[i]}, and finally \code{width[i]} is replaced by \code{end[i] - start[i] + 1}. Rule (2b): if the row contains only 1 NA, then it is replaced by the solution of the \code{width[i] == end[i] - start[i] + 1} equation. Finally, the set of solved rows is returned as an \link{IRanges} object of the same length as \code{refwidths} (after replication if \code{rep.refwidths=TRUE}). Note that an error is raised if either (1) the set of user-supplied start/end/width values is invalid or (2) \code{allow.nonnarrowing} is FALSE and the ranges represented by the solved start/end/width values are not narrowing the ranges represented by the user-supplied start/end/width values. } } } \author{H. Pages} \seealso{ \link{IRanges-class}, \code{\link{narrow}} } \examples{ ## --------------------------------------------------------------------- ## A. USING THE IRanges() CONSTRUCTOR ## --------------------------------------------------------------------- IRanges(start=11, end=rep.int(20, 5)) IRanges(start=11, width=rep.int(20, 5)) IRanges(-2, 20) # only one range IRanges(start=c(2, 0, NA), end=c(NA, NA, 14), width=11:0) IRanges() # IRanges instance of length zero IRanges(names=character()) ## With logical input: x <- IRanges(c(FALSE, TRUE, TRUE, FALSE, TRUE)) # logical vector input isNormal(x) # TRUE x <- IRanges(Rle(1:30) \%\% 5 <= 2) # logical Rle input isNormal(x) # TRUE ## --------------------------------------------------------------------- ## B. USING solveUserSEW() ## --------------------------------------------------------------------- refwidths <- c(5:3, 6:7) refwidths solveUserSEW(refwidths) solveUserSEW(refwidths, start=4) solveUserSEW(refwidths, end=3, width=2) solveUserSEW(refwidths, start=-3) solveUserSEW(refwidths, start=-3, width=2) solveUserSEW(refwidths, end=-4) ## The start/end/width arguments are recycled: solveUserSEW(refwidths, start=c(3, -4, NA), end=c(-2, NA)) ## Using 'rep.refwidths=TRUE': solveUserSEW(10, start=-(1:6), rep.refwidths=TRUE) solveUserSEW(10, end=-(1:6), width=3, rep.refwidths=TRUE) } \keyword{utilities} IRanges/man/IRanges-internals.Rd0000644000126300012640000000140512227064476020066 0ustar00biocbuildphs_compbio\name{IRanges internals} \alias{setValidity2} \alias{new2} \alias{setMethods} \alias{.Call2} \alias{class:characterORNULL} \alias{characterORNULL-class} \alias{characterORNULL} \alias{class:functionORNULL} \alias{functionORNULL-class} \alias{functionORNULL} \alias{coerce,ANY,vector-method} % More low-level helper functions (from R/normarg-utils.R): \alias{isTRUEorFALSE} \alias{isSingleInteger} \alias{isSingleNumber} \alias{isSingleString} \alias{isSingleNumberOrNA} \alias{isSingleStringOrNA} \alias{recycleIntegerArg} \alias{recycleNumericArg} \alias{fold} \title{IRanges internals} \description{ Objects, classes and methods defined in the IRanges package that are not intended to be used directly. } \keyword{internal} \keyword{methods} \keyword{classes} IRanges/man/IRanges-utils.Rd0000644000126300012640000000742612227064476017240 0ustar00biocbuildphs_compbio\name{IRanges-utils} \alias{IRanges-utils} \alias{successiveIRanges} \alias{breakInChunks} \alias{whichAsIRanges} % Coercion: \alias{asNormalIRanges} \alias{coerce,IRanges,NormalIRanges-method} \title{IRanges utility functions} \description{ Utility functions for creating or modifying \link{IRanges} objects. } \usage{ ## Create an IRanges instance: successiveIRanges(width, gapwidth=0, from=1) breakInChunks(totalsize, chunksize) ## Turn a logical vector into a set of ranges: whichAsIRanges(x) ## Coercion: asNormalIRanges(x, force=TRUE) } \arguments{ \item{width}{ A vector of non-negative integers (with no NAs) specifying the widths of the ranges to create. } \item{gapwidth}{ A single integer or an integer vector with one less element than the \code{width} vector specifying the widths of the gaps separating one range from the next one. } \item{from}{ A single integer specifying the starting position of the first range. } \item{totalsize}{ A single non-negative integer. The total size of the object to break. } \item{chunksize}{ A single positive integer. The size of the chunks (last chunk might be smaller). } \item{x}{ A logical vector for \code{whichAsIRanges}. An \link{IRanges} object for \code{asNormalIRanges}. } \item{force}{ \code{TRUE} or \code{FALSE}. Should \code{x} be turned into a \link{NormalIRanges} object even if \code{isNormal(x)} is \code{FALSE}? } } \details{ \code{successiveIRanges} returns an IRanges instance containing the ranges that have the widths specified in the \code{width} vector and are separated by the gaps specified in \code{gapwidth}. The first range starts at position \code{from}. When \code{gapwidth=0} and \code{from=1} (the defaults), the returned IRanges can be seen as a partitioning of the 1:sum(width) interval. See \code{?Partitioning} for more details on this. \code{whichAsIRanges} returns an \link{IRanges} instance containing all of the ranges where \code{x} is \code{TRUE}. If \code{force=TRUE} (the default), then \code{asNormalIRanges} will turn \code{x} into a \link{NormalIRanges} instance by reordering and reducing the set of ranges if necessary (i.e. only if \code{isNormal(x)} is \code{FALSE}, otherwise the set of ranges will be untouched). If \code{force=FALSE}, then \code{asNormalIRanges} will turn \code{x} into a \link{NormalIRanges} instance only if \code{isNormal(x)} is \code{TRUE}, otherwise it will raise an error. Note that when \code{force=FALSE}, the returned object is guaranteed to contain exactly the same set of ranges than \code{x}. \code{as(x, "NormalIRanges")} is equivalent to \code{asNormalIRanges(x, force=TRUE)}. } \author{H. Pages} \seealso{ \link{Ranges-class}, \link{IRanges-class}, \link{intra-range-methods} for intra range transformations, \link{inter-range-methods} for inter range transformations, \link{setops-methods}, \code{\link{solveUserSEW}}, \code{\link{successiveViews}} } \examples{ vec <- as.integer(c(19, 5, 0, 8, 5)) successiveIRanges(vec) breakInChunks(600999, 50000) # 13 chunks of size 50000 (last chunk is # smaller). whichAsIRanges(vec >= 5) x <- IRanges(start=c(-2L, 6L, 9L, -4L, 1L, 0L, -6L, 10L), width=c( 5L, 0L, 6L, 1L, 4L, 3L, 2L, 3L)) asNormalIRanges(x) # 3 non-empty ranges ordered from left to right and # separated by gaps of width >= 1. ## More on normality: example(`IRanges-class`) isNormal(x16) # FALSE if (interactive()) x16 <- asNormalIRanges(x16) # Error! whichFirstNotNormal(x16) # 57 isNormal(x16[1:56]) # TRUE xx <- asNormalIRanges(x16[1:56]) class(xx) max(xx) min(xx) } \keyword{utilities} IRanges/man/IRangesList-class.Rd0000644000126300012640000000766412227064476020045 0ustar00biocbuildphs_compbio\name{IRangesList-class} \docType{class} % IRangesList objects: \alias{class:IRangesList} \alias{class:CompressedIRangesList} \alias{class:SimpleIRangesList} \alias{IRangesList-class} \alias{CompressedIRangesList-class} \alias{SimpleIRangesList-class} \alias{IRangesList} \alias{CompressedIRangesList} \alias{SimpleIRangesList} % accessors \alias{end,CompressedIRangesList-method} \alias{width,CompressedIRangesList-method} \alias{start,CompressedIRangesList-method} % subset \alias{[,SimpleIRangesList-method} \alias{[,CompressedIRangesList-method} % coercion \alias{unlist,IRangesList-method} % general \alias{max,CompressedNormalIRangesList-method} \alias{max,SimpleNormalIRangesList-method} \alias{min,CompressedNormalIRangesList-method} \alias{min,SimpleNormalIRangesList-method} \alias{summary,CompressedIRangesList-method} % NormalIRangesList objects: \alias{class:NormalIRangesList} \alias{class:CompressedNormalIRangesList} \alias{class:SimpleNormalIRangesList} \alias{NormalIRangesList-class} \alias{CompressedNormalIRangesList-class} \alias{SimpleNormalIRangesList-class} \alias{NormalIRangesList} \alias{CompressedNormalIRangesList} \alias{SimpleNormalIRangesList} \alias{isNormal,CompressedIRangesList-method} \alias{isNormal,RangesList-method} \alias{isNormal,SimpleIRangesList-method} \alias{whichFirstNotNormal,RangesList-method} \alias{unlist,SimpleNormalIRangesList-method} % coercion \alias{coerce,CompressedIRangesList,CompressedNormalIRangesList-method} \alias{coerce,SimpleIRangesList,SimpleNormalIRangesList-method} \alias{as.list,CompressedNormalIRangesList-method} \alias{as.list.CompressedNormalIRangesList} \title{List of IRanges and NormalIRanges} \description{\code{\linkS4class{IRangesList}} and \code{\linkS4class{NormalIRangesList}} objects for storing \code{\linkS4class{IRanges}} and \code{\linkS4class{NormalIRanges}} objects respectively.} \section{Constructor}{ \describe{ \item{}{\code{IRangesList(..., universe = NULL, compress = TRUE)}: The \code{...} argument accepts either a comma-separated list of \code{IRanges} objects, or a single \code{LogicalList} / logical \code{RleList} object, or 2 elements named \code{start} and \code{end} each of them being either a list of integer vectors or an IntegerList object. When \code{IRanges} objects are supplied, each of them becomes an element in the new \code{IRangesList}, in the same order, which is analogous to the \code{\link{list}} constructor. If \code{compress}, the internal storage of the data is compressed. } } } \section{Coercion}{ \describe{ \item{}{\code{unlist(x)}: Unlists \code{x}, an \code{IRangesList}, by concatenating all of the ranges into a single \code{IRanges} instance. If the length of \code{x} is zero, an empty \code{IRanges} is returned. } } } \section{Methods for NormalIRangesList objects}{ \describe{ \item{}{ \code{max(x)}: An integer vector containing the maximum values of each of the elements of \code{x}. } \item{}{ \code{min(x)}: An integer vector containing the minimum values of each of the elements of \code{x}. } } } \author{ Michael Lawrence } \seealso{ \code{\linkS4class{RangesList}}, the parent of this class, for more functionality. \link{intra-range-methods} and \link{inter-range-methods} for intra and inter range transformations of IRangesList objects. \link{setops-methods} for set operations on IRangesList objects. } \examples{ range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) named <- IRangesList(one = range1, two = range2) length(named) # 2 names(named) # "one" and "two" named[[1]] # range1 unnamed <- IRangesList(range1, range2) names(unnamed) # NULL x <- IRangesList(start=list(c(1,2,3), c(15,45,20,1)), end=list(c(5,2,8), c(15,100,80,5))) as.list(x) } \keyword{classes} \keyword{methods} IRanges/man/IntervalForest-class.Rd0000644000126300012640000000654012227064476020620 0ustar00biocbuildphs_compbio\name{IntervalForest-class} \docType{class} \alias{IntervalForest-class} % constructor \alias{IntervalForest} % coercion \alias{coerce,CompressedIRangesList,IntervalForest-method} \alias{coerce,IntervalForest,CompressedIRangesList-method} \alias{coerce,IntervalForest,IRanges-method} \alias{coerce,RangesList,IntervalForest-method} % accessors \alias{length,IntervalForest-method} \alias{start,IntervalForest-method} \alias{end,IntervalForest-method} \alias{width,IntervalForest-method} \alias{elementLengths,IntervalForest-method} \alias{names,IntervalForest-method} % methods \alias{[,IntervalForest-method} \alias{show,IntervalForest-method} \title{Interval Search Forests} \description{ Efficiently perform overlap queries with a set of interval trees. } \details{ A common type of query that arises when working with intervals is finding which intervals in one set overlap those in another. An efficient family of algorithms for answering such queries is known as the Interval Tree. The \code{IntervalForest} class stores a set of Interval Trees corresponding to intervals that are partitioned into disjoint sets. The most efficient way to construct \code{IntervalForest} objects is to call the constructor below on a \link{CompressedIRangesList} object. See the \link{IntervalTree} class for the underlying Interval Tree data structure. A canonical example of a compressed ranges list are \code{\link[GenomicRanges]{GenomicRanges}} objects, where intervals are partitioned by their \code{seqnames}. See the \link[GenomicRanges]{GIntervalTree} class to see the use of \code{IntervalForest} objects in this case. The simplest approach for finding overlaps is to call the \code{\link{findOverlaps}} function on a \link{RangesList} object. See the man page of \code{\link{findOverlaps-methods}} for how to use this and other related functions. } \section{Constructor}{ \describe{ \item{}{IntervalForest(rangesList): Creates an \code{IntervalForest} from the ranges list in \code{rangesList}, an object coercible to \code{CompressedIRangesList}. } } } \section{Accessors}{ \describe{ \item{}{\code{length(x)}: Gets the number of ranges stored in the forest. This is a fast operation that does not bring the ranges into R.} \item{}{\code{start(x)}: Get the starts of the ranges as a \code{CompressedIntegerList}.} \item{}{\code{end(x)}: Get the ends of the ranges as \code{CompressedIntegerList}.} \item{}{\code{x@partitioning}: The range partitioning of class \code{PartitioningByEnd}.} \item{}{\code{names(x)}: Get the names of the range partitioning.} \item{}{\code{elementLengths(x)}: The number of ranges in each partition.} } } \author{Hector Corrada Bravo, Michael Lawrence} \seealso{ \code{\link{findOverlaps-methods}} for finding/counting interval overlaps between two compressed lists of "range-based" objects, \code{\linkS4class{RangesList}}, the parent of this class, \code{\linkS4class{CompressedHitsList}}, set of hits between 2 list-like objects, \code{\link[GenomicRanges]{GIntervalTree}}, which uses \code{IntervalForest} objects. } \examples{ query <- IRangesList(a=IRanges(c(1,4),c(5,7)),b=IRanges(9,10)) subject <- IRangesList(a=IRanges(c(2,2),c(2,3)),b=IRanges(10,12)) forest <- IntervalForest(subject) findOverlaps(query, forest) } \keyword{classes} \keyword{methods} IRanges/man/IntervalTree-class.Rd0000644000126300012640000001320612227064476020252 0ustar00biocbuildphs_compbio\name{IntervalTree-class} \docType{class} \alias{IntervalTree-class} % constructor \alias{IntervalTree} % coercion \alias{coerce,IRanges,IntervalTree-method} \alias{coerce,Ranges,IntervalTree-method} \alias{coerce,IntervalTree,IRanges-method} % accessors \alias{length,IntervalTree-method} \alias{start,IntervalTree-method} \alias{end,IntervalTree-method} \title{Interval Search Trees} \description{ Efficiently perform overlap queries with an interval tree. } \details{ A common type of query that arises when working with intervals is finding which intervals in one set overlap those in another. An efficient family of algorithms for answering such queries is known as the Interval Tree. This implementation makes use of the augmented tree algorithm from the reference below, but heavily adapts it for the use case of large, sorted query sets. The simplest approach for finding overlaps is to call the \code{\link{findOverlaps}} function on a \link{Ranges} or other object with range information. See the man page of \code{\link{findOverlaps}} for how to use this and other related functions. An \code{IntervalTree} object is a derivative of \link{Ranges} and stores its ranges as a tree that is optimized for overlap queries. Thus, for repeated queries against the same subject, it is more efficient to create an \code{IntervalTree} once for the subject using the constructor described below and then perform the queries against the \code{IntervalTree} instance. } \section{Constructor}{ \describe{ \item{}{IntervalTree(ranges): Creates an \code{IntervalTree} from the ranges in \code{ranges}, an object coercible to \code{IntervalTree}, such as an \code{\linkS4class{IRanges}} object. } } } \section{Coercion}{ \describe{ \item{}{\code{as(from, "IRanges")}: Imports the ranges in \code{from}, an \code{IntervalTree}, to an \code{\linkS4class{IRanges}}.} \item{}{\code{as(from, "IntervalTree")}: Constructs an \code{IntervalTree} representing \code{from}, a \code{Ranges} object that is coercible to \code{IRanges}. } } } \section{Accessors}{ \describe{ \item{}{\code{length(x)}: Gets the number of ranges stored in the tree. This is a fast operation that does not bring the ranges into R.} \item{}{\code{start(x)}: Get the starts of the ranges.} \item{}{\code{end(x)}: Get the ends of the ranges.} } } \section{Notes on Time Complexity}{ The cost of constructing an instance of the interval tree is a \code{O(n*lg(n))}, which makes it about as fast as other types of overlap query algorithms based on sorting. The good news is that the tree need only be built once per subject; this is useful in situations of frequent querying. Also, in this implementation the data is stored outside of R, avoiding needless copying. Of course, external storage is not always convenient, so it is possible to coerce the tree to an instance of \code{\linkS4class{IRanges}} (see the Coercion section). For the query operation, the running time is based on the query size \code{m} and the average number of hits per query \code{k}. The output size is then \code{max(mk,m)}, but we abbreviate this as \code{mk}. Note that when the \code{multiple} parameter is set to \code{FALSE}, \code{k} is fixed to 1 and drops out of this analysis. We also assume here that the query is sorted by start position (the \code{findOverlaps} function sorts the query if it is unsorted). An upper bound for finding overlaps is \code{O(min(mk*lg(n),n+mk))}. The fastest interval tree algorithm known is bounded by \code{O(min(m*lg(n),n)+mk)} but is a lot more complicated and involves two auxillary trees. The lower bound is \code{Omega(lg(n)+mk)}, which is almost the same as for returning the answer, \code{Omega(mk)}. The average is of course somewhere in between. This analysis informs the choice of which set of ranges to process into a tree, i.e. assigning one to be the subject and the other to be the query. Note that if \code{m > n}, then the running time is \code{O(m)}, and the total operation of complexity \code{O(n*lg(n) + m)} is better than if \code{m} and \code{n} were exchanged. Thus, for once-off operations, it is often most efficient to choose the smaller set to become the tree (but \code{k} also affects this). This is reinforced by the realization that if \code{mk} is about the same in either direction, the running time depends only on \code{n}, which should be minimized. Even in cases where a tree has already been constructed for one of the sets, it can be more efficient to build a new tree when the existing tree of size \code{n} is much larger than the query set of size \code{m}, roughly when \code{n > m*lg(n)}. } \references{ Interval tree algorithm from: Cormen, Thomas H.; Leiserson, Charles E.; Rivest, Ronald L.; Stein, Clifford. Introduction to Algorithms, second edition, MIT Press and McGraw-Hill. ISBN 0-262-53196-8 } \author{Michael Lawrence} \seealso{ \code{\link{findOverlaps}} for finding/counting interval overlaps between two "range-based" objects, \code{\linkS4class{Ranges}}, the parent of this class, \code{\linkS4class{Hits}}, set of hits between 2 vector-like objects. } \examples{ query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) tree <- IntervalTree(subject) findOverlaps(query, tree) ## query and subject are easily interchangeable query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2), c(5, 4)) tree <- IntervalTree(subject) t(findOverlaps(query, tree)) # the same as: findOverlaps(subject, query) } \keyword{classes} \keyword{methods} IRanges/man/List-class.Rd0000644000126300012640000002077712227064476016574 0ustar00biocbuildphs_compbio\name{List-class} \docType{class} % List class, functions and methods: \alias{class:List} \alias{List-class} \alias{List} \alias{elementType} \alias{elementType,List-method} \alias{elementType,vector-method} \alias{elementLengths} \alias{elementLengths,list-method} \alias{elementLengths,List-method} \alias{elementLengths,CompressedList-method} \alias{elementLengths,ANY-method} \alias{isEmpty} \alias{isEmpty,ANY-method} \alias{isEmpty,List-method} \alias{show,List-method} \alias{[[,List-method} \alias{[[<-,List-method} \alias{$,List-method} \alias{$<-,List-method} \alias{[,List-method} \alias{[<-,List-method} \alias{lapply,List-method} \alias{sapply,List-method} \alias{mapply,List-method} \alias{endoapply,List-method} \alias{mendoapply,List-method} \alias{revElements} \alias{revElements,List-method} \alias{coerce,List,list-method} \alias{as.list.List} \alias{coerce,ANY,List-method} \alias{coerce,integer,List-method} \alias{as.list,List-method} \alias{as.env} \alias{as.env,List-method} \alias{unlist,List-method} \alias{relist,ANY,List-method} \alias{unsplit,List-method} \alias{stack,List-method} \alias{eval} \alias{eval,expression,List-method} \alias{eval,language,List-method} \alias{with,List-method} \alias{within,List-method} \title{List objects} \description{ List objects are \link{Vector} objects with a \code{"[["}, \code{elementType} and \code{elementLengths} method. The List class serves a similar role as \link[base]{list} in base R. It adds one slot, the \code{elementType} slot, to the two slots shared by all \link{Vector} objects. The \code{elementType} slot is the preferred location for List subclasses to store the type of data represented in the sequence. It is designed to take a character of length 1 representing the class of the sequence elements. While the List class performs no validity checking based on \code{elementType}, if a subclass expects elements to be of a given type, that subclass is expected to perform the necessary validity checking. For example, the subclass \link{IntegerList} has \code{elementType = "integer"} and its validity method checks if this condition is TRUE. To be functional, a class that inherits from List must define at least a \code{"[["} method (in addition to the minimum set of \link{Vector} methods). } \section{Construction}{ \code{List} objects are typically constructed by calling the constructor of a concrete implementation, such as \code{\link{RangesList}} or \code{\link{IntegerList}}. A general and convenient way to convert any vector-like object into a \code{List} is to call \code{as(x, "List")}. This will typically yield an object from a subclass of \code{\linkS4class{CompressedList}}. } \section{Accessors}{ In the following code snippets, \code{x} is a List object. \describe{ \item{}{ \code{elementType(x)}: Get the scalar string naming the class from which all elements must derive. } \item{}{ \code{elementLengths(x)}: Get the length (or nb of row for a matrix-like object) of each of the elements. Equivalent to \code{sapply(x, NROW)}. } \item{}{ \code{isEmpty(x)}: Returns a logical indicating either if the sequence has no elements or if all its elements are empty. } } } \section{Element extraction (list style)}{ In the code snippets below, \code{x} is a List object. \describe{ \item{}{ \code{x[[i]]}: If defined, return the selected element \code{i}, where \code{i} is an numeric or character vector of length 1. } \item{}{ \code{x$name}: Similar to \code{x[[name]]}, but \code{name} is taken literally as an element name. } } } \section{Looping}{ In the code snippets below, \code{x} is a List object. \describe{ \item{}{ \code{lapply(X, FUN, ...)}: Like the standard \code{\link[base]{lapply}} function defined in the base package, the \code{lapply} method for List objects returns a list of the same length as \code{X}, with each element being the result of applying \code{FUN} to the corresponding element of \code{X}. } \item{}{ \code{sapply(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE)}: Like the standard \code{\link[base:lapply]{sapply}} function defined in the base package, the \code{sapply} method for List objects is a user-friendly version of \code{lapply} by default returning a vector or matrix if appropriate. } \item{}{ \code{mapply(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE)}: Like the standard \code{\link[base]{mapply}} function defined in the base package, the \code{mapply} method for List objects is a multivariate version of \code{sapply}. } \item{}{ \code{endoapply(X, FUN, ...)}: Similar to \code{\link[base]{lapply}}, but performs an endomorphism, i.e. returns an object of \code{class(X)}. } \item{}{ \code{mendoapply(FUN, ..., MoreArgs = NULL)}: Similar to \code{\link[base]{mapply}}, but performs an endomorphism across multiple objects, i.e. returns an object of \code{class(list(...)[[1]])}. } \item{}{ \code{revElements(x, i)}: A convenient way to do \code{x[i] <- endoapply(x[i], rev)}. There is a fast method for \link{CompressedList} objects, otherwise expect it to be rather slow. } } } \section{Coercion}{ In the code snippets below, \code{x} is a List object. \describe{ \item{}{\code{as.env(x, enclos = parent.frame())}: Creates an environment from \code{x} with a symbol for each \code{names(x)}. The values are not actually copied into the environment. Rather, they are dynamically bound using \code{\link{makeActiveBinding}}. This prevents unnecessary copying of the data from the external vectors into R vectors. The values are cached, so that the data is not copied every time the symbol is accessed. } \item{}{ \code{as.list(x, ...)}, \code{as(from, "list")}: Turns \code{x} into a standard list. } \item{}{\code{unlist(x, recursive = TRUE, use.names = TRUE)}: Concatenates the elements of \code{x} into a single \code{elementType(x)} object. } \item{}{\code{relist(flesh, skeleton)}: Convert \code{flesh} to a list with the same structure (element lengths) as \code{skeleton}, a \code{List} or \code{PartitioningByEnd} object. This makes sense when \code{flesh[i]} corresponds somehow to \code{unlist(skeleton)[i]}. } \item{}{\code{unsplit(value, f, drop = FALSE)}: Unlists \code{value}, where the order of the returned vector is as if \code{value} were originally created by splitting that vector on the factor \code{f}. } \item{}{\code{stack(x, index.var = "name", value.var = "value")}: As with \code{\link[utils:stack]{stack}} on a \code{list}, constructs a \code{DataFrame} with two columns: one for the unlisted values, the other indicating the name of the element from which each value was obtained. \code{index.var} specifies the column name for the index (source name) column and \code{value.var} specifies the column name for the values. } } } \section{Evaluating}{ In the code snippets below, \code{envir} and \code{data} are List objects. \describe{ \item{}{\code{eval(expr, envir, enclos = parent.frame())}: Converts the List object specified in \code{envir} to an environment using \code{as.env}, with \code{enclos} as its parent, and then evaluates \code{expr} within that environment. } \item{}{\code{with(data, expr, \dots)}: Equivalent to \code{eval(quote(expr), data, ...)}. } \item{}{\code{within(data, expr, \dots)}: Similar to \code{with}, except assignments made during evaluation are taken as assignments into \code{data}, i.e., new symbols have their value appended to \code{data}, and assigning new values to existing symbols results in replacement. } } } \author{P. Aboyoun and H. Pages} \seealso{ \itemize{ \item \link{Vector} for the parent class. \item The \link{SimpleList} and \link{CompressedList} classes for direct extensions of the \link{List} class. \item The \link{IRanges} class and constructor for an example of a concrete \link{List} subclass. \item \link{funprog-methods} for using functional programming methods on List objects. } } \examples{ showClass("List") # shows (some of) the known subclasses } \keyword{methods} \keyword{classes} IRanges/man/MaskCollection-class.Rd0000644000126300012640000001621312227064476020556 0ustar00biocbuildphs_compbio\name{MaskCollection-class} \docType{class} % Classes: \alias{class:MaskCollection} \alias{MaskCollection-class} \alias{MaskCollection} % Basic accessor methods: \alias{nir_list} \alias{nir_list,MaskCollection-method} \alias{length,MaskCollection-method} \alias{width,MaskCollection-method} \alias{active} \alias{active,MaskCollection-method} \alias{active<-} \alias{active<-,MaskCollection-method} \alias{names,MaskCollection-method} \alias{names<-,MaskCollection-method} \alias{desc} \alias{desc,MaskCollection-method} \alias{desc<-} \alias{desc<-,MaskCollection-method} % Constructor: \alias{Mask} % Other methods: \alias{max,MaskCollection-method} \alias{min,MaskCollection-method} \alias{maskedwidth} \alias{maskedwidth,MaskCollection-method} \alias{maskedratio} \alias{maskedratio,MaskCollection-method} % Subsetting and appending: \alias{[,MaskCollection-method} \alias{append,MaskCollection,MaskCollection-method} % Endomorphisms: \alias{collapse} \alias{collapse,MaskCollection-method} % Coercion: \alias{coerce,MaskCollection,NormalIRanges-method} % "show" method: \alias{MaskCollection.show_frame} \alias{show,MaskCollection-method} \title{MaskCollection objects} \description{ The MaskCollection class is a container for storing a collection of masks that can be used to mask regions in a sequence. } \details{ In the context of the Biostrings package, a mask is a set of regions in a sequence that need to be excluded from some computation. For example, when calling \code{\link[Biostrings:letterFrequency]{alphabetFrequency}} or \code{\link[Biostrings]{matchPattern}} on a chromosome sequence, you might want to exclude some regions like the centromere or the repeat regions. This can be achieved by putting one or several masks on the sequence before calling \code{\link[Biostrings:letterFrequency]{alphabetFrequency}} on it. A MaskCollection object is a vector-like object that represents such set of masks. Like standard R vectors, it has a "length" which is the number of masks contained in it. But unlike standard R vectors, it also has a "width" which determines the length of the sequences it can be "put on". For example, a MaskCollection object of width 20000 can only be put on an \link[Biostrings:XString-class]{XString} object of 20000 letters. Each mask in a MaskCollection object \code{x} is just a finite set of integers that are >= 1 and <= \code{width(x)}. When "put on" a sequence, these integers indicate the positions of the letters to mask. Internally, each mask is represented by a \link{NormalIRanges} object. } \section{Basic accessor methods}{ In the code snippets below, \code{x} is a MaskCollection object. \describe{ \item{}{ \code{length(x)}: The number of masks in \code{x}. } \item{}{ \code{width(x)}: The common with of all the masks in \code{x}. This determines the length of the sequences that \code{x} can be "put on". } \item{}{ \code{active(x)}: A logical vector of the same length as \code{x} where each element indicates whether the corresponding mask is active or not. } \item{}{ \code{names(x)}: \code{NULL} or a character vector of the same length as \code{x}. } \item{}{ \code{desc(x)}: \code{NULL} or a character vector of the same length as \code{x}. } \item{}{ \code{nir_list(x)}: A list of the same length as \code{x}, where each element is a \link{NormalIRanges} object representing a mask in \code{x}. } } } \section{Constructor}{ \describe{ \item{}{ \code{Mask(mask.width, start=NULL, end=NULL, width=NULL)}: Return a single mask (i.e. a MaskCollection object of length 1) of width \code{mask.width} (a single integer >= 1) and masking the ranges of positions specified by \code{start}, \code{end} and \code{width}. See the \code{\link{IRanges}} constructor (\code{?\link{IRanges}}) for how \code{start}, \code{end} and \code{width} can be specified. Note that the returned mask is active and unnamed. } } } \section{Other methods}{ In the code snippets below, \code{x} is a MaskCollection object. \describe{ \item{}{ \code{isEmpty(x)}: Return a logical vector of the same length as \code{x}, indicating, for each mask in \code{x}, whether it's empty or not. } \item{}{ \code{max(x)}: The greatest (or last, or rightmost) masked position for each mask. This is a numeric vector of the same length as \code{x}. } \item{}{ \code{min(x)}: The smallest (or first, or leftmost) masked position for each mask. This is a numeric vector of the same length as \code{x}. } \item{}{ \code{maskedwidth(x)}: The number of masked position for each mask. This is an integer vector of the same length as \code{x} where all values are >= 0 and <= \code{width(x)}. } \item{}{ \code{maskedratio(x)}: \code{maskedwidth(x) / width(x)} } } } \section{Subsetting and appending}{ In the code snippets below, \code{x} and \code{values} are MaskCollection objects. \describe{ \item{}{ \code{x[i]}: Return a new MaskCollection object made of the selected masks. Subscript \code{i} can be a numeric, logical or character vector. } \item{}{ \code{x[[i, exact=TRUE]]}: Extract the mask selected by \code{i} as a \link{NormalIRanges} object. Subscript \code{i} can be a single integer or a character string. } \item{}{ \code{append(x, values, after=length(x))}: Add masks in \code{values} to \code{x}. } } } \section{Other methods}{ In the code snippets below, \code{x} is a MaskCollection object. \describe{ \item{}{ \code{collapse(x)}: Return a MaskCollection object of length 1 obtained by collapsing all the active masks in \code{x}. } } } \author{H. Pages} \seealso{ \link{NormalIRanges-class}, \link{read.Mask}, \link[Biostrings]{MaskedXString-class}, \code{\link{reverse}}, \code{\link[Biostrings]{alphabetFrequency}}, \code{\link[Biostrings]{matchPattern}} } \examples{ ## Making a MaskCollection object: mask1 <- Mask(mask.width=29, start=c(11, 25, 28), width=c(5, 2, 2)) mask2 <- Mask(mask.width=29, start=c(3, 10, 27), width=c(5, 8, 1)) mask3 <- Mask(mask.width=29, start=c(7, 12), width=c(2, 4)) mymasks <- append(append(mask1, mask2), mask3) mymasks length(mymasks) width(mymasks) collapse(mymasks) ## Names and descriptions: names(mymasks) <- c("A", "B", "C") # names should be short and unique... mymasks mymasks[c("C", "A")] # ...to make subsetting by names easier desc(mymasks) <- c("you can be", "more verbose", "here") mymasks[-2] ## Activate/deactivate masks: active(mymasks)["B"] <- FALSE mymasks collapse(mymasks) active(mymasks) <- FALSE # deactivate all masks mymasks active(mymasks)[-1] <- TRUE # reactivate all masks except mask 1 active(mymasks) <- !active(mymasks) # toggle all masks ## Other advanced operations: mymasks[[2]] length(mymasks[[2]]) mymasks[[2]][-3] append(mymasks[-2], gaps(mymasks[2])) } \keyword{methods} \keyword{classes} IRanges/man/OverlapEncodings-class.Rd0000644000126300012640000002067412227064476021117 0ustar00biocbuildphs_compbio\name{OverlapEncodings-class} \docType{class} \alias{class:OverlapEncodings} \alias{OverlapEncodings-class} \alias{OverlapEncodings} \alias{length,OverlapEncodings-method} \alias{Loffset} \alias{Loffset,OverlapEncodings-method} \alias{Roffset} \alias{Roffset,OverlapEncodings-method} \alias{encoding} \alias{encoding,OverlapEncodings-method} \alias{levels,OverlapEncodings-method} \alias{flippedQuery} \alias{flippedQuery,OverlapEncodings-method} \alias{Lencoding} \alias{Lencoding,character-method} \alias{Lencoding,factor-method} \alias{Lencoding,OverlapEncodings-method} \alias{Rencoding} \alias{Rencoding,character-method} \alias{Rencoding,factor-method} \alias{Rencoding,OverlapEncodings-method} \alias{ngap,character-method} \alias{ngap,factor-method} \alias{ngap,OverlapEncodings-method} \alias{Lngap} \alias{Lngap,character-method} \alias{Lngap,factor-method} \alias{Lngap,OverlapEncodings-method} \alias{Rngap} \alias{Rngap,character-method} \alias{Rngap,factor-method} \alias{Rngap,OverlapEncodings-method} \alias{as.data.frame.OverlapEncodings} \alias{as.data.frame,OverlapEncodings-method} \alias{show,OverlapEncodings-method} \title{OverlapEncodings objects} \description{ The OverlapEncodings class is a container for storing the "overlap encodings" returned by the \code{\link{encodeOverlaps}} function. } \usage{ ## OverlapEncodings accessors: \S4method{length}{OverlapEncodings}(x) \S4method{Loffset}{OverlapEncodings}(x) \S4method{Roffset}{OverlapEncodings}(x) \S4method{encoding}{OverlapEncodings}(x) \S4method{levels}{OverlapEncodings}(x) \S4method{flippedQuery}{OverlapEncodings}(x) \S4method{Lencoding}{OverlapEncodings}(x) \S4method{Rencoding}{OverlapEncodings}(x) \S4method{ngap}{OverlapEncodings}(x) \S4method{Lngap}{OverlapEncodings}(x) \S4method{Rngap}{OverlapEncodings}(x) ## Coercing an OverlapEncodings object: \S4method{as.data.frame}{OverlapEncodings}(x, row.names=NULL, optional=FALSE, ...) ## Low-level related utilities: \S4method{Lencoding}{character}(x) \S4method{Rencoding}{character}(x) \S4method{ngap}{character}(x) \S4method{Lngap}{character}(x) \S4method{Rngap}{character}(x) \S4method{Lencoding}{factor}(x) \S4method{Rencoding}{factor}(x) \S4method{ngap}{factor}(x) \S4method{Lngap}{factor}(x) \S4method{Rngap}{factor}(x) } \arguments{ \item{x}{ An OverlapEncodings object. For the low-level utilities, \code{x} can also be a character vector or factor containing encodings. } \item{row.names}{ \code{NULL} or a character vector. } \item{optional, ...}{ Ignored. } } \details{ Given a \code{query} and a \code{subject} of the same length, both list-like objects with top-level elements typically containing multiple ranges (e.g. \link{RangesList} objects), the "overlap encoding" of the i-th element in \code{query} and i-th element in \code{subject} is a character string describing how the ranges in \code{query[[i]]} are \emph{qualitatively} positioned relatively to the ranges in \code{subject[[i]]}. The \code{\link{encodeOverlaps}} function computes those overlap encodings and returns them in an OverlapEncodings object of the same length as \code{query} and \code{subject}. The topic of working with overlap encodings is covered in details in the "Overlap encodings" vignette in the GenomicRanges package. } \section{OverlapEncodings accessors}{ In the following code snippets, \code{x} is an OverlapEncodings object typically obtained by a call to \code{\link{encodeOverlaps}(query, subject)}. \describe{ \item{}{ \code{length(x)}: Get the number of elements (i.e. encodings) in \code{x}. This is equal to \code{length(query)} and \code{length(subject)}. } \item{}{ \code{Loffset(x)}, \code{Roffset(x)}: Get the "left offsets" and "right offsets" of the encodings, respectively. Both are integer vectors of the same length as \code{x}. Let's denote \code{Qi = query[[i]]}, \code{Si = subject[[i]]}, and [q1,q2] the range covered by \code{Qi} i.e. \code{q1 = min(start(Qi))} and \code{q2 = max(end(Qi))}, then \code{Loffset(x)[i]} is the number \code{L} of ranges at the \emph{head} of \code{Si} that are strictly to the left of all the ranges in \code{Qi} i.e. \code{L} is the greatest value such that \code{end(Si)[k] < q1 - 1} for all \code{k} in \code{seq_len(L)}. Similarly, \code{Roffset(x)[i]} is the number \code{R} of ranges at the \emph{tail} of \code{Si} that are strictly to the right of all the ranges in \code{Qi} i.e. \code{R} is the greatest value such that \code{start(Si)[length(Si) + 1 - k] > q2 + 1} for all \code{k} in \code{seq_len(L)}. } \item{}{ \code{encoding(x)}: Factor of the same length as \code{x} where the i-th element is the encoding obtained by comparing each range in \code{Qi} with all the ranges in \code{tSi = Si[(1+L):(length(Si)-R)]} (\code{tSi} stands for "trimmed Si"). More precisely, here is how this encoding is obtained: \enumerate{ \item All the ranges in \code{Qi} are compared with \code{tSi[1]}, then with \code{tSi[2]}, etc... At each step (one step per range in \code{tSi}), comparing all the ranges in \code{Qi} with \code{tSi[k]} is done with \code{rangeComparisonCodeToLetter(compare(Qi, tSi[k]))}. So at each step, we end up with a vector of \code{M} single letters (where \code{M} is \code{length(Qi)}). \item Each vector obtained previously (1 vector per range in \code{tSi}, all of them of length \code{M}) is turned into a single string (called "encoding block") by pasting its individual letters together. \item All the encoding blocks (1 per range in \code{tSi}) are pasted together into a single long string and separated by colons (\code{":"}). An additional colon is prepended to the long string and another one appended to it. \item Finally, a special block containing the value of \code{M} is prepended to the long string. The final string is the encoding. } } \item{}{ \code{levels(x)}: Equivalent to \code{levels(encoding(x))}. } \item{}{ \code{flippedQuery(x)}: Whether or not the top-level element in query used for computing the encoding was "flipped" before the encoding was computed. Note that this flipping generally affects the "left offset", "right offset", in addition to the encoding itself. } \item{}{ \code{Lencoding(x)}, \code{Rencoding(x)}: Extract the "left encodings" and "right encodings" of paired-end encodings. Paired-end encodings are obtained by encoding paired-end overlaps i.e. overlaps between paired-end reads and transcripts (typically). The difference between a single-end encoding and a paired-end encoding is that all the blocks in the latter contain a \code{"--"} separator to mark the separation between the "left encoding" and the "right encoding". See the "Overlap encodings" vignette in the GenomicRanges package for examples of paired-end encodings. } \item{}{ \code{ngap(x)}, \code{Lngap(x)}, \code{Rngap(x)}: Extract the number of gaps in each encoding by looking at their first block (aka special block). If an element \code{xi} in \code{x} is a paired-end encoding, then \code{Lngap(xi)}, \code{Rngap(xi)}, and \code{ngap(xi)}, return \code{ngap(Lencoding(xi))}, \code{ngap(Rencoding(xi))}, and \code{Lngap(xi) + Rngap(xi)}, respectively. } } } \section{Coercing an OverlapEncodings object}{ In the following code snippets, \code{x} is an OverlapEncodings object. \describe{ \item{}{ \code{as.data.frame(x)}: Return \code{x} as a data frame with columns \code{"Loffset"}, \code{"Roffset"} and \code{"encoding"}. } } } \author{H. Pages} \seealso{ \itemize{ \item The "Overlap encodings" vignette in the GenomicRanges package. \item \code{\link{encodeOverlaps}}. \item \code{\link{compare}} for the interpretation of the string returned by \code{encoding}. \item The \link{RangesList} class. } } \examples{ example(encodeOverlaps) # to make 'ovenc' length(ovenc) Loffset(ovenc) Roffset(ovenc) encoding(ovenc) levels(ovenc) nlevels(ovenc) flippedQuery(ovenc) ngap(ovenc) as.data.frame(ovenc) ngap(levels(ovenc)) } \keyword{methods} \keyword{classes} IRanges/man/RDApplyParams-class.Rd0000644000126300012640000002034412227064476020326 0ustar00biocbuildphs_compbio\name{rdapply} \alias{rdapply} \alias{rdapply,RDApplyParams-method} \alias{RDApplyParams-class} % constructor \alias{RDApplyParams} % accessors \alias{applyFun} \alias{applyFun,RDApplyParams-method} \alias{applyFun<-} \alias{applyFun<-,RDApplyParams-method} \alias{applyParams} \alias{applyParams,RDApplyParams-method} \alias{applyParams<-} \alias{applyParams<-,RDApplyParams-method} \alias{filterRules} \alias{filterRules,RDApplyParams-method} \alias{filterRules<-} \alias{filterRules<-,RDApplyParams-method} \alias{rangedData} \alias{rangedData,RDApplyParams-method} \alias{rangedData<-} \alias{rangedData<-,RDApplyParams-method} \alias{reducerFun} \alias{reducerFun,RDApplyParams-method} \alias{reducerFun<-} \alias{reducerFun<-,RDApplyParams-method} \alias{reducerParams} \alias{reducerParams,RDApplyParams-method} \alias{reducerParams<-} \alias{reducerParams<-,RDApplyParams-method} \alias{simplify} \alias{simplify,RDApplyParams-method} \alias{simplify<-} \alias{simplify<-,RDApplyParams-method} \alias{iteratorFun} \alias{iteratorFun,RDApplyParams-method} \alias{iteratorFun<-} \alias{iteratorFun<-,RDApplyParams-method} \title{Applying over spaces} \description{The \code{rdapply} function applies a user function over the spaces of a \code{\linkS4class{RangedData}}. The parameters to \code{rdapply} are collected into an instance of \code{RDApplyParams}, which is passed as the sole parameter to \code{rdapply}.} \usage{ rdapply(x, ...) } \arguments{ \item{x}{The \code{RDApplyParams} instance, see below for how to make one.} \item{...}{Additional arguments for methods} } \value{ By default a \code{list} holding the result of each invocation of the user function, but see details. } \details{ The \code{rdapply} function is an attempt to facilitate the common operation of performing the same operation over each space (e.g. chromosome) in a \code{RangedData}. To facilitate a wide array of such tasks, the function takes a large number of options. The \code{RDApplyParams} class is meant to help manage this complexity. In particular, it facilitates experimentation through its support for incremental changes to parameter settings. There are two \code{RangedData} settings that are required: the user \code{function} object and the \code{RangedData} over which it is applied. The rest of the settings determine what is actually passed to the user function and how the return value is processed before relaying it to the user. The following is the description and rationale for each setting. \describe{ \item{\code{rangedData}}{\strong{REQUIRED}. The \code{RangedData} instance over which \code{applyFun} is applied. } \item{\code{applyFun}}{\strong{REQUIRED}. The user \code{function} to be applied to each space in the \code{RangedData}. The function must expect the \code{RangedData} as its first parameter and also accept the parameters specified in \code{applyParams}. } \item{\code{applyParams}}{ The \code{list} of additional parameters to pass to \code{applyFun}. Usually empty. } \item{\code{filterRules}}{ The instance of \code{\linkS4class{FilterRules}} that is used to filter each subset of the \code{RangedData} passed to the user function. This is an efficient and convenient means for performing the same operation over different subsets of the data on a space-by-space basis. In particular, this avoids the need to store subsets of the entire \code{RangedData}. A common workflow is to invoke \code{rdapply} with one set of active filters, enable different filters, reinvoke \code{rdapply}, and compare the results. } \item{\code{simplify}}{ A scalar logical (\code{TRUE} or \code{FALSE}) indicating whether the \code{list} to be returned from \code{rdapply} should be simplified as by \code{\link{sapply}}. Defaults to \code{FALSE}. } \item{\code{reducerFun}}{ The \code{function} that is used to convert the \code{list} that would otherwise be returned from \code{rdapply} to something more convenient. The function should take the list as its first parameter and also accept the parameters specified in \code{reducerParams}. This is an alternative to the primitive behavior of the \code{simplify} option (so \code{simplify} must be \code{FALSE} if this option is set). The aim is to orthogonalize the \code{applyFun} operation (i.e. the statistics) from the data structure of the result. } \item{\code{reducerParams}}{ A \code{list} of additional parameters to pass to \code{reducerFun}. Can only be set if \code{reducerFun} is set. Usually empty. } \item{\code{iteratorFun}}{ The function used for applying over the \code{RangedData}. By default, this is \code{lapply}, but it could also be a specialized function, like \code{mclapply}. } } } \section{Constructing an RDApplyParams object}{ \describe{ \item{}{\code{RDApplyParams(rangedData, applyFun, applyParams, filterRules, simplify, reducerFun, reducerParams)}: Constructs a \code{RDApplyParams} object with each setting specified by the argument of the same name. See the Details section for more information. } } } \section{Accessors}{ In the following code snippets, \code{x} is an \code{RDApplyParams} object. \describe{ \item{}{\code{rangedData(x)}, \code{rangedData(x) <- value}: Get or set the \code{RangedData} instance over which \code{applyFun} is applied. } \item{}{\code{applyFun(x)}, \code{applyFun(x) <- value}: Get or set the user \code{function} to be applied to each space in the \code{RangedData}. } \item{}{\code{applyParams(x)}, \code{applyParams(x) <- value}: Get or set the \code{list} of additional parameters to pass to \code{applyFun}. } \item{}{\code{filterRules(x)}, \code{filterRules(x) <- value}: Get or set the instance of \code{\linkS4class{FilterRules}} that is used to filter each subset of the \code{RangedData} passed to the user function. } \item{}{\code{simplify(x)}, \code{simplify(x) <- value}: Get or set a a scalar logical (\code{TRUE} or \code{FALSE}) indicating whether the \code{list} to be returned from \code{rdapply} should be simplified as by \code{\link{sapply}}. } \item{}{\code{reducerFun(x)}, \code{reducerFun(x) <- value}: Get or set the \code{function} that is used to convert the \code{list} that would otherwise be returned from \code{rdapply} to something more convenient. } \item{}{\code{reducerParams(x)}, \code{reducerParams(x) <- value}: Get or set a \code{list} of additional parameters to pass to \code{reducerFun}. } \item{}{\code{iteratorFun(x)}, \code{iteratorFun(x) <- value}: Get or set the function used for applying over the \code{RangedData}. } } } \author{Michael Lawrence} \seealso{ \code{\linkS4class{RangedData}}, \code{\linkS4class{FilterRules}} } \examples{ ranges <- IRanges(c(1,2,3),c(4,5,6)) score <- c(2L, 0L, 1L) rd <- RangedData(ranges, score, space = c("chr1","chr2","chr1")) ## a single function countrows <- function(rd) nrow(rd) params <- RDApplyParams(rd, countrows) rdapply(params) # list(chr1 = 2L, chr2 = 1L) ## with a parameter params <- RDApplyParams(rd, function(rd, x) nrow(rd)*x, list(x = 2)) rdapply(params) # list(chr1 = 4L, chr2 = 2L) ## add a filter cutoff <- 0 rules <- FilterRules(filter = score > cutoff) params <- RDApplyParams(rd, countrows, filterRules = rules) rdapply(params) # list(chr1 = 2L, chr2 = 0L) rules <- FilterRules(list(fun = function(rd) rd[["score"]] < 2), filter = score > cutoff) params <- RDApplyParams(rd, countrows, filterRules = rules) rdapply(params) # list(chr1 = 1L, chr2 = 0L) active(filterRules(params))["filter"] <- FALSE rdapply(params) # list(chr1 = 1L, chr2 = 1L) ## simplify params <- RDApplyParams(rd, countrows, simplify = TRUE) rdapply(params) # c(chr1 = 2L, chr2 = 1L) ## reducing params <- RDApplyParams(rd, countrows, reducerFun = unlist, reducerParams = list(use.names = FALSE)) rdapply(params) ## c(2L, 1L) } \keyword{classes} \keyword{methods} IRanges/man/RangedData-class.Rd0000644000126300012640000004710612227064476017646 0ustar00biocbuildphs_compbio\name{RangedData-class} \docType{class} \alias{class:RangedData} \alias{RangedData-class} % Accessors: \alias{nrow,RangedData-method} \alias{ncol,RangedData-method} \alias{rownames,RangedData-method} \alias{colnames,RangedData-method} \alias{rownames<-,RangedData-method} \alias{colnames<-,RangedData-method} \alias{elementLengths,RangedData-method} \alias{end,RangedData-method} \alias{end<-,RangedData-method} \alias{length,RangedData-method} \alias{names,RangedData-method} \alias{names<-,RangedData-method} \alias{ranges,RangedData-method} \alias{ranges<-,RangedData-method} \alias{start,RangedData-method} \alias{start<-,RangedData-method} \alias{values,RangedData-method} \alias{values<-,RangedData-method} \alias{width,RangedData-method} \alias{width<-,RangedData-method} \alias{space,RangedData-method} \alias{universe,RangedData-method} \alias{universe<-,RangedData-method} \alias{score,RangedData-method} \alias{score<-,RangedData-method} \alias{columnMetadata,RangedData-method} \alias{columnMetadata<-,RangedData-method} % Constructor: \alias{RangedData} % Coercion: \alias{as.data.frame.RangedData} \alias{as.data.frame,RangedData-method} \alias{coerce,RangedData,DataFrame-method} \alias{coerce,Rle,RangedData-method} \alias{coerce,RleList,RangedData-method} \alias{coerce,RleViewsList,RangedData-method} \alias{coerce,Ranges,RangedData-method} \alias{coerce,RangesList,RangedData-method} \alias{coerce,RangedData,CompressedIRangesList-method} \alias{coerce,RangedData,IRangesList-method} \alias{coerce,RangedData,RangesList-method} \alias{as.env,RangedData-method} \alias{coerce,data.frame,RangedData-method} \alias{coerce,DataTable,RangedData-method} % Combining and splitting \alias{c,RangedData-method} \alias{rbind,RangedData-method} \alias{split,RangedData,ANY-method} % Subsetting: \alias{[,RangedData-method} \alias{[[,RangedData-method} \alias{[[<-,RangedData-method} \alias{$<-,RangedData-method} % Utilities: \alias{within,RangedData-method} % Applying: \alias{endoapply,RangedData-method} \alias{lapply,RangedData-method} % Show: \alias{show,RangedData-method} \title{Data on ranges} \description{ \code{RangedData} supports storing data, i.e. a set of variables, on a set of ranges spanning multiple spaces (e.g. chromosomes). Although the data is split across spaces, it can still be treated as one cohesive dataset when desired and extends \code{\linkS4class{DataTable}}. In order to handle large datasets, the data values are stored externally to avoid copying, and the \code{\link{rdapply}} function facilitates the processing of each space separately (divide and conquer). } \details{ A \code{RangedData} object consists of two primary components: a \code{\linkS4class{RangesList}} holding the ranges over multiple spaces and a parallel \code{\linkS4class{SplitDataFrameList}}, holding the split data. There is also an \code{universe} slot for denoting the source (e.g. the genome) of the ranges and/or data. There are two different modes of interacting with a \code{RangedData}. The first mode treats the object as a contiguous "data frame" annotated with range information. The accessors \code{start}, \code{end}, and \code{width} get the corresponding fields in the ranges as atomic integer vectors, undoing the division over the spaces. The \code{[[} and matrix-style \code{[,} extraction and subsetting functions unroll the data in the same way. \code{[[<-} does the inverse. The number of rows is defined as the total number of ranges and the number of columns is the number of variables in the data. It is often convenient and natural to treat the data this way, at least when the data is small and there is no need to distinguish the ranges by their space. The other mode is to treat the \code{RangedData} as a list, with an element (a virtual \code{\linkS4class{Ranges}}/\code{\linkS4class{DataFrame}} pair) for each space. The length of the object is defined as the number of spaces and the value returned by the \code{names} accessor gives the names of the spaces. The list-style \code{[} subset function behaves analogously. The \code{rdapply} function provides a convenient and formal means of applying an operation over the spaces separately. This mode is helpful when ranges from different spaces must be treated separately or when the data is too large to process over all spaces at once. } \section{Accessor methods}{ In the code snippets below, \code{x} is a \code{RangedData} object. The following accessors treat the data as a contiguous dataset, ignoring the division into spaces: \describe{ \item{}{Array accessors: \describe{ \item{}{ \code{nrow(x)}: The number of ranges in \code{x}. } \item{}{ \code{ncol(x)}: The number of data variables in \code{x}. } \item{}{ \code{dim(x)}: An integer vector of length two, essentially \code{c(nrow(x), ncol(x))}. } \item{}{ \code{rownames(x)}, \code{rownames(x) <- value}: Gets or sets the names of the ranges in \code{x}. } \item{}{ \code{colnames(x)}, \code{colnames(x) <- value}: Gets the names of the variables in \code{x}. } \item{}{ \code{dimnames(x)}: A list with two elements, essentially \code{list(rownames(x), colnames(x))}. } \item{}{ \code{dimnames(x) <- value}: Sets the row and column names, where value is a list as described above. } \item{}{\code{columnMetadata(x)}: Get the \code{DataFrame} of metadata along the value columns, i.e., where each column in \code{x} is represented by a row in the metadata. Note that calling \code{mcols(x)} returns the metadata on each space in \code{x}. } \item{}{\code{columnMetadata(x) <- value}: Set the \code{DataFrame} of metadata for the columns. } \item{}{\code{within(data, expr, ...)}: Evaluates \code{expr} within \code{data}, a \code{RangedData}. Any values assigned in \code{expr} will be stored as value columns in \code{data}, unless they match one of the reserved names: \code{ranges}, \code{start}, \code{end}, \code{width} and \code{space}. Behavior is undefined if any of the range symbols are modified inconsistently. Modifications to \code{space} are ignored. } } } \item{}{Range accessors. The type of the return value depends on the type of \code{\linkS4class{Ranges}}. For \code{\linkS4class{IRanges}}, an integer vector. Regardless, the number of elements is always equal to \code{nrow(x)}. \describe{ \item{}{ \code{start(x), start(x) <- value}: Get or set the starts of the ranges. When setting the starts, \code{value} can be an integer vector of \code{length(sum(elementLengths(ranges(x))))} or an IntegerList object of length \code{length(ranges(x))} and names \code{names(ranges(x))}. } \item{}{ \code{end(x), end(x) <- value}: Get or set the ends of the ranges. When setting the ends, \code{value} can be an integer vector of \code{length(sum(elementLengths(ranges(x))))} or an IntegerList object of length \code{length(ranges(x))} and names \code{names(ranges(x))}. } \item{}{ \code{width(x), width(x) <- value}: Get or set the widths of the ranges. When setting the widths, \code{value} can be an integer vector of \code{length(sum(elementLengths(ranges(x))))} or an IntegerList object of length \code{length(ranges(x))} and names \code{names(ranges(x))}. } } } } These accessors make the object seem like a list along the spaces: \describe{ \item{}{ \code{length(x)}: The number of spaces (e.g. chromosomes) in \code{x}. } \item{}{ \code{names(x)}, \code{names(x) <- value}: Get or set the names of the spaces (e.g. \code{"chr1"}). \code{NULL} or a character vector of the same length as \code{x}. } } Other accessors: \describe{ \item{}{ \code{universe(x)}, \code{universe(x) <- value}: Get or set the scalar string identifying the scope of the data in some way (e.g. genome, experimental platform, etc). The universe may be \code{NULL}. } \item{}{ \code{ranges(x), ranges(x) <- value}: Gets or sets the ranges in \code{x} as a \code{\linkS4class{RangesList}}. } \item{}{ \code{space(x)}: Gets the spaces from \code{ranges(x)}. } \item{}{ \code{values(x), values(x) <- value}: Gets or sets the data values in \code{x} as a \code{\linkS4class{SplitDataFrameList}}. } \item{}{ \code{score(x), score(x) <- value}: Gets or sets the column representing a "score" in \code{x}, as a vector. This is the column named \code{score}, or, if this does not exist, the first column, if it is numeric. The get method return \code{NULL} if no suitable score column is found. The set method takes a numeric vector as its value. } } } \section{Constructor}{ \describe{ \item{}{ \code{RangedData(ranges = IRanges(), ..., space = NULL, universe = NULL)}: Creates a \code{RangedData} with the ranges in \code{ranges} and variables given by the arguments in \code{...}. See the constructor \code{\linkS4class{DataFrame}} for how the \code{...} arguments are interpreted. If \code{ranges} is a \code{\linkS4class{Ranges}} object, the \code{space} argument is used to split of the data into spaces. If \code{space} is \code{NULL}, all of the ranges and values are placed into the same space, resulting in a single-space (length one) \code{RangedData} object. Otherwise, the ranges and values are split into spaces according to \code{space}, which is treated as a factor, like the \code{f} argument in \code{\link{split}}. If \code{ranges} is a \code{\linkS4class{RangesList}} object, then the supplied \code{space} argument is ignored and its value is derived from \code{ranges}. If \code{ranges} is not a \code{\linkS4class{Ranges}} or \code{\linkS4class{RangesList}} object, this function calls \code{as(ranges, "RangedData")} and returns the result if successful. The universe may be specified as a scalar string by the \code{universe} argument. } } } \section{Coercion}{ \describe{ \item{}{ \code{as.data.frame(x, row.names=NULL, optional=FALSE, ...)}: Copy the start, end, width of the ranges and all of the variables as columns in a \code{data.frame}. This is a bridge to existing functionality in R, but of course care must be taken if the data is large. Note that \code{optional} and \code{...} are ignored. } \item{}{ \code{as(from, "DataFrame")}: Like \code{as.data.frame} above, except the result is an \code{\linkS4class{DataFrame}} and it probably involves less copying, especially if there is only a single space. } \item{}{ \code{as(from, "RangedData")}: Coerce \code{from} to a \code{RangedData}, according to the type of \code{from}: \describe{ \item{\code{\linkS4class{Rle}}, \code{\linkS4class{RleList}}}{ Converts each run to a range and stores the run values in a column named "score". } \item{\code{\linkS4class{RleViewsList}}}{ Creates a \code{RangedData} using the ranges given by the runs of \code{subject(from)} in each of the windows, with a value column \code{score} taken as the corresponding subject values. } \item{\code{\linkS4class{Ranges}}}{ Creates a \code{RangedData} with only the ranges in \code{from}; no data columns. } \item{\code{\linkS4class{RangesList}}}{ Creates a \code{RangedData} with the ranges in \code{from}. Also propagates the \emph{inner} metadata columns of the \code{RangesList} (accessed with \code{mcols(unlist(from))}) to the data columns (aka values) of the \code{RangedData}. This makes it a \emph{lossless} coercion and the exact reverse of the coercion from \code{RangedData} to \code{RangesList}. } \item{\code{data.frame} or \code{DataTable}}{Constructs a \code{RangedData}, using the columns \dQuote{start}, \dQuote{end}, and, optionally, \dQuote{space} columns in \code{from}. The other columns become data columns in the result. Any \dQuote{width} column is ignored. } } } \item{}{ \code{as(from, "RangesList")}: Creates a \code{CompressedIRangesList} (a subclass of \code{RangesList}) made of the ranges in \code{from}. Also propagates the data columns (aka values) of the \code{RangedData} to the inner metadata columns of the \code{RangesList}. This makes it a \emph{lossless} coercion and the exact reverse of the coercion from \code{RangesList} to \code{RangedData}. } \item{}{\code{as.env(x, enclos = parent.frame())}: Creates an \code{environment} with a symbol for each variable in the frame, as well as a \code{ranges} symbol for the ranges. This is efficient, as no copying is performed. } } } \section{Subsetting and Replacement}{ In the code snippets below, \code{x} is a \code{RangedData} object. \describe{ \item{}{ \code{x[i]}: Subsets \code{x} by indexing into its spaces, so the result is of the same class, with a different set of spaces. \code{i} can be numerical, logical, \code{NULL} or missing. } \item{}{ \code{x[i,j]}: Subsets \code{x} by indexing into its rows and columns. The result is of the same class, with a different set of rows and columns. The row index \code{i} can either treat \code{x} as a flat table by being a character, integer, or logical vector or treat \code{x} as a partitioned table by being a \code{\linkS4class{RangesList}}, \code{\linkS4class{LogicalList}}, or \code{\linkS4class{IntegerList}} of the same length as \code{x}. } \item{}{ \code{x[[i]]}: Extracts a variable from \code{x}, where \code{i} can be a character, numeric, or logical scalar that indexes into the columns. The variable is unlisted over the spaces. For convenience, values of \code{"space"} and \code{"ranges"} are equivalent to \code{space(x)} and \code{unlist(ranges(x))} respectively. } \item{}{ \code{x$name}: similar to above, where \code{name} is taken literally as a column name in the data. } \item{}{ \code{x[[i]] <- value}: Sets value as column \code{i} in \code{x}, where \code{i} can be a character, numeric, or logical scalar that indexes into the columns. The length of \code{value} should equal \code{nrow(x)}. \code{x[[i]]} should be identical to \code{value} after this operation. For convenience, \code{i="ranges"} is equivalent to \code{ranges(x) <- value}. } \item{}{ \code{x$name <- value}: similar to above, where \code{name} is taken literally as a column name in the data. } } } \section{Splitting and Combining}{ In the code snippets below, \code{x} is a \code{RangedData} object. \describe{ \item{}{ \code{split(x, f, drop = FALSE)}: Split \code{x} according to \code{f}, which should be of length equal to \code{nrow(x)}. Note that \code{drop} is ignored here. The result is a \code{\linkS4class{RangedDataList}} where every element has the same length (number of spaces) but different sets of ranges within each space. } \item{}{ \code{rbind(...)}: Matches the spaces from the \code{RangedData} objects in \code{...} by name and combines them row-wise. In a way, this is the reverse of the \code{split} operation described above. } \item{}{ \code{c(x, ..., recursive = FALSE)}: Combines \code{x} with arguments specified in \code{...}, which must all be \code{RangedData} objects. This combination acts as if \code{x} is a list of spaces, meaning that the result will contain the spaces of the first concatenated with the spaces of the second, and so on. This function is useful when creating \code{RangedData} objects on a space-by-space basis and then needing to combine them. } } } \section{Applying}{ There are two ways explicitly supported ways to apply a function over the spaces of a \code{RangedData}. The richest interface is \code{\link{rdapply}}, which is described in its own man page. The simpler interface is an \code{lapply} method: \describe{ \item{}{\code{lapply(X, FUN, ...)}: Applies \code{FUN} to each space in \code{X} with extra parameters in \code{...}. } } } \author{ Michael Lawrence } \seealso{ \linkS4class{DataTable}, the parent of this class, with more utilities. The \code{\link{rdapply}} function for applying a function to each space separately. } \examples{ ranges <- IRanges(c(1,2,3),c(4,5,6)) filter <- c(1L, 0L, 1L) score <- c(10L, 2L, NA) ## constructing RangedData instances ## no variables rd <- RangedData() rd <- RangedData(ranges) ranges(rd) ## one variable rd <- RangedData(ranges, score) rd[["score"]] ## multiple variables rd <- RangedData(ranges, filter, vals = score) rd[["vals"]] # same as rd[["score"]] above rd$vals rd[["filter"]] rd <- RangedData(ranges, score + score) rd[["score...score"]] # names made valid ## use a universe rd <- RangedData(ranges, universe = "hg18") universe(rd) ## split some data over chromosomes range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) both <- c(ranges, range2) score <- c(score, c(0L, 3L, NA, 22L)) filter <- c(filter, c(0L, 1L, NA, 0L)) chrom <- paste("chr", rep(c(1,2), c(length(ranges), length(range2))), sep="") rd <- RangedData(both, score, filter, space = chrom, universe = "hg18") rd[["score"]] # identical to score rd[1][["score"]] # identical to score[1:3] ## subsetting ## list style: [i] rd[numeric()] # these three are all empty rd[logical()] rd[NULL] rd[] # missing, full instance returned rd[FALSE] # logical, supports recycling rd[c(FALSE, FALSE)] # same as above rd[TRUE] # like rd[] rd[c(TRUE, FALSE)] rd[1] # numeric index rd[c(1,2)] rd[-2] ## matrix style: [i,j] rd[,NULL] # no columns rd[NULL,] # no rows rd[,1] rd[,1:2] rd[,"filter"] rd[1,] # now by the rows rd[c(1,3),] rd[1:2, 1] # row and column rd[c(1:2,1,3),1] ## repeating rows ## dimnames colnames(rd)[2] <- "foo" colnames(rd) rownames(rd) <- head(letters, nrow(rd)) rownames(rd) ## space names names(rd) names(rd)[1] <- "chr1" ## variable replacement count <- c(1L, 0L, 2L) rd <- RangedData(ranges, count, space = c(1, 2, 1)) ## adding a variable score <- c(10L, 2L, NA) rd[["score"]] <- score rd[["score"]] # same as 'score' ## replacing a variable count2 <- c(1L, 1L, 0L) rd[["count"]] <- count2 ## numeric index also supported rd[[2]] <- score rd[[2]] # gets 'score' ## removing a variable rd[[2]] <- NULL ncol(rd) # is only 1 rd$score2 <- score ## combining/splitting rd <- RangedData(ranges, score, space = c(1, 2, 1)) c(rd[1], rd[2]) # equal to 'rd' rd2 <- RangedData(ranges, score) unlist(split(rd2, c(1, 2, 1))) # same as 'rd' ## applying lapply(rd, `[[`, 1) # get first column in each space } \keyword{methods} \keyword{classes} IRanges/man/RangedDataList-class.Rd0000644000126300012640000000244412227064476020476 0ustar00biocbuildphs_compbio\name{RangedDataList-class} \docType{class} \alias{RangedDataList-class} \alias{unlist,RangedDataList-method} \alias{stack,RangedDataList-method} % Constructor \alias{RangedDataList} \title{Lists of RangedData} \description{ A formal list of \code{\linkS4class{RangedData}} objects. Extends and inherits all its methods from \code{\linkS4class{List}}. One use case is to group together all of the samples from an experiment generating data on ranges. } \section{Constructor}{ \describe{ \item{}{\code{RangedDataList(...)}: Concatenates the \code{RangedData} objects in \code{...} into a new \code{RangedDataList}. } } } \section{Other methods}{ \describe{ \item{}{\code{stack(x, index.var = "name")}: Concantenates the elements of \code{x} into a \code{RangedData}, with a column named by \code{index.var} that groups the records by their original element in \code{x}. } } } \author{Michael Lawrence} \seealso{ \code{\linkS4class{RangedData}}, the element type of this \code{\linkS4class{List}}. } \examples{ ranges <- IRanges(c(1,2,3),c(4,5,6)) a <- RangedData(IRanges(c(1,2,3),c(4,5,6)), score = c(10L, 2L, NA)) b <- RangedData(IRanges(c(1,2,4),c(4,7,5)), score = c(3L, 5L, 7L)) RangedDataList(sample1 = a, sample2 = b) } \keyword{classes} IRanges/man/RangedSelection-class.Rd0000644000126300012640000000462712227064476020723 0ustar00biocbuildphs_compbio\name{RangedSelection-class} \docType{class} \alias{RangedSelection-class} % accessors \alias{ranges,RangedSelection-method} \alias{colnames,RangedSelection-method} \alias{ranges<-,RangedSelection-method} \alias{colnames<-,RangedSelection-method} % coercion \alias{coerce,RangesList,RangedSelection-method} % constructor \alias{RangedSelection} \title{Selection of ranges and columns} \description{A \code{RangedSelection} represents a query against a table of interval data in terms of ranges and column names. The ranges select any table row with an overlapping interval. Note that the intervals are always returned, even if no columns are selected.} \details{ Traditionally, tabular data structures have supported the \code{\link{subset}} function, which allows one to select a subset of the rows and columns from the table. In that case, the rows and columns are specified by two separate arguments. As querying interval data sources, especially those external to R, such as binary indexed files and databases, is increasingly common, there is a need to encapsulate the row and column specifications into a single data structure, mostly for the sake of interface cleanliness. The \code{RangedSelection} class fills that role. } \section{Constructor}{ \describe{ \item{}{\code{RangedSelection(ranges = RangesList(), colnames = character())}: Constructors a \code{RangedSelection} with the given \code{ranges} and \code{colnames}. } } } \section{Coercion}{ \describe{ \item{}{\code{as(from, "RangedSelection")}: Coerces \code{from} to a \code{RangedSelection} object. Typically, \code{from} is a \code{\linkS4class{RangesList}}, the ranges of which become the ranges in the new \code{RangedSelection}. } } } \section{Accessors}{ In the code snippets below, \code{x} is always a \code{RangedSelection}. \describe{ \item{}{\code{ranges(x), ranges(x) <- value}: Gets or sets the ranges, a \code{\linkS4class{RangesList}}, that select rows with overlapping intervals. } \item{}{\code{colnames(x), colnames(x) <- value}: Gets the names, a \code{character} vector, indicating the columns. } } } \author{ Michael Lawrence } \examples{ rl <- RangesList(chr1 = IRanges(c(1, 5), c(3, 6))) RangedSelection(rl) as(rl, "RangedSelection") # same as above RangedSelection(rl, "score") } \keyword{methods} \keyword{classes} IRanges/man/Ranges-class.Rd0000644000126300012640000002752312227064476017074 0ustar00biocbuildphs_compbio\name{Ranges-class} \docType{class} % Classes: \alias{class:Ranges} \alias{Ranges-class} \alias{Ranges} % Generics and methods: \alias{length,Ranges-method} \alias{elementLengths,Ranges-method} \alias{width} \alias{start,Ranges-method} \alias{width,Ranges-method} \alias{end,Ranges-method} \alias{mid} \alias{mid,Ranges-method} \alias{start<-} \alias{width<-} \alias{end<-} \alias{isEmpty,Ranges-method} \alias{as.matrix,Ranges-method} \alias{as.data.frame.Ranges} \alias{as.data.frame,Ranges-method} \alias{as.integer,Ranges-method} \alias{unlist,Ranges-method} \alias{show,Ranges-method} \alias{showAsCell,Ranges-method} \alias{isNormal} \alias{isNormal,Ranges-method} \alias{whichFirstNotNormal} \alias{whichFirstNotNormal,Ranges-method} \alias{update,Ranges-method} % Old stuff: \alias{first} \alias{first,Ranges-method} \alias{last} \alias{last,Ranges-method} \title{Ranges objects} \description{ The Ranges virtual class is a general container for storing a set of integer ranges. } \details{ A Ranges object is a vector-like object where each element describes a "range of integer values". A "range of integer values" is a finite set of consecutive integer values. Each range can be fully described with exactly 2 integer values which can be arbitrarily picked up among the 3 following values: its "start" i.e. its smallest (or first, or leftmost) value; its "end" i.e. its greatest (or last, or rightmost) value; and its "width" i.e. the number of integer values in the range. For example the set of integer values that are greater than or equal to -20 and less than or equal to 400 is the range that starts at -20 and has a width of 421. In other words, a range is a closed, one-dimensional interval with integer end points and on the domain of integers. The starting point (or "start") of a range can be any integer (see \code{start} below) but its "width" must be a non-negative integer (see \code{width} below). The ending point (or "end") of a range is equal to its "start" plus its "width" minus one (see \code{end} below). An "empty" range is a range that contains no value i.e. a range that has a null width. Depending on the context, it can be interpreted either as just the empty \emph{set} of integers or, more precisely, as the position \emph{between} its "end" and its "start" (note that for an empty range, the "end" equals the "start" minus one). The length of a Ranges object is the number of ranges in it, not the number of integer values in its ranges. A Ranges object is considered empty iff all its ranges are empty. Ranges objects have a vector-like semantic i.e. they only support single subscript subsetting (unlike, for example, standard R data frames which can be subsetted by row and by column). The Ranges class itself is a virtual class. The following classes derive directly from the Ranges class: \link{IRanges} and \link{IntervalTree}. } \section{Methods}{ In the code snippets below, \code{x}, \code{y} and \code{object} are Ranges objects. Not all the functions described below will necessarily work with all kinds of Ranges objects but they should work at least for \link{IRanges} objects. Note that many more operations on Ranges objects are described in other man pages of the IRanges package. See for example the man page for intra range transformations (e.g. \code{shift()}, see \code{?`\link{intra-range-methods}`}), or the man page for inter range transformations (e.g. \code{reduce()}, see \code{?`\link{inter-range-methods}`}), or the man page for \code{findOverlaps} methods (see \code{?`\link{findOverlaps-methods}`}), or the man page for \link{RangesList} objects where the \code{split} method for Ranges objects is documented. \describe{ \item{}{ \code{length(x)}: The number of ranges in \code{x}. } \item{}{ \code{start(x)}: The start values of the ranges. This is an integer vector of the same length as \code{x}. } \item{}{ \code{width(x)}: The number of integer values in each range. This is a vector of non-negative integers of the same length as \code{x}. } \item{}{ \code{end(x)}: \code{start(x) + width(x) - 1L} } \item{}{ \code{mid(x)}: returns the midpoint of the range, \code{start(x) + floor((width(x) - 1)/2)}. } \item{}{ \code{names(x)}: \code{NULL} or a character vector of the same length as \code{x}. } \item{}{ \code{update(object, ...)}: Convenience method for combining multiple modifications of \code{object} in one single call. For example \code{object <- update(object, start=start(object)-2L, end=end(object)+2L)} is equivalent to \code{start(object) <- start(object)-2L; end(object) <- end(object)+2L}. } \item{}{ \code{isEmpty(x)}: Return a logical value indicating whether \code{x} is empty or not. } \item{}{ \code{as.matrix(x, ...)}: Convert \code{x} into a 2-column integer matrix containing \code{start(x)} and \code{width(x)}. Extra arguments (\code{...}) are ignored. } \item{}{ \code{as.data.frame(x, row.names=NULL, optional=FALSE, ...)}: Convert \code{x} into a standard R data frame object. \code{row.names} must be \code{NULL} or a character vector giving the row names for the data frame, and \code{optional} and any additional argument (\code{...}) is ignored. See \code{?\link{as.data.frame}} for more information about these arguments. } \item{}{ \code{as.integer(x)}: Convert \code{x} into an integer vector, by converting each range into the integer sequence formed by \code{from:to} and concatenating them together. } \item{}{ \code{unlist(x, recursive = TRUE, use.names = TRUE)}: Similar to \code{as.integer(x)} except can add names to elements. } \item{}{ \code{x[[i]]}: Return integer vector \code{start(x[i]):end(x[i])} denoted by \code{i}. Subscript \code{i} can be a single integer or a character string. } \item{}{ \code{x[i]}: Return a new Ranges object (of the same type as \code{x}) made of the selected ranges. \code{i} can be a numeric vector, a logical vector, \code{NULL} or missing. If \code{x} is a \link{NormalIRanges} object and \code{i} a positive numeric subscript (i.e. a numeric vector of positive values), then \code{i} must be strictly increasing. } \item{}{ \code{rep(x, times, length.out, each)}: Repeats the values in \code{x} through one of the following conventions: \describe{ \item{\code{times}}{Vector giving the number of times to repeat each element if of length \code{length(x)}, or to repeat the Ranges elements if of length 1.} \item{\code{length.out}}{Non-negative integer. The desired length of the output vector.} \item{\code{each}}{Non-negative integer. Each element of \code{x} is repeated \code{each} times.} } } \item{}{ \code{c(x, ...)}: Combine \code{x} and the Ranges objects in \code{...} together. Any object in \code{...} must belong to the same class as \code{x}, or to one of its subclasses, or must be \code{NULL}. The result is an object of the same class as \code{x}. NOTE: Only works for \link{IRanges} (and derived) objects for now. } \item{}{ \code{x * y}: The arithmetic operation \code{x * y} is for centered zooming. It symmetrically scales the width of \code{x} by \code{1/y}, where \code{y} is a numeric vector that is recycled as necessary. For example, \code{x * 2} results in ranges with half their previous width but with approximately the same midpoint. The ranges have been \dQuote{zoomed in}. If \code{y} is negative, it is equivalent to \code{x * (1/abs(y))}. Thus, \code{x * -2} would double the widths in \code{x}. In other words, \code{x} has been \dQuote{zoomed out}. } \item{}{ \code{x + y}: Expands the ranges in \code{x} on either side by the corresponding value in the numeric vector \code{y}. } \item{}{ \code{show(x)}: By default the \code{show} method displays 5 head and 5 tail lines. The number of lines can be altered by setting the global options \code{showHeadLines} and \code{showTailLines}. If the object length is less than the sum of the options, the full object is displayed. These options affect GRanges, GAlignments, Ranges and XString objects. } } } \section{Normality}{ A Ranges object \code{x} is implicitly representing an arbitrary finite set of integers (that are not necessarily consecutive). This set is the set obtained by taking the union of all the values in all the ranges in \code{x}. This representation is clearly not unique: many different Ranges objects can be used to represent the same set of integers. However one and only one of them is guaranteed to be "normal". By definition a Ranges object is said to be "normal" when its ranges are: (a) not empty (i.e. they have a non-null width); (b) not overlapping; (c) ordered from left to right; (d) not even adjacent (i.e. there must be a non empty gap between 2 consecutive ranges). Here is a simple algorithm to determine whether \code{x} is "normal": (1) if \code{length(x) == 0}, then \code{x} is normal; (2) if \code{length(x) == 1}, then \code{x} is normal iff \code{width(x) >= 1}; (3) if \code{length(x) >= 2}, then \code{x} is normal iff: \preformatted{ start(x)[i] <= end(x)[i] < start(x)[i+1] <= end(x)[i+1]} for every 1 <= \code{i} < \code{length(x)}. The obvious advantage of using a "normal" Ranges object to represent a given finite set of integers is that it is the smallest in terms of of number of ranges and therefore in terms of storage space. Also the fact that we impose its ranges to be ordered from left to right makes it unique for this representation. A special container (\link{NormalIRanges}) is provided for holding a "normal" \link{IRanges} object: a \link{NormalIRanges} object is just an \link{IRanges} object that is guaranteed to be "normal". Here are some methods related to the notion of "normal" Ranges: \describe{ \item{}{ \code{isNormal(x)}: Return a logical value indicating whether \code{x} is "normal" or not. } \item{}{ \code{whichFirstNotNormal(x)}: Return \code{NA} if \code{x} is normal, or the smallest valid indice \code{i} in \code{x} for which \code{x[1:i]} is not "normal". } } } \author{H. Pages and M. Lawrence} \seealso{ \link{Ranges-comparison}, \link{intra-range-methods}, \link{inter-range-methods}, \link{IRanges-class}, \link{IRanges-utils}, \link{setops-methods}, \link{RangedData-class}, \link{IntervalTree-class}, \code{\link{update}}, \code{\link{as.matrix}}, \code{\link{as.data.frame}}, \code{\link{rep}} } \examples{ x <- IRanges(start=c(2:-1, 13:15), width=c(0:3, 2:0)) x length(x) start(x) width(x) end(x) isEmpty(x) as.matrix(x) as.data.frame(x) ## Subsetting: x[4:2] # 3 ranges x[-1] # 6 ranges x[FALSE] # 0 range x0 <- x[width(x) == 0] # 2 ranges isEmpty(x0) ## Use the replacement methods to resize the ranges: width(x) <- width(x) * 2 + 1 x end(x) <- start(x) # equivalent to width(x) <- 0 x width(x) <- c(2, 0, 4) x start(x)[3] <- end(x)[3] - 2 # resize the 3rd range x ## Name the elements: names(x) names(x) <- c("range1", "range2") x x[is.na(names(x))] # 5 ranges x[!is.na(names(x))] # 2 ranges ir <- IRanges(c(1,5), c(3,10)) ir*1 # no change ir*c(1,2) # zoom second range by 2X ir*-2 # zoom out 2X } \keyword{methods} \keyword{classes} IRanges/man/Ranges-comparison.Rd0000644000126300012640000002702212227064476020133 0ustar00biocbuildphs_compbio\name{Ranges-comparison} \alias{Ranges-comparison} \alias{compare,Ranges,Ranges-method} \alias{rangeComparisonCodeToLetter} \alias{match,Ranges,Ranges-method} \alias{selfmatch,Ranges-method} \alias{duplicated,Ranges-method} \alias{duplicated.Ranges} \alias{\%in\%,Ranges,Ranges-method} \alias{findMatches,Ranges,Ranges-method} \alias{countMatches,Ranges,Ranges-method} \alias{order,Ranges-method} \alias{rank,Ranges-method} \title{Comparing and ordering ranges} \description{ Methods for comparing and/or ordering \link{Ranges} objects. } \usage{ ## Element-wise (aka "parallel") comparison of 2 Ranges objects ## ------------------------------------------------------------ \S4method{compare}{Ranges,Ranges}(x, y) rangeComparisonCodeToLetter(code) ## match() ## ------- \S4method{match}{Ranges,Ranges}(x, table, nomatch=NA_integer_, incomparables=NULL, method=c("auto", "quick", "hash"), match.if.overlap=FALSE) ## selfmatch() ## ----------- \S4method{selfmatch}{Ranges}(x, method=c("auto", "quick", "hash"), match.if.overlap=FALSE) ## order() and related methods ## ---------------------------- \S4method{order}{Ranges}(..., na.last=TRUE, decreasing=FALSE) \S4method{rank}{Ranges}(x, na.last=TRUE, ties.method=c("average", "first", "random", "max", "min")) } \arguments{ \item{x, y, table}{ \link{Ranges} objects. } \item{nomatch}{ The value to be returned in the case when no match is found. It is coerced to an \code{integer}. } \item{incomparables}{ Not supported. } \item{method}{ Use a Quicksort-based (\code{method="quick"}) or a hash-based (\code{method="hash"}) algorithm. The latter tends to give better performance, except maybe for some pathological input that we've not been able to determine so far. When \code{method="auto"} is specified, the most efficient algorithm will be used, that is, the hash-based algorithm if \code{length(x) <= 2^29}, otherwise the Quicksort-based algorithm. } \item{match.if.overlap}{ For \code{match}: This argument is deprecated in BioC 2.13 and won't be supported anymore in BioC 2.14. Please use \code{findOverlaps(x, table, select="first")} instead of \code{match(x, table, match.if.overlap=TRUE)}. For \code{selfmatch}: This argument is ignored and will be removed soon. } \item{...}{ One or more \link{Ranges} objects. The additional \link{Ranges} objects are used to break ties. } \item{na.last}{ Ignored. } \item{decreasing}{ \code{TRUE} or \code{FALSE}. } \item{ties.method}{ A character string specifying how ties are treated. Only \code{"first"} is supported for now. } \item{code}{ A vector of codes as returned by \code{compare}. } } \details{ Two ranges are considered equal iff they share the same start and width. Note that with this definition, 2 empty ranges are generally not equal (they need to share the same start to be considered equal). This means that, when it comes to comparing ranges, an empty range is interpreted as a position between its end and start. For example, a typical usecase is comparison of insertion points defined along a string (like a DNA sequence) and represented as empty ranges. Ranges are ordered by starting position first, and then by width. This way, the space of ranges is totally ordered. On a \link{Ranges} object, \code{order}, \code{sort}, and \code{rank} are consistent with this order. \describe{ \item{}{ \code{compare(x, y)}: Performs "generalized range-wise comparison" of \code{x} and \code{y}, that is, returns an integer vector where the i-th element is a code describing how the i-th element in \code{x} is qualitatively positioned relatively to the i-th element in \code{y}. Here is a summary of the 13 predefined codes (and their letter equivalents) and their meanings: \preformatted{ -6 a: x[i]: .oooo....... 6 m: x[i]: .......oooo. y[i]: .......oooo. y[i]: .oooo....... -5 b: x[i]: ..oooo...... 5 l: x[i]: ......oooo.. y[i]: ......oooo.. y[i]: ..oooo...... -4 c: x[i]: ...oooo..... 4 k: x[i]: .....oooo... y[i]: .....oooo... y[i]: ...oooo..... -3 d: x[i]: ...oooooo... 3 j: x[i]: .....oooo... y[i]: .....oooo... y[i]: ...oooooo... -2 e: x[i]: ..oooooooo.. 2 i: x[i]: ....oooo.... y[i]: ....oooo.... y[i]: ..oooooooo.. -1 f: x[i]: ...oooo..... 1 h: x[i]: ...oooooo... y[i]: ...oooooo... y[i]: ...oooo..... 0 g: x[i]: ...oooooo... y[i]: ...oooooo... } Note that this way of comparing ranges is a refinement over the standard ranges comparison defined by the \code{==}, \code{!=}, \code{<=}, \code{>=}, \code{<} and \code{>} operators. In particular a code that is \code{< 0}, \code{= 0}, or \code{> 0}, corresponds to \code{x[i] < y[i]}, \code{x[i] == y[i]}, or \code{x[i] > y[i]}, respectively. The \code{compare} method for \link{Ranges} objects is guaranteed to return predefined codes only but methods for other objects (e.g. for \link[GenomicRanges]{GenomicRanges} objects) can return non-predefined codes. Like for the predefined codes, the sign of any non-predefined code must tell whether \code{x[i]} is less than, or greater than \code{y[i]}. } \item{}{ \code{rangeComparisonCodeToLetter(x)}: Translate the codes returned by \code{compare}. The 13 predefined codes are translated as follow: -6 -> a; -5 -> b; -4 -> c; -3 -> d; -2 -> e; -1 -> f; 0 -> g; 1 -> h; 2 -> i; 3 -> j; 4 -> k; 5-> l; 6 -> m. Any non-predefined code is translated to X. The translated codes are returned in a factor with 14 levels: a, b, ..., l, m, X. } \item{}{ \code{match(x, table, nomatch=NA_integer_, method=c("auto", "quick", "hash"))}: Returns an integer vector of the length of \code{x}, containing the index of the first matching range in \code{table} (or \code{nomatch} if there is no matching range) for each range in \code{x}. } \item{}{ \code{selfmatch(x, method=c("auto", "quick", "hash"))}: Equivalent to, but more efficient than, \code{match(x, x, method=method)}. } \item{}{ \code{duplicated(x, fromLast=FALSE, method=c("auto", "quick", "hash"))}: Determines which elements of \code{x} are equal to elements with smaller subscripts, and returns a logical vector indicating which elements are duplicates. \code{duplicated(x)} is equivalent to, but more efficient than, \code{duplicated(as.data.frame(x))} on a \link{Ranges} object. See \code{\link[base]{duplicated}} in the \pkg{base} package for more details. } \item{}{ \code{unique(x, fromLast=FALSE, method=c("auto", "quick", "hash"))}: Removes duplicate ranges from \code{x}. \code{unique(x)} is equivalent to, but more efficient than, \code{unique(as.data.frame(x))} on a \link{Ranges} object. See \code{\link[base]{unique}} in the \pkg{base} package for more details. } \item{}{ \code{x \%in\% table}: A shortcut for finding the ranges in \code{x} that match any of the ranges in \code{table}. Returns a logical vector of length equal to the number of ranges in \code{x}. } \item{}{ \code{findMatches(x, table, method=c("auto", "quick", "hash"))}: An enhanced version of \code{match} that returns all the matches in a \link{Hits} object. } \item{}{ \code{countMatches(x, table, method=c("auto", "quick", "hash"))}: Returns an integer vector of the length of \code{x} containing the number of matches in \code{table} for each element in \code{x}. } \item{}{ \code{order(...)}: Returns a permutation which rearranges its first argument (a \link{Ranges} object) into ascending order, breaking ties by further arguments (also \link{Ranges} objects). See \code{\link[BiocGenerics]{order}} in the \pkg{BiocGenerics} package for more information. } \item{}{ \code{sort(x)}: Sorts \code{x}. See \code{\link[base]{sort}} in the \pkg{base} package for more details. } \item{}{ \code{rank(x, na.last=TRUE, ties.method=c("average", "first", "random", "max", "min"))}: Returns the sample ranks of the ranges in \code{x}. See \code{\link[base]{rank}} in the \pkg{base} package for more details. } } } \author{H. Pages} \seealso{ \itemize{ \item The \link{Ranges} class. \item \link[GenomicRanges]{GenomicRanges-comparison} in the \pkg{GenomicRanges} package for comparing and ordering genomic ranges. \item \link{intra-range-methods} and \link{inter-range-methods} for intra and inter range transformations. \item \link{setops-methods} for set operations on \link{IRanges} objects. \item \code{\link{findOverlaps}} for finding overlapping ranges. \item \link{Vector-comparison} for the generic functions and methods for comparing, ordering, and tabulating vector-like objects. } } \examples{ ## --------------------------------------------------------------------- ## A. ELEMENT-WISE (AKA "PARALLEL") COMPARISON OF 2 Ranges OBJECTS ## --------------------------------------------------------------------- x0 <- IRanges(1:11, width=4) x0 y0 <- IRanges(6, 9) compare(x0, y0) compare(IRanges(4:6, width=6), y0) compare(IRanges(6:8, width=2), y0) compare(x0, y0) < 0 # equivalent to 'x0 < y0' compare(x0, y0) == 0 # equivalent to 'x0 == y0' compare(x0, y0) > 0 # equivalent to 'x0 > y0' rangeComparisonCodeToLetter(-10:10) rangeComparisonCodeToLetter(compare(x0, y0)) ## Handling of zero-width ranges (a.k.a. empty ranges): x1 <- IRanges(11:17, width=0) x1 compare(x1, x1[4]) compare(x1, IRanges(12, 15)) ## Note that x1[2] and x1[6] are empty ranges on the edge of non-empty ## range IRanges(12, 15). Even though -1 and 3 could also be considered ## valid codes for describing these configurations, compare() ## considers x1[2] and x1[6] to be *adjacent* to IRanges(12, 15), and ## thus returns codes -5 and 5: compare(x1[2], IRanges(12, 15)) # -5 compare(x1[6], IRanges(12, 15)) # 5 x2 <- IRanges(start=c(20L, 8L, 20L, 22L, 25L, 20L, 22L, 22L), width=c( 4L, 0L, 11L, 5L, 0L, 9L, 5L, 0L)) x2 which(width(x2) == 0) # 3 empty ranges x2[2] == x2[2] # TRUE x2[2] == x2[5] # FALSE x2 == x2[4] x2 >= x2[3] ## --------------------------------------------------------------------- ## B. match(), selfmatch(), duplicated(), unique(), %in% ## --------------------------------------------------------------------- table <- x2[c(2:4, 7:8)] match(x2, table) x2 \%in\% table # Warning! The warning will be removed in BioC 2.14. ## In the meantime, use suppressWarnings() to suppress the warning: suppressWarnings(x2 \%in\% table) duplicated(x2) unique(x2) ## --------------------------------------------------------------------- ## C. findMatches(), countMatches() ## --------------------------------------------------------------------- findMatches(x2, table) countMatches(x2, table) x2_levels <- unique(x2) countMatches(x2_levels, x2) ## --------------------------------------------------------------------- ## D. order() AND RELATED METHODS ## --------------------------------------------------------------------- order(x2) sort(x2) rank(x2, ties.method="first") } \keyword{methods} IRanges/man/RangesList-class.Rd0000644000126300012640000001742212227064476017725 0ustar00biocbuildphs_compbio\name{RangesList-class} \docType{class} \alias{class:RangesList-class} \alias{class:SimpleRangesList-class} \alias{RangesList-class} \alias{SimpleRangesList-class} \alias{RangesList} \alias{SimpleRangesList} % accessors \alias{end,RangesList-method} \alias{end<-,RangesList-method} \alias{width,RangesList-method} \alias{width<-,RangesList-method} \alias{start,RangesList-method} \alias{start<-,RangesList-method} \alias{space} \alias{space,RangesList-method} \alias{universe,RangesList-method} \alias{universe<-,RangesList-method} \alias{universe} \alias{universe<-} % subset \alias{[,RangesList-method} \alias{[,SimpleRangesList-method} % coercion \alias{as.data.frame.RangesList} \alias{as.data.frame,RangesList-method} \alias{coerce,RangesList,IRangesList-method} \alias{coerce,RangesList,CompressedIRangesList-method} \alias{coerce,RangesList,SimpleIRangesList-method} \alias{coerce,SimpleRangesList,SimpleIRangesList-method} \alias{coerce,RangesList,SimpleRangesList-method} \alias{coerce,RangesList,NormalIRangesList-method} \alias{coerce,RangesList,CompressedNormalIRangesList-method} \alias{coerce,RangesList,SimpleNormalIRangesList-method} \alias{coerce,LogicalList,IRangesList-method} \alias{coerce,LogicalList,CompressedIRangesList-method} \alias{coerce,LogicalList,SimpleIRangesList-method} \alias{coerce,LogicalList,NormalIRangesList-method} \alias{coerce,LogicalList,CompressedNormalIRangesList-method} \alias{coerce,LogicalList,SimpleNormalIRangesList-method} \alias{coerce,RleList,IRangesList-method} \alias{coerce,RleList,CompressedIRangesList-method} \alias{coerce,RleList,SimpleIRangesList-method} \alias{coerce,RleList,NormalIRangesList-method} \alias{coerce,RleList,CompressedNormalIRangesList-method} \alias{coerce,RleList,SimpleNormalIRangesList-method} \alias{merge,RangesList,missing-method} \alias{merge,missing,RangesList-method} \alias{merge,RangesList,RangesList-method} % show \alias{show,RangesList-method} \alias{showAsCell,RangesList-method} \title{List of Ranges} \description{An extension of \linkS4class{List} that holds only \linkS4class{Ranges} objects. Useful for storing ranges over a set of spaces (e.g. chromosomes), each of which requires a separate \code{Ranges} object. As a \code{Vector}, \code{RangesList} may be annotated with its universe identifier (e.g. a genome) in which all of its spaces exist. } \section{Accessors}{ In the code snippets below, \code{x} is a \code{RangesList} object. All of these accessors collapse over the spaces: \describe{ \item{}{\code{start(x), start(x) <- value}: Get or set the starts of the ranges. When setting the starts, \code{value} can be an integer vector of \code{length(sum(elementLengths(x)))} or an IntegerList object of length \code{length(x)} and names \code{names(x)}.} \item{}{\code{end(x), end(x) <- value}: Get or set the ends of the ranges. When setting the starts, \code{value} can be an integer vector of \code{length(sum(elementLengths(x)))} or an IntegerList object of length \code{length(x)} and names \code{names(x)}.} \item{}{\code{width(x), width(x) <- value}: Get or set the widths of the ranges. When setting the starts, \code{value} can be an integer vector of \code{length(sum(elementLengths(x)))} or an IntegerList object of length \code{length(x)} and names \code{names(x)}.} \item{}{\code{space(x)}: Gets the spaces of the ranges as a character vector. This is equivalent to \code{names(x)}, except each name is repeated according to the length of its element. } } These accessors are for the \code{universe} identifier: \describe{ \item{}{\code{universe(x)}: gets the name of the universe as a single string, if one has been specified, \code{NULL} otherwise. } \item{}{\code{universe(x) <- value}: sets the name of the universe to \code{value}, a single string or \code{NULL}. } } } \section{Constructor}{ \describe{ \item{}{\code{RangesList(..., universe = NULL)}: Each \code{Ranges} in \code{...} becomes an element in the new \code{RangesList}, in the same order. This is analogous to the \code{\link{list}} constructor, except every argument in \code{...} must be derived from \code{Ranges}. The universe is specified by the \code{universe} parameter, which should be a single string or NULL, to leave unspecified. } } } \section{Subsetting}{ In the code snippets below, \code{x} is a \code{RangesList} object. \describe{ \item{}{ \code{x[i]}: Subset \code{x} by index \code{i}, with the same semantics as a basic \code{\linkS4class{Vector}}, except \code{i} may itself be a \code{RangesList}, in which case only the ranges in \code{x} that overlap with those in \code{i} are kept. See the \code{\link[=findOverlaps,RangesList,RangesList-method]{findOverlaps}} method for more details. } } } \section{Coercion}{ In the code snippets below, \code{x} and \code{from} are a \code{RangesList} object. \describe{ \item{}{\code{as.data.frame(x, row.names = NULL, optional = FALSE)}: Coerces \code{x} to a \code{data.frame}. Essentially the same as calling \code{data.frame(space=rep(names(x), elementLengths(x)), as.data.frame(unlist(x, use.names=FALSE)))}. } \item{}{\code{as(from, "SimpleIRangesList")}: Coerces \code{from}, to a \code{\linkS4class{SimpleIRangesList}}, requiring that all \code{Ranges} elements are coerced to internal \code{IRanges} elements. This is a convenient way to ensure that all \code{Ranges} have been imported into R (and that there is no unwanted overhead when accessing them). } \item{}{\code{as(from, "CompressedIRangesList")}: Coerces \code{from}, to a \code{\linkS4class{CompressedIRangesList}}, requiring that all \code{Ranges} elements are coerced to internal \code{IRanges} elements. This is a convenient way to ensure that all \code{Ranges} have been imported into R (and that there is no unwanted overhead when accessing them). } \item{}{\code{as(from, "SimpleNormalIRangesList")}: Coerces \code{from}, to a \code{\linkS4class{SimpleNormalIRangesList}}, requiring that all \code{Ranges} elements are coerced to internal \code{NormalIRanges} elements. } \item{}{\code{as(from, "CompressedNormalIRangesList")}: Coerces \code{from}, to a \code{\linkS4class{CompressedNormalIRangesList}}, requiring that all \code{Ranges} elements are coerced to internal \code{NormalIRanges} elements. } } } \section{Arithmetic Operations}{ Any arithmetic operation, such as \code{x + y}, \code{x * y}, etc, where \code{x} is a \code{RangesList}, is performed identically on each element. Currently, \code{Ranges} supports only the \code{*} operator, which zooms the ranges by a numeric factor. } \author{ Michael Lawrence } \seealso{ \code{\linkS4class{List}}, the parent of this class, for more functionality. } \examples{ range1 <- IRanges(start=c(1,2,3), end=c(5,2,8)) range2 <- IRanges(start=c(15,45,20,1), end=c(15,100,80,5)) named <- RangesList(one = range1, two = range2) length(named) # 2 start(named) # same as start(c(range1, range2)) names(named) # "one" and "two" named[[1]] # range1 unnamed <- RangesList(range1, range2) names(unnamed) # NULL # edit the width of the ranges in the list edited <- named width(edited) <- rep(c(3,2), elementLengths(named)) edited # same as list(range1, range2) as.list(RangesList(range1, range2)) # coerce to data.frame as.data.frame(named) # set the universe universe(named) <- "hg18" universe(named) RangesList(range1, range2, universe = "hg18") ## zoom in 2X collection <- RangesList(one = range1, range2) collection * 2 } \keyword{methods} \keyword{classes} IRanges/man/RangesMapping-class.Rd0000644000126300012640000000535012227064476020402 0ustar00biocbuildphs_compbio\name{RangesMapping-class} \docType{class} \alias{RangesMapping-class} % generic \alias{map} \alias{pmap} % accessors \alias{hits} \alias{ranges,RangesMapping-method} \alias{space,RangesMapping-method} \alias{dim,RangesMapping-method} \alias{length,RangesMapping-method} \alias{queryHits,RangesMapping-method} \alias{subjectHits,RangesMapping-method} % coercion \alias{coerce,RangesMapping,RangedData-method} \title{Mapping of ranges to another sequence} \description{ The \code{map} generic converts a set of ranges to the equivalent ranges on another sequence, through some sort of alignment between sequences, and outputs a \code{RangesMapping} object. There are three primary components of that object: the transformed \code{ranges}, the \code{space} (destination sequence) for the ranges, and the \code{hits}, a \code{\linkS4class{Hits}} object of the same length that matches each input range to a destination sequence (useful when the alignment is one/many to many). The \code{pmap} function is simpler: it treats the two inputs as parallel vectors, maps each input range via the corresponding alignment, and returns the mapped ranges. There is one result per input element, instead of the many-to-many result from \code{map}. } \usage{ map(from, to, ...) pmap(from, to, ...) } \arguments{ \item{from}{Typically an object containing ranges to map.} \item{to}{Typically an object representing an alignment.} \item{...}{Arguments to pass to methods} } \value{ A \code{RangesMapping} object, as documented here. } \section{\code{RangesMapping} Accessors}{ \describe{ \item{}{\code{ranges(x)}: Gets the mapped ranges.} \item{}{\code{space(x)}: Gets the destination spaces (sequence names).} \item{}{\code{hits(x)}: Gets the matching between the input ranges and the destination sequences (of which there may be more than one).} \item{}{\code{dim(x)}: Same as \code{dim(hits(x))}.} \item{}{\code{length(x)}: Same as \code{length(hits(x))}.} \item{}{\code{subjectHits(x)}: Same as \code{subjectHits(hits(x))}.} \item{}{\code{queryHits(x)}: Same as \code{queryHits(hits(x))}.} } } \section{\code{RangesMapping} Coercion}{ \describe{ \item{}{\code{as(from, "RangedData")}: Converts a \code{RangesMapping} into a \code{\linkS4class{RangedData}}. The \code{ranges}/\code{space} in the \code{RangedData} are the \code{ranges}/\code{space} of \code{from}, and the \code{values} result from the coercion of the \code{hits} to a \code{DataFrame}. } } } \author{ Michael Lawrence } \seealso{ Methods on the generic \code{map}, which generates an instance of this class, are defined in other packages, like GenomicRanges. } \keyword{methods} \keyword{classes} IRanges/man/Rle-class.Rd0000644000126300012640000010265312227064476016375 0ustar00biocbuildphs_compbio\name{Rle-class} \docType{class} \alias{class:Rle} \alias{Rle-class} \alias{Rle} \alias{Rle,missing,missing-method} \alias{Rle,vectorORfactor,missing-method} \alias{Rle,vectorORfactor,integer-method} \alias{Rle,vectorORfactor,numeric-method} \alias{runLength} \alias{runLength,Rle-method} \alias{runValue} \alias{runValue,Rle-method} \alias{nrun} \alias{nrun,Rle-method} \alias{start,Rle-method} \alias{end,Rle-method} \alias{width,Rle-method} \alias{ranges,Rle-method} \alias{runLength<-} \alias{runLength<-,Rle-method} \alias{runValue<-} \alias{runValue<-,Rle-method} \alias{as.vector,Rle-method} \alias{as.vectorORfactor} \alias{as.vectorORfactor,Rle-method} \alias{as.logical,Rle-method} \alias{as.integer,Rle-method} \alias{as.numeric,Rle-method} \alias{as.complex,Rle-method} \alias{as.character,Rle-method} \alias{as.raw,Rle-method} \alias{as.factor,Rle-method} \alias{as.data.frame.Rle} \alias{as.data.frame,Rle-method} \alias{as.list.Rle} \alias{as.list,Rle-method} \alias{coerce,Rle,list-method} \alias{coerce,vector,Rle-method} \alias{coerce,logical,Rle-method} \alias{coerce,integer,Rle-method} \alias{coerce,numeric,Rle-method} \alias{coerce,complex,Rle-method} \alias{coerce,character,Rle-method} \alias{coerce,raw,Rle-method} \alias{coerce,factor,Rle-method} \alias{coerce,Rle,vector-method} \alias{coerce,Rle,logical-method} \alias{coerce,Rle,integer-method} \alias{coerce,Rle,numeric-method} \alias{coerce,Rle,complex-method} \alias{coerce,Rle,character-method} \alias{coerce,Rle,raw-method} \alias{coerce,Rle,factor-method} \alias{coerce,Rle,IRanges-method} \alias{coerce,Rle,NormalIRanges-method} \alias{coerce,Rle,data.frame-method} \alias{Ops,Rle,Rle-method} \alias{Ops,Rle,vector-method} \alias{Ops,vector,Rle-method} \alias{Math,Rle-method} \alias{Math2,Rle-method} \alias{Summary,Rle-method} \alias{Complex,Rle-method} \alias{[,Rle-method} \alias{[<-,Rle-method} \alias{\%in\%,Rle,ANY-method} \alias{aggregate.Rle} \alias{aggregate,Rle-method} \alias{c,Rle-method} \alias{findRange} \alias{findRange,Rle-method} \alias{findRun} \alias{findRun,Rle-method} \alias{is.na,Rle-method} \alias{is.unsorted,Rle-method} \alias{length,Rle-method} \alias{match,Rle,ANY-method} \alias{rep,Rle-method} \alias{rep.int,Rle-method} \alias{rev.Rle} \alias{rev,Rle-method} \alias{shiftApply,Rle,Rle-method} \alias{show,Rle-method} \alias{showAsCell,Rle-method} \alias{order,Rle-method} \alias{sort.Rle} \alias{sort,Rle-method} \alias{splitRanges} \alias{splitRanges,Rle-method} \alias{splitRanges,vectorORfactor-method} \alias{summary.Rle} \alias{summary,Rle-method} \alias{table,Rle-method} \alias{unique.Rle} \alias{unique,Rle-method} \alias{duplicated,Rle-method} \alias{duplicated.Rle} \alias{window.Rle} \alias{window,Rle-method} \alias{!,Rle-method} \alias{which,Rle-method} \alias{ifelse,ANY,ANY,Rle-method} \alias{ifelse,ANY,Rle,ANY-method} \alias{ifelse,ANY,Rle,Rle-method} \alias{pmax,Rle-method} \alias{pmin,Rle-method} \alias{pmax.int,Rle-method} \alias{pmin.int,Rle-method} \alias{which.max,Rle-method} \alias{diff.Rle} \alias{diff,Rle-method} \alias{mean.Rle} \alias{mean,Rle-method} \alias{var,Rle,missing-method} \alias{var,Rle,Rle-method} \alias{cov,Rle,Rle-method} \alias{cor,Rle,Rle-method} \alias{sd,Rle-method} \alias{median.Rle} \alias{median,Rle-method} \alias{quantile.Rle} \alias{quantile,Rle-method} \alias{mad.Rle} \alias{mad,Rle-method} \alias{IQR,Rle-method} \alias{smoothEnds,Rle-method} \alias{runmean,Rle-method} \alias{runmed,Rle-method} \alias{runsum,Rle-method} \alias{runwtsum,Rle-method} \alias{runq,Rle-method} \alias{nchar,Rle-method} \alias{substr,Rle-method} \alias{substring,Rle-method} \alias{chartr,ANY,ANY,Rle-method} \alias{tolower,Rle-method} \alias{toupper,Rle-method} \alias{sub,ANY,ANY,Rle-method} \alias{gsub,ANY,ANY,Rle-method} \alias{paste,Rle-method} \alias{levels.Rle} \alias{levels,Rle-method} \alias{levels<-,Rle-method} \title{Rle objects} \description{ The Rle class is a general container for storing an atomic vector that is stored in a run-length encoding format. It is based on the \code{\link[base]{rle}} function from the base package. } \section{Constructors}{ \describe{ \item{}{ \code{Rle(values)}: This constructor creates an Rle instances out of an atomic vector \code{values}. } \item{}{ \code{Rle(values, lengths)}: This constructor creates an Rle instances out of an atomic vector or factor object \code{values} and an integer or numeric vector \code{lengths} with all positive elements that represent how many times each value is repeated. The length of these two vectors must be the same. } \item{}{ \code{as(from, "Rle")}: This constructor creates an Rle instances out of an atomic vector \code{from}. } } } \section{Accessors}{ In the code snippets below, \code{x} is an Rle object: \describe{ \item{}{ \code{runLength(x)}: Returns the run lengths for \code{x}. } \item{}{ \code{runValue(x)}: Returns the run values for \code{x}. } \item{}{ \code{nrun(x)}: Returns the number of runs in \code{x}. } \item{}{ \code{start(x)}: Returns the starts of the runs for \code{x}. } \item{}{ \code{end(x)}: Returns the ends of the runs for \code{x}. } \item{}{ \code{width(x)}: Same as \code{runLength(x)}. } } } \section{Replacers}{ In the code snippets below, \code{x} is an Rle object: \describe{ \item{}{ \code{runLength(x) <- value}: Replaces \code{x} with a new Rle object using run values \code{runValue(x)} and run lengths \code{value}. } \item{}{ \code{runValue(x) <- value}: Replaces \code{x} with a new Rle object using run values \code{value} and run lengths \code{runLength(x)}. } } } \section{Coercion}{ In the code snippets below, \code{x} and \code{from} are Rle objects: \describe{ \item{}{ \code{as.vector(x, mode="any")}, \code{as(from, "vector")}: Creates an atomic vector based on the values contained in \code{x}. The vector will be coerced to the requested \code{mode}, unless \code{mode} is "any", in which case the most appropriate type is chosen. } \item{}{ \code{as.vectorORfactor(x)}: Creates an atomic vector or factor, based on the type of values contained in \code{x}. This is the most general way to decompress the Rle to a native R data structure. } \item{}{ \code{as.logical(x)}, \code{as(from, "logical")}: Creates a logical vector based on the values contained in \code{x}. } \item{}{ \code{as.integer(x)}, \code{as(from, "integer")}: Creates an integer vector based on the values contained in \code{x}. } \item{}{ \code{as.numeric(x)}, \code{as(from, "numeric")}: Creates a numeric vector based on the values contained in \code{x}. } \item{}{ \code{as.complex(x)}, \code{as(from, "complex")}: Creates a complex vector based on the values contained in \code{x}. } \item{}{ \code{as.character(x)}, \code{as(from, "character")}: Creates a character vector based on the values contained in \code{x}. } \item{}{ \code{as.raw(x)}, \code{as(from, "raw")}: Creates a raw vector based on the values contained in \code{x}. } \item{}{ \code{as.factor(x)}, \code{as(from, "factor")}: Creates a factor object based on the values contained in \code{x}. } \item{}{ \code{as.data.frame(x)}, \code{as(from, "data.frame")}: Creates a \code{data.frame} with a single column holding the result of \code{as.vector(x)}. } \item{}{ \code{as(from, "IRanges")}: Creates an \link{IRanges} instance from a logical Rle. Note that this instance is guaranteed to be normal. } \item{}{ \code{as(from, "NormalIRanges")}: Creates a \link{NormalIRanges} instance from a logical Rle. } } } \section{Group Generics}{ Rle objects have support for S4 group generic functionality: \describe{ \item{\code{Arith}}{\code{"+"}, \code{"-"}, \code{"*"}, \code{"^"}, \code{"\%\%"}, \code{"\%/\%"}, \code{"/"}} \item{\code{Compare}}{\code{"=="}, \code{">"}, \code{"<"}, \code{"!="}, \code{"<="}, \code{">="}} \item{\code{Logic}}{\code{"&"}, \code{"|"}} \item{\code{Ops}}{\code{"Arith"}, \code{"Compare"}, \code{"Logic"}} \item{\code{Math}}{\code{"abs"}, \code{"sign"}, \code{"sqrt"}, \code{"ceiling"}, \code{"floor"}, \code{"trunc"}, \code{"cummax"}, \code{"cummin"}, \code{"cumprod"}, \code{"cumsum"}, \code{"log"}, \code{"log10"}, \code{"log2"}, \code{"log1p"}, \code{"acos"}, \code{"acosh"}, \code{"asin"}, \code{"asinh"}, \code{"atan"}, \code{"atanh"}, \code{"exp"}, \code{"expm1"}, \code{"cos"}, \code{"cosh"}, \code{"sin"}, \code{"sinh"}, \code{"tan"}, \code{"tanh"}, \code{"gamma"}, \code{"lgamma"}, \code{"digamma"}, \code{"trigamma"}} \item{\code{Math2}}{\code{"round"}, \code{"signif"}} \item{\code{Summary}}{\code{"max"}, \code{"min"}, \code{"range"}, \code{"prod"}, \code{"sum"}, \code{"any"}, \code{"all"}} \item{\code{Complex}}{\code{"Arg"}, \code{"Conj"}, \code{"Im"}, \code{"Mod"}, \code{"Re"}} } See \link[methods]{S4groupGeneric} for more details. } \section{General Methods}{ In the code snippets below, \code{x} is an Rle object: \describe{ \item{}{ \code{x[i, drop=getOption("dropRle", default=FALSE)]}: Subsets \code{x} by index \code{i}, where \code{i} can be positive integers, negative integers, a logical vector of the same length as \code{x}, an Rle object of the same length as \code{x} containing logical values, or an \link{IRanges} object. When \code{drop=FALSE} returns an Rle object. When \code{drop=TRUE}, returns an atomic vector. } \item{}{ \code{x[i] <- value}: Replaces elements in \code{x} specified by \code{i} with corresponding elements in \code{value}. Supports the same types for \code{i} as \code{x[i]}. } \item{}{ \code{x \%in\% table}: Returns a logical Rle representing set membership in \code{table}. } \item{}{ \code{aggregate(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE))}: Generates summaries on the specified windows and returns the result in a convenient form: \describe{ \item{\code{by}}{An object with \code{start}, \code{end}, and \code{width} methods.} \item{\code{FUN}}{The function, found via \code{match.fun}, to be applied to each window of \code{x}.} \item{\code{start}, \code{end}, \code{width}}{the start, end, or width of the window. If \code{by} is missing, then must supply two of the three.} \item{\code{frequency}, \code{delta}}{Optional arguments that specify the sampling frequency and increment within the window.} \item{\dots}{Further arguments for \code{FUN}.} \item{\code{simplify}}{A logical value specifying whether or not the result should be simplified to a vector or matrix if possible.} } } \item{}{ \code{append(x, values, after = length(x))}: Insert one Rle into another Rle. \describe{ \item{\code{values}}{the Rle to insert.} \item{\code{after}}{the subscript in \code{x} after which the values are to be inserted.} } } \item{}{ \code{c(x, ...)}: Combines a set of Rle objects. } \item{}{ \code{findRange(x, vec)}: Returns an \link{IRanges} object representing the ranges in Rle \code{vec} that are referenced by the indices in the integer vector \code{x}. } \item{}{ \code{findRun(x, vec)}: Returns an integer vector indicating the run indices in Rle \code{vec} that are referenced by the indices in the integer vector \code{x}. } \item{}{ \code{head(x, n = 6L)}: If \code{n} is non-negative, returns the first n elements of \code{x}. If \code{n} is negative, returns all but the last \code{abs(n)} elements of \code{x}. } \item{}{ \code{is.na(x)}: Returns a logical Rle indicating with values are \code{NA}. } \item{}{ \code{is.unsorted(x, na.rm = FALSE, strictly = FALSE)}: Returns a logical value specifying if \code{x} is unsorted. \describe{ \item{\code{na.rm}}{remove missing values from check.} \item{\code{strictly}}{check for _strictly_ increasing values.} } } \item{}{ \code{length(x)}: Returns the underlying vector length of \code{x}. } \item{}{ \code{match(x, table, nomatch = NA_integer_, incomparables = NULL)}: Matches the values in \code{x} to \code{table}: \describe{ \item{\code{table}}{the values to be matched against.} \item{\code{nomatch}}{the value to be returned in the case when no match is found.} \item{\code{incomparables}}{a vector of values that cannot be matched. Any value in \code{x} matching a value in this vector is assigned the \code{nomatch} value.} } } \item{}{ \code{rep(x, times, length.out, each)}, \code{rep.int(x, times)}: Repeats the values in \code{x} through one of the following conventions: \describe{ \item{\code{times}}{Vector giving the number of times to repeat each element if of length \code{length(x)}, or to repeat the whole vector if of length 1.} \item{\code{length.out}}{Non-negative integer. The desired length of the output vector.} \item{\code{each}}{Non-negative integer. Each element of \code{x} is repeated \code{each} times.} } } \item{}{ \code{rev(x)}: Reverses the order of the values in \code{x}. } \item{}{ \code{shiftApply(SHIFT, X, Y, FUN, ..., OFFSET = 0L, simplify = TRUE, verbose = FALSE)}: Let \code{i} be the indices in \code{SHIFT}, \code{X_i = window(X, 1 + OFFSET, length(X) - SHIFT[i])}, and \code{Y_i = window(Y, 1 + SHIFT[i], length(Y) - OFFSET)}. Calculates the set of \code{FUN(X_i, Y_i, ...)} values and return the results in a convenient form: \describe{ \item{\code{SHIFT}}{A non-negative integer vector of shift values.} \item{\code{X}, \code{Y}}{The Rle objects to shift.} \item{\code{FUN}}{The function, found via \code{match.fun}, to be applied to each set of shifted vectors.} \item{\dots}{Further arguments for \code{FUN}.} \item{OFFSET}{A non-negative integer offset to maintain throughout the shift operations.} \item{\code{simplify}}{A logical value specifying whether or not the result should be simplified to a vector or matrix if possible.} \item{\code{verbose}}{A logical value specifying whether or not to print the \code{i} indices to track the iterations.} } } \item{}{ \code{show(object)}: Prints out the Rle object in a user-friendly way. } \item{}{ \code{order(..., na.last = TRUE, decreasing = FALSE)}: Returns a permutation which rearranges its first argument into ascending or descending order, breaking ties by further arguments. See \code{\link[BiocGenerics]{order}}. } \item{}{ \code{sort(x, decreasing = FALSE, na.last = NA)}: Sorts the values in \code{x}. \describe{ \item{\code{decreasing}}{If \code{TRUE}, sort values in decreasing order. If \code{FALSE}, sort values in increasing order.} \item{\code{na.last}}{If \code{TRUE}, missing values are placed last. If \code{FALSE}, they are placed first. If \code{NA}, they are removed.} } } \item{}{ \code{split(x, f, drop=FALSE)}: Splits \code{x} according to \code{f} to create a \link{CompressedRleList} object. If \code{f} is a list-like object then \code{drop} is ignored and \code{f} is treated as if it was \code{rep(seq_len(length(f)), sapply(f, length))}, so the returned object has the same shape as \code{f} (it also receives the names of \code{f}). Otherwise, if \code{f} is not a list-like object, empty list elements are removed from the returned object if \code{drop} is \code{TRUE}. } \item{}{ \code{splitRanges(x)}: Returns a \linkS4class{CompressedIRangesList} object that contain the ranges for each of the unique run values. } \item{}{ \code{subset(x, subset)}: Returns a new Rle object made of the subset using logical vector \code{subset}. } \item{}{ \code{summary(object, ..., digits = max(3, getOption("digits") - 3))}: Summarizes the Rle object using an atomic vector convention. The \code{digits} argument is used for number formatting with \code{signif()}. } \item{}{ \code{table(...)}: Returns a table containing the counts of the unique values. Supported arguments include \code{useNA} with values of `no' and `ifany'. Multiple Rle's must be combined with \code{c()} before calling \code{table}. } \item{}{ \code{tail(x, n = 6L)}: If \code{n} is non-negative, returns the last n elements of \code{x}. If \code{n} is negative, returns all but the first \code{abs(n)} elements of \code{x}. } \item{}{ \code{unique(x, incomparables = FALSE, ...)}: Returns the unique run values. The \code{incomparables} argument takes a vector of values that cannot be compared with \code{FALSE} being a special value that means that all values can be compared. } \item{}{ \code{window(x, start=NA, end=NA, width=NA, frequency=NULL, delta=NULL, ...)}: Extract the subsequence window from \code{x} specified by: \describe{ \item{\code{start}, \code{end}, \code{width}}{The start, end, or width of the window. Two of the three are required.} \item{\code{frequency}, \code{delta}}{Optional arguments that specify the sampling frequency and increment within the window.} } } \item{}{ \code{window(x, start=NA, end=NA, width=NA) <- value}: Replace the subsequence window specified on the left (i.e. the subsequence in \code{x} specified by \code{start}, \code{end} and \code{width}) by \code{value}. \code{value} must either be of class Rle, belong to a subclass of Rle, or be coercible to Rle or a subclass of Rle. The elements of \code{value} are repeated to create an Rle with the same number of elements as the width of the subsequence window it is replacing. } } } \section{Logical Data Methods}{ In the code snippets below, \code{x} is an Rle object: \describe{ \item{}{ \code{!x}: Returns logical negation (NOT) of \code{x}. } \item{}{ \code{which(x)}: Returns an integer vector representing the \code{TRUE} indices of \code{x}. } \item{}{ \code{ifelse(x, yes, no)}: For each element of \code{x}, returns the corresponding element in \code{yes} if \code{TRUE}, otherwise the element in \code{no}. \code{yes} and \code{no} may be \code{Rle} objects or anything else coercible to a vector. } } } \section{Numerical Data Methods}{ In the code snippets below, \code{x} is an Rle object: \describe{ \item{}{ \code{diff(x, lag = 1, differences = 1}: Returns suitably lagged and iterated differences of \code{x}. \describe{ \item{\code{lag}}{An integer indicating which lag to use.} \item{\code{differences}}{An integer indicating the order of the difference.} } } \item{}{ \code{pmax(..., na.rm = FALSE)}, \code{pmax.int(..., na.rm = FALSE)}: Parallel maxima of the Rle input values. Removes \code{NA}s when \code{na.rm = TRUE}. } \item{}{ \code{pmin(..., na.rm = FALSE)}, \code{pmin.int(..., na.rm = FALSE)}: Parallel minima of the Rle input values. Removes \code{NA}s when \code{na.rm = TRUE}. } \item{}{ \code{which.max(x)}: Returns the index of the first element matching the maximum value of \code{x}. } \item{}{ \code{mean(x, na.rm = FALSE)}: Calculates the mean of \code{x}. Removes \code{NA}s when \code{na.rm = TRUE}. } \item{}{ \code{var(x, y = NULL, na.rm = FALSE)}: Calculates the variance of \code{x} or covariance of \code{x} and \code{y} if both are supplied. Removes \code{NA}s when \code{na.rm = TRUE}. } \item{}{ \code{cov(x, y, use = "everything")}, \code{cor(x, y, use = "everything")}: Calculates the covariance and correlation respectively of Rle objects \code{x} and \code{y}. The \code{use} argument is an optional character string giving a method for computing covariances in the presence of missing values. This must be (an abbreviation of) one of the strings \code{"everything"}, \code{"all.obs"}, \code{"complete.obs"}, \code{"na.or.complete"}, or \code{"pairwise.complete.obs"}. } \item{}{ \code{sd(x, na.rm = FALSE)}: Calculates the standard deviation of \code{x}. Removes \code{NA}s when \code{na.rm = TRUE}. } \item{}{ \code{median(x, na.rm = FALSE)}: Calculates the median of \code{x}. Removes \code{NA}s when \code{na.rm = TRUE}. } \item{}{ \code{quantile(x, probs = seq(0, 1, 0.25), na.rm = FALSE, names = TRUE, type = 7, ...)}: Calculates the specified quantiles of \code{x}. \describe{ \item{\code{probs}}{A numeric vector of probabilities with values in [0,1].} \item{\code{na.rm}}{If \code{TRUE}, removes \code{NA}s from \code{x} before the quantiles are computed.} \item{\code{names}}{If \code{TRUE}, the result has names describing the quantiles.} \item{\code{type}}{An integer between 1 and 9 selecting one of the nine quantile algorithms detailed in \code{\link[stats]{quantile}}.} \item{\dots}{Further arguments passed to or from other methods.} } } \item{}{ \code{mad(x, center = median(x), constant = 1.4826, na.rm = FALSE, low = FALSE, high = FALSE)}: Calculates the median absolute deviation of \code{x}. \describe{ \item{\code{center}}{The center to calculate the deviation from.} \item{\code{constant}}{The scale factor.} \item{\code{na.rm}}{If \code{TRUE}, removes \code{NA}s from \code{x} before the mad is computed.} \item{\code{low}}{If \code{TRUE}, compute the 'lo-median'.} \item{\code{high}}{If \code{TRUE}, compute the 'hi-median'.} } } \item{}{ \code{IQR(x, na.rm = FALSE)}: Calculates the interquartile range of \code{x}. \describe{ \item{\code{na.rm}}{If \code{TRUE}, removes \code{NA}s from \code{x} before the IQR is computed.} } } \item{}{ \code{smoothEnds(y, k = 3)}: Smooth end points of an Rle \code{y} using subsequently smaller medians and Tukey's end point rule at the very end. \describe{ \item{\code{k}}{An integer indicating the width of largest median window; must be odd.} } } \item{}{ \code{runmean(x, k, endrule = c("drop", "constant"), na.rm = FALSE)}: Calculates the means for fixed width running windows across \code{x}. \describe{ \item{\code{k}}{An integer indicating the fixed width of the running window. Must be odd when \code{endrule == "constant"}.} \item{endrule}{A character string indicating how the values at the beginning and the end (of the data) should be treated. \describe{ \item{\code{"drop"}}{do not extend the running statistics to be the same length as the underlying vectors;} \item{\code{"constant"}}{copies running statistic to the first values and analogously for the last ones making the smoothed ends \emph{constant};} } } \item{\code{na.rm}}{A logical indicating if NA and NaN values should be removed.} } } \item{}{ \code{runmed(x, k, endrule = c("median", "keep", "drop", "constant"))}: Calculates the medians for fixed width running windows across \code{x}. \describe{ \item{\code{k}}{An integer indicating the fixed width of the running window. Must be odd when \code{endrule != "drop"}.} \item{endrule}{A character string indicating how the values at the beginning and the end (of the data) should be treated. \describe{ \item{\code{"keep"}}{keeps the first and last \eqn{k_2}{k2} values at both ends, where \eqn{k_2}{k2} is the half-bandwidth \code{k2 = k \%/\% 2}, i.e., \code{y[j] = x[j]} for \eqn{j \in \{1,\ldots,k_2; n-k_2+1,\ldots,n\}} \eqn{j = 1,..,k2 and (n-k2+1),..,n};} \item{\code{"constant"}}{copies the running statistic to the first values and analogously for the last ones making the smoothed ends \emph{constant};} \item{\code{"median"}}{the default, smooths the ends by using symmetrical medians of subsequently smaller bandwidth, but for the very first and last value where Tukey's robust end-point rule is applied, see \code{\link[stats]{smoothEnds}}.} } } } } \item{}{ \code{runsum(x, k, endrule = c("drop", "constant"), na.rm = FALSE)}: Calculates the sums for fixed width running windows across \code{x}. \describe{ \item{\code{k}}{An integer indicating the fixed width of the running window. Must be odd when \code{endrule == "constant"}.} \item{endrule}{A character string indicating how the values at the beginning and the end (of the data) should be treated. \describe{ \item{\code{"drop"}}{do not extend the running statistics to be the same length as the underlying vectors;} \item{\code{"constant"}}{copies running statistic to the first values and analogously for the last ones making the smoothed ends \emph{constant};} } } \item{\code{na.rm}}{A logical indicating if NA and NaN values should be removed.} } } \item{}{ \code{runwtsum(x, k, wt, endrule = c("drop", "constant"), na.rm = FALSE)}: Calculates the sums for fixed width running windows across \code{x}. \describe{ \item{\code{k}}{An integer indicating the fixed width of the running window. Must be odd when \code{endrule == "constant"}.} \item{\code{wt}}{A numeric vector of length \code{k} that provides the weights to use.} \item{endrule}{A character string indicating how the values at the beginning and the end (of the data) should be treated. \describe{ \item{\code{"drop"}}{do not extend the running statistics to be the same length as the underlying vectors;} \item{\code{"constant"}}{copies running statistic to the first values and analogously for the last ones making the smoothed ends \emph{constant};} } } \item{\code{na.rm}}{A logical indicating if NA and NaN values should be removed.} } } \item{}{ \code{runq(x, k, i, endrule = c("drop", "constant"))}: Calculates the order statistic for fixed width running windows across \code{x}. \describe{ \item{\code{k}}{An integer indicating the fixed width of the running window. Must be odd when \code{endrule == "constant"}.} \item{\code{i}}{An integer indicating which order statistic to calculate.} \item{endrule}{A character string indicating how the values at the beginning and the end (of the data) should be treated. \describe{ \item{\code{"drop"}}{do not extend the running statistics to be the same length as the underlying vectors;} \item{\code{"constant"}}{copies running statistic to the first values and analogously for the last ones making the smoothed ends \emph{constant};} } } \item{\code{na.rm}}{A logical indicating if NA and NaN values should be removed.} } } } } \section{Character Data Methods}{ In the code snippets below, \code{x} is an Rle object: \describe{ \item{}{ \code{nchar(x, type = "chars", allowNA = FALSE)}: Returns an integer Rle representing the number of characters in the corresponding values of \code{x}. \describe{ \item{\code{type}}{One of \code{c("bytes", "chars", "width")}.} \item{\code{allowNA}}{Should \code{NA} be returned for invalid multibyte strings rather than throwing an error?} } } \item{}{ \code{substr(x, start, stop)}, \code{substring(text, first, last = 1000000L)}: Returns a character or factor Rle containing the specified substrings beginning at \code{start}/\code{first} and ending at \code{stop}/\code{last}. } \item{}{ \code{chartr(old, new, x)}: Returns a character or factor Rle containing a translated version of \code{x}. \describe{ \item{\code{old}}{A character string specifying the characters to be translated.} \item{\code{new}}{A character string specifying the translations.} } } \item{}{ \code{tolower(x)}: Returns a character or factor Rle containing a lower case version of \code{x}. } \item{}{ \code{toupper(x)}: Returns a character or factor Rle containing an upper case version of \code{x}. } \item{}{ \code{sub(pattern, replacement, x, ignore.case = FALSE, perl = FALSE, fixed = FALSE, useBytes = FALSE)}: Returns a character or factor Rle containing replacements based on matches determined by regular expression matching. See \code{\link{sub}} for a description of the arguments. } \item{}{ \code{gsub(pattern, replacement, x, ignore.case = FALSE, perl = FALSE, fixed = FALSE, useBytes = FALSE)}: Returns a character or factor Rle containing replacements based on matches determined by regular expression matching. See \code{\link{gsub}} for a description of the arguments. } \item{}{ \code{paste(..., sep = " ", collapse = NULL)}: Returns a character or factor Rle containing a concatenation of the values in \code{...}. } } } \section{Factor Data Methods}{ In the code snippets below, \code{x} is an Rle object: \describe{ \item{}{ \code{levels(x)}, \code{levels(x) <- value}: Gets and sets the factor levels, respectively. } \item{}{ \code{nlevels(x)}: Returns the number of factor levels. } } } \author{P. Aboyoun} \seealso{ \code{\link[base]{rle}}, \link{Vector-class}, \link[methods]{S4groupGeneric}, \link{IRanges-class} } \examples{ x <- Rle(10:1, 1:10) x runLength(x) runValue(x) nrun(x) diff(x) unique(x) sort(x) sqrt(x) x^2 + 2 * x + 1 x[c(1,3,5,7,9)] window(x, 4, 14) range(x) sum(x) mean(x) x > 4 aggregate(x, x > 4, mean) aggregate(x, FUN = mean, start = 1:(length(x) - 50), end = 51:length(x)) x2 <- Rle(LETTERS[c(21:26, 25:26)], 8:1) table(x2) y <- Rle(c(TRUE,TRUE,FALSE,FALSE,TRUE,FALSE,TRUE,TRUE,TRUE)) y as.vector(y) rep(y, 10) c(y, x > 5) z <- c("the", "quick", "red", "fox", "jumps", "over", "the", "lazy", "brown", "dog") z <- Rle(z, seq_len(length(z))) chartr("a", "@", z) toupper(z) ## --------------------------------------------------------------------- ## runsum, runmean, runwtsum, and runq functions ## --------------------------------------------------------------------- ## The .naive_runsum() function demonstrates the semantics of ## runsum(). This test ensures the behavior is consistent with ## base::sum(). .naive_runsum <- function(x, k, na.rm=FALSE) sapply(0:(length(x)-k), function(offset) sum(x[1:k + offset], na.rm=na.rm)) x0 <- c(1, Inf, 3, 4, 5, NA) x <- Rle(x0) target1 <- .naive_runsum(x0, 3, na.rm = TRUE) target2 <- .naive_runsum(x, 3, na.rm = TRUE) stopifnot(target1 == target2) current <- as.vector(runsum(x, 3, na.rm = TRUE)) stopifnot(target1 == current) ## runmean() and runwtsum() : x <- Rle(c(2, 1, NA, 0, 1, -Inf)) runmean(x, k = 3) runmean(x, k = 3, na.rm = TRUE) runwtsum(x, k = 3, wt = c(0.25, 0.50, 0.25)) runwtsum(x, k = 3, wt = c(0.25, 0.50, 0.25), na.rm = TRUE) ## runq() : runq(x, k = 3, i = 1, na.rm = TRUE) ## smallest value in window runq(x, k = 3, i = 3, na.rm = TRUE) ## largest value in window ## When na.rm = TRUE, it is possible the number of non-NA ## values in the window will be less than the 'i' specified. ## Here we request the 4th smallest value in the window, ## which tranlates to the value at the 4/5 (0.8) percentile. x <- Rle(c(1, 2, 3, 4, 5)) runq(x, k=length(x), i=4, na.rm=TRUE) ## The same request on a Rle with two missing values ## finds the value at the 0.8 percentile of the vector ## at the new length of 3 after the NA's have been removed. ## This translates to round((0.8) * 3). x <- Rle(c(1, 2, 3, NA, NA)) runq(x, k=length(x), i=4, na.rm=TRUE) } \keyword{methods} \keyword{classes} IRanges/man/RleViews-class.Rd0000644000126300012640000000277212227064476017414 0ustar00biocbuildphs_compbio\name{RleViews-class} \docType{class} % Classes: \alias{class:RleViews} \alias{RleViews-class} \alias{RleViews} % Constructors: \alias{Views,Rle-method} % Methods: \alias{show,RleViews-method} % coercion \alias{coerce,AtomicList,RleViews-method} \title{The RleViews class} \description{ The RleViews class is the basic container for storing a set of views (start/end locations) on the same Rle object. } \details{ An RleViews object contains a set of views (start/end locations) on the same \link{Rle} object called "the subject vector" or simply "the subject". Each view is defined by its start and end locations: both are integers such that start <= end. An RleViews object is in fact a particular case of a \link{Views} object (the RleViews class contains the \link{Views} class) so it can be manipulated in a similar manner: see \code{?\link{Views}} for more information. Note that two views can overlap and that a view can be "out of limits" i.e. it can start before the first element of the subject or/and end after its last element. } \author{P. Aboyoun} \seealso{ \link{Views-class}, \link{Rle-class}, \link{view-summarization-methods} } \examples{ subject <- Rle(rep(c(3L, 2L, 18L, 0L), c(3,2,1,5))) myViews <- Views(subject, 3:0, 5:8) myViews subject(myViews) length(myViews) start(myViews) end(myViews) width(myViews) myViews[[2]] set.seed(0) vec <- Rle(sample(0:2, 20, replace = TRUE)) vec Views(vec, vec > 0) } \keyword{methods} \keyword{classes} IRanges/man/RleViewsList-class.Rd0000644000126300012640000000562612227064476020251 0ustar00biocbuildphs_compbio\name{RleViewsList-class} \docType{class} \alias{RleViewsList-class} \alias{SimpleRleViewsList-class} % accessor \alias{subject,SimpleRleViewsList-method} % constructor \alias{Views,RleList-method} \alias{RleViewsList} % coercion \alias{coerce,RleViewsList,IRangesList-method} \alias{coerce,RleViewsList,CompressedIRangesList-method} \alias{coerce,RleViewsList,SimpleIRangesList-method} \title{List of RleViews} \description{An extension of \linkS4class{ViewsList} that holds only \linkS4class{RleViews} objects. Useful for storing coverage vectors over a set of spaces (e.g. chromosomes), each of which requires a separate \linkS4class{RleViews} object. } \details{ For more information on methods available for RleViewsList objects consult the man pages for \link{ViewsList-class} and \link{view-summarization-methods}. } \section{Constructor}{ \describe{ \item{}{\code{RleViewsList(..., rleList, rangesList, universe = NULL)}: Either \code{...} or the \code{rleList}/\code{rangesList} couplet provide the RleViews for the list. If \code{...} is provided, each of these arguments must be RleViews objects. Alternatively, \code{rleList} and \code{rangesList} accept Rle and Ranges objects respectively that are meshed together for form the RleViewsList. The universe is specified by the \code{universe} parameter, which should be a single string or NULL, to leave unspecified. } \item{}{\code{Views(subject, start=NULL, end=NULL, width=NULL, names=NULL)}: Same as \code{RleViewsList(rleList = subject, rangesList = start)}. } } } \section{Coercion}{ In the code snippets below, \code{from} is an RleViewsList object: \describe{ \item{}{ \code{as(from, "IRangesList")}: Creates a \code{CompressedIRangesList} object containing the view locations in \code{from}. } \item{}{ \code{as(from, "CompressedIRangesList")}: Creates a \code{CompressedIRangesList} object containing the view locations in \code{from}. } \item{}{ \code{as(from, "SimpleIRangesList")}: Creates a \code{SimpleIRangesList} object containing the view locations in \code{from}. } } } \author{P. Aboyoun} \seealso{ \link{ViewsList-class}, \link{view-summarization-methods} } \examples{ ## Rle objects subject1 <- Rle(c(3L,2L,18L,0L), c(3,2,1,5)) set.seed(0) subject2 <- Rle(c(0L,5L,2L,0L,3L), c(8,5,2,7,4)) ## Views rleViews1 <- Views(subject1, 3:0, 5:8) rleViews2 <- Views(subject2, subject2 > 0) ## RleList and RangesList objects rleList <- RleList(subject1, subject2) rangesList <- IRangesList(IRanges(3:0, 5:8), IRanges(subject2 > 0)) ## methods for construction method1 <- RleViewsList(rleViews1, rleViews2) method2 <- RleViewsList(rleList = rleList, rangesList = rangesList) identical(method1, method2) ## calculation over the views viewSums(method1) } \keyword{methods} \keyword{classes} IRanges/man/SimpleList-class.Rd0000644000126300012640000001055112227064476017733 0ustar00biocbuildphs_compbio\name{SimpleList-class} \docType{class} \alias{SimpleList} \alias{SimpleList-class} \alias{CompressedList} \alias{CompressedList-class} % accessors \alias{isEmpty,CompressedList-method} \alias{isEmpty,SimpleList-method} \alias{length,CompressedList-method} \alias{length,SimpleList-method} \alias{names,CompressedList-method} \alias{names,SimpleList-method} \alias{names<-,CompressedList-method} \alias{names<-,SimpleList-method} % subsetting \alias{[,CompressedList-method} \alias{[,SimpleList-method} \alias{[[<-,CompressedList-method} \alias{[[<-,SimpleList-method} \alias{$<-,CompressedList-method} \alias{$<-,SimpleList-method} % splitting and combining \alias{c,CompressedList-method} \alias{c,SimpleList-method} % looping \alias{aggregate,CompressedList-method} \alias{aggregate,SimpleList-method} \alias{endoapply,CompressedList-method} \alias{endoapply,SimpleList-method} \alias{lapply,CompressedList-method} \alias{lapply,SimpleList-method} \alias{mendoapply,CompressedList-method} \alias{mendoapply,SimpleList-method} \alias{revElements,CompressedList-method} % coercion \alias{as.list,CompressedList-method} \alias{as.list.CompressedList} \alias{as.list,SimpleList-method} \alias{as.list.SimpleList} \alias{unlist,CompressedList-method} \alias{coerce,ANY,SimpleList-method} \title{Simple and Compressed List Classes} \description{The (non-virtual) SimpleList and (virtual) CompressedList classes extend the \linkS4class{List} virtual class.} \details{ The SimpleList and CompressedList classes provide an implementation that subclasses can easily extend. The underlying storage in a SimpleList subclass is a list object. The underlying storage in a CompressedList object is a virtually partitioned vector-like object. For more information on the available methods, see the \linkS4class{List} man page. } \section{Constructor}{ \code{List} objects are typically constructed by calling the constructor of a concrete implementation, such as \code{\link{RangesList}} or \code{\link{IntegerList}}. The simplest, most generic implementation is \code{SimpleList}, which has the following constructor: \describe{ \item{}{\code{SimpleList(...)}: takes possibly named objects as elements for the new SimpleList object. } } Calling \code{as(x, "List")} will convert a vector-like object into a \code{List}, usually a \code{CompressedList}. To explicitly request a \code{SimpleList} derivative, call \code{as(x, "SimpleList")} } \section{Coercion}{ In the following code snippets, \code{x} is a SimpleList or CompressedList object. \describe{ \item{}{\code{as.list(x)}: Copies the elements of \code{x} into a new R list object. } \item{}{\code{unlist(x, recursive = TRUE, use.names = TRUE)}: Concatenates the elements of \code{x} into a single \code{elementType(x)} object. } } } \section{Subsetting}{ In the following code snippets, \code{x} is a SimpleList or CompressedList object. \describe{ \item{}{ \code{x[i]}: In addition to normal usage, the \code{i} parameter can be a \code{RangesList}, logical \code{RleList}, \code{LogicalList}, or \code{IntegerList} object to perform subsetting within the list elements rather than across them. } \item{}{ \code{x[i] <- value}: In addition to normal usage, the \code{i} parameter can be a \code{RangesList}, logical \code{RleList}, \code{LogicalList}, or \code{IntegerList} object to perform subsetting within the list elements rather than across them. } } } \section{Looping}{ In the following code snippets, \code{x} is a SimpleList or CompressedList object. \describe{ \item{}{ \code{aggregate(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE))}: In addition to normal usage, the \code{by} parameter can be a \code{RangesList} to aggregate within the list elements rather than across them. When \code{by} is a \code{RangesList}, the output is either a \code{SimpleAtomicList} object, if possible, or a \code{SimpleList} object, if not. } } } \author{P. Aboyoun} \seealso{\linkS4class{List}, \linkS4class{AtomicList} and \linkS4class{RangesList} for example implementations} \examples{ SimpleList(a = letters, ranges = IRanges(1:10, 1:10)) } \keyword{methods} \keyword{classes} IRanges/man/Vector-class.Rd0000644000126300012640000003274012227064476017114 0ustar00biocbuildphs_compbio\name{Vector-class} \docType{class} % Vector class, functions and methods: \alias{class:Vector} \alias{Vector-class} \alias{Vector} \alias{showAsCell} \alias{showAsCell,ANY-method} \alias{showAsCell,list-method} \alias{showAsCell,Vector-method} \alias{NROW,Vector-method} \alias{elementMetadata} \alias{elementMetadata,Vector-method} \alias{mcols} \alias{mcols,Vector-method} \alias{values} \alias{values,Vector-method} \alias{elementMetadata<-} \alias{elementMetadata<-,Vector-method} \alias{mcols<-} \alias{mcols<-,Vector-method} \alias{values<-} \alias{values<-,Vector-method} \alias{[,Vector-method} \alias{[<-,Vector-method} \alias{window,Vector-method} \alias{window.Vector} \alias{window,vector-method} \alias{window.vector} \alias{window,factor-method} \alias{window.factor} \alias{window,NULL-method} \alias{window.NULL} \alias{window<-,Vector-method} \alias{window<-.Vector} \alias{window<-,vector-method} \alias{window<-.vector} \alias{window<-,factor-method} \alias{window<-.factor} \alias{seqselect} \alias{seqselect,ANY-method} \alias{seqselect<-} \alias{seqselect<-,ANY-method} \alias{head,Vector-method} \alias{head.Vector} \alias{tail,Vector-method} \alias{tail.Vector} \alias{rev,Vector-method} \alias{rep,Vector-method} \alias{rep.int,Vector-method} \alias{subset,Vector-method} \alias{c,Vector-method} \alias{append,Vector,Vector-method} \alias{split,Vector,Vector-method} \alias{split,ANY,Vector-method} \alias{split,Vector,ANY-method} \alias{split,list,Vector-method} \alias{mstack} \alias{mstack,Vector-method} \alias{mstack,vector-method} \alias{split<-,Vector-method} \alias{relist,Vector,list-method} \alias{tapply,ANY,Vector-method} \alias{tapply,Vector,ANY-method} \alias{tapply,Vector,Vector-method} \alias{shiftApply} \alias{shiftApply,Vector,Vector-method} \alias{shiftApply,vector,vector-method} \alias{aggregate,Vector-method} \alias{aggregate,vector-method} \alias{aggregate,matrix-method} \alias{aggregate,data.frame-method} \alias{aggregate,ts-method} \alias{rename} \alias{rename,Vector-method} \alias{rename,vector-method} \alias{as.logical,Vector-method} \alias{as.integer,Vector-method} \alias{as.numeric,Vector-method} \alias{as.double,Vector-method} \alias{as.complex,Vector-method} \alias{as.character,Vector-method} \alias{as.raw,Vector-method} \alias{coerce,Vector,vector-method} \alias{coerce,Vector,logical-method} \alias{coerce,Vector,integer-method} \alias{coerce,Vector,numeric-method} \alias{coerce,Vector,double-method} \alias{coerce,Vector,complex-method} \alias{coerce,Vector,character-method} \alias{coerce,Vector,raw-method} \alias{coerce,Vector,data.frame-method} \alias{as.data.frame.Vector} \alias{as.data.frame,Vector-method} \title{Vector objects} \description{ The Vector virtual class serves as the heart of the IRanges package and has over 90 subclasses. It serves a similar role as \link[base]{vector} in base R. The Vector class supports the storage of \emph{global} and \emph{element-wise} metadata: \enumerate{ \item The \emph{global} metadata annotates the object as a whole: this metadata is accessed via the \code{metadata} accessor and is represented as an ordinary list; \item The \emph{element-wise} metadata annotates individual elements of the object: this metadata is accessed via the \code{mcols} accessor (\code{mcols} stands for \emph{metadata columns}) and is represented as a \link{DataTable} object (i.e. as an instance of a concrete subclass of \link{DataTable}, e.g. a \link{DataFrame} object), with a row for each element and a column for each metadata variable. Note that the element-wise metadata can also be \code{NULL}. } To be functional, a class that inherits from Vector must define at least a \code{length}, \code{names} and \code{"["} method. } \section{Accessors}{ In the following code snippets, \code{x} is a Vector object. \describe{ \item{}{ \code{length(x)}: Get the number of elements in \code{x}. } \item{}{ \code{NROW(x)}: Defined as \code{length(x)} for any Vector object that is \emph{not} a \linkS4class{DataTable} object. If \code{x} is a \linkS4class{DataTable} object, then it's defined as \code{nrow(x)}. } \item{}{ \code{names(x)}, \code{names(x) <- value}: Get or set the names of the elements in the Vector. } \item{}{ \code{rename(x, value, ...)}: Replace the names of \code{x} according to a mapping defined by a named character vector, formed by concatenating \code{value} with any arguments in \code{...}. The names of the character vector indicate the source names, and the corresponding values the destination names. This also works on a plain old \code{vector}. } \item{}{ \code{nlevels(x)}: Returns the number of factor levels. } \item{}{ \code{mcols(x, use.names=FALSE)}, \code{mcols(x) <- value}: Get or set the metadata columns. If \code{use.names=TRUE} and the metadata columns are not \code{NULL}, then the names of \code{x} are propagated as the row names of the returned \link{DataTable} object. When setting the metadata columns, the supplied value must be \code{NULL} or a \link{DataTable} object holding element-wise metadata. } \item{}{ \code{elementMetadata(x, use.names=FALSE)}, \code{elementMetadata(x) <- value}, \code{values(x, use.names=FALSE)}, \code{values(x) <- value}: Alternatives to \code{mcols} functions. Their use is discouraged. } } } \section{Subsetting}{ In the code snippets below, \code{x} is a Vector object or regular R vector object. The R vector object methods for \code{window} are defined in this package and the remaining methods are defined in base R. \describe{ \item{}{ \code{x[i, drop=TRUE]}: If defined, returns a new Vector object made of selected elements \code{i}, which can be missing; an NA-free logical, numeric, or character vector; or a logical Rle object. The \code{drop} argument specifies whether or not to coerce the returned sequence to a standard vector. } \item{}{ \code{x[i] <- value}: Replacement version of \code{x[i]}. } \item{}{ \code{window(x, start=NA, end=NA, width=NA, frequency=NULL, delta=NULL, ...)}: Extract the subsequence window from the Vector object using: \describe{ \item{\code{start}, \code{end}, \code{width}}{The start, end, or width of the window. Two of the three are required.} \item{\code{frequency}, \code{delta}}{Optional arguments that specify the sampling frequency and increment within the window.} } In general, this is more efficient than using \code{"["} operator. } \item{}{ \code{window(x, start=NA, end=NA, width=NA) <- value}: Replace the subsequence window specified on the left (i.e. the subsequence in \code{x} specified by \code{start}, \code{end} and \code{width}) by \code{value}. \code{value} must either be of class \code{class(x)}, belong to a subclass of \code{class(x)}, or be coercible to \code{class(x)} or a subclass of \code{class(x)}. The elements of \code{value} are repeated to create a Vector with the same number of elements as the width of the subsequence window it is replacing. } \item{}{ \code{split(x, f, drop = FALSE) <- value}: Virtually splits \code{x} by the factor \code{f}, replaces the elements of the resulting list with the elements from the list \code{value}, and restores \code{x} to its original form. Note that this works for any \code{Vector}, even though \code{split} itself is not universally supported. } \item{}{ \code{head(x, n = 6L)}: If \code{n} is non-negative, returns the first n elements of the Vector object. If \code{n} is negative, returns all but the last \code{abs(n)} elements of the Vector object. } \item{}{ \code{tail(x, n = 6L)}: If \code{n} is non-negative, returns the last n elements of the Vector object. If \code{n} is negative, returns all but the first \code{abs(n)} elements of the Vector object. } \item{}{ \code{rev(x)}: Return a new Vector object made of the original elements in the reverse order. } \item{}{ \code{rep(x, times, length.out, each)}, \code{rep.int(x, times)}: Repeats the values in \code{x} through one of the following conventions: \describe{ \item{\code{times}}{Vector giving the number of times to repeat each element if of length \code{length(x)}, or to repeat the whole vector if of length 1.} \item{\code{length.out}}{Non-negative integer. The desired length of the output vector.} \item{\code{each}}{Non-negative integer. Each element of \code{x} is repeated \code{each} times.} } } \item{}{ \code{subset(x, subset)}: Return a new Vector object made of the subset using logical vector \code{subset}, where missing values are taken as FALSE. } } } \section{Combining}{ In the code snippets below, \code{x} is a Vector object. \describe{ \item{}{ \code{c(x, ...)}: Combine \code{x} and the Vector objects in \code{...} together. Any object in \code{...} must belong to the same class as \code{x}, or to one of its subclasses, or must be \code{NULL}. The result is an object of the same class as \code{x}. } \item{}{\code{append(x, values, after = length(x))}: Insert the \code{Vector} \code{values} onto \code{x} at the position given by \code{after}. \code{values} must have an \code{elementType} that extends that of \code{x}. } \item{}{\code{mstack(..., .index.var = "name")}: A variant of \code{\link{stack}}, where the list is taken as the list of arguments in \code{...}, each of which should be a \code{Vector} or \code{vector} (mixing the two will not work). } } } \section{Looping}{ In the code snippets below, \code{x} is a Vector object. \describe{ \item{}{ \code{tapply(X, INDEX, FUN = NULL, ..., simplify = TRUE)}: Like the standard \code{\link[base]{tapply}} function defined in the base package, the \code{tapply} method for Vector objects applies a function to each cell of a ragged array, that is to each (non-empty) group of values given by a unique combination of the levels of certain factors. } \item{}{ \code{shiftApply(SHIFT, X, Y, FUN, ..., OFFSET = 0L, simplify = TRUE, verbose = FALSE)}: Let \code{i} be the indices in \code{SHIFT}, \code{X_i = window(X, 1 + OFFSET, length(X) - SHIFT[i])}, and \code{Y_i = window(Y, 1 + SHIFT[i], length(Y) - OFFSET)}. Calculates the set of \code{FUN(X_i, Y_i, ...)} values and return the results in a convenient form: \describe{ \item{\code{SHIFT}}{A non-negative integer vector of shift values.} \item{\code{X}, \code{Y}}{The Vector or R vector objects to shift.} \item{\code{FUN}}{The function, found via \code{match.fun}, to be applied to each set of shifted vectors.} \item{\dots}{Further arguments for \code{FUN}.} \item{OFFSET}{A non-negative integer offset to maintain throughout the shift operations.} \item{\code{simplify}}{A logical value specifying whether or not the result should be simplified to a vector or matrix if possible.} \item{\code{verbose}}{A logical value specifying whether or not to print the \code{i} indices to track the iterations.} } } \item{}{ \code{aggregate(x, by, FUN, start = NULL, end = NULL, width = NULL, frequency = NULL, delta = NULL, ..., simplify = TRUE))}: Generates summaries on the specified windows and returns the result in a convenient form: \describe{ \item{\code{by}}{An object with \code{start}, \code{end}, and \code{width} methods.} \item{\code{FUN}}{The function, found via \code{match.fun}, to be applied to each window of \code{x}.} \item{\code{start}, \code{end}, \code{width}}{the start, end, or width of the window. If \code{by} is missing, then must supply two of the three.} \item{\code{frequency}, \code{delta}}{Optional arguments that specify the sampling frequency and increment within the window.} \item{\dots}{Further arguments for \code{FUN}.} \item{\code{simplify}}{A logical value specifying whether or not the result should be simplified to a vector or matrix if possible.} } } } } \section{Coercion}{ \describe{ \item{}{\code{as(from, "data.frame")}, \code{as.data.frame(from)}: Coerces \code{from}, a \code{Vector}, to a \code{data.frame} by first coercing the \code{Vector} to a \code{vector} via \code{as.vector}. Note that many \code{Vector} derivatives do not support \code{as.vector}, so this coercion is possible only for certain types. } } } \author{P. Aboyoun} \seealso{ \link{Rle} and \link[XVector]{XRaw} for example implementations. \link{List} for a direct extension that serves a similar role as \link[base]{list} in base R. \link{DataTable} which is the type of objects returned by the \code{mcols} accessor. \link{Annotated} which Vector extends. } \examples{ showClass("Vector") # shows (some of) the known subclasses } \keyword{methods} \keyword{classes} IRanges/man/Vector-comparison.Rd0000644000126300012640000003142512227064476020160 0ustar00biocbuildphs_compbio\name{Vector-comparison} \alias{Vector-comparison} \alias{compare} \alias{==,Vector,Vector-method} \alias{==,Vector,ANY-method} \alias{==,ANY,Vector-method} \alias{<=,Vector,Vector-method} \alias{<=,Vector,ANY-method} \alias{<=,ANY,Vector-method} \alias{!=,Vector,Vector-method} \alias{!=,Vector,ANY-method} \alias{!=,ANY,Vector-method} \alias{>=,Vector,Vector-method} \alias{>=,Vector,ANY-method} \alias{>=,ANY,Vector-method} \alias{<,Vector,Vector-method} \alias{<,Vector,ANY-method} \alias{<,ANY,Vector-method} \alias{>,Vector,Vector-method} \alias{>,Vector,ANY-method} \alias{>,ANY,Vector-method} \alias{selfmatch} \alias{selfmatch,ANY-method} \alias{duplicated,Vector-method} \alias{duplicated.Vector} \alias{unique,Vector-method} \alias{unique.Vector} \alias{\%in\%,Vector,Vector-method} \alias{\%in\%,Vector,ANY-method} \alias{\%in\%,ANY,Vector-method} \alias{findMatches} \alias{findMatches,ANY,ANY-method} \alias{countMatches} \alias{countMatches,ANY,ANY-method} \alias{sort,Vector-method} \alias{sort.Vector} \alias{table,Vector-method} \title{Compare, order, tabulate vector-like objects} \description{ Generic functions and methods for comparing, ordering, and tabulating vector-like objects. } \usage{ ## Element-wise (aka "parallel") comparison of 2 Vector objects ## ------------------------------------------------------------ compare(x, y) \S4method{==}{Vector,Vector}(e1, e2) \S4method{==}{Vector,ANY}(e1, e2) \S4method{==}{ANY,Vector}(e1, e2) \S4method{<=}{Vector,Vector}(e1, e2) \S4method{<=}{Vector,ANY}(e1, e2) \S4method{<=}{ANY,Vector}(e1, e2) \S4method{!=}{Vector,Vector}(e1, e2) \S4method{!=}{Vector,ANY}(e1, e2) \S4method{!=}{ANY,Vector}(e1, e2) \S4method{>=}{Vector,Vector}(e1, e2) \S4method{>=}{Vector,ANY}(e1, e2) \S4method{>=}{ANY,Vector}(e1, e2) \S4method{<}{Vector,Vector}(e1, e2) \S4method{<}{Vector,ANY}(e1, e2) \S4method{<}{ANY,Vector}(e1, e2) \S4method{>}{Vector,Vector}(e1, e2) \S4method{>}{Vector,ANY}(e1, e2) \S4method{>}{ANY,Vector}(e1, e2) ## selfmatch() ## ----------- selfmatch(x, ...) ## duplicated() & unique() ## ----------------------- \S4method{duplicated}{Vector}(x, incomparables=FALSE, ...) \S4method{unique}{Vector}(x, incomparables=FALSE, ...) ## %in% ## ---- \S4method{\%in\%}{Vector,Vector}(x, table) \S4method{\%in\%}{Vector,ANY}(x, table) \S4method{\%in\%}{ANY,Vector}(x, table) ## findMatches() & countMatches() ## ------------------------------ findMatches(x, table, select=c("all", "first", "last"), ...) countMatches(x, table, ...) ## sort() ## ------ \S4method{sort}{Vector}(x, decreasing=FALSE, ...) ## table() ## ------- \S4method{table}{Vector}(...) } \arguments{ \item{x, y, e1, e2, table}{ Vector-like objects. } \item{incomparables}{ The \code{duplicated} method for \link{Vector} objects does NOT support this argument. The \code{unique} method for \link{Vector} objects, which is implemented on top of \code{duplicated}, propagates this argument to its call to \code{duplicated}. See \code{?base::\link[base]{duplicated}} and \code{?base::\link[base]{unique}} for more information about this argument. } \item{select}{ Only \code{select="all"} is supported at the moment. Note that you can use \code{match} if you want to do \code{select="first"}. Otherwise you're welcome to request this on the Bioconductor mailing list. } \item{decreasing}{ See \code{?base::\link[base]{sort}}. } \item{...}{ A \link{Vector} object for \code{table} (the \code{table} method for \link{Vector} objects currently only supports one argument). Otherwise, extra arguments supported by specific methods. In particular: \itemize{ \item The default \code{selfmatch} method, which is implemented on top of \code{match}, propagates the extra arguments to its call to \code{match}. \item The \code{duplicated} method for \link{Vector} objects, which is implemented on top of \code{selfmatch}, accepts extra argument \code{fromLast} and propagates the other extra arguments to its call to \code{selfmatch}. See \code{?base::\link[base]{duplicated}} for more information about this argument. \item The \code{unique} method for \link{Vector} objects, which is implemented on top of \code{duplicated}, propagates the extra arguments to its call to \code{duplicated}. \item The default \code{findMatches} and \code{countMatches} methods, which are implemented on top of \code{match} and \code{selfmatch}, propagate the extra arguments to their calls to \code{match} and \code{selfmatch}. \item The \code{sort} method for \link{Vector} objects, which is implemented on top of \code{order}, only accepts extra argument \code{na.last} and propagates it to its call to \code{order}. } } } \details{ Doing \code{compare(x, y)} on 2 vector-like objects \code{x} and \code{y} of length 1 must return an integer less than, equal to, or greater than zero if the single element in \code{x} is considered to be respectively less than, equal to, or greater than the single element in \code{y}. If \code{x} or \code{y} have a length != 1, then they are typically expected to have the same length so \code{compare(x, y)} can operate element-wise, that is, in that case it returns an integer vector of the same length as \code{x} and \code{y} where the i-th element is the result of compairing \code{x[i]} and \code{y[i]}. If \code{x} and \code{y} don't have the same length and are not zero-length vectors, then the shortest is first recycled to the length of the longest. If one of them is a zero-length vector then \code{compare(x, y)} returns a zero-length integer vector. \code{selfmatch(x, ...)} is equivalent to \code{match(x, x, ...)}. This is actually how the default method is implemented. However note that \code{selfmatch(x, ...)} will typically be more efficient than \code{match(x, x, ...)} on vector-like objects for which a specific \code{selfmatch} method is implemented. \code{findMatches} is an enhanced version of \code{match} which, by default (i.e. if \code{select="all"}), returns all the matches in a \link{Hits} object. \code{countMatches} returns an integer vector of the length of \code{x} containing the number of matches in \code{table} for each element in \code{x}. } \value{ For \code{compare}: see Details section above. For \code{selfmatch}: an integer vector of the same length as \code{x}. For \code{duplicated}, \code{unique}, and \code{\%in\%}: see \code{?BiocGenerics::\link[BiocGenerics]{duplicated}}, \code{?BiocGenerics::\link[BiocGenerics]{unique}}, and \code{?`\link{\%in\%}`}. For \code{findMatches}: a \link{Hits} object by default (i.e. if \code{select="all"}). For \code{countMatches}: an integer vector of the length of \code{x} containing the number of matches in \code{table} for each element in \code{x}. For \code{sort}: see \code{?BiocGenerics::\link[BiocGenerics]{sort}}. For \code{table}: a 1D array of integer values promoted to the \code{"table"} class. See \code{?BiocGeneric::\link[BiocGenerics]{table}} for more information. } \note{ The following notes are for developpers who want to implement a \link{Vector} subclass: \enumerate{ \item The 6 traditional binary comparison operators are: \code{==}, \code{!=}, \code{<=}, \code{>=}, \code{<}, and \code{>}. The \pkg{IRanges} package defines methods for each of these operators and for \link{Vector} objects as follow: \preformatted{ setMethod("==", c("Vector", "Vector"), function(e1, e2) { compare(e1, e2) == 0L } ) setMethod("<=", c("Vector", "Vector"), function(e1, e2) { compare(e1, e2) <= 0L } ) setMethod("!=", c("Vector", "Vector"), function(e1, e2) { !(e1 == e2) } ) setMethod(">=", c("Vector", "Vector"), function(e1, e2) { e2 <= e1 } ) setMethod("<", c("Vector", "Vector"), function(e1, e2) { !(e2 <= e1) } ) setMethod(">", c("Vector", "Vector"), function(e1, e2) { !(e1 <= e2) } ) } With these definitions, the 6 binary operators work out-of-the-box on \link{Vector} objects for which \code{compare} works the expected way. If \code{compare} is not implemented, then it's enough to implement \code{==} and \code{<=} methods to have the 4 remaining operators (\code{!=}, \code{>=}, \code{<}, and \code{>}) work out-of-the-box. \item No \code{compare} method is actually implemented for the \link{Vector} class. Specific \code{compare} methods need to be implemented for specific \link{Vector} subclasses (e.g. for \link{Ranges} objects). These specific methods must obey the rules described in the Details section above. \item The \code{duplicated}, \code{unique}, and \code{\%in\%} methods for \link{Vector} objects are implemented on top of \code{selfmatch}, \code{duplicated}, and \code{match}, respectively, so they work out-of-the-box on \link{Vector} objects for which \code{selfmatch}, \code{duplicated}, and \code{match} work the expected way. \item Also the default \code{findMatches} and \code{countMatches} methods are implemented on top of \code{match} and \code{selfmatch} so they work out-of-the-box on \link{Vector} objects for which those things work the expected way. \item However, since \code{selfmatch} itself is also implemented on top of \code{match}, then having \code{match} work the expected way is actually enough to get \code{selfmatch}, \code{duplicated}, \code{unique}, \code{\%in\%}, \code{findMatches}, and \code{countMatches} work out-of-the-box on \link{Vector} objects. \item The \code{sort} method for \link{Vector} objects is implemented on top of \code{order}, so it works out-of-the-box on \link{Vector} objects for which \code{order} works the expected way. \item The \code{table} method for \link{Vector} objects is implemented on top of \code{selfmatch}, \code{order}, and \code{as.character}, so it works out-of-the-box on a \link{Vector} object for which those things work the expected way. \item No \code{match} or \code{order} method is actually implemented for the \link{Vector} class. Specific methods need to be implemented for specific \link{Vector} subclasses (e.g. for \link{Ranges} objects). } } \author{H. Pages} \seealso{ \itemize{ \item The \link{Vector} class. \item \link{Ranges-comparison} for comparing and ordering ranges. \item \code{\link{==}} and \code{\link{\%in\%}} in the \pkg{base} package, and \code{BiocGenerics::\link[BiocGenerics]{match}}, \code{BiocGenerics::\link[BiocGenerics]{duplicated}}, \code{BiocGenerics::\link[BiocGenerics]{unique}}, \code{BiocGenerics::\link[BiocGenerics]{order}}, \code{BiocGenerics::\link[BiocGenerics]{sort}}, \code{BiocGenerics::\link[BiocGenerics]{rank}} in the \pkg{BiocGenerics} package for general information about the comparison/ordering operators and functions. \item The \link{Hits} class. \item \code{BiocGeneric::\link[BiocGenerics]{table}} in the \pkg{BiocGenerics} package. } } \examples{ ## --------------------------------------------------------------------- ## A. SIMPLE EXAMPLES ## --------------------------------------------------------------------- y <- c(16L, -3L, -2L, 15L, 15L, 0L, 8L, 15L, -2L) selfmatch(y) x <- c(unique(y), 999L) findMatches(x, y) countMatches(x, y) ## See ?`Ranges-comparison` for more examples (using Ranges objects). ## --------------------------------------------------------------------- ## B. FOR DEVELOPPERS: HOW TO IMPLEMENT THE BINARY COMPARISON OPERATORS ## FOR YOUR Vector SUBCLASS ## --------------------------------------------------------------------- ## The answer is: don't implement them. Just implement compare() and the ## binary comparison operators will work out-of-the-box. Here is an ## example: ## (1) Implement a simple Vector subclass. setClass("Raw", contains="Vector", representation(data="raw")) setMethod("length", "Raw", function(x) length(x@data)) setMethod("[", "Raw", function(x, i, j, ..., drop) { x@data <- x@data[i]; x } ) x <- new("Raw", data=charToRaw("AB.x0a-BAA+C")) stopifnot(identical(length(x), 12L)) stopifnot(identical(x[7:3], new("Raw", data=charToRaw("-a0x.")))) ## (2) Implement a "compare" method for Raw objects. setMethod("compare", c("Raw", "Raw"), function(x, y) {as.integer(x@data) - as.integer(y@data)} ) stopifnot(identical(which(x == x[1]), c(1L, 9L, 10L))) stopifnot(identical(x[x < x[5]], new("Raw", data=charToRaw(".-+")))) } \keyword{methods} IRanges/man/Views-class.Rd0000644000126300012640000001252212227064476016743 0ustar00biocbuildphs_compbio\name{Views-class} \docType{class} \alias{class:Views} \alias{Views-class} \alias{subject} \alias{subject,Views-method} \alias{ranges} \alias{ranges,Views-method} \alias{ranges<-} \alias{ranges<-,Views-method} \alias{length,Views-method} \alias{start,Views-method} \alias{end,Views-method} \alias{width,Views-method} \alias{names,Views-method} \alias{start<-,Views-method} \alias{end<-,Views-method} \alias{width<-,Views-method} \alias{names<-,Views-method} \alias{elementLengths,Views-method} \alias{newViews} \alias{Views} \alias{coerce,Vector,Views-method} \alias{coerce,Views,Ranges-method} \alias{coerce,Views,IRanges-method} \alias{coerce,Views,NormalIRanges-method} \alias{as.matrix,Views-method} \alias{c,Views-method} \alias{trim} \alias{trim,Views-method} \alias{subviews} \alias{subviews,Views-method} \alias{successiveViews} \title{Views objects} \description{ The Views virtual class is a general container for storing a set of views on an arbitrary \link{Vector} object, called the "subject". Its primary purpose is to introduce concepts and provide some facilities that can be shared by the concrete classes that derive from it. Some direct subclasses of the Views class are: \link{RleViews}, \link[XVector]{XIntegerViews} (defined in the XVector package), \link[Biostrings]{XStringViews} (defined in the Biostrings package), etc... } \section{Constructor}{ \describe{ \item{}{ \code{Views(subject, start=NULL, end=NULL, width=NULL, names=NULL)}: This constructor is a generic function with dispatch on argument \code{subject}. Specific methods must be defined for the subclasses of the Views class. For example a method for \link[Biostrings:XString-class]{XString} subjects is defined in the Biostrings package that returns an \link[Biostrings:XStringViews-class]{XStringViews} object. There is no default method. The treatment of the \code{start}, \code{end} and \code{width} arguments is the same as with the \code{\link{IRanges}} constructor, except that, in addition, \code{Views} allows \code{start} to be a \link{Ranges} object. With this feature, \code{Views(subject, IRanges(my_starts, my_ends, my_widths, my_names))} and \code{Views(subject, my_starts, my_ends, my_widths, my_names)} are equivalent (except when \code{my_starts} is itself a \link{Ranges} object). } } } \section{Coercion}{ In the code snippets below, \code{from} is a Views object: \describe{ \item{}{ \code{as(from, "IRanges")}: Creates an \code{IRanges} object containing the view locations in \code{from}. } } } \section{Accessor-like methods}{ All the accessor-like methods defined for \code{IRanges} objects work on Views objects. In addition, the following accessors are defined for Views objects: \describe{ \item{}{ \code{subject(x)}: Return the subject of the views. } } } \section{Subsetting}{ \describe{ \item{}{ \code{x[i]}: Select the views specified by \code{i}. } \item{}{ \code{x[[i]]}: Extracts the view selected by \code{i} as an object of the same class as \code{subject(x)}. Subscript \code{i} can be a single integer or a character string. The result is the subsequence of \code{subject(x)} defined by \code{window(subject(x), start=start(x)[i], end=end(x)[i])} or an error if the view is "out of limits" (i.e. \code{start(x)[i] < 1} or \code{end(x)[i] > length(subject(x))}). } } } \section{Combining}{ \describe{ \item{}{ \code{c(x, ..., ignore.mcols=FALSE)}: Combine \code{Views} objects. They must have the same subject. } } } \section{Other methods}{ \describe{ \item{}{ \code{trim(x, use.names=TRUE)}: Equivalent to \code{restrict(x, start=1L, end=length(subject(x)), keep.all.ranges=TRUE, use.names=use.names)}. } \item{}{ \code{subviews(x, start=NA, end=NA, width=NA, use.names=TRUE)}: \code{start}, \code{end}, and \code{width} arguments must be vectors of integers, eventually with NAs, that contain coordinates relative to the current ranges. Equivalent to \code{trim(narrow(x, start=start, end=end, width=width, use.names=use.names))}. } \item{}{ \code{successiveViews(subject, width, gapwidth=0, from=1)}: Equivalent to \code{Views(subject, successiveIRanges(width, gapwidth, from))}. See \code{?successiveIRanges} for a description of the \code{width}, \code{gapwidth} and \code{from} arguments. } } } \author{H. Pages} \seealso{ \link{IRanges-class}, \link{Vector-class}, \link{IRanges-utils}, \link[XVector]{XVector}. Some direct subclasses of the Views class: \link{RleViews-class}, \link[XVector]{XIntegerViews-class}, \link[XVector]{XDoubleViews-class}, \link[Biostrings]{XStringViews-class}. \code{\link{findOverlaps}}. } \examples{ showClass("Views") # shows (some of) the known subclasses ## Create a set of 4 views on an XInteger subject of length 10: subject <- Rle(3:-6) v1 <- Views(subject, start=4:1, end=4:7) ## Extract the 2nd view: v1[[2]] ## Some views can be "out of limits" v2 <- Views(subject, start=4:-1, end=6) trim(v2) subviews(v2, end=-2) ## See ?`XIntegerViews-class` in the XVector package for more examples. } \keyword{methods} \keyword{classes} IRanges/man/ViewsList-class.Rd0000644000126300012640000000267512227064476017607 0ustar00biocbuildphs_compbio\name{ViewsList-class} \docType{class} \alias{class:ViewsList} \alias{ViewsList-class} \alias{ViewsList} \alias{class:SimpleViewsList} \alias{SimpleViewsList-class} \alias{SimpleViewsList} % accessors \alias{ranges,SimpleViewsList-method} \alias{start,SimpleViewsList-method} \alias{end,SimpleViewsList-method} \alias{width,SimpleViewsList-method} \alias{universe,ViewsList-method} \alias{universe<-,ViewsList-method} % coercion \alias{as.matrix,ViewsList-method} \title{List of Views} \description{An extension of \linkS4class{List} that holds only \linkS4class{Views} objects. } \details{ ViewsList is a virtual class. Specialized subclasses like e.g. \linkS4class{RleViewsList} are useful for storing coverage vectors over a set of spaces (e.g. chromosomes), each of which requires a separate \linkS4class{RleViews} object. As a \linkS4class{Vector} subclass, ViewsList may be annotated with its universe identifier (e.g. a genome) in which all of its spaces exist. As a \linkS4class{List} subclass, ViewsList inherits all the methods available for \linkS4class{List} objects. It also presents an API that is very similar to that of \linkS4class{Views}, where operations are vectorized over the elements and generally return lists. } \author{P. Aboyoun and H. Pages} \seealso{ \link{List-class}, \link{RleViewsList-class}. \code{\link{findOverlaps}}. } \examples{ showClass("ViewsList") } \keyword{methods} \keyword{classes} IRanges/man/classNameForDisplay-methods.Rd0000644000126300012640000000157212227064476022112 0ustar00biocbuildphs_compbio\name{classNameForDisplay} \alias{classNameForDisplay} \alias{classNameForDisplay,ANY-method} \alias{classNameForDisplay,AsIs-method} \alias{classNameForDisplay,CompressedList-method} \alias{classNameForDisplay,CompressedNormalIRangesList-method} \alias{classNameForDisplay,SimpleList-method} \alias{classNameForDisplay,SimpleNormalIRangesList-method} \title{Provide a class name for displaying to users} \description{ Generic function to create a class name suitable for display to users. Current methods remove "Compressed" or "Simple" from the formal names of classes defined in IRanges. } \usage{ classNameForDisplay(x) } \arguments{ \item{x}{ An instance of any class. } } \value{ A character vector of length 1, as returned by \code{class}. } \author{Martin Morgan} \examples{ classNameForDisplay(IntegerList()) class(IntegerList()) } \keyword{utilities} IRanges/man/coverage-methods.Rd0000644000126300012640000003162612232576334020002 0ustar00biocbuildphs_compbio\name{coverage-methods} \alias{coverage-methods} \alias{coverage} \alias{coverage,Ranges-method} \alias{coverage,Views-method} \alias{coverage,RangesList-method} \alias{coverage,RangedData-method} \title{Coverage across a set of ranges} \description{ For each position in the space underlying a set of ranges, counts the number of ranges that cover it. } \usage{ coverage(x, shift=0L, width=NULL, weight=1L, ...) \S4method{coverage}{Ranges}(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash")) \S4method{coverage}{RangesList}(x, shift=0L, width=NULL, weight=1L, method=c("auto", "sort", "hash")) } \arguments{ \item{x}{ A \link{Ranges}, \link{Views}, or \link{RangesList} object. See \code{?`\link[GenomicRanges]{coverage-methods}`} in the \pkg{GenomicRanges} package for \code{coverage} methods for other objects. } \item{shift}{ Specifies how much each range in \code{x} should be shifted before the coverage is computed. \itemize{ \item If \code{x} is a \link{Ranges} or \link{Views} object: \code{shift} must be an integer or numeric vector parallel to \code{x} (will get recycled if necessary) and with no NAs. \item If \code{x} is a \link{RangesList} object: \code{shift} must be a numeric vector or list-like object of the same length as \code{x} (will get recycled if necessary). If it's a numeric vector, it's first turned into a list with \code{as.list}. After recycling, each list element \code{shift[[i]]} must be an integer or numeric vector parallel to \code{x[[i]]} (will get recycled if necessary) and with no NAs. } A positive shift value will shift the corresponding range in \code{x} to the right, and a negative value to the left. } \item{width}{ Specifies the length of the returned coverage vector(s). \itemize{ \item If \code{x} is a \link{Ranges} object: \code{width} must be \code{NULL} (the default), an NA, or a single non-negative integer. After being shifted, the ranges in \code{x} are always clipped on the left to keep only their positive portion i.e. their intersection with the [1, +inf) interval. If \code{width} is a single non-negative integer, then they're also clipped on the right to keep only their intersection with the [1, width] interval. In that case \code{coverage} returns a vector of length \code{width}. Otherwise, it returns a vector that extends to the last position in the underlying space covered by the shifted ranges. \item If \code{x} is a \link{Views} object: Same as for a \link{Ranges} object, except that, if \code{width} is \code{NULL} then it's treated as if it was \code{length(subject(x))}. \item If \code{x} is a \link{RangesList} object: \code{width} must be \code{NULL} or an integer vector parallel to \code{x} (i.e. with one element per list element in \code{x}). If not \code{NULL}, the vector must contain NAs or non-negative integers and it will get recycled to the length of \code{x} if necessary. If \code{NULL}, it is replaced with \code{NA} and recycled to the length of \code{x}. Finally \code{width[i]} is used to compute the coverage vector for \code{x[[i]]} and is therefore treated like explained above (when \code{x} is a \link{Ranges} object). } } \item{weight}{ Assigns a weight to each range in \code{x}. \itemize{ \item If \code{x} is a \link{Ranges} or \link{Views} object: \code{weight} must be an integer or numeric vector parallel to \code{x} (will get recycled if necessary). \item If \code{x} is a \link{RangesList} object: \code{weight} must be a numeric vector or list-like object of the same length as \code{x} (will get recycled if necessary). If it's a numeric vector, it's first turned into a list with \code{as.list}. After recycling, each list element \code{weight[[i]]} must be an integer or numeric vector parallel to \code{x[[i]]} (will get recycled if necessary). } If \code{weight} is an integer vector or list-like object of integer vectors, the coverage vector(s) will be returned as integer-\link{Rle} object(s). If it's a numeric vector or list-like object of numeric vectors, the coverage vector(s) will be returned as numeric-\link{Rle} object(s). Alternatively, \code{weight} can also be specified as a single string naming a metadata column in \code{x} (i.e. a column in \code{mcols(x)}) to be used as the \code{weight} vector. } \item{method}{ If \code{method} is set to \code{"sort"}, then \code{x} is sorted previous to the calculation of the coverage. If \code{method} is set to \code{hash}, then \code{x} is hashed directly to a vector of length \code{width} without previous sorting. The \code{"hash"} method is faster than the \code{"sort"} method when \code{x} is large (i.e. contains a lot of ranges). When \code{x} is small and \code{width} is big (e.g. \code{x} represents a small set of reads aligned to a big chromosome), then \code{method="sort"} is faster and uses less memory than \code{method="hash"}. Using \code{method="auto"} selects the best method based on \code{length(x)} and \code{width}. } \item{...}{ Further arguments to be passed to or from other methods. } } \value{ If \code{x} is a \link{Ranges} or \link{Views} object: An integer- or numeric-\link{Rle} object depending on whether \code{weight} is an integer or numeric vector. If \code{x} is a \link{RangesList} object: An \link{RleList} object with one coverage vector per list element in \code{x}, and with \code{x} names propagated to it. The i-th coverage vector can be either an integer- or numeric-\link{Rle} object, depending on the type of \code{weight[[i]]} (after \code{weight} has gone thru \code{as.list} and recycling, like described previously). } \author{H. Pages and P. Aboyoun} \seealso{ \itemize{ \item \link[GenomicRanges]{coverage-methods} in the \pkg{GenomicRanges} package for more \code{coverage} methods. \item The \code{\link{slice}} function for slicing the \link{Rle} or \link{RleList} object returned by \code{coverage}. \item The \link{Ranges}, \link{RangesList}, \link{Rle}, and \link{RleList} classes. } } \examples{ ## --------------------------------------------------------------------- ## A. COVERAGE OF AN IRanges OBJECT ## --------------------------------------------------------------------- x <- IRanges(start=c(-2L, 6L, 9L, -4L, 1L, 0L, -6L, 10L), width=c( 5L, 0L, 6L, 1L, 4L, 3L, 2L, 3L)) coverage(x) coverage(x, shift=7) coverage(x, shift=7, width=27) coverage(x, shift=c(-4, 2)) # 'shift' gets recycled coverage(x, shift=c(-4, 2), width=12) coverage(x, shift=-max(end(x))) coverage(restrict(x, 1, 10)) coverage(reduce(x), shift=7) coverage(gaps(shift(x, 7), start=1, end=27)) ## With weights: coverage(x, weight=as.integer(10^(0:7))) # integer-Rle coverage(x, weight=c(2.8, -10)) # numeric-Rle, 'shift' gets recycled ## --------------------------------------------------------------------- ## B. SOME MATHEMATICAL PROPERTIES OF THE coverage() FUNCTION ## --------------------------------------------------------------------- ## PROPERTY 1: The coverage vector is not affected by reordering the ## input ranges: set.seed(24) x <- IRanges(sample(1000, 40, replace=TRUE), width=17:10) cvg0 <- coverage(x) stopifnot(identical(coverage(sample(x)), cvg0)) ## Of course, if the ranges are shifted and/or assigned weights, then ## this doesn't hold anymore, unless the 'shift' and/or 'weight' ## arguments are reordered accordingly. ## PROPERTY 2: The coverage of the concatenation of 2 Ranges objects 'x' ## and 'y' is the sum of the 2 individual coverage vectors: y <- IRanges(sample(-20:280, 36, replace=TRUE), width=28) stopifnot(identical(coverage(c(x, y), width=100), coverage(x, width=100) + coverage(y, width=100))) ## Note that, because adding 2 vectors in R recycles the shortest to ## the length of the longest, the following is generally FALSE: identical(coverage(c(x, y)), coverage(x) + coverage(y)) # FALSE ## It would only be TRUE if the 2 coverage vectors we add had the same ## length, which would only happen by chance. By using the same 'width' ## value when we computed the 2 coverages previously, we made sure they ## had the same length. ## Because of properties 1 & 2, we have: x1 <- x[c(TRUE, FALSE)] # pick up 1st, 3rd, 5th, etc... ranges x2 <- x[c(FALSE, TRUE)] # pick up 2nd, 4th, 6th, etc... ranges cvg1 <- coverage(x1, width=100) cvg2 <- coverage(x2, width=100) stopifnot(identical(coverage(x, width=100), cvg1 + cvg2)) ## PROPERTY 3: Multiplying the weights by a scalar has the effect of ## multiplying the coverage vector by the same scalar: weight <- runif(40) cvg3 <- coverage(x, weight=weight) stopifnot(all.equal(coverage(x, weight=-2.68 * weight), -2.68 * cvg3)) ## Because of properties 1 & 2 & 3, we have: stopifnot(identical(coverage(x, width=100, weight=c(5L, -11L)), 5L * cvg1 - 11L * cvg2)) ## PROPERTY 4: Using the sum of 2 weight vectors produces the same ## result as using the 2 weight vectors separately and summing the ## 2 results: weight2 <- 10 * runif(40) + 3.7 stopifnot(all.equal(coverage(x, weight=weight + weight2), cvg3 + coverage(x, weight=weight2))) ## PROPERTY 5: Repeating any input range N number of times is ## equivalent to multiplying its assigned weight by N: times <- sample(0:10L, length(x), replace=TRUE) stopifnot(all.equal(coverage(rep(x, times), weight=rep(weight, times)), coverage(x, weight=weight * times))) ## In particular, if 'weight' is not supplied: stopifnot(identical(coverage(rep(x, times)), coverage(x, weight=times))) ## PROPERTY 6: If none of the input range actually gets clipped during ## the "shift and clip" process, then: ## ## sum(cvg) = sum(width(x) * weight) ## stopifnot(sum(cvg3) == sum(width(x) * weight)) ## In particular, if 'weight' is not supplied: stopifnot(sum(cvg0) == sum(width(x))) ## Note that this property is sometimes used in the context of a ## ChIP-Seq analysis to estimate "the number of reads in a peak", that ## is, the number of short reads that belong to a peak in the coverage ## vector computed from the genomic locations (a.k.a. genomic ranges) ## of the aligned reads. Because of property 6, the number of reads in ## a peak is approximately the area under the peak divided by the short ## read length. ## PROPERTY 7: If 'weight' is not supplied, then disjoining or reducing ## the ranges before calling coverage() has the effect of "shaving" the ## coverage vector at elevation 1: table(cvg0) shaved_cvg0 <- cvg0 runValue(shaved_cvg0) <- pmin(runValue(cvg0), 1L) table(shaved_cvg0) stopifnot(identical(coverage(disjoin(x)), shaved_cvg0)) stopifnot(identical(coverage(reduce(x)), shaved_cvg0)) ## --------------------------------------------------------------------- ## C. SOME SANITY CHECKS ## --------------------------------------------------------------------- dummy.coverage <- function(x, shift=0L, width=NULL) { y <- unlist(shift(x, shift)) if (is.null(width)) width <- max(c(0L, y)) Rle(tabulate(y, nbins=width)) } check_real_vs_dummy <- function(x, shift=0L, width=NULL) { res1 <- coverage(x, shift=shift, width=width) res2 <- dummy.coverage(x, shift=shift, width=width) stopifnot(identical(res1, res2)) } check_real_vs_dummy(x) check_real_vs_dummy(x, shift=7) check_real_vs_dummy(x, shift=7, width=27) check_real_vs_dummy(x, shift=c(-4, 2)) check_real_vs_dummy(x, shift=c(-4, 2), width=12) check_real_vs_dummy(x, shift=-max(end(x))) ## With a set of distinct single positions: x3 <- IRanges(sample(50000, 20000), width=1) stopifnot(identical(sort(start(x3)), which(coverage(x3) != 0L))) ## --------------------------------------------------------------------- ## D. COVERAGE OF AN IRangesList OBJECT ## --------------------------------------------------------------------- x <- IRangesList(A=IRanges(3*(4:-1), width=1:3), B=IRanges(2:10, width=5)) cvg <- coverage(x) cvg stopifnot(identical(cvg[[1]], coverage(x[[1]]))) stopifnot(identical(cvg[[2]], coverage(x[[2]]))) coverage(x, width=c(50, 9)) coverage(x, width=c(NA, 9)) coverage(x, width=9) # 'width' gets recycled ## Each list element in 'shift' and 'weight' gets recycled to the length ## of the corresponding element in 'x'. weight <- list(as.integer(10^(0:5)), -0.77) cvg2 <- coverage(x, weight=weight) cvg2 # 1st coverage vector is an integer-Rle, 2nd is a numeric-Rle identical(mapply(coverage, x=x, weight=weight), as.list(cvg2)) } \keyword{methods} \keyword{utilities} IRanges/man/encodeOverlaps-methods.Rd0000644000126300012640000001227212227064476021157 0ustar00biocbuildphs_compbio\name{encodeOverlaps} \alias{encodeOverlaps} \alias{encodeOverlaps,RangesList,RangesList-method} \alias{encodeOverlaps,RangesList,Ranges-method} \alias{encodeOverlaps,Ranges,RangesList-method} \alias{encodeOverlaps1} \alias{RangesList_encodeOverlaps} \title{Compute overlap encodings} \description{ The \code{encodeOverlaps} function computes the overlap encodings between a \code{query} and a \code{subject}, both list-like objects with top-level elements typically containing multiple ranges. } \usage{ encodeOverlaps(query, subject, hits=NULL, ...) } \arguments{ \item{query, subject}{ List-like objects, usually of the same length, with top-level elements typically containing multiple ranges (e.g. \link{RangesList} or \link[GenomicRanges]{GRangesList} objects). If the 2 objects don't have the same length, and if \code{hits} is not supplied, then the shortest is recycled to the length of the longest (the standard recycling rules apply). } \item{hits}{ An optional \link{Hits} object that is compatible with \code{query} and \code{subject}, that is, \code{\link{queryLength}(hits)} and \code{\link{subjectLength}(hits)} must be equal to \code{length(query)} and \code{length(subject)}, respectively. Note that when \code{query} and \code{subject} are \link[GenomicRanges]{GRangesList} objects, \code{hits} will typically be the result of a call to \code{\link{findOverlaps}(query, subject)}. See \code{?`\link[GenomicRanges]{encodeOverlaps,GRangesList,GRangesList-method}`} for more information about the \code{encodeOverlaps} method for \link[GenomicRanges]{GRangesList} objects (you might need to load the GenomicRanges package first). Supplying \code{hits} is a convenient way to do \code{encodeOverlaps(query[queryHits(hits)], subject[subjectHits(hits)])}, that is, calling \code{encodeOverlaps(query, subject, hits)} is equivalent to the above, but is much more efficient, especially when \code{query} and/or \code{subject} are big. Of course, when \code{hits} is supplied, \code{query} and \code{subject} are not expected to have the same length anymore. } \item{...}{ Additional arguments for methods. } } \details{ See \code{?OverlapEncodings} for a short introduction to "overlap encodings". } \value{ An \link{OverlapEncodings} object with the length of \code{query} and \code{subject} for \code{encodeOverlaps(query, subject)}, or with the length of \code{hits} for \code{encodeOverlaps(query, subject, hits)}. } \author{H. Pages} \seealso{ \itemize{ \item The \link{OverlapEncodings}, \link{Hits}, and \link{RangesList} classes. \item The \code{\link{findOverlaps}} generic function for computing overlaps. \item The \code{\link[GenomicRanges]{isCompatibleWithSplicing}} utility function defined in the GenomicRanges package for detecting encodings associated with "compatible" overlaps i.e. encodings that show splicing "compatibility" between the read and the transcript involved in the associated overlap. (You might need to load the GenomicRanges package first.) } } \examples{ ## --------------------------------------------------------------------- ## A. BETWEEN 2 RangesList OBJECTS ## --------------------------------------------------------------------- ## In the context of an RNA-seq experiment, encoding the overlaps ## between 2 GRangesList objects, one containing the reads (the query), ## and one containing the transcripts (the subject), can be used for ## detecting hits between reads and transcripts that are "compatible" ## with the splicing of the transcript. Here we illustrate this with 2 ## RangesList objects, in order to keep things simple: ## 4 aligned reads in the query: read1 <- IRanges(c(7, 15, 22), c(9, 19, 23)) # 2 gaps read2 <- IRanges(c(5, 15), c(9, 17)) # 1 gap read3 <- IRanges(c(16, 22), c(19, 24)) # 1 gap read4 <- IRanges(c(16, 23), c(19, 24)) # 1 gap query <- IRangesList(read1, read2, read3, read4) ## 1 transcript in the subject: tx <- IRanges(c(1, 4, 15, 22, 38), c(2, 9, 19, 25, 47)) # 5 exons subject <- IRangesList(tx) ## Encode the overlaps: ovenc <- encodeOverlaps(query, subject) ovenc encoding(ovenc) ## Reads that are "compatible" with the transcript can be detected with ## a regular expression (the regular expression below assumes that ## reads have at most 2 gaps): regex0 <- "(:[fgij]:|:[jg].:.[gf]:|:[jg]..:.g.:..[gf]:)" grepl(regex0, encoding(ovenc)) # read4 is NOT "compatible" ## This was for illustration purpose only. In practise you don't need ## (and should not) use this regular expression, but use instead the ## isCompatibleWithSplicing() utility function defined in the ## GenomicRanges package. See '?isCompatibleWithSplicing' in the ## GenomicRanges package for more information. ## --------------------------------------------------------------------- ## B. BETWEEN 2 GRangesList OBJECTS ## --------------------------------------------------------------------- ## With real RNA-seq data, the reads and transcripts will typically be ## stored in GRangesList objects. See '?isCompatibleWithSplicing' in the ## GenomicRanges package for more information. } \keyword{methods} IRanges/man/endoapply.Rd0000644000126300012640000000325312227064476016537 0ustar00biocbuildphs_compbio\name{endoapply} \alias{endoapply} \alias{endoapply,list-method} \alias{endoapply,data.frame-method} \alias{mendoapply} \alias{mendoapply,list-method} \alias{mendoapply,data.frame-method} \title{Endomorphisms via application of a function over an object's elements} \description{Performs the endomorphic equivalents of \code{\link[base]{lapply}} and \code{\link[base]{mapply}} by returning objects of the same class as the inputs rather than a list. } \usage{ endoapply(X, FUN, \dots) mendoapply(FUN, \dots, MoreArgs = NULL) } \arguments{ \item{X}{a list, data.frame or List object.} \item{FUN}{the function to be applied to each element of \code{X} (for \code{endoapply}) or for the elements in \code{\dots} (for \code{mendoapply}).} \item{\dots}{For \code{endoapply}, optional arguments to \code{FUN}. For \code{mendoapply}, a set of list, data.frame or List objects to compute over.} \item{MoreArgs}{a list of other arguments to \code{FUN}.} } \value{ \code{endoapply} returns an object of the same class as \code{X}, each element of which is the result of applying \code{FUN} to the corresponding element of \code{X}. \code{mendoapply} returns an object of the same class as the first object specified in \code{\dots}, each element of which is the result of applying \code{FUN} to the corresponding elements of \code{\dots}. } \seealso{ \code{\link[base]{lapply}}, \code{\link[base]{mapply}} } \examples{ a <- data.frame(x = 1:10, y = rnorm(10)) b <- data.frame(x = 1:10, y = rnorm(10)) endoapply(a, function(x) (x - mean(x))/sd(x)) mendoapply(function(e1, e2) (e1 - mean(e1)) * (e2 - mean(e2)), a, b) } \keyword{manip} \keyword{utilities} IRanges/man/expand-methods.Rd0000644000126300012640000000373412227064476017470 0ustar00biocbuildphs_compbio\name{expand} \alias{expand} \alias{expand,DataFrame-method} \title{The expand method for uncompressing compressed data columns} \description{ Expand an object with compressed columns such that all compressed values are represented as separate rows. } \usage{ \S4method{expand}{DataFrame}(x, colnames, keepEmptyRows, ...) } \arguments{ \item{x}{ A \code{DataFrame} containing some columns that are compressed (e.g., \code{CompressedCharacterList}). } \item{colnames}{ A \code{character} or \code{numeric} vector containing the names or indices of the compressed columns to expand. The order of expansion is controlled by the column order in this vector. } \item{keepEmptyRows}{ A \code{logical} indicating if rows containing empty values in the specified \code{colnames} should be retained or dropped. When \code{TRUE}, empty values are set to NA and all rows are kept. When \code{FALSE}, rows with empty values in the \code{colnames} columns are dropped. } \item{\dots}{Arguments passed to other methods. } } \value{ A \code{DataFrame} that has been expanded row-wise to match the dimension of the uncompressed columns. } \author{Herve Pages and Marc Carlson} \seealso{ \link{DataFrame-class} } \examples{ aa <- CharacterList("a", paste0("d", 1:2), paste0("b", 1:3), c(), "c") bb <- CharacterList(paste0("sna", 1:2),"foo", paste0("bar",1:3),c(),"hica") df <- DataFrame(aa=aa, bb=bb, cc=11:15) ## expand the aa column only, and keep rows adjacent to empty values expand(df, colnames="aa", keepEmptyRows=TRUE) ## expand the aa column only but do not keep rows expand(df, colnames="aa", keepEmptyRows=FALSE) ## expand the aa and then the bb column, but ## keeping rows next to empty compressed values expand(df, colnames=c("aa","bb"), keepEmptyRows=TRUE) ## expand the bb and then the aa column, but don't keep rows adjacent to ## empty values from bb and aa expand(df, colnames=c("aa","bb"), keepEmptyRows=FALSE) } \keyword{methods} IRanges/man/findOverlaps-methods.Rd0000644000126300012640000004324712227064476020650 0ustar00biocbuildphs_compbio\name{findOverlaps-methods} \alias{findOverlaps-methods} \alias{findOverlaps} \alias{findOverlaps,Ranges,IntervalTree-method} \alias{findOverlaps,RangesList,IntervalForest-method} \alias{findOverlaps,Ranges,Ranges-method} \alias{findOverlaps,Vector,missing-method} \alias{findOverlaps,integer,Ranges-method} \alias{findOverlaps,Views,Views-method} \alias{findOverlaps,Views,Vector-method} \alias{findOverlaps,Vector,Views-method} \alias{findOverlaps,RangesList,RangesList-method} \alias{findOverlaps,ViewsList,ViewsList-method} \alias{findOverlaps,ViewsList,Vector-method} \alias{findOverlaps,Vector,ViewsList-method} \alias{findOverlaps,RangedData,RangedData-method} \alias{findOverlaps,RangedData,RangesList-method} \alias{findOverlaps,RangesList,RangedData-method} \alias{countOverlaps} \alias{countOverlaps,ANY,Vector-method} \alias{countOverlaps,ANY,missing-method} \alias{countOverlaps,RangesList,RangesList-method} \alias{countOverlaps,RangesList,IntervalForest-method} \alias{countOverlaps,ViewsList,ViewsList-method} \alias{countOverlaps,ViewsList,Vector-method} \alias{countOverlaps,Vector,ViewsList-method} \alias{countOverlaps,RangedData,RangedData-method} \alias{countOverlaps,RangedData,RangesList-method} \alias{countOverlaps,RangesList,RangedData-method} \alias{match,Views,Views-method} \alias{match,Views,Vector-method} \alias{match,Vector,Views-method} \alias{match,RangesList,RangesList-method} \alias{match,ViewsList,ViewsList-method} \alias{match,ViewsList,Vector-method} \alias{match,Vector,ViewsList-method} \alias{match,RangedData,RangedData-method} \alias{match,RangedData,RangesList-method} \alias{match,RangesList,RangedData-method} \alias{overlapsAny} \alias{overlapsAny,Ranges,Ranges-method} \alias{overlapsAny,Views,Views-method} \alias{overlapsAny,Views,Vector-method} \alias{overlapsAny,Vector,Views-method} \alias{overlapsAny,RangesList,RangesList-method} \alias{overlapsAny,RangesList,IntervalForest-method} \alias{overlapsAny,ViewsList,ViewsList-method} \alias{overlapsAny,ViewsList,Vector-method} \alias{overlapsAny,Vector,ViewsList-method} \alias{overlapsAny,RangedData,RangedData-method} \alias{overlapsAny,RangedData,RangesList-method} \alias{overlapsAny,RangesList,RangedData-method} \alias{\%over\%} \alias{\%within\%} \alias{\%outside\%} \alias{\%in\%,Views,Views-method} \alias{\%in\%,Views,Vector-method} \alias{\%in\%,Vector,Views-method} \alias{\%in\%,RangesList,RangesList-method} \alias{\%in\%,ViewsList,ViewsList-method} \alias{\%in\%,ViewsList,Vector-method} \alias{\%in\%,Vector,ViewsList-method} \alias{\%in\%,RangedData,RangedData-method} \alias{\%in\%,RangedData,RangesList-method} \alias{\%in\%,RangesList,RangedData-method} \alias{subsetByOverlaps} \alias{subsetByOverlaps,Vector,Vector-method} \alias{subsetByOverlaps,RangedData,RangedData-method} \alias{subsetByOverlaps,RangedData,RangesList-method} \alias{subsetByOverlaps,RangesList,RangedData-method} \alias{ranges,Hits-method} \alias{findMatches,Views,Views-method} \alias{findMatches,Views,Vector-method} \alias{findMatches,Vector,Views-method} \alias{findMatches,RangesList,RangesList-method} \alias{findMatches,ViewsList,ViewsList-method} \alias{findMatches,ViewsList,Vector-method} \alias{findMatches,Vector,ViewsList-method} \alias{findMatches,RangedData,RangedData-method} \alias{findMatches,RangedData,RangesList-method} \alias{findMatches,RangesList,RangedData-method} \alias{countMatches,Views,Views-method} \alias{countMatches,Views,Vector-method} \alias{countMatches,Vector,Views-method} \alias{countMatches,RangesList,RangesList-method} \alias{countMatches,ViewsList,ViewsList-method} \alias{countMatches,ViewsList,Vector-method} \alias{countMatches,Vector,ViewsList-method} \alias{countMatches,RangedData,RangedData-method} \alias{countMatches,RangedData,RangesList-method} \alias{countMatches,RangesList,RangedData-method} \title{Finding overlapping ranges} \description{ Various methods for finding/counting interval overlaps between two "range-based" objects: a query and a subject. NOTE: This man page describes the methods that operate on a query and a subject that are both either a \link{Ranges}, \link{Views}, \link{RangesList}, \link{ViewsList}, or \link{RangedData} object. (In addition, if the query is a \link{Ranges} object, the subject can be an \link{IntervalTree} object; if the query is a \link{RangesList} object, the subject can be a \link{IntervalForest} object. And if the subject is a \link{Ranges} object, the query can be an integer vector.) See \code{?`\link[GenomicRanges]{findOverlaps,GenomicRanges,GenomicRanges-method}`} in the GenomicRanges package for methods that operate on \link[GenomicRanges]{GRanges} or \link[GenomicRanges]{GRangesList} objects. See also the \code{?`\link[GenomicRanges]{GIntervalTree}`} class and the \code{?`\link[GenomicRanges]{findOverlaps,GenomicRanges,GIntervalTree-method}`} method for finding overlaps with persistent \link{IntervalForest} objects. } \usage{ findOverlaps(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), select=c("all", "first", "last", "arbitrary"), ...) countOverlaps(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) overlapsAny(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) query \%over\% subject query \%within\% subject query \%outside\% subject subsetByOverlaps(query, subject, maxgap=0L, minoverlap=1L, type=c("any", "start", "end", "within", "equal"), ...) \S4method{ranges}{Hits}(x, query, subject) } \arguments{ \item{query, subject}{ Each of them can be a \link{Ranges}, \link{Views}, \link{RangesList}, \link{ViewsList}, or \link{RangedData} object. In addition, if \code{query} is a \link{Ranges} object, \code{subject} can be an \link{IntervalTree} object; if \code{query} is a \link{RangesList} object, then \code{subject} can be an \link{IntervalForest} object. And if \code{subject} is a \link{Ranges} object, \code{query} can be an integer vector to be converted to length-one ranges. If \code{query} is a \link{RangesList} or \link{RangedData}, \code{subject} must be a \link{RangesList} or \link{RangedData}. If both lists have names, each element from the subject is paired with the element from the query with the matching name, if any. Otherwise, elements are paired by position. The overlap is then computed between the pairs as described below. If \code{query} is unsorted, it is sorted first, so it is usually better to sort up-front, to avoid a sort with each \code{findOverlaps} call. If \code{subject} is omitted, \code{query} is queried against itself. In this case, and only this case, the \code{ignoreSelf} and \code{ignoreRedundant} arguments are allowed. By default, the result will contain hits for each range against itself, and if there is a hit from A to B, there is also a hit for B to A. If \code{ignoreSelf} is \code{TRUE}, all self matches are dropped. If \code{ignoreRedundant} is \code{TRUE}, only one of A->B and B->A is returned. } \item{maxgap, minoverlap}{ Intervals with a separation of \code{maxgap} or less and a minimum of \code{minoverlap} overlapping positions, allowing for \code{maxgap}, are considered to be overlapping. \code{maxgap} should be a scalar, non-negative, integer. \code{minoverlap} should be a scalar, positive integer. } \item{type}{ By default, any overlap is accepted. By specifying the \code{type} parameter, one can select for specific types of overlap. The types correspond to operations in Allen's Interval Algebra (see references). If \code{type} is \code{start} or \code{end}, the intervals are required to have matching starts or ends, respectively. While this operation seems trivial, the naive implementation using \code{outer} would be much less efficient. Specifying \code{equal} as the type returns the intersection of the \code{start} and \code{end} matches. If \code{type} is \code{within}, the query interval must be wholly contained within the subject interval. Note that all matches must additionally satisfy the \code{minoverlap} constraint described above. The \code{maxgap} parameter has special meaning with the special overlap types. For \code{start}, \code{end}, and \code{equal}, it specifies the maximum difference in the starts, ends or both, respectively. For \code{within}, it is the maximum amount by which the query may be wider than the subject. } \item{select}{ When \code{select} is \code{"all"} (the default), the results are returned as a \link{Hits} object. When \code{select} is \code{"first"}, \code{"last"}, or \code{"arbitrary"} the results are returned as an integer vector of length \code{query} containing the first, last, or arbitrary overlapping interval in \code{subject}, with \code{NA} indicating intervals that did not overlap any intervals in \code{subject}. If \code{select} is \code{"all"}, a \link{Hits} object is returned. For all other \code{select} the return value depends on the \code{drop} argument. When \code{select != "all" && !drop}, an \link{IntegerList} is returned, where each element of the result corresponds to a space in \code{query}. When\code{select != "all" && drop}, an integer vector is returned containing indices that are offset to align with the unlisted \code{query}. } \item{...}{ Further arguments to be passed to or from other methods: \itemize{ \item \code{drop}: All methods accept the \code{drop} argument (\code{FALSE} by default). See \code{select} argument above for the details. \item \code{ignoreSelf}, \code{ignoreRedundant}: When \code{subject} is omitted, the \code{ignoreSelf} and \code{ignoreRedundant} arguments (both \code{FALSE} by default) are allowed. See \code{query} and \code{subject} arguments above for the details. } } \item{x}{ \link{Hits} object returned by \code{findOverlaps}. } } \details{ A common type of query that arises when working with intervals is finding which intervals in one set overlap those in another. The simplest approach is to call the \code{findOverlaps} function on a \link{Ranges} or other object with range information (aka "range-based object"). An \link{IntervalTree} object is a derivative of \link{Ranges} and stores its ranges as a tree that is optimized for overlap queries. Thus, for repeated queries against the same subject, it is more efficient to create an \link{IntervalTree} once for the subject using the \code{\link{IntervalTree}} constructor and then perform the queries against the \link{IntervalTree} instance. An \link{IntervalForest} object is a derivative of \link{RangesList} and stores its ranges as a set of trees optimizized for partitioned overlap queries. Again, for repeated queries against the same subject list, it is more efficient to create an \link{IntervalForest} once and then perform the queries against the \link{IntervalForest} instance. } \value{ \code{findOverlaps} returns either a \link{Hits} object when \code{select="all"} (the default), or an integer vector when \code{select} is not \code{"all"}. For \link{RangesList} objects it returns a \link{HitsList-class} object when \code{select="all"}, or an \link{IntegerList} when \code{select} is not \code{"all"}. When \code{subject} is an \link{IntervalForest} object, it returns a \link{CompressedHitsList} or \link{CompressedIntegerList} respectively. \code{countOverlaps} returns the overlap hit count for each range in \code{query} using the specified \code{findOverlaps} parameters. For \link{RangesList} objects, it returns an \link{IntegerList} object. When \code{subject} is an \link{IntervalForest} it returns a \link{CompressedIntegerList}. \code{overlapsAny} finds the ranges in \code{query} that overlap any of the ranges in \code{subject}. For \link{Ranges} or \link{Views} objects, it returns a logical vector of length equal to the number of ranges in \code{query}. For \link{RangesList}, \link{RangedData}, or \link{ViewsList} objects, it returns a \link{LogicalList} object, where each element of the result corresponds to a space in \code{query}. When \code{subject} is an \link{IntervalForest} object, it returns a \link{CompressedLogicalList} object. \code{\%over\%} and \code{\%within\%} are convenience wrappers for the 2 most common use cases. Currently defined as \code{`\%over\%` <- function(query, subject) overlapsAny(query, subject)} and \code{`\%within\%` <- function(query, subject) overlapsAny(query, subject, type="within")}. \code{\%outside\%} is simply the inverse of \code{\%over\%}. \code{subsetByOverlaps} returns the subset of \code{query} that has an overlap hit with a range in \code{subject} using the specified \code{findOverlaps} parameters. \code{ranges(x, query, subject)} returns a \code{Ranges} of the same length as \link{Hits} object \code{x} holding the regions of intersection between the overlapping ranges in objects \code{query} and \code{subject}, which should be the same query and subject used in the call to \code{findOverlaps} that generated \code{x}. } \references{ Allen's Interval Algebra: James F. Allen: Maintaining knowledge about temporal intervals. In: Communications of the ACM. 26/11/1983. ACM Press. S. 832-843, ISSN 0001-0782 } \author{Michael Lawrence with contributions by Hector Corrada Bravo} \seealso{ \itemize{ \item The \link{Hits} and \linkS4class{HitsList} classes for representing a set of hits between 2 vector-like objects. \item \link[GenomicRanges]{findOverlaps,GenomicRanges,GenomicRanges-method} in the GenomicRanges package for methods that operate on \link[GenomicRanges]{GRanges} or \link[GenomicRanges]{GRangesList} objects. \item \link[GenomicRanges]{findOverlaps,GenomicRanges,GIntervalTree-method} in the GenomicRanges package for methods that use \link{IntervalForest} objects to find overlaps. \item The \code{\link{IntervalTree}} class and constructor. \item The \code{\link{IntervalForest}} class and constructor. \item The \link{Ranges}, \link{Views}, \link{RangesList}, \link{ViewsList}, and \link{RangedData} classes. \item The \link{IntegerList} and \link{LogicalList} classes. } } \examples{ query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) tree <- IntervalTree(subject) ## --------------------------------------------------------------------- ## findOverlaps() ## --------------------------------------------------------------------- ## at most one hit per query findOverlaps(query, tree, select = "first") findOverlaps(query, tree, select = "last") findOverlaps(query, tree, select = "arbitrary") ## overlap even if adjacent only ## (FIXME: the gap between 2 adjacent ranges should be still considered ## 0. So either we have an argument naming problem, or we should modify ## the handling of the 'maxgap' argument so that the user would need to ## specify maxgap = 0L to obtain the result below.) findOverlaps(query, tree, maxgap = 1L) ## shortcut findOverlaps(query, subject) query <- IRanges(c(1, 4, 9), c(5, 7, 10)) subject <- IRanges(c(2, 2), c(5, 4)) tree <- IntervalTree(subject) ## one Ranges with itself findOverlaps(query) ## single points as query subject <- IRanges(c(1, 6, 13), c(4, 9, 14)) findOverlaps(c(3L, 7L, 10L), subject, select = "first") ## alternative overlap types query <- IRanges(c(1, 5, 3, 4), width=c(2, 2, 4, 6)) subject <- IRanges(c(1, 3, 5, 6), width=c(4, 4, 5, 4)) findOverlaps(query, subject, type = "start") findOverlaps(query, subject, type = "start", maxgap = 1L) findOverlaps(query, subject, type = "end", select = "first") ov <- findOverlaps(query, subject, type = "within", maxgap = 1L) ov ## --------------------------------------------------------------------- ## overlapsAny() ## --------------------------------------------------------------------- overlapsAny(query, subject, type="start") overlapsAny(query, subject, type="end") query \%over\% subject # same as overlapsAny(query, subject) query \%within\% subject # same as overlapsAny(query, subject, # type="within") ## --------------------------------------------------------------------- ## "ranges" METHOD FOR Hits OBJECTS ## --------------------------------------------------------------------- ## extract the regions of intersection between the overlapping ranges ranges(ov, query, subject) ## --------------------------------------------------------------------- ## using IntervalForest objects ## --------------------------------------------------------------------- query <- IRanges(c(1, 4, 9), c(5, 7, 10)) qpartition <- factor(c("a","a","b")) qlist <- split(query, qpartition) subject <- IRanges(c(2, 2, 10), c(2, 3, 12)) spartition <- factor(c("a","a","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) ## at most one hit per query findOverlaps(qlist, forest, select = "first") findOverlaps(qlist, forest, select = "last") findOverlaps(qlist, forest, select = "arbitrary") query <- IRanges(c(1, 5, 3, 4), width=c(2, 2, 4, 6)) qpartition <- factor(c("a","a","b","b")) qlist <- split(query, qpartition) subject <- IRanges(c(1, 3, 5, 6), width=c(4, 4, 5, 4)) spartition <- factor(c("a","a","b","b")) slist <- split(subject, spartition) forest <- IntervalForest(slist) overlapsAny(qlist, forest, type="start") overlapsAny(qlist, forest, type="end") qlist %over% forest subsetByOverlaps(qlist, forest) countOverlaps(qlist, forest) } \keyword{methods} IRanges/man/funprog-methods.Rd0000644000126300012640000000361612227064476017670 0ustar00biocbuildphs_compbio\name{funprog-methods} \alias{funprog-methods} \alias{Reduce,List-method} \alias{Filter,List-method} \alias{Find,List-method} \alias{Map,List-method} \alias{Position,List-method} \title{Functional programming methods for List objects} \description{ The R base package defines some higher-order functions that are commonly found in Functional Programming Languages. See \code{?\link[base]{Reduce}} for the details, and, in particular, for a description of their arguments. The IRanges package provides methods for \link{List} objects, so, in addition to be an ordinary vector or list, the \code{x} argument can also be a \link{List} object. } \usage{ \S4method{Reduce}{List}(f, x, init, right=FALSE, accumulate=FALSE) \S4method{Filter}{List}(f, x) \S4method{Find}{List}(f, x, right=FALSE, nomatch=NULL) \S4method{Map}{List}(f, ...) \S4method{Position}{List}(f, x, right=FALSE, nomatch=NA_integer_) } \arguments{ \item{f, init, right, accumulate, nomatch}{ See \code{?base::\link[base]{Reduce}} for a description of these arguments. } \item{x}{ A \link{List} object. } \item{...}{ One or more \link{List} objects. (FIXME: Mixing \link{List} objects with ordinary lists doesn't seem to work properly at the moment.) } } \author{P. Aboyoun} \seealso{ \itemize{ \item The \link{List} class. \item The \link{IntegerList} class and constructor for an example of a \link{List} subclass. \item \code{\link[base]{Reduce}} for a full description of what these functions do and what they return. } } \examples{ x <- IntegerList(a=1:3, b=16:11, c=22:21, d=31:36) x Reduce("+", x) Filter(is.unsorted, x) pos1 <- Position(is.unsorted, x) stopifnot(identical(Find(is.unsorted, x), x[[pos1]])) pos2 <- Position(is.unsorted, x, right=TRUE) stopifnot(identical(Find(is.unsorted, x, right=TRUE), x[[pos2]])) y <- x * 1000L Map("c", x, y) } \keyword{methods} IRanges/man/inter-range-methods.Rd0000644000126300012640000003242512227064476020423 0ustar00biocbuildphs_compbio\name{inter-range-methods} \alias{inter-range-methods} \alias{range,Ranges-method} \alias{range,RangesList-method} \alias{range,CompressedIRangesList-method} \alias{range,IntervalForest-method} \alias{range,RangedData-method} \alias{reduce} \alias{reduce,IRanges-method} \alias{reduce,Ranges-method} \alias{reduce,Views-method} \alias{reduce,RangesList-method} \alias{reduce,CompressedIRangesList-method} \alias{reduce,IntervalForest-method} \alias{reduce,RangedData-method} \alias{gaps} \alias{gaps,IRanges-method} \alias{gaps,Ranges-method} \alias{gaps,Views-method} \alias{gaps,RangesList-method} \alias{gaps,IntervalForest-method} \alias{gaps,CompressedIRangesList-method} \alias{gaps,MaskCollection-method} \alias{disjoin} \alias{disjoin,Ranges-method} \alias{disjoin,RangesList-method} \alias{disjoin,IntervalForest-method} \alias{disjoin,CompressedIRangesList-method} \alias{isDisjoint} \alias{isDisjoint,Ranges-method} \alias{isDisjoint,RangesList-method} \alias{disjointBins} \alias{disjointBins,Ranges-method} \alias{disjointBins,RangesList-method} \title{Inter range transformations of a Ranges, Views, RangesList, MaskCollection, or RangedData object} \description{ Except for \code{isDisjoint()} and \code{disjointBins()}, all the transformations described in this man page are \emph{endomorphisms} that operate on a single "range-based" object, that is, they transform the ranges contained in the input object and return them in an object of the \emph{same class} as the input object. Range-based endomorphisms are grouped in 2 categories: \enumerate{ \item Intra range transformations like \code{\link{shift}()} that transform each range individually (and independently of the other ranges) and return an object of the \emph{same length} as the input object. Those transformations are described in the \link{intra-range-methods} man page (see \code{?`\link{intra-range-methods}`}). \item Inter range transformations like \code{reduce()} that transform all the ranges together as a set to produce a new set of ranges and return an object not necessarily of the same length as the input object. Those transformations are described in this man page. } } \usage{ ## range() ## ------- \S4method{range}{Ranges}(x, ..., na.rm=FALSE) \S4method{range}{RangesList}(x, ..., na.rm=FALSE) ## reduce() ## -------- reduce(x, ...) \S4method{reduce}{Ranges}(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) \S4method{reduce}{Views}(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) \S4method{reduce}{RangesList}(x, drop.empty.ranges=FALSE, min.gapwidth=1L, with.mapping=FALSE, with.inframe.attrib=FALSE) \S4method{reduce}{RangedData}(x, by=character(), drop.empty.ranges=FALSE, min.gapwidth=1L, with.inframe.attrib=FALSE) ## gaps() ## ------ gaps(x, start=NA, end=NA) ## disjoin() ## --------- disjoin(x, ...) ## isDisjoint() ## ------------ isDisjoint(x, ...) ## disjointBins() ## -------------- disjointBins(x, ...) } \arguments{ \item{x}{ A \link{Ranges}, \link{Views}, \link{RangesList}, \link{MaskCollection}, or \link{RangedData} object. } \item{...}{ For \code{range}, additional \code{Ranges} or \code{RangesList} to consider. } \item{na.rm}{Ignored.} \item{drop.empty.ranges}{ \code{TRUE} or \code{FALSE}. Should empty ranges be dropped? } \item{min.gapwidth}{ Ranges separated by a gap of at least \code{min.gapwidth} positions are not merged. } \item{with.mapping}{ \code{TRUE} or \code{FALSE}. Should the mapping from reduced to original ranges be stored in the returned object? If yes, then it is stored as metadata column \code{"mapping"} of type \link{IntegerList}. } \item{with.inframe.attrib}{ \code{TRUE} or \code{FALSE}. For internal use. } \item{by}{ A character vector. } \item{start, end}{ \itemize{ \item If \code{x} is a \link{Ranges} or \link{Views} object: A single integer or \code{NA}. Use these arguments to specify the interval of reference i.e. which interval the returned gaps should be relative to. \item If \code{x} is a \link{RangesList} object: Integer vectors containing the coordinate bounds for each \link{RangesList} top-level element. } } } \details{ Here we start by describing how each transformation operates on a \link{Ranges} object \code{x}. \code{range} first combines \code{x} and the arguments in \code{...}. If the combined \link{IRanges} object contains at least 1 range, then \code{range} returns an \code{IRanges} instance with a single range, from the minimum start to the maximum end of the combined object. Otherwise (i.e. if the combined object contains no range), \code{IRanges()} is returned (i.e. an \link{IRanges} instance of length 0). If \code{x} is a \link{RangedData} object, then \code{range} returns a \code{RangesList} object resulting from calling \code{range(ranges(x))}, i.e. the bounds of the ranges in each space. \code{reduce} first orders the ranges in \code{x} from left to right, then merges the overlapping or adjacent ones. If \code{x} is a \link{RangedData} object, \code{reduce} merges the ranges in each of the spaces after grouping by the \code{by} values columns and returns the result as a \code{RangedData} containing the reduced ranges and the \code{by} value columns. \code{gaps} returns the "normal" \link{Ranges} object representing the set of integers that remain after the set of integers represented by \code{x} has been removed from the interval specified by the \code{start} and \code{end} arguments. If \code{x} is a \link{Views} object, then \code{start=NA} and \code{end=NA} are interpreted as \code{start=1} and \code{end=length(subject(x))}, respectively, so, if \code{start} and \code{end} are not specified, then gaps are extracted with respect to the entire subject. \code{disjoin} returns a disjoint object, by finding the union of the end points in \code{x}. In other words, the result consists of a range for every interval, of maximal length, over which the set of overlapping ranges in \code{x} is the same and at least of size 1. \code{isDisjoint} returns a logical value indicating whether the ranges \code{x} are disjoint (i.e. non-overlapping). \code{isDisjoint} handles empty ranges (a.k.a. zero-width ranges) as follow: single empty range A is considered to overlap with single range B iff it's contained in B without being on the edge of B (in which case it would be ambiguous whether A is contained in or adjacent to B). In other words, single empty range A is considered to overlap with single range B iff \preformatted{ start(B) < start(A) and end(A) < end(B)} Because A is an empty range it verifies \code{end(A) = start(A) - 1} so the above is equivalent to: \preformatted{ start(B) < start(A) <= end(B)} and also equivalent to: \preformatted{ start(B) <= end(A) < end(B)} Finally, it is also equivalent to: \preformatted{ compare(A, B) == 2} See \code{?\link{compare}} for the meaning of the codes returned by the \code{\link{compare}} function. \code{disjointBins} segregates \code{x} into a set of bins so that the ranges in each bin are disjoint. Lower-indexed bins are filled first. The method returns an integer vector indicating the bin index for each range. When \code{x} in a \link{RangesList} object, doing any of the transformation above is equivalent to applying the transformation to each \link{RangesList} top-level element separately. For \code{range}, if there are additional \code{RangesList} objects in \code{...}, they are merged into \code{x} by name, if all objects have names, otherwise, if they are all of the same length, by position. Else, an exception is thrown. } \author{H. Pages, M. Lawrence, P. Aboyoun} \seealso{ \itemize{ \item \link{intra-range-methods} for intra range transformations. \item The \link{Ranges}, \link{Views}, \link{RangesList}, \link{MaskCollection}, and \link{RangedData} classes. \item The \link[GenomicRanges]{inter-range-methods} man page in the GenomicRanges package for methods that operate on \link[GenomicRanges]{GenomicRanges} and other objects. \item \link{setops-methods} for set operations on \link{IRanges} objects. \item \code{\link{solveUserSEW}} for the SEW (Start/End/Width) interface. } } \examples{ ## --------------------------------------------------------------------- ## range() ## --------------------------------------------------------------------- ## On a Ranges object: x <- IRanges(start=c(-2, 6, 9, -4, 1, 0, -6, 3, 10), width=c( 5, 0, 6, 1, 4, 3, 2, 0, 3)) range(x) ## On a RangesList object (XVector package required): range1 <- IRanges(start=c(1, 2, 3), end=c(5, 2, 8)) range2 <- IRanges(start=c(15, 45, 20, 1), end=c(15, 100, 80, 5)) range3 <- IRanges(start=c(-2, 6, 7), width=c(8, 0, 0)) # with empty ranges collection <- IRangesList(one=range1, range2, range3) if (require(XVector)) { range(collection) } irl1 <- IRangesList(a=IRanges(c(1,2),c(4,3)), b=IRanges(c(4,6),c(10,7))) irl2 <- IRangesList(c=IRanges(c(0,2),c(4,5)), a=IRanges(c(4,5),c(6,7))) range(irl1, irl2) # matched by names names(irl2) <- NULL range(irl1, irl2) # now by position ## On a RangedData object: ranges <- IRanges(c(1,2,3),c(4,5,6)) score <- c(10L, 2L, NA) rd <- RangedData(ranges, score) range(rd) rd2 <- RangedData(IRanges(c(5,2,0), c(6,3,1))) range(rd, rd2) ## --------------------------------------------------------------------- ## reduce() ## --------------------------------------------------------------------- ## On a Ranges object: reduce(x) y <- reduce(x, with.mapping=TRUE) mcols(y)$mapping # an IntegerList reduce(x, drop.empty.ranges=TRUE) y <- reduce(x, drop.empty.ranges=TRUE, with.mapping=TRUE) mcols(y)$mapping ## Use the mapping from reduced to original ranges to split the DataFrame ## of original metadata columns by reduced range: ir0 <- IRanges(c(11:13, 2, 7:6), width=3) mcols(ir0) <- DataFrame(id=letters[1:6], score=1:6) ir <- reduce(ir0, with.mapping=TRUE) ir mapping <- mcols(ir)$mapping mapping relist(mcols(ir0)[unlist(mapping), ], mapping) # a SplitDataFrameList ## On a RangesList object. These 4 are the same: res1 <- reduce(collection) res2 <- IRangesList(one=reduce(range1), reduce(range2), reduce(range3)) res3 <- do.call(IRangesList, lapply(collection, reduce)) res4 <- endoapply(collection, reduce) stopifnot(identical(res2, res1)) stopifnot(identical(res3, res1)) stopifnot(identical(res4, res1)) reduce(collection, drop.empty.ranges=TRUE) ## On a RangedData object: rd <- RangedData( RangesList( chrA=IRanges(start=c(1, 4, 6), width=c(3, 2, 4)), chrB=IRanges(start=c(1, 3, 6), width=c(3, 3, 4))), score=c(2, 7, 3, 1, 1, 1)) rd reduce(rd) ## --------------------------------------------------------------------- ## gaps() ## --------------------------------------------------------------------- ## On a Ranges object: x0 <- IRanges(start=c(-2, 6, 9, -4, 1, 0, -6, 10), width=c( 5, 0, 6, 1, 4, 3, 2, 3)) gaps(x0) gaps(x0, start=-6, end=20) ## On a Views object: subject <- Rle(1:-3, 6:2) v <- Views(subject, start=c(8, 3), end=c(14, 4)) gaps(v) ## On a RangesList object. These 4 are the same: res1 <- gaps(collection) res2 <- IRangesList(one=gaps(range1), gaps(range2), gaps(range3)) res3 <- do.call(IRangesList, lapply(collection, gaps)) res4 <- endoapply(collection, gaps) stopifnot(identical(res2, res1)) stopifnot(identical(res3, res1)) stopifnot(identical(res4, res1)) ## On a MaskCollection object: mask1 <- Mask(mask.width=29, start=c(11, 25, 28), width=c(5, 2, 2)) mask2 <- Mask(mask.width=29, start=c(3, 10, 27), width=c(5, 8, 1)) mask3 <- Mask(mask.width=29, start=c(7, 12), width=c(2, 4)) mymasks <- append(append(mask1, mask2), mask3) mymasks gaps(mymasks) ## --------------------------------------------------------------------- ## disjoin() ## --------------------------------------------------------------------- ## On a Ranges object: ir <- IRanges(c(1, 1, 4, 10), c(6, 3, 8, 10)) disjoin(ir) # IRanges(c(1, 4, 7, 10), c(3, 6, 8, 10)) ## On a RangesList object: disjoin(collection) ## --------------------------------------------------------------------- ## isDisjoint() ## --------------------------------------------------------------------- ## On a Ranges object: isDisjoint(IRanges(c(2,5,1), c(3,7,3))) # FALSE isDisjoint(IRanges(c(2,9,5), c(3,9,6))) # TRUE isDisjoint(IRanges(1, 5)) # TRUE ## Handling of empty ranges: x <- IRanges(c(11, 16, 11, -2, 11), c(15, 29, 10, 10, 10)) stopifnot(isDisjoint(x)) ## Sliding an empty range along a non-empty range: sapply(11:17, function(i) compare(IRanges(i, width=0), IRanges(12, 15))) sapply(11:17, function(i) isDisjoint(c(IRanges(i, width=0), IRanges(12, 15)))) ## On a RangesList object: isDisjoint(collection) ## --------------------------------------------------------------------- ## disjointBins() ## --------------------------------------------------------------------- ## On a Ranges object: disjointBins(IRanges(1, 5)) # 1L disjointBins(IRanges(c(3, 1, 10), c(5, 12, 13))) # c(2L, 1L, 2L) ## On a RangesList object: disjointBins(collection) } \keyword{utilities} IRanges/man/intra-range-methods.Rd0000644000126300012640000004212412227064476020414 0ustar00biocbuildphs_compbio\name{intra-range-methods} \alias{intra-range-methods} \alias{shift} \alias{shift,Ranges-method} \alias{shift,Views-method} \alias{shift,RangesList-method} \alias{shift,CompressedIRangesList-method} \alias{shift,IntervalForest-method} \alias{narrow} \alias{narrow,Ranges-method} \alias{narrow,Views-method} \alias{narrow,RangesList-method} \alias{narrow,IntervalForest-method} \alias{narrow,CompressedIRangesList-method} \alias{narrow,MaskCollection-method} \alias{flank} \alias{flank,Ranges-method} \alias{flank,RangesList-method} \alias{flank,IntervalForest-method} \alias{flank,CompressedIRangesList-method} \alias{promoters} \alias{promoters,Ranges-method} \alias{promoters,Views-method} \alias{promoters,RangesList-method} \alias{promoters,CompressedIRangesList-method} \alias{promoters,IntervalForest-method} \alias{reflect} \alias{reflect,Ranges-method} \alias{resize} \alias{resize,Ranges-method} \alias{resize,RangesList-method} \alias{resize,IntervalList-method} \alias{resize,CompressedIRangesList-method} \alias{resize,IntervalForest-method} \alias{restrict} \alias{restrict,Ranges-method} \alias{restrict,RangesList-method} \alias{restrict,IntervalForest-method} \alias{restrict,CompressedIRangesList-method} \alias{threebands} \alias{threebands,IRanges-method} \alias{Ops,Ranges,numeric-method} \alias{Ops,Ranges,ANY-method} \alias{Ops,CompressedIRangesList,ANY-method} \alias{Ops,RangesList,ANY-method} \title{Intra range transformations of a Ranges, Views, RangesList, or MaskCollection object} \description{ Except for \code{threebands()}, all the transformations described in this man page are \emph{endomorphisms} that operate on a single "range-based" object, that is, they transform the ranges contained in the input object and return them in an object of the \emph{same class} as the input object. Range-based endomorphisms are grouped in 2 categories: \enumerate{ \item Intra range transformations like \code{shift()} that transform each range individually (and independently of the other ranges) and return an object of the \emph{same length} as the input object. Those transformations are described in this man page. \item Inter range transformations like \code{\link{reduce}()} that transform all the ranges together as a set to produce a new set of ranges and return an object not necessarily of the same length as the input object. Those transformations are described in the \link{inter-range-methods} man page (see \code{?`\link{inter-range-methods}`}). } } \usage{ ## shift() shift(x, shift=0L, use.names=TRUE) ## narrow() narrow(x, start=NA, end=NA, width=NA, use.names=TRUE) ## flank() flank(x, width, start=TRUE, both=FALSE, use.names=TRUE, ...) ## promoters() promoters(x, upstream=2000, downstream=200, ...) ## reflect() reflect(x, bounds, use.names=TRUE) ## resize() resize(x, width, fix="start", use.names=TRUE, ...) ## restrict() restrict(x, start=NA, end=NA, keep.all.ranges=FALSE, use.names=TRUE) ## threebands() threebands(x, start=NA, end=NA, width=NA) } \arguments{ \item{x}{ A \link{Ranges}, \link{Views}, \link{RangesList}, or \link{MaskCollection} object. } \item{shift}{ An integer vector containing the shift information. Recycled as necessary so that each element corresponds to a range in \code{x}. It can also be an \link{IntegerList} object if \code{x} is a \link{RangesList} object. } \item{use.names}{ \code{TRUE} or \code{FALSE}. Should names be preserved? } \item{start, end}{ \itemize{ \item If \code{x} is a \link{Ranges} or \link{Views} object: A vector of integers for all functions except for \code{flank}. For \code{restrict}, the supplied \code{start} and \code{end} arguments must be vectors of integers, eventually with NAs, that specify the restriction interval(s). Recycled as necessary so that each element corresponds to a range in \code{x}. Same thing for \code{narrow} and \code{threebands}, except that here \code{start} and \code{end} must contain coordinates relative to the ranges in \code{x}. See the Details section below. For \code{flank}, \code{start} is a logical indicating whether \code{x} should be flanked at the start (\code{TRUE}) or the end (\code{FALSE}). Recycled as necessary so that each element corresponds to a range in \code{x}. \item If \code{x} is a \link{RangesList} object: For \code{flank}, \code{start} must be either a logical vector or a \link{LogicalList} object indicating whether \code{x} should be flanked at the start (\code{TRUE}) or the end (\code{FALSE}). Recycled as necessary so that each element corresponds to a range in \code{x}. For \code{narrow}, \code{start} and \code{end} must be either an integer vector or an \link{IntegerList} object containing coordinates relative to the current ranges. For \code{restrict}, \code{start} and \code{end} must be either an integer vector or an \link{IntegerList} object (possibly containing NA's). } } \item{width}{ \itemize{ \item If \code{x} is a \link{Ranges} or \link{Views} object: For \code{narrow} and \code{threebands}, a vector of integers, eventually with NAs. See the SEW (Start/End/Width) interface for the details (\code{?solveUserSEW}). For \code{resize} and \code{flank}, the width of the resized or flanking regions. Note that if \code{both} is \code{TRUE}, this is effectively doubled. Recycled as necessary so that each element corresponds to a range in \code{x}. \item If \code{x} is a \link{RangesList} object: For \code{flank} and \code{resize}, either an integer vector or an \link{IntegerList} object containing the width of the flanking or resized regions. Recycled as necessary so that each element corresponds to a range in \code{x}. (Note for \code{flank}: if \code{both} is \code{TRUE}, this is effectively doubled.) For \code{narrow}, either an integer vector or a \link{IntegerList} object containing the widths to narrow to. See the SEW (Start/End/Width) interface for the details (\code{?solveUserSEW}). } } \item{both}{ If \code{TRUE}, extends the flanking region \code{width} positions \emph{into} the range. The resulting range thus straddles the end point, with \code{width} positions on either side. } \item{bounds}{ An \link{IRanges} object to serve as the reference bounds for the reflection, see below. } \item{fix}{ \itemize{ \item If \code{x} is a \link{Ranges} or \link{Views} object: A character vector or character-Rle of length 1 or \code{length(x)} containing the values \code{"start"}, \code{"end"}, and \code{"center"} denoting what to use as an anchor for each element in \code{x}. \item If \code{x} is a \link{RangesList} object: A character vector of length 1, a \link{CharacterList} object, or a character-RleList object containing the values \code{"start"}, \code{"end"}, and \code{"center"} denoting what to use as an anchor for each element in \code{x}. } } \item{upstream, downstream}{ Single \code{integer} values >= 0L. \code{upstream} defines the number of nucleotides toward the 5' end and \code{downstream} defines the number toward the 3' end, relative to the transcription start site. Promoter regions are formed by merging the upstream and downstream ranges. Default values for \code{upstream} and \code{downstream} were chosen based on our current understanding of gene regulation. On average, promoter regions in the mammalian genome are 5000 bp upstream and downstream of the transcription start site. } \item{keep.all.ranges}{ \code{TRUE} or \code{FALSE}. Should ranges that don't overlap with the restriction interval(s) be kept? Note that "don't overlap" means that they end strictly before \code{start - 1} or start strictly after \code{end + 1}. Ranges that end at \code{start - 1} or start at \code{end + 1} are always kept and their width is set to zero in the returned \link{IRanges} object. } \item{...}{ Additional arguments for methods. } } \details{ Here we start by describing how each transformation operates on a \link{Ranges} object \code{x}. \code{shift} shifts all the ranges in \code{x} by the amount specified by the \code{shift} argument. \code{narrow} narrows the ranges in \code{x} i.e. each range in the returned \link{Ranges} object is a subrange of the corresponding range in \code{x}. The supplied start/end/width values are solved by a call to \code{solveUserSEW(width(x), start=start, end=end, width=width)} and therefore must be compliant with the rules of the SEW (Start/End/Width) interface (see \code{?\link{solveUserSEW}} for the details). Then each subrange is derived from the original range according to the solved start/end/width values for this range. Note that those solved values are interpreted relatively to the original range. \code{flank} generates flanking ranges for each range in \code{x}. If \code{start} is \code{TRUE} for a given range, the flanking occurs at the start, otherwise the end. The widths of the flanks are given by the \code{width} parameter. The widths can be negative, in which case the flanking region is reversed so that it represents a prefix or suffix of the range in \code{x}. The \code{flank} operation is illustrated below for a call of the form \code{flank(x, 3, TRUE)}, where \code{x} indicates a range in \code{x} and \code{-} indicates the resulting flanking region: \preformatted{ ---xxxxxxx } If \code{start} were \code{FALSE}: \preformatted{ xxxxxxx--- } For negative width, i.e. \code{flank(x, -3, FALSE)}, where \code{*} indicates the overlap between \code{x} and the result: \preformatted{ xxxx*** } If \code{both} is \code{TRUE}, then, for all ranges in \code{x}, the flanking regions are extended \emph{into} (or out of, if width is negative) the range, so that the result straddles the given endpoint and has twice the width given by \code{width}. This is illustrated below for \code{flank(x, 3, both=TRUE)}: \preformatted{ ---***xxxx } \code{promoters} generates promoter ranges for each range in \code{x} relative to the transcription start site (TSS), where TSS is \code{start(x)}. The promoter range is expanded around the TSS according to the \code{upsteam} and \code{downstream} arguments. \code{upstream} represents the number of nucleotides in the 5' direction and \code{downstream} the number in the 3' direction. The full range is defined as, (start(x) - upstream) to (start(x) + downstream - 1). For documentation for using \code{promoters} on \code{GenomicRanges} objects see ?\code{"promoters,GRanges-method"}. \code{reflect} "reflects" or reverses each range in \code{x} relative to the corresponding range in \code{bounds}, which is recycled as necessary. Reflection preserves the width of a range, but shifts it such the distance from the left bound to the start of the range becomes the distance from the end of the range to the right bound. This is illustrated below, where \code{x} represents a range in \code{x} and \code{[} and \code{]} indicate the bounds: \preformatted{ [..xxx.....] becomes [.....xxx..] } \code{restrict} restricts the ranges in \code{x} to the interval(s) specified by the \code{start} and \code{end} arguments. \code{resize} resizes the ranges to the specified width where either the start, end, or center is used as an anchor. \code{threebands} extends the capability of \code{narrow} by returning the 3 ranges objects associated to the narrowing operation. The returned value \code{y} is a list of 3 ranges objects named \code{"left"}, \code{"middle"} and \code{"right"}. The middle component is obtained by calling \code{narrow} with the same arguments (except that names are dropped). The left and right components are also instances of the same class as \code{x} and they contain what has been removed on the left and right sides (respectively) of the original ranges during the narrowing. Note that original object \code{x} can be reconstructed from the left and right bands with \code{punion(y$left, y$right, fill.gap=TRUE)}. When \code{x} in a \link{RangesList} object, doing any of the transformation above is equivalent to applying the transformation to each \link{RangesList} top-level element separately. } \author{H. Pages, M. Lawrence, P. Aboyoun} \seealso{ \itemize{ \item \link{inter-range-methods} for inter range transformations. \item The \link{Ranges}, \link{Views}, \link{RangesList}, and \link{MaskCollection} classes. \item The \link[XVector]{intra-range-methods} man page in the XVector package for methods that operate on \link[XVector]{XVectorList} objects. \item The \link[GenomicRanges]{intra-range-methods} man page in the GenomicRanges package for methods that operate on \link[GenomicRanges]{GenomicRanges} and other objects. \item \link{setops-methods} for set operations on \link{IRanges} objects. \item \code{\link{solveUserSEW}} for the SEW (Start/End/Width) interface. } } \examples{ ## --------------------------------------------------------------------- ## shift() ## --------------------------------------------------------------------- ## On a Ranges object ir1 <- successiveIRanges(c(19, 5, 0, 8, 5)) ir1 shift(ir1, shift=-3) ## On a RangesList object range1 <- IRanges(start=c(1, 2, 3), end=c(5, 2, 8)) range2 <- IRanges(start=c(15, 45, 20, 1), end=c(15, 100, 80, 5)) range3 <- IRanges(start=c(-2, 6, 7), width=c(8, 0, 0)) # with empty ranges collection <- IRangesList(one=range1, range2, range3) shift(collection, shift=5) ## --------------------------------------------------------------------- ## narrow() ## --------------------------------------------------------------------- ## On a Ranges object ir2 <- ir1[width(ir1) != 0] narrow(ir2, start=4, end=-2) narrow(ir2, start=-4, end=-2) narrow(ir2, end=5, width=3) narrow(ir2, start=c(3, 4, 2, 3), end=c(12, 5, 7, 4)) ## On a RangesList object narrow(collection[-3], start=2) narrow(collection[-3], end=-2) ## On a MaskCollection object mask1 <- Mask(mask.width=29, start=c(11, 25, 28), width=c(5, 2, 2)) mask2 <- Mask(mask.width=29, start=c(3, 10, 27), width=c(5, 8, 1)) mask3 <- Mask(mask.width=29, start=c(7, 12), width=c(2, 4)) mymasks <- append(append(mask1, mask2), mask3) mymasks narrow(mymasks, start=8) ## --------------------------------------------------------------------- ## flank() ## --------------------------------------------------------------------- ## On a Ranges object ir3 <- IRanges(c(2,5,1), c(3,7,3)) flank(ir3, 2) flank(ir3, 2, start=FALSE) flank(ir3, 2, start=c(FALSE, TRUE, FALSE)) flank(ir3, c(2, -2, 2)) flank(ir3, 2, both = TRUE) flank(ir3, 2, start=FALSE, both=TRUE) flank(ir3, -2, start=FALSE, both=TRUE) ## On a RangesList object flank(collection, width=10) ## --------------------------------------------------------------------- ## promoters() ## --------------------------------------------------------------------- ## On a Ranges object ir4 <- IRanges(20:23, width=3) promoters(ir4, upstream=0, downstream=0) ## no change promoters(ir4, upstream=0, downstream=1) ## start value only promoters(ir4, upstream=1, downstream=0) ## single upstream nucleotide ## On a RangesList object promoters(collection, upstream=5, downstream=2) ## --------------------------------------------------------------------- ## reflect() ## --------------------------------------------------------------------- ## On a Ranges object bounds <- IRanges(c(0, 5, 3), c(10, 6, 9)) reflect(ir3, bounds) ## reflect() does not yet support RangesList objects! ## --------------------------------------------------------------------- ## resize() ## --------------------------------------------------------------------- ## On a Ranges object resize(ir2, 200) resize(ir2, 2, fix="end") ## On a RangesList object resize(collection, width=200) ## --------------------------------------------------------------------- ## restrict() ## --------------------------------------------------------------------- ## On a Ranges object restrict(ir1, start=12, end=34) restrict(ir1, start=20) restrict(ir1, start=21) restrict(ir1, start=21, keep.all.ranges=TRUE) ## On a RangesList object restrict(collection, start=2, end=8) ## --------------------------------------------------------------------- ## threebands() ## --------------------------------------------------------------------- ## On a Ranges object z <- threebands(ir2, start=4, end=-2) ir2b <- punion(z$left, z$right, fill.gap=TRUE) stopifnot(identical(ir2, ir2b)) threebands(ir2, start=-5) ## threebands() does not support RangesList objects. } \keyword{utilities} IRanges/man/isConstant.Rd0000644000126300012640000000435612227064476016676 0ustar00biocbuildphs_compbio\name{isConstant} \alias{isConstant} \alias{isConstant,integer-method} \alias{isConstant,numeric-method} \alias{isConstant,array-method} \title{Test if an atomic vector or array is constant} \description{ Generic function to test if an atomic vector or array is constant or not. Currently only methods for vectors or arrays of type integer or double are implemented. } \usage{ isConstant(x) } \arguments{ \item{x}{ An atomic vector or array. } } \details{ Vectors of length 0 or 1 are always considered to be constant. } \value{ A single logical i.e. \code{TRUE}, \code{FALSE} or \code{NA}. } \author{H. Pages} \seealso{ \code{\link{duplicated}}, \code{\link{unique}}, \code{\link{all.equal}}, \code{\link{NA}}, \code{\link{is.finite}} } \examples{ ## --------------------------------------------------------------------- ## A. METHOD FOR integer VECTORS ## --------------------------------------------------------------------- ## On a vector with no NAs: stopifnot(isConstant(rep(-29L, 10000))) ## On a vector with NAs: stopifnot(!isConstant(c(0L, NA, -29L))) stopifnot(is.na(isConstant(c(-29L, -29L, NA)))) ## On a vector of length <= 1: stopifnot(isConstant(NA_integer_)) ## --------------------------------------------------------------------- ## B. METHOD FOR numeric VECTORS ## --------------------------------------------------------------------- ## This method does its best to handle rounding errors and special ## values NA, NaN, Inf and -Inf in a way that "makes sense". ## Below we only illustrate handling of rounding errors. ## Here values in 'x' are "conceptually" the same: x <- c(11/3, 2/3 + 4/3 + 5/3, 50 + 11/3 - 50, 7.00001 - 1000003/300000) ## However, due to machine rounding errors, they are not *strictly* ## equal: duplicated(x) unique(x) ## only *nearly* equal: all.equal(x, rep(11/3, 4)) # TRUE ## 'isConstant(x)' uses 'all.equal()' internally to decide whether ## the values in 'x' are all the same or not: stopifnot(isConstant(x)) ## This is not perfect though: isConstant((x - 11/3) * 1e8) # FALSE on Intel Pentium paltforms # (but this is highly machine dependent!) } \keyword{utilities} IRanges/man/multisplit.Rd0000644000126300012640000000160012227064476016744 0ustar00biocbuildphs_compbio\name{multisplit} \alias{multisplit} \title{ Split elements belonging to multiple groups } \description{ This is like \code{\link{split}}, except elements can belong to multiple groups, in which case they are repeated to appear in multiple elements of the return value. } \usage{ multisplit(x, f) } \arguments{ \item{x}{ The object to split, like a vector. } \item{f}{ A list-like object of vectors, the same length as \code{x}, where each element indicates the groups to which each element of \code{x} belongs. } } \value{ A list-like object, with an element for each unique value in the unlisted \code{f}, containing the elements in \code{x} where the corresponding element in \code{f} contained that value. Just try it. } \author{ Michael Lawrence } \examples{ multisplit(1:3, list(letters[1:2], letters[2:3], letters[2:4])) } \keyword{ manip } IRanges/man/nearest-methods.Rd0000644000126300012640000001733212227064476017651 0ustar00biocbuildphs_compbio\name{nearest-methods} \alias{nearest-methods} \alias{class:RangesORmissing} \alias{RangesORmissing-class} \alias{RangesORmissing} \alias{nearest} \alias{precede} \alias{follow} \alias{distance} \alias{distanceToNearest} \alias{nearest,Ranges,RangesORmissing-method} \alias{precede,Ranges,RangesORmissing-method} \alias{follow,Ranges,RangesORmissing-method} \alias{distance,Ranges,Ranges-method} \alias{distanceToNearest,Ranges,RangesORmissing-method} \title{Finding the nearest range neighbor} \description{ The \code{nearest}, \code{precede}, \code{follow}, \code{distance} and \code{distanceToNearest} methods for \code{\linkS4class{Ranges}} objects and subclasses. } \usage{ \S4method{nearest}{Ranges,RangesORmissing}(x, subject, select = c("arbitrary", "all")) \S4method{precede}{Ranges,RangesORmissing}(x, subject, select = c("first", "all")) \S4method{follow}{Ranges,RangesORmissing}(x, subject, select = c("last", "all")) \S4method{distanceToNearest}{Ranges,RangesORmissing}(x, subject, select = c("arbitrary", "all")) \S4method{distance}{Ranges,Ranges}(x, y) } \arguments{ \item{x}{The query \code{\linkS4class{Ranges}} instance. } \item{subject}{The subject \code{Ranges} instance, within which the nearest neighbors are found. Can be missing, in which case \code{x} is also the subject. } \item{y}{For the \code{distance} method, a \code{Ranges} instance. Cannot be missing. If \code{x} and \code{y} are not the same length, the shortest will be recycled to match the length of the longest. } \item{select}{Logic for handling ties. By default, all the methods select a single interval (arbitrary for \code{nearest},the first by order in \code{subject} for \code{precede}, and the last for \code{follow}). To get all matchings, as a \code{Hits} object, use \dQuote{all}. } \item{...}{Additional arguments for methods} } \details{ \itemize{ \item{nearest: }{ The conventional nearest neighbor finder. Returns a integer vector containing the index of the nearest neighbor range in \code{subject} for each range in \code{x}. If there is no nearest neighbor (if \code{subject} is empty), NA's are returned. The algorithm is roughly as follows, for a range \code{xi} in \code{x}: \enumerate{ \item Find the ranges in \code{subject} that overlap \code{xi}. If a single range \code{si} in \code{subject} overlaps \code{xi}, \code{si} is returned as the nearest neighbor of \code{xi}. If there are multiple overlaps, one of the overlapping ranges is chosen arbitrarily. \item If no ranges in \code{subject} overlap with \code{xi}, then the range in \code{subject} with the shortest distance from its end to the start \code{xi} or its start to the end of \code{xi} is returned. } } \item{precede: }{ For each range in \code{x}, \code{precede} returns the index of the interval in \code{subject} that is directly preceded by the query range. Overlapping ranges are excluded. \code{NA} is returned when there are no qualifying ranges in \code{subject}. } \item{follow: }{ The opposite of \code{precede}, this function returns the index of the range in \code{subject} that a query range in \code{x} directly follows. Overlapping ranges are excluded. \code{NA} is returned when there are no qualifying ranges in \code{subject}. } \item{distanceToNearest: }{ Returns the distance for each range in \code{x} to its nearest neighbor in \code{subject}. } \item{distance: }{ Returns the distance for each range in \code{x} to the range in \code{y}. The \code{distance} method differs from others documented on this page in that it is symmetric; \code{y} cannot be missing. If \code{x} and \code{y} are not the same length, the shortest will be recycled to match the length of the longest. The \code{select} argument is not available for \code{distance} because comparisons are made in a pair-wise fashion. The return value is the length of the longest of \code{x} and \code{y}. In Bioconductor >=2.12 the distance calculation has been changed to accommodate zero-width ranges in a consistent and intuitive manner. Because of this change, a warning will be emitted when \code{distance} is called. This warning is temporary and will be removed in Bioconductor 2.13. To suppress the warning, code can be wrapped in \code{suppressWarnings()}. The modified \code{distance} calculation can be explained by a `block' model where a range is represented by a series of blocks of size 1. Blocks are adjacent to each other and there is no gap between them. A visual representation of IRanges(4,7) would be \preformatted{ +-----+-----+-----+-----+ 4 5 6 7 } The distance between two consecutive blocks is 0L (prior to Bioconductor 2.12 it was 1L). The distance calculation now returns the number of gaps between two ranges. This change to distance affects the notion of overlaps in that we no longer say: x and y overlap <=> distance(x, y) == 0 Instead we say x and y overlap => distance(x, y) == 0 or x and y overlap or are adjacent <=> distance(x, y) == 0 } } } \value{ For \code{nearest}, \code{precede} and \code{follow}, an integer vector of indices in \code{subject}, or a \code{\linkS4class{Hits}} if \code{select="all"}. For \code{distanceToNearest}, a \code{Hits} object with a column for the \code{query} index (queryHits), \code{subject} index (subjectHits) and \code{distance} between the pair. For \code{distance}, an integer vector of distances between the ranges in \code{x} and \code{y}. } \author{M. Lawrence} \seealso{ \itemize{ \item The \link{Ranges} and \link{Hits} classes. \item The \link[GenomicRanges]{GenomicRanges} and \link[GenomicRanges]{GRanges} classes in the GenomicRanges package. \item \code{\link{findOverlaps}} for finding just the overlapping ranges. \item{}{ GenomicRanges methods for \itemize{ \item \code{precede} \item \code{follow} \item \code{nearest} \item \code{distance} \item \code{distanceToNearest} } are documented at ?\code{\link[GenomicRanges]{nearest-methods}} or ?\code{\link[GenomicRanges]{precede,GenomicRanges,GenomicRanges-method}} } } } \examples{ ## ------------------------------------------ ## precede() and follow() ## ------------------------------------------ query <- IRanges(c(1, 3, 9), c(3, 7, 10)) subject <- IRanges(c(3, 2, 10), c(3, 13, 12)) precede(query, subject) # c(3L, 3L, NA) precede(IRanges(), subject) # integer() precede(query, IRanges()) # rep(NA_integer_, 3) precede(query) # c(3L, 3L, NA) follow(query, subject) # c(NA, NA, 1L) follow(IRanges(), subject) # integer() follow(query, IRanges()) # rep(NA_integer_, 3) follow(query) # c(NA, NA, 2L) ## ------------------------------------------ ## nearest() ## ------------------------------------------ query <- IRanges(c(1, 3, 9), c(2, 7, 10)) subject <- IRanges(c(3, 5, 12), c(3, 6, 12)) nearest(query, subject) # c(1L, 1L, 3L) nearest(query) # c(2L, 1L, 2L) ## ------------------------------------------ ## distance() ## ------------------------------------------ ## adjacent distance(IRanges(1,5), IRanges(6,10)) # 0L ## overlap distance(IRanges(1,5), IRanges(3,7)) # 0L ## zero-width sapply(-3:3, function(i) distance(shift(IRanges(4,3), i), IRanges(4,3))) } \keyword{utilities} IRanges/man/read.Mask.Rd0000644000126300012640000001450312227064476016351 0ustar00biocbuildphs_compbio\name{read.Mask} \alias{read.Mask} \alias{read.agpMask} \alias{read.gapMask} \alias{read.liftMask} \alias{read.rmMask} \alias{read.trfMask} \title{Read a mask from a file} \description{ \code{read.agpMask} and \code{read.gapMask} extract the AGAPS mask from an NCBI "agp" file or a UCSC "gap" file, respectively. \code{read.liftMask} extracts the AGAPS mask from a UCSC "lift" file (i.e. a file containing offsets of contigs within sequences). \code{read.rmMask} extracts the RM mask from a RepeatMasker .out file. \code{read.trfMask} extracts the TRF mask from a Tandem Repeats Finder .bed file. } \usage{ read.agpMask(file, seqname="?", mask.width=NA, gap.types=NULL, use.gap.types=FALSE) read.gapMask(file, seqname="?", mask.width=NA, gap.types=NULL, use.gap.types=FALSE) read.liftMask(file, seqname="?", mask.width=NA) read.rmMask(file, seqname="?", mask.width=NA, use.IDs=FALSE) read.trfMask(file, seqname="?", mask.width=NA) } \arguments{ \item{file}{ Either a character string naming a file or a connection open for reading. } \item{seqname}{ The name of the sequence for which the mask must be extracted. If no sequence is specified (i.e. \code{seqname="?"}) then an error is raised and the sequence names found in the file are displayed. If the file doesn't contain any information for the specified sequence, then a warning is issued and an empty mask of width \code{mask.width} is returned. } \item{mask.width}{ The width of the mask to return i.e. the length of the sequence this mask will be put on. See \code{?`\link{MaskCollection-class}`} for more information about the width of a \link{MaskCollection} object. } \item{gap.types}{ \code{NULL} or a character vector containing gap types. Use this argument to filter the assembly gaps that are to be extracted from the "agp" or "gap" file based on their type. Most common gap types are \code{"contig"}, \code{"clone"}, \code{"centromere"}, \code{"telomere"}, \code{"heterochromatin"}, \code{"short_arm"} and \code{"fragment"}. With \code{gap.types=NULL}, all the assembly gaps described in the file are extracted. With \code{gap.types="?"}, an error is raised and the gap types found in the file for the specified sequence are displayed. } \item{use.gap.types}{ Whether or not the gap types provided in the "agp" or "gap" file should be used to name the ranges constituing the returned mask. See \code{?`\link{IRanges-class}`} for more information about the names of an \link{IRanges} object. } \item{use.IDs}{ Whether or not the repeat IDs provided in the RepeatMasker .out file should be used to name the ranges constituing the returned mask. See \code{?`\link{IRanges-class}`} for more information about the names of an \link{IRanges} object. } } \seealso{ \link{MaskCollection-class}, \link{IRanges-class} } \examples{ ## --------------------------------------------------------------------- ## A. Extract a mask of assembly gaps ("AGAPS" mask) with read.agpMask() ## --------------------------------------------------------------------- ## Note: The hs_b36v3_chrY.agp file was obtained by downloading, ## extracting and renaming the hs_ref_chrY.agp.gz file from ## ## ftp://ftp.ncbi.nih.gov/genomes/H_sapiens/Assembled_chromosomes/ ## hs_ref_chrY.agp.gz 5 KB 24/03/08 04:33:00 PM ## ## on May 9, 2008. chrY_length <- 57772954 file1 <- system.file("extdata", "hs_b36v3_chrY.agp", package="IRanges") mask1 <- read.agpMask(file1, seqname="chrY", mask.width=chrY_length, use.gap.types=TRUE) mask1 mask1[[1]] mask11 <- read.agpMask(file1, seqname="chrY", mask.width=chrY_length, gap.types=c("centromere", "heterochromatin")) mask11[[1]] ## --------------------------------------------------------------------- ## B. Extract a mask of assembly gaps ("AGAPS" mask) with read.liftMask() ## --------------------------------------------------------------------- ## Note: The hg18liftAll.lft file was obtained by downloading, ## extracting and renaming the liftAll.zip file from ## ## http://hgdownload.cse.ucsc.edu/goldenPath/hg18/bigZips/ ## liftAll.zip 03-Feb-2006 11:35 5.5K ## ## on May 8, 2008. file2 <- system.file("extdata", "hg18liftAll.lft", package="IRanges") mask2 <- read.liftMask(file2, seqname="chr1") mask2 if (interactive()) { ## contigs 7 and 8 for chrY are adjacent read.liftMask(file2, seqname="chrY") ## displays the sequence names found in the file read.liftMask(file2) ## specify an unknown sequence name read.liftMask(file2, seqname="chrZ", mask.width=300) } ## --------------------------------------------------------------------- ## C. Extract a RepeatMasker ("RM") or Tandem Repeats Finder ("TRF") ## mask with read.rmMask() or read.trfMask() ## --------------------------------------------------------------------- ## Note: The ce2chrM.fa.out and ce2chrM.bed files were obtained by ## downloading, extracting and renaming the chromOut.zip and ## chromTrf.zip files from ## ## http://hgdownload.cse.ucsc.edu/goldenPath/ce2/bigZips/ ## chromOut.zip 21-Apr-2004 09:05 2.6M ## chromTrf.zip 21-Apr-2004 09:07 182K ## ## on May 7, 2008. ## Before you can extract a mask with read.rmMask() or read.trfMask(), you ## need to know the length of the sequence that you're going to put the ## mask on: if (interactive()) { library(BSgenome.Celegans.UCSC.ce2) chrM_length <- seqlengths(Celegans)[["chrM"]] ## Read the RepeatMasker .out file for chrM in ce2: file3 <- system.file("extdata", "ce2chrM.fa.out", package="IRanges") RMmask <- read.rmMask(file3, seqname="chrM", mask.width=chrM_length) RMmask ## Read the Tandem Repeats Finder .bed file for chrM in ce2: file4 <- system.file("extdata", "ce2chrM.bed", package="IRanges") TRFmask <- read.trfMask(file4, seqname="chrM", mask.width=chrM_length) TRFmask desc(TRFmask) <- paste(desc(TRFmask), "[period<=12]") TRFmask ## Put the 2 masks on chrM: chrM <- Celegans$chrM masks(chrM) <- RMmask # this would drop all current masks, if any masks(chrM) <- append(masks(chrM), TRFmask) chrM } } \keyword{manip} IRanges/man/reverse-methods.Rd0000644000126300012640000000324612227064476017662 0ustar00biocbuildphs_compbio\name{reverse} \alias{reverse} \alias{reverse,character-method} \alias{reverse,IRanges-method} \alias{reverse,NormalIRanges-method} \alias{reverse,Views-method} \alias{reverse,MaskCollection-method} \title{reverse} \description{ A generic function for reversing vector-like or list-like objects. This man page describes methods for reversing a character vector, a \link{Views} object, or a \link{MaskCollection} object. Note that \code{reverse} is similar to but not the same as \code{\link[base]{rev}}. } \usage{ reverse(x, ...) } \arguments{ \item{x}{ A vector-like or list-like object. } \item{...}{ Additional arguments to be passed to or from methods. } } \details{ On a character vector or a \link{Views} object, \code{reverse} reverses each element individually, without modifying the top-level order of the elements. More precisely, each individual string of a character vector is reversed. } \value{ An object of the same class and length as the original object. } \seealso{ \link[XVector]{reverse-methods}, \link{Views-class}, \link{MaskCollection-class}, \code{\link{endoapply}}, \code{\link[base]{rev}} } \examples{ ## On a character vector: reverse(c("Hi!", "How are you?")) rev(c("Hi!", "How are you?")) ## On a Views object: v <- successiveViews(Rle(c(-0.5, 12.3, 4.88), 4:2), 1:4) v reverse(v) rev(v) ## On a MaskCollection object: mask1 <- Mask(mask.width=29, start=c(11, 25, 28), width=c(5, 2, 2)) mask2 <- Mask(mask.width=29, start=c(3, 10, 27), width=c(5, 8, 1)) mask3 <- Mask(mask.width=29, start=c(7, 12), width=c(2, 4)) mymasks <- append(append(mask1, mask2), mask3) reverse(mymasks) } \keyword{methods} \keyword{manip} IRanges/man/runstat.Rd0000644000126300012640000000506312227064476016245 0ustar00biocbuildphs_compbio\name{runstat} \alias{runstat} \alias{runsum} \alias{runmean} \alias{runwtsum} \alias{runq} \title{Fixed width running window summaries across vector-like objects} \description{ The \code{runsum}, \code{runmean}, \code{runwtsum}, \code{runq} functions calculate the sum, mean, weighted sum, and order statistics for fixed width running windows. } \usage{ runsum(x, k, endrule = c("drop", "constant"), ...) runmean(x, k, endrule = c("drop", "constant"), ...) runwtsum(x, k, wt, endrule = c("drop", "constant"), ...) runq(x, k, i, endrule = c("drop", "constant"), ...) } \arguments{ \item{x}{ The data object. } \item{k}{ An integer indicating the fixed width of the running window. Must be odd when \code{endrule == "constant"}. } \item{wt}{ A numeric vector of length \code{k} that provides the weights to use. } \item{i}{ An integer in [0, k] indicating which order statistic to calculate. } \item{endrule}{ A character string indicating how the values at the beginning and the end (of the data) should be treated. \describe{ \item{\code{"drop"}}{do not extend the running statistics to be the same length as the underlying vectors;} \item{\code{"constant"}}{copies running statistic to the first values and analogously for the last ones making the smoothed ends \emph{constant};} } } \item{\dots}{Additional arguments passed to methods. Specifically, \code{na.rm}. When \code{na.rm = TRUE}, the \code{NA} and \code{NaN} values are removed. When \code{na.rm = FALSE}, \code{NA} is returned if either \code{NA} or \code{NaN} are in the specified window. } } \details{ The \code{runsum}, \code{runmean}, \code{runwtsum}, and \code{runq} functions provide efficient methods for calculating the specified numeric summary by performing the looping in compiled code. } \value{ An object of the same class as \code{x}. } \author{P. Aboyoun and V. Obenchain} \seealso{ \code{\link[stats]{runmed}}, \link{Rle-class}, \link{RleList-class} } \examples{ x <- Rle(1:10, 1:10) runsum(x, k = 3) runsum(x, k = 3, endrule = "constant") runmean(x, k = 3) runwtsum(x, k = 3, wt = c(0.25, 0.5, 0.25)) runq(x, k = 5, i = 3, endrule = "constant") ## Missing and non-finite values x <- Rle(c(1, 2, NA, 0, 3, Inf, 4, NaN)) runsum(x, k = 2) runsum(x, k = 2, na.rm = TRUE) runmean(x, k = 2, na.rm = TRUE) runwtsum(x, k = 2, wt = c(0.25, 0.5), na.rm = TRUE) runq(x, k = 2, i = 2, na.rm = TRUE) ## max value in window } \keyword{methods} \keyword{algebra} \keyword{arith} IRanges/man/score.Rd0000644000126300012640000000053312227064476015655 0ustar00biocbuildphs_compbio\name{score} \alias{score} \alias{score<-} \title{Score accessor and setter} \description{ Gets and sets the score of an object. } \usage{ score(x, ...) score(x, ...) <- value } \arguments{ \item{x}{An object to get or set the score value of.} \item{value}{A new score value.} \item{\dots}{Additional arguments.} } \keyword{methods} IRanges/man/seqapply.Rd0000644000126300012640000000545312227064476016406 0ustar00biocbuildphs_compbio\name{seqapply} \alias{seqapply} \alias{mseqapply} \alias{tseqapply} \alias{seqsplit} \alias{seqby} \title{ Apply function and cast to Vector } \description{ The \code{seqapply} family of functions behaves much like the existing \code{lapply} family, except the return value is cast to a \linkS4class{Vector} subclass. This facilitates constraining computation to the \code{Vector} framework across iteration and (for \code{seqsplit}) splitting. } \usage{ seqapply(X, FUN, ...) mseqapply(FUN, ..., MoreArgs = NULL, USE.NAMES = TRUE) tseqapply(X, INDEX, FUN = NULL, ...) seqsplit(x, f, drop = FALSE) seqby(data, INDICES, FUN, ...) } \arguments{ \item{X}{ The object over which to iterate, usually a vector or \code{Vector} } \item{x}{ Like \code{X} } \item{data}{ Like \code{X} } \item{FUN}{ The function that is applied to each element of \code{X} } \item{MoreArgs}{ Additional arguments to \code{FUN} that are treated like scalars } \item{USE.NAMES}{ Whether the return values should inherit names from one of the arguments } \item{INDEX}{ A \code{list} of factors to split \code{X} into subsets, each of which is passed in a separate invocation of \code{FUN} } \item{INDICES}{ Like \code{INDEX}, except a single factor need not be in a \code{list}. } \item{f}{ A \code{factor} or \code{list} of factors } \item{drop}{ Whether to drop empty elements from the returned list } \item{\dots}{ Extra arguments to pass to \code{FUN} } } \details{ These functions should be used just like their base equivalent: \describe{ \item{\code{seqapply}}{=> \code{lapply}} \item{\code{mseqapply}}{=> \code{mapply}} \item{\code{tseqapply}}{=> \code{tapply}} \item{\code{seqsplit}}{=> \code{split}} \item{\code{seqby}}{=> \code{by}} } The only difference is that the result is cast to a \code{Vector} object. The casting logic simply looks for a common class from which all returned values inherit. It then checks for the existence of a function of the form \code{ClassList} where \code{Class} is the name of the class. If such a function is not found, the search proceeds up the hierarchy of classes. An error is thrown when hierarchy is exhausted. If \code{ClassList} is found, it is called with the list of return values as its only argument, under the assumption that a \code{Vector}-derived instance will be constructed. } \value{ A \code{Vector} object } \author{ Michael Lawrence } \examples{ starts <- IntegerList(c(1, 5), c(2, 8)) ends <- IntegerList(c(3, 8), c(5, 9)) rangesList <- mseqapply(IRanges, starts, ends) rangeDataFrame <- stack(rangesList, "space", "ranges") dataFrameList <- seqsplit(rangeDataFrame, rangeDataFrame$space) starts <- seqapply(dataFrameList[,"ranges"], start) } \keyword{manip} IRanges/man/setops-methods.Rd0000644000126300012640000001265212227064476017525 0ustar00biocbuildphs_compbio\name{setops-methods} \alias{setops-methods} \alias{union,IRanges,IRanges-method} \alias{union,RangesList,RangesList-method} \alias{union,CompressedIRangesList,CompressedIRangesList-method} \alias{union,Hits,Hits-method} \alias{intersect,IRanges,IRanges-method} \alias{intersect,RangesList,RangesList-method} \alias{intersect,CompressedIRangesList,CompressedIRangesList-method} \alias{intersect,Hits,Hits-method} \alias{setdiff,IRanges,IRanges-method} \alias{setdiff,RangesList,RangesList-method} \alias{setdiff,CompressedIRangesList,CompressedIRangesList-method} \alias{setdiff,Hits,Hits-method} \alias{punion} \alias{punion,IRanges,IRanges-method} \alias{pintersect} \alias{pintersect,IRanges,IRanges-method} \alias{psetdiff} \alias{psetdiff,IRanges,IRanges-method} \alias{pgap} \alias{pgap,IRanges,IRanges-method} \title{Set operations on IRanges, RangesList, and Hits objects} \description{ Performs set operations on \link{IRanges} objects. } \usage{ ## Vector-wise operations: \S4method{union}{IRanges,IRanges}(x, y,...) \S4method{intersect}{IRanges,IRanges}(x, y,...) \S4method{setdiff}{IRanges,IRanges}(x, y,...) ## Element-wise (aka "parallel") operations: \S4method{punion}{IRanges,IRanges}(x, y, fill.gap=FALSE, ...) \S4method{pintersect}{IRanges,IRanges}(x, y, resolve.empty=c("none", "max.start", "start.x"), ...) \S4method{psetdiff}{IRanges,IRanges}(x, y, ...) \S4method{pgap}{IRanges,IRanges}(x, y, ...) } \arguments{ \item{x, y}{ \link{IRanges} objects. } \item{fill.gap}{ Logical indicating whether or not to force a union by using the rule \code{start = min(start(x), start(y)), end = max(end(x), end(y))}. } \item{resolve.empty}{ One of \code{"none"}, \code{"max.start"}, or \code{"start.x"} denoting how to handle ambiguous empty ranges formed by intersections. \code{"none"} - throw an error if an ambiguous empty range is formed, \code{"max.start"} - associate the maximum start value with any ambiguous empty range, and \code{"start.x"} - associate the start value of \code{x} with any ambiguous empty range. (See Details section below for the definition of an ambiguous range.) } \item{...}{ Further arguments to be passed to or from other methods. } } \details{ The \code{union}, \code{intersect} and \code{setdiff} methods for \link{IRanges} objects return a "normal" \link{IRanges} object (of the same class as \code{x}) representing the union, intersection and (asymmetric!) difference of the sets of integers represented by \code{x} and \code{y}. \code{punion}, \code{pintersect}, \code{psetdiff} and \code{pgap} are generic functions that compute the element-wise (aka "parallel") union, intersection, (asymmetric!) difference and gap between each element in \code{x} and its corresponding element in \code{y}. Methods for \link{IRanges} objects are defined. For these methods, \code{x} and \code{y} must have the same length (i.e. same number of ranges) and they return an \link{IRanges} instance of the same length as \code{x} and \code{y} where each range represents the union/intersection/difference/gap of/between the corresponding ranges in \code{x} and \code{y}. By default, \code{pintersect} will throw an error when an "ambiguous empty range" is formed. An ambiguous empty range can occur three different ways: 1) when corresponding non-empty ranges elements \code{x} and \code{y} have an empty intersection, 2) if the position of an empty range element does not fall within the corresponding limits of a non-empty range element, or 3) if two corresponding empty range elements do not have the same position. For example if empty range element [22,21] is intersected with non-empty range element [1,10], an error will be produced; but if it is intersected with the range [22,28], it will produce [22,21]. As mentioned in the Arguments section above, this behavior can be changed using the \code{resolve.empty} argument. } \author{H. Pages and M. Lawrence} \seealso{ \code{pintersect} is similar to \code{\link{narrow}}, except the end points are absolute, not relative. \code{pintersect} is also similar to \code{\link{restrict}}, except ranges outside of the restriction become empty and are not discarded. \link[BiocGenerics]{union}, \link{Ranges-class}, \link{intra-range-methods} for intra range transformations, \link{inter-range-methods} for inter range transformations, \link{IRanges-class}, \link{IRanges-utils} } \examples{ x <- IRanges(c(1, 5, -2, 0, 14), c(10, 9, 3, 11, 17)) subject <- Rle(1:-3, 6:2) y <- Views(subject, start=c(14, 0, -5, 6, 18), end=c(20, 2, 2, 8, 20)) ## Vector-wise operations: union(x, ranges(y)) union(ranges(y), x) intersect(x, ranges(y)) intersect(ranges(y), x) setdiff(x, ranges(y)) setdiff(ranges(y), x) ## Element-wise (aka "parallel") operations: try(punion(x, ranges(y))) punion(x[3:5], ranges(y)[3:5]) punion(x, ranges(y), fill.gap=TRUE) try(pintersect(x, ranges(y))) pintersect(x[3:4], ranges(y)[3:4]) pintersect(x, ranges(y), resolve.empty="max.start") psetdiff(ranges(y), x) try(psetdiff(x, ranges(y))) start(x)[4] <- -99 end(y)[4] <- 99 psetdiff(x, ranges(y)) pgap(x, ranges(y)) ## On RangesList objects: irl1 <- IRangesList(a = IRanges(c(1,2),c(4,3)), b = IRanges(c(4,6),c(10,7))) irl2 <- IRangesList(c = IRanges(c(0,2),c(4,5)), a = IRanges(c(4,5),c(6,7))) union(irl1, irl2) intersect(irl1, irl2) setdiff(irl1, irl2) } \keyword{utilities} IRanges/man/slice-methods.Rd0000644000126300012640000000457212227064476017311 0ustar00biocbuildphs_compbio\name{slice-methods} \alias{slice-methods} \alias{slice} \alias{slice,Rle-method} \alias{slice,RleList-method} \title{Slice a vector-like or list-like object} \description{ \code{slice} is a generic function that creates views on a vector-like or list-like object that contain the elements that are within the specified bounds. } \usage{ slice(x, lower=-Inf, upper=Inf, ...) \S4method{slice}{Rle}(x, lower=-Inf, upper=Inf, includeLower=TRUE, includeUpper=TRUE, rangesOnly=FALSE) \S4method{slice}{RleList}(x, lower=-Inf, upper=Inf, includeLower=TRUE, includeUpper=TRUE, rangesOnly=FALSE) } \arguments{ \item{x}{ An \link{Rle} or \link{RleList} object for the methods described here. } \item{lower, upper}{ The lower and upper bounds for the slice. } \item{includeLower, includeUpper}{ Logical indicating whether or not the specified boundary is open or closed. } \item{rangesOnly}{ A logical indicating whether or not to drop the original data from the output. } \item{...}{ Additional arguments to be passed to specific methods. } } \details{ \code{slice} is useful for finding areas of absolute maxima (peaks), absolute minima (troughs), or fluctuations within specified limits. One or more view summarization methods can be used on the result of \code{slice}. See \code{?`link{view-summarization-methods}`} } \value{ The method for \link{Rle} objects returns an \link{RleViews} object if \code{rangesOnly=FALSE} or an \link{IRanges} object if \code{rangesOnly=TRUE}. The method for \link{RleList} objects returns an \link{RleViewsList} object if \code{rangesOnly=FALSE} or an \link{IRangesList} object if \code{rangesOnly=TRUE}. } \author{P. Aboyoun} \seealso{ \itemize{ \item \link{view-summarization-methods} for summarizing the views returned by \code{slice}. \item \link[XVector]{slice-methods} in the \pkg{XVector} package for more \code{slice} methods. \item \code{\link{coverage}} for computing the coverage across a set of ranges. \item The \link{Rle}, \link{RleList}, \link{RleViews}, and \link{RleViewsList} classes. } } \examples{ ## Views derived from coverage x <- IRanges(start=c(1L, 9L, 4L, 1L, 5L, 10L), width=c(5L, 6L, 3L, 4L, 3L, 3L)) cvg <- coverage(x) slice(cvg, lower=2) slice(cvg, lower=2, rangesOnly=TRUE) } \keyword{methods} IRanges/man/strutils.Rd0000644000126300012640000000464512227064476016443 0ustar00biocbuildphs_compbio\name{strutils} \alias{safeExplode} \alias{strsplitAsListOfIntegerVectors} \alias{svn.time} \title{Low-level string utilities} \description{ Some low-level string utilities that operate on ordinary character vectors. For more advanced string manipulations, see the Biostrings package. } \usage{ strsplitAsListOfIntegerVectors(x, sep=",") } \arguments{ \item{x}{ A character vector where each element is a string containing comma-separated decimal integer values. } \item{sep}{ The value separator character. } } \value{ A list of integer vectors. The list is of the same length as the input. } \note{ \code{strsplitAsListOfIntegerVectors} is similar to the \code{strsplitAsListOfIntegerVectors2} function shown in the Examples section below, except that the former generally raises an error where the latter would have inserted an \code{NA} in the returned object. More precisely: \itemize{ \item The latter accepts NAs in the input, the former doesn't (raises an error). \item The latter introduces NAs by coercion (with a warning), the former doesn't (raises an error). \item The latter supports "inaccurate integer conversion in coercion" when the value to coerce is > INT_MAX (then it's coerced to INT_MAX), the former doesn't (raises an error). \item The latter coerces non-integer values (e.g. 10.3) to an int by truncating them, the former doesn't (raises an error). } When it fails, \code{strsplitAsListOfIntegerVectors} will print an informative error message. Finally, \code{strsplitAsListOfIntegerVectors} is faster and uses much less memory than \code{strsplitAsListOfIntegerVectors2}. } \author{H. Pages} \seealso{ \code{\link{strsplit}} } \examples{ x <- c("1116,0,-19", " +55291 , 2476,", "19184,4269,5659,6470,6721,7469,14601", "7778889, 426900, -4833,5659,6470,6721,7096", "19184 , -99999") y <- strsplitAsListOfIntegerVectors(x) y ## In normal situations (i.e. when the input is well-formed), ## strsplitAsListOfIntegerVectors() does actually the same as the ## function below but is more efficient (both in speed and memory ## footprint): strsplitAsListOfIntegerVectors2 <- function(x, sep=",") { tmp <- strsplit(x, sep, fixed = TRUE) lapply(tmp, as.integer) } y2 <- strsplitAsListOfIntegerVectors2(x) stopifnot(identical(y, y2)) } \keyword{utilities} IRanges/man/updateObject-methods.Rd0000644000126300012640000000377112227064476020623 0ustar00biocbuildphs_compbio\name{updateObject-methods} \alias{updateObject-methods} \alias{updateObject,AnnotatedList-method} \alias{updateObject,CharacterList-method} \alias{updateObject,ComplexList-method} \alias{updateObject,FilterRules-method} \alias{updateObject,IntegerList-method} \alias{updateObject,IntervalTree-method} \alias{updateObject,IRanges-method} \alias{updateObject,IRangesList-method} \alias{updateObject,LogicalList-method} \alias{updateObject,MaskCollection-method} \alias{updateObject,NormalIRanges-method} \alias{updateObject,NumericList-method} \alias{updateObject,RangedData-method} \alias{updateObject,RangedDataList-method} \alias{updateObject,RangesList-method} \alias{updateObject,RawList-method} \alias{updateObject,RDApplyParams-method} \alias{updateObject,Rle-method} \alias{updateObject,RleList-method} \alias{updateObject,RleViews-method} \alias{updateObject,SplitXDataFrameList-method} \alias{updateObject,XDataFrame-method} \alias{updateObject,XDataFrameList-method} \title{Update an object of a class defined in the IRanges package to its current class definition} \description{ The IRanges package provides an extensive collection of \code{\link[BiocGenerics]{updateObject}} methods for updating almost any instance of a class defined in the package. } \usage{ ## Showing usage of method defined for IntegerList objects only (usage ## is the same for all methods). \S4method{updateObject}{IntegerList}(object, ..., verbose=FALSE) } \arguments{ \item{object}{ Object to be updated. Many (but not all) IRanges classes are supported. If no specific method is available for the object, then the default method (defined in the BiocGenerics package) is used. See \code{?\link[BiocGenerics]{updateObject}} for a description of the default method. } \item{..., verbose}{ See \code{?\link[BiocGenerics]{updateObject}}. } } \value{ Returns a valid instance of \code{object}. } \author{The Bioconductor Dev Team} \seealso{ \code{\link[BiocGenerics]{updateObject}} } \keyword{manip} IRanges/man/view-summarization-methods.Rd0000644000126300012640000001067012227064476022060 0ustar00biocbuildphs_compbio\name{view-summarization-methods} \alias{view-summarization-methods} \alias{viewApply} \alias{viewApply,Views-method} \alias{viewApply,RleViews-method} \alias{viewApply,RleViewsList-method} \alias{viewMins} \alias{viewMins,RleViews-method} \alias{viewMins,RleViewsList-method} \alias{viewMaxs} \alias{viewMaxs,RleViews-method} \alias{viewMaxs,RleViewsList-method} \alias{viewSums} \alias{viewSums,RleViews-method} \alias{viewSums,RleViewsList-method} \alias{viewMeans} \alias{viewMeans,RleViews-method} \alias{viewMeans,RleViewsList-method} \alias{viewWhichMins} \alias{viewWhichMins,RleViews-method} \alias{viewWhichMins,RleViewsList-method} \alias{viewWhichMaxs} \alias{viewWhichMaxs,RleViews-method} \alias{viewWhichMaxs,RleViewsList-method} \alias{viewRangeMins} \alias{viewRangeMins,RleViews-method} \alias{viewRangeMins,RleViewsList-method} \alias{viewRangeMaxs} \alias{viewRangeMaxs,RleViews-method} \alias{viewRangeMaxs,RleViewsList-method} \alias{Summary,Views-method} \alias{mean,Views-method} \alias{max,Views-method} \alias{min,Views-method} \alias{sum,Views-method} \alias{which.min,Views-method} \alias{which.max,Views-method} \title{Summarize views on a vector-like object with numeric values} \description{ \code{viewApply} applies a function on each view of a \link{Views} or \link{ViewsList} object. \code{viewMins}, \code{viewMaxs}, \code{viewSums}, \code{viewMeans} calculate respectively the minima, maxima, sums, and means of the views in a \link{Views} or \link{ViewsList} object. } \usage{ viewApply(X, FUN, ..., simplify = TRUE) viewMins(x, na.rm=FALSE) \S4method{min}{Views}(x, ..., na.rm = FALSE) viewMaxs(x, na.rm=FALSE) \S4method{max}{Views}(x, ..., na.rm = FALSE) viewSums(x, na.rm=FALSE) \S4method{sum}{Views}(x, ..., na.rm = FALSE) viewMeans(x, na.rm=FALSE) \S4method{mean}{Views}(x, ...) viewWhichMins(x, na.rm=FALSE) \S4method{which.min}{Views}(x) viewWhichMaxs(x, na.rm=FALSE) \S4method{which.max}{Views}(x) viewRangeMins(x, na.rm=FALSE) viewRangeMaxs(x, na.rm=FALSE) } \arguments{ \item{X}{ A Views object. } \item{FUN}{ The function to be applied to each view in \code{X}. } \item{...}{ Additional arguments to be passed on. } \item{simplify}{ A logical value specifying whether or not the result should be simplified to a vector or matrix if possible. } \item{x}{ An \link{RleViews} or \link{RleViewsList} object. } \item{na.rm}{ Logical indicating whether or not to include missing values in the results. } } \details{ The \code{viewMins}, \code{viewMaxs}, \code{viewSums}, and \code{viewMeans} functions provide efficient methods for calculating the specified numeric summary by performing the looping in compiled code. The \code{viewWhichMins}, \code{viewWhichMaxs}, \code{viewRangeMins}, and \code{viewRangeMaxs} functions provide efficient methods for finding the locations of the minima and maxima. } \value{ For all the functions in this man page (except \code{viewRangeMins} and \code{viewRangeMaxs}): A numeric vector of the length of \code{x} if \code{x} is an \link{RleViews} object, or a \link{List} object of the length of \code{x} if it's an \link{RleViewsList} object. For \code{viewRangeMins} and \code{viewRangeMaxs}: An \link{IRanges} object if \code{x} is an \link{RleViews} object, or an \link{IRangesList} object if it's an \link{RleViewsList} object. } \note{ For convenience, methods for \code{min}, \code{max}, \code{sum}, \code{mean}, \code{which.min} and \code{which.max} are provided as wrappers around the corresponding \code{view*} functions (which might be deprecated at some point). } \author{P. Aboyoun} \seealso{ \itemize{ \item The \code{\link{slice}} function for slicing an \link{Rle} or \link{RleList} object. \item \link[XVector]{view-summarization-methods} in the \pkg{XVector} package for more view summarization methods. \item The \link{RleViews} and \link{RleViewsList} classes. \item The \code{\link{which.min}} and \code{\link{colSums}} functions. } } \examples{ ## Views derived from coverage x <- IRanges(start=c(1L, 9L, 4L, 1L, 5L, 10L), width=c(5L, 6L, 3L, 4L, 3L, 3L)) cvg <- coverage(x) cvg_views <- slice(cvg, lower=2) viewApply(cvg_views, diff) viewMins(cvg_views) viewMaxs(cvg_views) viewSums(cvg_views) viewMeans(cvg_views) viewWhichMins(cvg_views) viewWhichMaxs(cvg_views) viewRangeMins(cvg_views) viewRangeMaxs(cvg_views) } \keyword{methods} \keyword{arith} IRanges/src/0000755000126300012640000000000012234075662014263 5ustar00biocbuildphs_compbioIRanges/src/AEbufs.c0000644000126300012640000007676012234075662015614 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of the Auto-Extending buffers * * ---------------------------------------------------- * ****************************************************************************/ #include "IRanges.h" #include /* for malloc, free, realloc */ #define MAX_BUFLENGTH_INC (32 * 1024 * 1024) #define MAX_BUFLENGTH (32 * MAX_BUFLENGTH_INC) static int debug = 0; SEXP debug_AEbufs() { #ifdef DEBUG_IRANGES debug = !debug; Rprintf("Debug mode turned %s in file %s\n", debug ? "on" : "off", __FILE__); #else Rprintf("Debug mode not available in file %s\n", __FILE__); #endif return R_NilValue; } /**************************************************************************** * Core helper functions used for allocation/reallocation of the AEbufs. */ static int use_malloc = 0; SEXP AEbufs_use_malloc(SEXP x) { use_malloc = LOGICAL(x)[0]; return R_NilValue; } /* Guaranteed to return a new buflength > 'buflength', or to raise an error. */ int _get_new_buflength(int buflength) { if (buflength >= MAX_BUFLENGTH) error("_get_new_buflength(): MAX_BUFLENGTH reached"); if (buflength == 0) return 128; if (buflength <= MAX_BUFLENGTH_INC) return 2 * buflength; buflength += MAX_BUFLENGTH_INC; if (buflength <= MAX_BUFLENGTH) return buflength; return MAX_BUFLENGTH; } static void *malloc_AEbuf(int buflength, size_t size) { void *elts; if (buflength == 0) return NULL; elts = malloc((size_t) buflength * size); if (elts == NULL) error("IRanges internal error in malloc_AEbuf(): " "cannot allocate memory"); return elts; } static void *alloc_AEbuf(int buflength, size_t size) { if (use_malloc) return malloc_AEbuf(buflength, size); if (buflength == 0) return NULL; return (void *) R_alloc(buflength, size); } static void *realloc_AEbuf(void *elts, int new_buflength, int buflength, size_t size) { void *new_elts; if (use_malloc) { new_elts = realloc(elts, (size_t) new_buflength * size); if (new_elts == NULL) error("IRanges internal error in realloc_AEbuf(): " "cannot reallocate memory"); return new_elts; } new_elts = (void *) R_alloc(new_buflength, size); return memcpy(new_elts, elts, (size_t) buflength * size); } /**************************************************************************** * IntAE buffers * * We use a "global IntAE malloc stack" to store a copy of each top-level * malloc-based IntAE that is created during the execution of a .Call entry * point. The copy must be modified at every reallocation or every time the * nb of elements in the buffer (_nelt member) is modified. * Every .Call() should start with an empty stack. * After the .Call() has returned, the stack must be emptied with * .Call("AEbufs_free", PACKAGE="IRanges") */ #define INTAE_MALLOC_STACK_NELT_MAX 2048 static IntAE IntAE_malloc_stack[INTAE_MALLOC_STACK_NELT_MAX]; static int IntAE_malloc_stack_nelt = 0; static void IntAE_alloc(IntAE *int_ae, int buflength) { int_ae->elts = (int *) alloc_AEbuf(buflength, sizeof(int)); int_ae->buflength = buflength; int_ae->_AE_malloc_stack_idx = -1; return; } static void IntAE_realloc(IntAE *int_ae) { int new_buflength, idx; new_buflength = _get_new_buflength(int_ae->buflength); int_ae->elts = (int *) realloc_AEbuf(int_ae->elts, new_buflength, int_ae->buflength, sizeof(int)); int_ae->buflength = new_buflength; idx = int_ae->_AE_malloc_stack_idx; if (idx >= 0) IntAE_malloc_stack[idx] = *int_ae; return; } int _IntAE_get_nelt(const IntAE *int_ae) { return int_ae->_nelt; } int _IntAE_set_nelt(IntAE *int_ae, int nelt) { int idx; int_ae->_nelt = nelt; idx = int_ae->_AE_malloc_stack_idx; if (idx >= 0) IntAE_malloc_stack[idx] = *int_ae; return nelt; } #ifdef DEBUG_IRANGES static void IntAE_print(const IntAE *int_ae) { Rprintf("buflength=%d elts=%p _nelt=%d _AE_malloc_stack_idx=%d", int_ae->buflength, int_ae->elts, int_ae->_nelt, int_ae->_AE_malloc_stack_idx); return; } #endif /* Must be used on a malloc-based IntAE */ static void IntAE_free(const IntAE *int_ae) { if (int_ae->elts != NULL) free(int_ae->elts); return; } static void reset_IntAE_malloc_stack() { int i; const IntAE *int_ae; for (i = 0, int_ae = IntAE_malloc_stack; i < IntAE_malloc_stack_nelt; i++, int_ae++) { #ifdef DEBUG_IRANGES if (debug) { Rprintf("IntAE_malloc_stack[%d]: ", i); IntAE_print(int_ae); Rprintf("\n"); } #endif IntAE_free(int_ae); } IntAE_malloc_stack_nelt = 0; return; } void _IntAE_set_val(const IntAE *int_ae, int val) { int nelt, i, *elt; nelt = _IntAE_get_nelt(int_ae); for (i = 0, elt = int_ae->elts; i < nelt; i++, elt++) *elt = val; return; } IntAE _new_IntAE(int buflength, int nelt, int val) { IntAE int_ae; int idx; /* Allocation */ IntAE_alloc(&int_ae, buflength); if (use_malloc) { if (IntAE_malloc_stack_nelt >= INTAE_MALLOC_STACK_NELT_MAX) error("IRanges internal error in _new_IntAE(): " "the \"global IntAE malloc stack\" is full"); idx = IntAE_malloc_stack_nelt++; int_ae._AE_malloc_stack_idx = idx; IntAE_malloc_stack[idx] = int_ae; } /* Initialization */ _IntAE_set_nelt(&int_ae, nelt); _IntAE_set_val(&int_ae, val); return int_ae; } void _IntAE_insert_at(IntAE *int_ae, int at, int val) { int nelt, i; int *elt1; const int *elt2; nelt = _IntAE_get_nelt(int_ae); if (nelt >= int_ae->buflength) IntAE_realloc(int_ae); elt1 = int_ae->elts + nelt; elt2 = elt1 - 1; for (i = nelt; i > at; i--) *(elt1--) = *(elt2--); *elt1 = val; _IntAE_set_nelt(int_ae, nelt + 1); return; } void _IntAE_append(IntAE *int_ae, const int *newvals, int nnewval) { int new_nelt, *dest; new_nelt = _IntAE_get_nelt(int_ae) + nnewval; while (int_ae->buflength < new_nelt) IntAE_realloc(int_ae); dest = int_ae->elts + _IntAE_get_nelt(int_ae); memcpy(dest, newvals, nnewval * sizeof(int)); _IntAE_set_nelt(int_ae, new_nelt); return; } void _IntAE_delete_at(IntAE *int_ae, int at) { int *elt1; const int *elt2; int nelt0, i2; elt1 = int_ae->elts + at; elt2 = elt1 + 1; nelt0 = _IntAE_get_nelt(int_ae); for (i2 = at + 1; i2 < nelt0; i2++) *(elt1++) = *(elt2++); _IntAE_set_nelt(int_ae, nelt0 - 1); return; } void _IntAE_shift(const IntAE *int_ae, int shift) { int nelt, i, *elt; nelt = _IntAE_get_nelt(int_ae); for (i = 0, elt = int_ae->elts; i < nelt; i++, elt++) *elt += shift; return; } /* * Left and right IntAE objects must have the same length. This is * NOT checked! */ void _IntAE_sum_and_shift(const IntAE *int_ae1, const IntAE *int_ae2, int shift) { int nelt, i, *elt1, *elt2; nelt = _IntAE_get_nelt(int_ae1); for (i = 0, elt1 = int_ae1->elts, elt2 = int_ae2->elts; i < nelt; i++, elt1++, elt2++) *elt1 += *elt2 + shift; return; } void _IntAE_append_shifted_vals(IntAE *int_ae, const int *newvals, int nnewval, int shift) { int nelt, new_nelt, i, *elt1; const int *elt2; nelt = _IntAE_get_nelt(int_ae); new_nelt = nelt + nnewval; while (int_ae->buflength < new_nelt) IntAE_realloc(int_ae); for (i = 0, elt1 = int_ae->elts + nelt, elt2 = newvals; i < nnewval; i++, elt1++, elt2++) *elt1 = *elt2 + shift; _IntAE_set_nelt(int_ae, new_nelt); return; } void _IntAE_qsort(const IntAE *int_ae, int desc) { _sort_int_array(int_ae->elts, _IntAE_get_nelt(int_ae), desc); return; } void _IntAE_delete_adjdups(IntAE *int_ae) { int nelt, *elt1; const int *elt2; int i2; nelt = _IntAE_get_nelt(int_ae); if (nelt <= 1) return; elt1 = int_ae->elts; elt2 = elt1 + 1; for (i2 = 1; i2 < nelt; i2++) { if (*elt2 != *elt1) { elt1++; *elt1 = *elt2; } elt2++; } _IntAE_set_nelt(int_ae, elt1 - int_ae->elts + 1); return; } SEXP _new_INTEGER_from_IntAE(const IntAE *int_ae) { int nelt; SEXP ans; nelt = _IntAE_get_nelt(int_ae); PROTECT(ans = NEW_INTEGER(nelt)); memcpy(INTEGER(ans), int_ae->elts, sizeof(int) * nelt); UNPROTECT(1); return ans; } static void copy_INTEGER_to_IntAE(SEXP x, IntAE *int_ae) { _IntAE_set_nelt(int_ae, LENGTH(x)); memcpy(int_ae->elts, INTEGER(x), sizeof(int) * LENGTH(x)); return; } IntAE _new_IntAE_from_INTEGER(SEXP x) { IntAE int_ae; int_ae = _new_IntAE(LENGTH(x), 0, 0); copy_INTEGER_to_IntAE(x, &int_ae); return int_ae; } IntAE _new_IntAE_from_CHARACTER(SEXP x, int keyshift) { IntAE int_ae; int i, *elt; #ifdef DEBUG_IRANGES if (debug) { Rprintf("[DEBUG] _new_IntAE_from_CHARACTER(): BEGIN ... " "LENGTH(x)=%d keyshift=%d\n", LENGTH(x), keyshift); } #endif int_ae = _new_IntAE(LENGTH(x), 0, 0); _IntAE_set_nelt(&int_ae, int_ae.buflength); for (i = 0, elt = int_ae.elts; i < int_ae.buflength; i++, elt++) { sscanf(CHAR(STRING_ELT(x, i)), "%d", elt); *elt += keyshift; #ifdef DEBUG_IRANGES if (debug) { if (i < 100 || i >= int_ae.buflength - 100) Rprintf("[DEBUG] _new_IntAE_from_CHARACTER(): " "i=%d key=%s *elt=%d\n", i, CHAR(STRING_ELT(x, i)), *elt); } #endif } #ifdef DEBUG_IRANGES if (debug) { Rprintf("[DEBUG] _new_IntAE_from_CHARACTER(): END\n"); } #endif return int_ae; } /**************************************************************************** * IntAEAE buffers * * We use a "global IntAEAE malloc stack" to store a copy of each top-level * malloc-based IntAEAE that is created during the execution of a .Call entry * point. The copy must be modified at every reallocation or every time the * nb of elements in the buffer (nelt member) is modified. * Every .Call() should start with an empty stack. * After the .Call() has returned, the stack must be emptied with * .Call("AEbufs_free", PACKAGE="IRanges") */ #define INTAEAE_MALLOC_STACK_NELT_MAX 2048 static IntAEAE IntAEAE_malloc_stack[INTAEAE_MALLOC_STACK_NELT_MAX]; static int IntAEAE_malloc_stack_nelt = 0; static void IntAEAE_alloc(IntAEAE *int_aeae, int buflength) { int_aeae->elts = (IntAE *) alloc_AEbuf(buflength, sizeof(IntAE)); int_aeae->buflength = buflength; int_aeae->_AE_malloc_stack_idx = -1; return; } static void IntAEAE_realloc(IntAEAE *int_aeae) { int new_buflength, idx; new_buflength = _get_new_buflength(int_aeae->buflength); int_aeae->elts = (IntAE *) realloc_AEbuf(int_aeae->elts, new_buflength, int_aeae->buflength, sizeof(IntAE)); int_aeae->buflength = new_buflength; idx = int_aeae->_AE_malloc_stack_idx; if (idx >= 0) IntAEAE_malloc_stack[idx] = *int_aeae; return; } int _IntAEAE_get_nelt(const IntAEAE *int_aeae) { return int_aeae->_nelt; } int _IntAEAE_set_nelt(IntAEAE *int_aeae, int nelt) { int idx; int_aeae->_nelt = nelt; idx = int_aeae->_AE_malloc_stack_idx; if (idx >= 0) IntAEAE_malloc_stack[idx] = *int_aeae; return nelt; } /* Must be used on a malloc-based IntAEAE */ static void IntAEAE_free(const IntAEAE *int_aeae) { int nelt, i; IntAE *elt; nelt = _IntAEAE_get_nelt(int_aeae); for (i = 0, elt = int_aeae->elts; i < nelt; i++, elt++) IntAE_free(elt); if (int_aeae->elts != NULL) free(int_aeae->elts); return; } static void reset_IntAEAE_malloc_stack() { int i; const IntAEAE *int_aeae; for (i = 0, int_aeae = IntAEAE_malloc_stack; i < IntAEAE_malloc_stack_nelt; i++, int_aeae++) { IntAEAE_free(int_aeae); } IntAEAE_malloc_stack_nelt = 0; return; } IntAEAE _new_IntAEAE(int buflength, int nelt) { IntAEAE int_aeae; int idx, i; IntAE *elt; /* Allocation */ IntAEAE_alloc(&int_aeae, buflength); if (use_malloc) { if (IntAEAE_malloc_stack_nelt >= INTAEAE_MALLOC_STACK_NELT_MAX) error("IRanges internal error in _new_IntAEAE(): " "the \"global IntAEAE malloc stack\" is full"); idx = IntAEAE_malloc_stack_nelt++; int_aeae._AE_malloc_stack_idx = idx; IntAEAE_malloc_stack[idx] = int_aeae; } /* Initialization */ _IntAEAE_set_nelt(&int_aeae, nelt); for (i = 0, elt = int_aeae.elts; i < nelt; i++, elt++) { IntAE_alloc(elt, 0); _IntAE_set_nelt(elt, 0); } return int_aeae; } void _IntAEAE_insert_at(IntAEAE *int_aeae, int at, const IntAE *int_ae) { int nelt, i; IntAE *elt1; const IntAE *elt2; if (int_ae->_AE_malloc_stack_idx >= 0) error("IRanges internal error in _IntAEAE_insert_at(): " "cannot insert an IntAE that is in the " "\"global IntAE malloc stack\""); nelt = _IntAEAE_get_nelt(int_aeae); if (nelt >= int_aeae->buflength) IntAEAE_realloc(int_aeae); elt1 = int_aeae->elts + nelt; elt2 = elt1 - 1; for (i = nelt; i > at; i--) *(elt1--) = *(elt2--); *elt1 = *int_ae; _IntAEAE_set_nelt(int_aeae, nelt + 1); return; } /* * Left and right IntAEAE objects must have the same length. This is * NOT checked! */ void _IntAEAE_eltwise_append(const IntAEAE *int_aeae1, const IntAEAE *int_aeae2) { int nelt, i; IntAE *elt1; const IntAE *elt2; nelt = _IntAEAE_get_nelt(int_aeae1); for (i = 0, elt1 = int_aeae1->elts, elt2 = int_aeae2->elts; i < nelt; i++, elt1++, elt2++) _IntAE_append(elt1, elt2->elts, _IntAE_get_nelt(elt2)); return; } void _IntAEAE_shift(const IntAEAE *int_aeae, int shift) { int nelt, i; IntAE *elt; nelt = _IntAEAE_get_nelt(int_aeae); for (i = 0, elt = int_aeae->elts; i < nelt; i++, elt++) _IntAE_shift(elt, shift); return; } /* * Left and right IntAEAE objects must have the same length. This is * NOT checked! */ void _IntAEAE_sum_and_shift(const IntAEAE *int_aeae1, const IntAEAE *int_aeae2, int shift) { int nelt, i; IntAE *elt1; const IntAE *elt2; nelt = _IntAEAE_get_nelt(int_aeae1); for (i = 0, elt1 = int_aeae1->elts, elt2 = int_aeae2->elts; i < nelt; i++, elt1++, elt2++) _IntAE_sum_and_shift(elt1, elt2, shift); return; } /* * 'mode' controls how empty list elements should be represented: * 0 -> integer(0); 1 -> NULL; 2 -> NA */ SEXP _new_LIST_from_IntAEAE(const IntAEAE *int_aeae, int mode) { int nelt, i; SEXP ans, ans_elt; const IntAE *elt; nelt = _IntAEAE_get_nelt(int_aeae); PROTECT(ans = NEW_LIST(nelt)); for (i = 0, elt = int_aeae->elts; i < nelt; i++, elt++) { if (_IntAE_get_nelt(elt) != 0 || mode == 0) { PROTECT(ans_elt = _new_INTEGER_from_IntAE(elt)); } else if (mode == 1) { continue; } else { // Not sure new LOGICALs are initialized with NAs, // need to check! If not, then LOGICAL(ans_elt)[0] must // be set to NA but I don't know how to do this :-/ PROTECT(ans_elt = NEW_LOGICAL(1)); } SET_VECTOR_ELT(ans, i, ans_elt); UNPROTECT(1); } UNPROTECT(1); return ans; } IntAEAE _new_IntAEAE_from_LIST(SEXP x) { IntAEAE int_aeae; int i; IntAE *elt; SEXP x_elt; int_aeae = _new_IntAEAE(LENGTH(x), 0); _IntAEAE_set_nelt(&int_aeae, int_aeae.buflength); for (i = 0, elt = int_aeae.elts; i < int_aeae.buflength; i++, elt++) { x_elt = VECTOR_ELT(x, i); if (TYPEOF(x_elt) != INTSXP) error("IRanges internal error in " "_new_IntAEAE_from_LIST(): " "not all elements in the list " "are integer vectors"); IntAE_alloc(elt, LENGTH(x_elt)); copy_INTEGER_to_IntAE(x_elt, elt); } return int_aeae; } SEXP _IntAEAE_toEnvir(const IntAEAE *int_aeae, SEXP envir, int keyshift) { int nelt, i; const IntAE *elt; char key[11]; SEXP value; nelt = _IntAEAE_get_nelt(int_aeae); #ifdef DEBUG_IRANGES int nkey = 0, cum_length = 0; if (debug) { Rprintf("[DEBUG] _IntAEAE_toEnvir(): BEGIN ... " "int_aeae->_nelt=%d keyshift=%d\n", nelt, keyshift); } #endif for (i = 0, elt = int_aeae->elts; i < nelt; i++, elt++) { #ifdef DEBUG_IRANGES if (debug) { if (i < 100 || i >= nelt - 100) Rprintf("[DEBUG] _IntAEAE_toEnvir(): " "nkey=%d int_aeae->elts[%d]._nelt=%d\n", nkey, i, _IntAE_get_nelt(elt)); } #endif if (_IntAE_get_nelt(elt) == 0) continue; //snprintf(key, sizeof(key), "%d", i + keyshift); snprintf(key, sizeof(key), "%010d", i + keyshift); #ifdef DEBUG_IRANGES if (debug) { if (i < 100 || i >= nelt - 100) Rprintf("[DEBUG] _IntAEAE_toEnvir(): " "installing key=%s ... ", key); } #endif PROTECT(value = _new_INTEGER_from_IntAE(elt)); defineVar(install(key), value, envir); UNPROTECT(1); #ifdef DEBUG_IRANGES if (debug) { nkey++; cum_length += _IntAE_get_nelt(elt); if (i < 100 || i >= nelt - 100) Rprintf("OK (nkey=%d cum_length=%d)\n", nkey, cum_length); } #endif } #ifdef DEBUG_IRANGES if (debug) { Rprintf("[DEBUG] _IntAEAE_toEnvir(): END " "(nkey=%d cum_length=%d)\n", nkey, cum_length); } #endif return envir; } /**************************************************************************** * RangeAE buffers * * We use a "global RangeAE malloc stack" to store a copy of each top-level * malloc-based RangeAE that is created during the execution of a .Call entry * point. The copy must be modified every time the start or width members are * modified. * Every .Call() should start with an empty stack. * After the .Call() has returned, the stack must be emptied with * .Call("AEbufs_free", PACKAGE="IRanges") */ #define RANGEAE_MALLOC_STACK_NELT_MAX 2048 static RangeAE RangeAE_malloc_stack[RANGEAE_MALLOC_STACK_NELT_MAX]; static int RangeAE_malloc_stack_nelt = 0; static void RangeAE_alloc(RangeAE *range_ae, int buflength) { IntAE_alloc(&(range_ae->start), buflength); IntAE_alloc(&(range_ae->width), buflength); range_ae->_AE_malloc_stack_idx = -1; return; } int _RangeAE_get_nelt(const RangeAE *range_ae) { return _IntAE_get_nelt(&(range_ae->start)); } int _RangeAE_set_nelt(RangeAE *range_ae, int nelt) { int idx; _IntAE_set_nelt(&(range_ae->start), nelt); _IntAE_set_nelt(&(range_ae->width), nelt); idx = range_ae->_AE_malloc_stack_idx; if (idx >= 0) RangeAE_malloc_stack[idx] = *range_ae; return nelt; } #ifdef DEBUG_IRANGES static void RangeAE_print(const RangeAE *range_ae) { IntAE_print(&(range_ae->start)); Rprintf(" "); IntAE_print(&(range_ae->width)); Rprintf(" _AE_malloc_stack_idx=%d", range_ae->_AE_malloc_stack_idx); return; } #endif /* Must be used on a malloc-based RangeAE */ static void RangeAE_free(const RangeAE *range_ae) { IntAE_free(&(range_ae->start)); IntAE_free(&(range_ae->width)); return; } static void reset_RangeAE_malloc_stack() { int i; const RangeAE *range_ae; for (i = 0, range_ae = RangeAE_malloc_stack; i < RangeAE_malloc_stack_nelt; i++, range_ae++) { #ifdef DEBUG_IRANGES if (debug) { Rprintf("RangeAE_malloc_stack[%d]: ", i); RangeAE_print(range_ae); Rprintf("\n"); } #endif RangeAE_free(range_ae); } RangeAE_malloc_stack_nelt = 0; return; } RangeAE _new_RangeAE(int buflength, int nelt) { RangeAE range_ae; int idx; /* Allocation */ RangeAE_alloc(&range_ae, buflength); if (use_malloc) { if (RangeAE_malloc_stack_nelt >= RANGEAE_MALLOC_STACK_NELT_MAX) error("IRanges internal error in _new_RangeAE(): " "the \"global RangeAE malloc stack\" is full"); idx = RangeAE_malloc_stack_nelt++; range_ae._AE_malloc_stack_idx = idx; RangeAE_malloc_stack[idx] = range_ae; } /* Elements are NOT initialized */ _RangeAE_set_nelt(&range_ae, nelt); return range_ae; } void _RangeAE_insert_at(RangeAE *range_ae, int at, int start, int width) { int idx; _IntAE_insert_at(&(range_ae->start), at, start); _IntAE_insert_at(&(range_ae->width), at, width); idx = range_ae->_AE_malloc_stack_idx; if (idx >= 0) RangeAE_malloc_stack[idx] = *range_ae; return; } /**************************************************************************** * RangeAEAE buffers * * We use a "global RangeAEAE malloc stack" to store a copy of each top-level * malloc-based RangeAEAE that is created during the execution of a .Call entry * point. The copy must be modified at every reallocation or every time the * nb of elements in the buffer (nelt member) is modified. * Every .Call() should start with an empty stack. * After the .Call() has returned, the stack must be emptied with * .Call("AEbufs_free", PACKAGE="IRanges") */ #define RANGEAEAE_MALLOC_STACK_NELT_MAX 2048 static RangeAEAE RangeAEAE_malloc_stack[RANGEAEAE_MALLOC_STACK_NELT_MAX]; static int RangeAEAE_malloc_stack_nelt = 0; static void RangeAEAE_alloc(RangeAEAE *range_aeae, int buflength) { range_aeae->elts = (RangeAE *) alloc_AEbuf(buflength, sizeof(RangeAE)); range_aeae->buflength = buflength; range_aeae->_AE_malloc_stack_idx = -1; return; } static void RangeAEAE_realloc(RangeAEAE *range_aeae) { int new_buflength, idx; new_buflength = _get_new_buflength(range_aeae->buflength); range_aeae->elts = (RangeAE *) realloc_AEbuf(range_aeae->elts, new_buflength, range_aeae->buflength, sizeof(RangeAE)); range_aeae->buflength = new_buflength; idx = range_aeae->_AE_malloc_stack_idx; if (idx >= 0) RangeAEAE_malloc_stack[idx] = *range_aeae; return; } int _RangeAEAE_get_nelt(const RangeAEAE *range_aeae) { return range_aeae->_nelt; } int _RangeAEAE_set_nelt(RangeAEAE *range_aeae, int nelt) { int idx; range_aeae->_nelt = nelt; idx = range_aeae->_AE_malloc_stack_idx; if (idx >= 0) RangeAEAE_malloc_stack[idx] = *range_aeae; return nelt; } /* Must be used on a malloc-based RangeAEAE */ static void RangeAEAE_free(const RangeAEAE *range_aeae) { int nelt, i; RangeAE *elt; nelt = _RangeAEAE_get_nelt(range_aeae); for (i = 0, elt = range_aeae->elts; i < nelt; i++, elt++) RangeAE_free(elt); if (range_aeae->elts != NULL) free(range_aeae->elts); return; } static void reset_RangeAEAE_malloc_stack() { int i; const RangeAEAE *range_aeae; for (i = 0, range_aeae = RangeAEAE_malloc_stack; i < RangeAEAE_malloc_stack_nelt; i++, range_aeae++) { RangeAEAE_free(range_aeae); } RangeAEAE_malloc_stack_nelt = 0; return; } RangeAEAE _new_RangeAEAE(int buflength, int nelt) { RangeAEAE range_aeae; int idx, i; RangeAE *elt; /* Allocation */ RangeAEAE_alloc(&range_aeae, buflength); if (use_malloc) { if (RangeAEAE_malloc_stack_nelt >= RANGEAEAE_MALLOC_STACK_NELT_MAX) error("IRanges internal error in _new_RangeAEAE(): " "the \"global RangeAEAE malloc stack\" is full"); idx = RangeAEAE_malloc_stack_nelt++; range_aeae._AE_malloc_stack_idx = idx; RangeAEAE_malloc_stack[idx] = range_aeae; } /* Initialization */ _RangeAEAE_set_nelt(&range_aeae, nelt); for (i = 0, elt = range_aeae.elts; i < nelt; i++, elt++) { RangeAE_alloc(elt, 0); _RangeAE_set_nelt(elt, 0); } return range_aeae; } void _RangeAEAE_insert_at(RangeAEAE *range_aeae, int at, const RangeAE *range_ae) { int nelt, i; RangeAE *elt1; const RangeAE *elt2; if (range_ae->_AE_malloc_stack_idx >= 0) error("IRanges internal error in _RangeAEAE_insert_at(): " "cannot insert a RangeAE that is in the " "\"global RangeAE malloc stack\""); nelt = _RangeAEAE_get_nelt(range_aeae); if (nelt >= range_aeae->buflength) RangeAEAE_realloc(range_aeae); elt1 = range_aeae->elts + nelt; elt2 = elt1 - 1; for (i = nelt; i > at; i--) *(elt1--) = *(elt2--); *elt1 = *range_ae; _RangeAEAE_set_nelt(range_aeae, nelt + 1); return; } /**************************************************************************** * CharAE buffers * * We use a "global CharAE malloc stack" to store a copy of each top-level * malloc-based CharAE that is created during the execution of a .Call entry * point. The copy must be modified at every reallocation or every time the * nb of elements in the buffer (nelt member) is modified. * Every .Call() should start with an empty stack. * After the .Call() has returned, the stack must be emptied with * .Call("AEbufs_free", PACKAGE="IRanges") */ #define CHARAE_MALLOC_STACK_NELT_MAX 2048 static CharAE CharAE_malloc_stack[CHARAE_MALLOC_STACK_NELT_MAX]; static int CharAE_malloc_stack_nelt = 0; static void CharAE_alloc(CharAE *char_ae, int buflength) { char_ae->elts = (char *) alloc_AEbuf(buflength, sizeof(char)); char_ae->buflength = buflength; char_ae->_AE_malloc_stack_idx = -1; return; } static void CharAE_realloc(CharAE *char_ae) { int new_buflength, idx; new_buflength = _get_new_buflength(char_ae->buflength); char_ae->elts = (char *) realloc_AEbuf(char_ae->elts, new_buflength, char_ae->buflength, sizeof(char)); char_ae->buflength = new_buflength; idx = char_ae->_AE_malloc_stack_idx; if (idx >= 0) CharAE_malloc_stack[idx] = *char_ae; return; } int _CharAE_get_nelt(const CharAE *char_ae) { return char_ae->_nelt; } int _CharAE_set_nelt(CharAE *char_ae, int nelt) { int idx; char_ae->_nelt = nelt; idx = char_ae->_AE_malloc_stack_idx; if (idx >= 0) CharAE_malloc_stack[idx] = *char_ae; return nelt; } /* Must be used on a malloc-based CharAE */ static void CharAE_free(const CharAE *char_ae) { if (char_ae->elts != NULL) free(char_ae->elts); return; } static void reset_CharAE_malloc_stack() { int i; const CharAE *char_ae; for (i = 0, char_ae = CharAE_malloc_stack; i < CharAE_malloc_stack_nelt; i++, char_ae++) { CharAE_free(char_ae); } CharAE_malloc_stack_nelt = 0; return; } CharAE _new_CharAE(int buflength) { CharAE char_ae; int idx; /* Allocation */ CharAE_alloc(&char_ae, buflength); if (use_malloc) { if (CharAE_malloc_stack_nelt >= CHARAE_MALLOC_STACK_NELT_MAX) error("IRanges internal error in _new_IntAE(): " "the \"global CharAE malloc stack\" is full"); idx = CharAE_malloc_stack_nelt++; char_ae._AE_malloc_stack_idx = idx; CharAE_malloc_stack[idx] = char_ae; } /* Initialization */ _CharAE_set_nelt(&char_ae, 0); return char_ae; } CharAE _new_CharAE_from_string(const char *string) { CharAE char_ae; char_ae = _new_CharAE(strlen(string)); _CharAE_set_nelt(&char_ae, char_ae.buflength); memcpy(char_ae.elts, string, char_ae.buflength); return char_ae; } void _CharAE_insert_at(CharAE *char_ae, int at, char c) { int nelt, i; char *elt1; const char *elt2; nelt = _CharAE_get_nelt(char_ae); if (nelt >= char_ae->buflength) CharAE_realloc(char_ae); elt1 = char_ae->elts + nelt; elt2 = elt1 - 1; for (i = nelt; i > at; i--) *(elt1--) = *(elt2--); *elt1 = c; _CharAE_set_nelt(char_ae, nelt + 1); return; } void _append_string_to_CharAE(CharAE *char_ae, const char *string) { int nnewval, nelt, new_nelt; char *dest; nnewval = strlen(string); nelt = _CharAE_get_nelt(char_ae); new_nelt = nelt + nnewval; while (char_ae->buflength < new_nelt) CharAE_realloc(char_ae); dest = char_ae->elts + nelt; memcpy(dest, string, nnewval * sizeof(char)); _CharAE_set_nelt(char_ae, new_nelt); return; } /* * Delete 'nelt' elements, starting at position 'at'. * Doing _CharAE_delete_at(x, at, nelt) is equivalent to doing * _CharAE_delete_at(x, at, 1) 'nelt' times. */ void _CharAE_delete_at(CharAE *char_ae, int at, int nelt) { char *elt1; const char *elt2; int nelt0, i2; if (nelt == 0) return; elt1 = char_ae->elts + at; elt2 = elt1 + nelt; nelt0 = _CharAE_get_nelt(char_ae); for (i2 = at + nelt; i2 < nelt0; i2++) *(elt1++) = *(elt2++); _CharAE_set_nelt(char_ae, nelt0 - nelt); return; } SEXP _new_RAW_from_CharAE(const CharAE *char_ae) { int nelt; SEXP ans; if (sizeof(Rbyte) != sizeof(char)) // should never happen! error("_new_RAW_from_CharAE(): sizeof(Rbyte) != sizeof(char)"); nelt = _CharAE_get_nelt(char_ae); PROTECT(ans = NEW_RAW(nelt)); memcpy(RAW(ans), char_ae->elts, sizeof(char) * nelt); UNPROTECT(1); return ans; } /* only until we have a bitset or something smaller than char */ SEXP _new_LOGICAL_from_CharAE(const CharAE *char_ae) { int nelt, i, *ans_elt; SEXP ans; const char *elt; nelt = _CharAE_get_nelt(char_ae); PROTECT(ans = NEW_LOGICAL(nelt)); for (i = 0, ans_elt = LOGICAL(ans), elt = char_ae->elts; i < nelt; i++, ans_elt++, elt++) { *ans_elt = *elt; } UNPROTECT(1); return ans; } /**************************************************************************** * CharAEAE buffers * * We use a "global CharAEAE malloc stack" to store a copy of each top-level * malloc-based CharAEAE that is created during the execution of a .Call entry * point. The copy must be modified at every reallocation or every time the * nb of elements in the buffer (nelt member) is modified. * Every .Call() should start with an empty stack. * After the .Call() has returned, the stack must be emptied with * .Call("AEbufs_free", PACKAGE="IRanges") */ #define CHARAEAE_MALLOC_STACK_NELT_MAX 2048 static CharAEAE CharAEAE_malloc_stack[CHARAEAE_MALLOC_STACK_NELT_MAX]; static int CharAEAE_malloc_stack_nelt = 0; static void CharAEAE_alloc(CharAEAE *char_aeae, int buflength) { char_aeae->elts = (CharAE *) alloc_AEbuf(buflength, sizeof(CharAE)); char_aeae->buflength = buflength; char_aeae->_AE_malloc_stack_idx = -1; return; } static void CharAEAE_realloc(CharAEAE *char_aeae) { int new_buflength, idx; new_buflength = _get_new_buflength(char_aeae->buflength); char_aeae->elts = (CharAE *) realloc_AEbuf(char_aeae->elts, new_buflength, char_aeae->buflength, sizeof(CharAE)); char_aeae->buflength = new_buflength; idx = char_aeae->_AE_malloc_stack_idx; if (idx >= 0) CharAEAE_malloc_stack[idx] = *char_aeae; return; } int _CharAEAE_get_nelt(const CharAEAE *char_aeae) { return char_aeae->_nelt; } int _CharAEAE_set_nelt(CharAEAE *char_aeae, int nelt) { int idx; char_aeae->_nelt = nelt; idx = char_aeae->_AE_malloc_stack_idx; if (idx >= 0) CharAEAE_malloc_stack[idx] = *char_aeae; return nelt; } /* Must be used on a malloc-based CharAEAE */ static void CharAEAE_free(const CharAEAE *char_aeae) { int nelt, i; CharAE *elt; nelt = _CharAEAE_get_nelt(char_aeae); for (i = 0, elt = char_aeae->elts; i < nelt; i++, elt++) CharAE_free(elt); if (char_aeae->elts != NULL) free(char_aeae->elts); return; } static void reset_CharAEAE_malloc_stack() { int i; const CharAEAE *char_aeae; for (i = 0, char_aeae = CharAEAE_malloc_stack; i < CharAEAE_malloc_stack_nelt; i++, char_aeae++) { CharAEAE_free(char_aeae); } CharAEAE_malloc_stack_nelt = 0; return; } CharAEAE _new_CharAEAE(int buflength, int nelt) { CharAEAE char_aeae; int idx, i; CharAE *elt; /* Allocation */ CharAEAE_alloc(&char_aeae, buflength); if (use_malloc) { if (CharAEAE_malloc_stack_nelt >= CHARAEAE_MALLOC_STACK_NELT_MAX) error("IRanges internal error in _new_CharAEAE(): " "the \"global CharAEAE malloc stack\" is full"); idx = CharAEAE_malloc_stack_nelt++; char_aeae._AE_malloc_stack_idx = idx; CharAEAE_malloc_stack[idx] = char_aeae; } /* Initialization */ _CharAEAE_set_nelt(&char_aeae, nelt); for (i = 0, elt = char_aeae.elts; i < nelt; i++, elt++) { CharAE_alloc(elt, 0); _CharAE_set_nelt(elt, 0); } return char_aeae; } void _CharAEAE_insert_at(CharAEAE *char_aeae, int at, const CharAE *char_ae) { int nelt, i; CharAE *elt1; const CharAE *elt2; if (char_ae->_AE_malloc_stack_idx >= 0) error("IRanges internal error in _CharAEAE_insert_at(): " "cannot insert a CharAE that is in the " "\"global CharAE malloc stack\""); nelt = _CharAEAE_get_nelt(char_aeae); if (nelt >= char_aeae->buflength) CharAEAE_realloc(char_aeae); elt1 = char_aeae->elts + nelt; elt2 = elt1 - 1; for (i = nelt; i > at; i--) *(elt1--) = *(elt2--); *elt1 = *char_ae; _CharAEAE_set_nelt(char_aeae, nelt + 1); return; } void _append_string_to_CharAEAE(CharAEAE *char_aeae, const char *string) { CharAE char_ae; CharAE_alloc(&char_ae, strlen(string)); _CharAE_set_nelt(&char_ae, char_ae.buflength); memcpy(char_ae.elts, string, char_ae.buflength); _CharAEAE_insert_at(char_aeae, _CharAEAE_get_nelt(char_aeae), &char_ae); return; } SEXP _new_CHARACTER_from_CharAEAE(const CharAEAE *char_aeae) { int nelt, i; SEXP ans, ans_elt; CharAE *elt; nelt = _CharAEAE_get_nelt(char_aeae); PROTECT(ans = NEW_CHARACTER(nelt)); for (i = 0, elt = char_aeae->elts; i < nelt; i++, elt++) { PROTECT(ans_elt = mkCharLen(elt->elts, _CharAE_get_nelt(elt))); SET_STRING_ELT(ans, i, ans_elt); UNPROTECT(1); } UNPROTECT(1); return ans; } /**************************************************************************** * Freeing the malloc-based AEbufs. */ SEXP AEbufs_free() { reset_IntAE_malloc_stack(); reset_IntAEAE_malloc_stack(); reset_RangeAE_malloc_stack(); reset_RangeAEAE_malloc_stack(); reset_CharAE_malloc_stack(); reset_CharAEAE_malloc_stack(); return R_NilValue; } IRanges/src/CompressedIRangesList_class.c0000644000126300012640000001272512234075662022034 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of CompressedIRangesList objects * ****************************************************************************/ #include "IRanges.h" #include #define R_INT_MIN (1+INT_MIN) /**************************************************************************** * C-level abstract getters. */ cachedCompressedIRangesList _cache_CompressedIRangesList(SEXP x) { cachedCompressedIRangesList cached_x; SEXP x_end; cached_x.classname = _get_classname(x); x_end = _get_PartitioningByEnd_end( _get_CompressedList_partitioning(x)); cached_x.length = LENGTH(x_end); cached_x.end = INTEGER(x_end); cached_x.cached_unlistData = _cache_IRanges( _get_CompressedList_unlistData(x)); return cached_x; } int _get_cachedCompressedIRangesList_length( const cachedCompressedIRangesList *cached_x) { return cached_x->length; } cachedIRanges _get_cachedCompressedIRangesList_elt( const cachedCompressedIRangesList *cached_x, int i) { int offset, length; offset = i == 0 ? 0 : cached_x->end[i - 1]; length = cached_x->end[i] - offset; return _sub_cachedIRanges(&(cached_x->cached_unlistData), offset, length); } int _get_cachedCompressedIRangesList_eltLength( const cachedCompressedIRangesList *cached_x, int i) { /* cachedIRanges cached_ir; cached_ir = _get_cachedCompressedIRangesList_elt(cached_x, i); return _get_cachedIRanges_length(&cached_ir); */ int offset; offset = i == 0 ? 0 : cached_x->end[i - 1]; return cached_x->end[i] - offset; /* faster than the above */ } /**************************************************************************** * CompressedIRangesList methods. */ /* --- .Call ENTRY POINT --- */ SEXP CompressedIRangesList_isNormal(SEXP x, SEXP use_names) { SEXP ans, ans_names; cachedCompressedIRangesList cached_x; cachedIRanges cached_ir; int x_length, i; cached_x = _cache_CompressedIRangesList(x); x_length = _get_cachedCompressedIRangesList_length(&cached_x); PROTECT(ans = NEW_LOGICAL(x_length)); for (i = 0; i < x_length; i++) { cached_ir = _get_cachedCompressedIRangesList_elt(&cached_x, i); LOGICAL(ans)[i] = _is_normal_cachedIRanges(&cached_ir); } if (LOGICAL(use_names)[0]) { PROTECT(ans_names = duplicate(_get_CompressedList_names(x))); SET_NAMES(ans, ans_names); UNPROTECT(1); } UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP CompressedIRangesList_summary(SEXP object) { int ans_len; SEXP part_end; SEXP ans, ans_names, col_names; part_end = _get_PartitioningByEnd_end( _get_CompressedList_partitioning(object)); ans_len = LENGTH(part_end); PROTECT(ans = allocMatrix(INTSXP, ans_len, 2)); memset(INTEGER(ans), 0, 2 * ans_len * sizeof(int)); if (ans_len > 0) { int i, j, prev_end = 0; int *ans1_elt, *ans2_elt; const int *part_end_elt, *ranges_width; SEXP unlistData = _get_CompressedList_unlistData(object); ranges_width = INTEGER(_get_IRanges_width(unlistData)); for (i = 0, ans1_elt = INTEGER(ans), ans2_elt = (INTEGER(ans) + ans_len), part_end_elt = INTEGER(part_end); i < ans_len; i++, ans1_elt++, ans2_elt++, part_end_elt++) { *ans1_elt = *part_end_elt - prev_end; for (j = 0; j < *ans1_elt; j++) { *ans2_elt += *ranges_width; ranges_width++; } prev_end = *part_end_elt; } } PROTECT(ans_names = NEW_LIST(2)); PROTECT(col_names = NEW_CHARACTER(2)); SET_STRING_ELT(col_names, 0, mkChar("Length")); SET_STRING_ELT(col_names, 1, mkChar("WidthSum")); SET_VECTOR_ELT(ans_names, 0, duplicate(_get_CompressedList_names(object))); SET_VECTOR_ELT(ans_names, 1, col_names); SET_DIMNAMES(ans, ans_names); UNPROTECT(3); return ans; } /**************************************************************************** * CompressedNormalIRangesList methods. */ /* --- .Call ENTRY POINT --- */ SEXP CompressedNormalIRangesList_min(SEXP x, SEXP use_names) { SEXP ans, ans_names; cachedCompressedIRangesList cached_x; cachedIRanges cached_ir; int x_length, ir_length, i; int *ans_elt; cached_x = _cache_CompressedIRangesList(x); x_length = _get_cachedCompressedIRangesList_length(&cached_x); PROTECT(ans = NEW_INTEGER(x_length)); for (i = 0, ans_elt = INTEGER(ans); i < x_length; i++, ans_elt++) { cached_ir = _get_cachedCompressedIRangesList_elt(&cached_x, i); ir_length = _get_cachedIRanges_length(&cached_ir); if (ir_length == 0) { *ans_elt = INT_MAX; } else { *ans_elt = _get_cachedIRanges_elt_start(&cached_ir, 0); } } if (LOGICAL(use_names)[0]) { PROTECT(ans_names = duplicate(_get_CompressedList_names(x))); SET_NAMES(ans, ans_names); UNPROTECT(1); } UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP CompressedNormalIRangesList_max(SEXP x, SEXP use_names) { SEXP ans, ans_names; cachedCompressedIRangesList cached_x; cachedIRanges cached_ir; int x_length, ir_length, i; int *ans_elt; cached_x = _cache_CompressedIRangesList(x); x_length = _get_cachedCompressedIRangesList_length(&cached_x); PROTECT(ans = NEW_INTEGER(x_length)); for (i = 0, ans_elt = INTEGER(ans); i < x_length; i++, ans_elt++) { cached_ir = _get_cachedCompressedIRangesList_elt(&cached_x, i); ir_length = _get_cachedIRanges_length(&cached_ir); if (ir_length == 0) { *ans_elt = R_INT_MIN; } else { *ans_elt = _get_cachedIRanges_elt_end(&cached_ir, ir_length - 1); } } if (LOGICAL(use_names)[0]) { PROTECT(ans_names = duplicate(_get_CompressedList_names(x))); SET_NAMES(ans, ans_names); UNPROTECT(1); } UNPROTECT(1); return ans; } IRanges/src/CompressedList_class.c0000644000126300012640000000423512234075662020560 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of CompressedList objects * ****************************************************************************/ #include "IRanges.h" /**************************************************************************** * C-level slot getters. * * Be careful that these functions do NOT duplicate the returned slot. * Thus they cannot be made .Call entry points! */ static SEXP unlistData_symbol = NULL, partitioning_symbol = NULL; SEXP _get_CompressedList_unlistData(SEXP x) { INIT_STATIC_SYMBOL(unlistData) return GET_SLOT(x, unlistData_symbol); } SEXP _get_CompressedList_partitioning(SEXP x) { INIT_STATIC_SYMBOL(partitioning) return GET_SLOT(x, partitioning_symbol); } /* Not strict "slot getters" but very much like. */ int _get_CompressedList_length(SEXP x) { return LENGTH(_get_PartitioningByEnd_end( _get_CompressedList_partitioning(x))); } SEXP _get_CompressedList_names(SEXP x) { return _get_Partitioning_names( _get_CompressedList_partitioning(x)); } /**************************************************************************** * C-level slot setters. * * Be careful that these functions do NOT duplicate the assigned value! */ static void set_CompressedList_unlistData(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(unlistData) SET_SLOT(x, unlistData_symbol, value); return; } static void set_CompressedList_partitioning(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(partitioning) SET_SLOT(x, partitioning_symbol, value); return; } /**************************************************************************** * C-level constructor. */ /* Be careful that this constructor does NOT duplicate its arguments before putting them in the slots of the returned object. So don't try to make it a .Call entry point! */ SEXP _new_CompressedList(const char *classname, SEXP unlistData, SEXP partitioning) { SEXP classdef, ans; PROTECT(classdef = MAKE_CLASS(classname)); PROTECT(ans = NEW_OBJECT(classdef)); set_CompressedList_unlistData(ans, unlistData); set_CompressedList_partitioning(ans, partitioning); UNPROTECT(2); return ans; } IRanges/src/DataFrame_class.c0000644000126300012640000000145412234075662017444 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of DataFrame objects ****************************************************************************/ #include "IRanges.h" static SEXP rownames_symbol = NULL, nrows_symbol = NULL; static void set_DataFrame_rownames(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(rownames) SET_SLOT(x, rownames_symbol, value); } static void set_DataFrame_nrows(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(nrows) SET_SLOT(x, nrows_symbol, value); } SEXP _new_DataFrame(const char *classname, SEXP vars, SEXP rownames, SEXP nrows) { SEXP ans; PROTECT(ans = _new_SimpleList(classname, vars)); set_DataFrame_rownames(ans, rownames); set_DataFrame_nrows(ans, nrows); UNPROTECT(1); return ans; } IRanges/src/GappedRanges_class.c0000644000126300012640000000431112234075662020153 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of GappedRanges objects * ****************************************************************************/ #include "IRanges.h" static const char *is_valid_GappedRanges_elt(const cachedIRanges *cached_ir) { if (_get_cachedIRanges_length(cached_ir) == 0) return "IRanges object has no ranges"; if (!_is_normal_cachedIRanges(cached_ir)) return "IRanges object is not normal"; return NULL; } /* * TODO: This is not needed anymore now that the 'cirl' slot has been * replaced by the 'cnirl' slot which is guaranteed to hold a * CompressedNormalIRangesList object (instead of just a CompressedIRangesList * object for the old slot). Hence the validity method for GappedRanges * should just check that all the elements in 'x@cnirl' are of length >= 1 * (which can be done in R with elementLengths()). * * We assume that 'x@cnirl' is already a valid CompressedIRangesList object. * Here we only check that its elements are normal and of length >= 1. * ans_type: a single integer specifying the type of answer to return: * 0: 'ans' is a string describing the first validity failure or NULL; * 1: 'ans' is logical vector with TRUE values for valid elements in 'x'. */ SEXP valid_GappedRanges(SEXP x, SEXP ans_type) { SEXP cnirl, ans; cachedCompressedIRangesList cached_cnirl; int x_length, ans_type0, i; cachedIRanges cached_ir; const char *errmsg; char string_buf[80]; cnirl = GET_SLOT(x, install("cnirl")); cached_cnirl = _cache_CompressedIRangesList(cnirl); x_length = _get_cachedCompressedIRangesList_length(&cached_cnirl); ans_type0 = INTEGER(ans_type)[0]; if (ans_type0 == 1) PROTECT(ans = NEW_LOGICAL(x_length)); else ans = R_NilValue; for (i = 0; i < x_length; i++) { cached_ir = _get_cachedCompressedIRangesList_elt(&cached_cnirl, i); errmsg = is_valid_GappedRanges_elt(&cached_ir); if (ans_type0 == 1) { LOGICAL(ans)[i] = errmsg == NULL; continue; } if (errmsg != NULL) { snprintf(string_buf, sizeof(string_buf), "element %d is invalid (%s)", i + 1, errmsg); return mkString(string_buf); } } if (ans_type0 == 1) UNPROTECT(1); return ans; } IRanges/src/Grouping_class.c0000644000126300012640000001075612234075662017417 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of Grouping objects * * Author: Herve Pages * ****************************************************************************/ #include "IRanges.h" static int debug = 0; SEXP debug_Grouping_class() { #ifdef DEBUG_IRANGES debug = !debug; Rprintf("Debug mode turned %s in file %s\n", debug ? "on" : "off", __FILE__); #else Rprintf("Debug mode not available in file %s\n", __FILE__); #endif return R_NilValue; } /**************************************************************************** * C-level slot getters. * * Be careful that these functions do NOT duplicate the returned slot. * Thus they cannot be made .Call entry points! */ static SEXP high2low_symbol = NULL, low2high_symbol = NULL, end_symbol = NULL, NAMES_symbol = NULL; SEXP _get_H2LGrouping_high2low(SEXP x) { INIT_STATIC_SYMBOL(high2low) return GET_SLOT(x, high2low_symbol); } SEXP _get_H2LGrouping_low2high(SEXP x) { INIT_STATIC_SYMBOL(low2high) return GET_SLOT(x, low2high_symbol); } SEXP _get_Partitioning_names(SEXP x) { INIT_STATIC_SYMBOL(NAMES) return GET_SLOT(x, NAMES_symbol); } SEXP _get_PartitioningByEnd_end(SEXP x) { INIT_STATIC_SYMBOL(end) return GET_SLOT(x, end_symbol); } /**************************************************************************** * C-level slot setters. * * Be careful that these functions do NOT duplicate the assigned value! */ static void set_Partitioning_names(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(NAMES) SET_SLOT(x, NAMES_symbol, value); return; } static void set_PartitioningByEnd_end(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(end) SET_SLOT(x, end_symbol, value); return; } /**************************************************************************** * C-level constructor. */ /* Be careful that this constructor does NOT duplicate its arguments before putting them in the slots of the returned object. So don't try to make it a .Call entry point! */ SEXP _new_PartitioningByEnd(const char *classname, SEXP end, SEXP names) { SEXP classdef, ans; PROTECT(classdef = MAKE_CLASS(classname)); PROTECT(ans = NEW_OBJECT(classdef)); set_PartitioningByEnd_end(ans, end); if (names == NULL) names = R_NilValue; set_Partitioning_names(ans, names); UNPROTECT(2); return ans; } /**************************************************************************** * --- .Call ENTRY POINTS --- * ****************************************************************************/ SEXP H2LGrouping_members(SEXP x, SEXP group_ids) { SEXP ans, x_high2low, x_low2high, x_low2high_elt; int x_length, nids, ans_length, i, j, group_id, *ans_elt; if (TYPEOF(group_ids) != INTSXP) error("the group ids must be integers"); x_high2low = _get_H2LGrouping_high2low(x); x_low2high = _get_H2LGrouping_low2high(x); x_length = LENGTH(x_low2high); /* same as LENGTH(x_high2low) */ nids = LENGTH(group_ids); /* 1st pass: determine 'ans_length' */ ans_length = 0; for (j = 0; j < nids; j++) { group_id = INTEGER(group_ids)[j]; if (group_id == NA_INTEGER) error("some group ids are NAs"); i = group_id - 1; if (i < 0 || i >= x_length) error("subscript out of bounds"); if (INTEGER(x_high2low)[i] != NA_INTEGER) continue; ans_length++; x_low2high_elt = VECTOR_ELT(x_low2high, i); if (x_low2high_elt == R_NilValue) continue; ans_length += LENGTH(x_low2high_elt); } PROTECT(ans = NEW_INTEGER(ans_length)); /* 2nd pass: fill 'ans' */ ans_elt = INTEGER(ans); for (j = 0; j < nids; j++) { group_id = INTEGER(group_ids)[j]; i = group_id - 1; if (INTEGER(x_high2low)[i] != NA_INTEGER) continue; *(ans_elt++) = i + 1; x_low2high_elt = VECTOR_ELT(x_low2high, i); if (x_low2high_elt == R_NilValue) continue; memcpy(ans_elt, INTEGER(x_low2high_elt), sizeof(int) * LENGTH(x_low2high_elt)); ans_elt += LENGTH(x_low2high_elt); } _sort_int_array(INTEGER(ans), ans_length, 0); UNPROTECT(1); return ans; } SEXP H2LGrouping_vmembers(SEXP x, SEXP group_ids_list) { SEXP ans, group_ids; int ans_length, i; ans_length = LENGTH(group_ids_list); PROTECT(ans = NEW_LIST(ans_length)); for (i = 0; i < ans_length; i++) { group_ids = VECTOR_ELT(group_ids_list, i); if (TYPEOF(group_ids) != INTSXP) error("'L' must be a list of integer vectors"); SET_VECTOR_ELT(ans, i, H2LGrouping_members(x, group_ids)); } UNPROTECT(1); return ans; } IRanges/src/Hits_class.c0000644000126300012640000000430712234075662016527 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of Hits objects * ****************************************************************************/ #include "IRanges.h" /* * --- .Call ENTRY POINT --- * 'hit_type' must be 0, -1 or 1 (single integer). */ SEXP make_all_group_inner_hits(SEXP group_sizes, SEXP hit_type) { int ngroup, htype, ans_length, i, j, k, gs, nhit, iofeig, *left, *right; const int *group_sizes_elt; SEXP ans_query_hits, ans_subject_hits, ans_query_length, ans_subject_length, ans; ngroup = LENGTH(group_sizes); htype = INTEGER(hit_type)[0]; for (i = ans_length = 0, group_sizes_elt = INTEGER(group_sizes); i < ngroup; i++, group_sizes_elt++) { gs = *group_sizes_elt; if (gs == NA_INTEGER || gs < 0) error("'group_sizes' contains NAs or negative values"); nhit = htype == 0 ? gs * gs : (gs * (gs - 1)) / 2; ans_length += nhit; } PROTECT(ans_query_hits = NEW_INTEGER(ans_length)); PROTECT(ans_subject_hits = NEW_INTEGER(ans_length)); left = INTEGER(ans_query_hits); right = INTEGER(ans_subject_hits); iofeig = 0; /* 0-based Index Of First Element In Group */ for (i = 0, group_sizes_elt = INTEGER(group_sizes); i < ngroup; i++, group_sizes_elt++) { gs = *group_sizes_elt; if (htype > 0) { for (j = 1; j < gs; j++) { for (k = j + 1; k <= gs; k++) { *(left++) = j + iofeig; *(right++) = k + iofeig; } } } else if (htype < 0) { for (j = 2; j <= gs; j++) { for (k = 1; k < j; k++) { *(left++) = j + iofeig; *(right++) = k + iofeig; } } } else { for (j = 1; j <= gs; j++) { for (k = 1; k <= gs; k++) { *(left++) = j + iofeig; *(right++) = k + iofeig; } } } iofeig += gs; } PROTECT(ans_query_length = ScalarInteger(iofeig)); PROTECT(ans_subject_length = ScalarInteger(iofeig)); PROTECT(ans = NEW_OBJECT(MAKE_CLASS("Hits"))); SET_SLOT(ans, install("queryHits"), ans_query_hits); SET_SLOT(ans, install("subjectHits"), ans_subject_hits); SET_SLOT(ans, install("queryLength"), ans_query_length); SET_SLOT(ans, install("subjectLength"), ans_subject_length); UNPROTECT(5); return ans; } IRanges/src/IRanges.h0000644000126300012640000003421012234075662015764 0ustar00biocbuildphs_compbio#include "../inst/include/IRanges_defines.h" #include #define DEBUG_IRANGES 1 #define INIT_STATIC_SYMBOL(NAME) \ { \ if (NAME ## _symbol == NULL) \ NAME ## _symbol = install(# NAME); \ } /* safe_arithm.c */ void _reset_ovflow_flag(); int _get_ovflow_flag(); int _safe_int_add( int x, int y ); int _safe_int_mult( int x, int y ); /* sort_utils.c */ void _sort_int_array( int *x, int nelt, int desc ); void _get_order_of_int_array( const int *x, int nelt, int desc, int *out, int out_shift ); void _get_order_of_int_pairs( const int *a, const int *b, int nelt, int desc, int *out, int out_shift ); void _get_matches_of_ordered_int_pairs( const int *a1, const int *b1, const int *o1, int nelt1, const int *a2, const int *b2, const int *o2, int nelt2, int nomatch, int *out, int out_shift ); void _get_order_of_int_quads( const int *a, const int *b, const int *c, const int *d, int nelt, int desc, int *out, int out_shift ); void _get_matches_of_ordered_int_quads( const int *a1, const int *b1, const int *c1, const int *d1, const int *o1, int nelt1, const int *a2, const int *b2, const int *c2, const int *d2, const int *o2, int nelt2, int nomatch, int *out, int out_shift ); /* hash_utils.c */ struct htab _new_htab(int n); int _get_hbucket_val( const struct htab *htab, int bucket_idx ); void _set_hbucket_val( struct htab *htab, int bucket_idx, int val ); /* AEbufs.c */ SEXP debug_AEbufs(); SEXP AEbufs_use_malloc(SEXP x); int _get_new_buflength(int buflength); int _IntAE_get_nelt(const IntAE *int_ae); int _IntAE_set_nelt( IntAE *int_ae, int nelt ); void _IntAE_set_val( const IntAE *int_ae, int val ); IntAE _new_IntAE( int buflength, int nelt, int val ); void _IntAE_insert_at( IntAE *int_ae, int at, int val ); void _IntAE_append( IntAE *int_ae, const int *newvals, int nnewval ); void _IntAE_delete_at( IntAE *int_ae, int at ); void _IntAE_shift( const IntAE *int_ae, int shift ); void _IntAE_sum_and_shift( const IntAE *int_ae1, const IntAE *int_ae2, int shift ); void _IntAE_append_shifted_vals( IntAE *int_ae, const int *newvals, int nnewval, int shift ); void _IntAE_qsort( const IntAE *int_ae, int desc ); void _IntAE_delete_adjdups(IntAE *int_ae); SEXP _new_INTEGER_from_IntAE(const IntAE *int_ae); IntAE _new_IntAE_from_INTEGER(SEXP x); IntAE _new_IntAE_from_CHARACTER( SEXP x, int keyshift ); int _IntAEAE_get_nelt(const IntAEAE *int_aeae); int _IntAEAE_set_nelt( IntAEAE *int_aeae, int nelt ); IntAEAE _new_IntAEAE( int buflength, int nelt ); void _IntAEAE_insert_at( IntAEAE *int_aeae, int at, const IntAE *int_ae ); void _IntAEAE_eltwise_append( const IntAEAE *int_aeae1, const IntAEAE *int_aeae2 ); void _IntAEAE_shift( const IntAEAE *int_aeae, int shift ); void _IntAEAE_sum_and_shift( const IntAEAE *int_aeae1, const IntAEAE *int_aeae2, int shift ); SEXP _new_LIST_from_IntAEAE( const IntAEAE *int_aeae, int mode ); IntAEAE _new_IntAEAE_from_LIST(SEXP x); SEXP _IntAEAE_toEnvir( const IntAEAE *int_aeae, SEXP envir, int keyshift ); int _RangeAE_get_nelt(const RangeAE *range_ae); int _RangeAE_set_nelt( RangeAE *range_ae, int nelt ); RangeAE _new_RangeAE( int buflength, int nelt ); void _RangeAE_insert_at( RangeAE *range_ae, int at, int start, int width ); int _RangeAEAE_get_nelt(const RangeAEAE *range_aeae); int _RangeAEAE_set_nelt( RangeAEAE *range_aeae, int nelt ); RangeAEAE _new_RangeAEAE( int buflength, int nelt ); void _RangeAEAE_insert_at( RangeAEAE *range_aeae, int at, const RangeAE *range_ae ); int _CharAE_get_nelt(const CharAE *char_ae); int _CharAE_set_nelt( CharAE *char_ae, int nelt ); CharAE _new_CharAE(int buflength); CharAE _new_CharAE_from_string(const char *string); void _CharAE_insert_at( CharAE *char_ae, int at, char c ); void _append_string_to_CharAE( CharAE *char_ae, const char *string ); void _CharAE_delete_at( CharAE *char_ae, int at, int nelt ); SEXP _new_RAW_from_CharAE(const CharAE *char_ae); SEXP _new_LOGICAL_from_CharAE(const CharAE *char_ae); int _CharAEAE_get_nelt(const CharAEAE *char_aeae); int _CharAEAE_set_nelt( CharAEAE *char_aeae, int nelt ); CharAEAE _new_CharAEAE( int buflength, int nelt ); void _CharAEAE_insert_at( CharAEAE *char_aeae, int at, const CharAE *char_ae ); void _append_string_to_CharAEAE( CharAEAE *char_aeae, const char *string ); SEXP _new_CHARACTER_from_CharAEAE(const CharAEAE *char_aeae); SEXP AEbufs_free(); /* anyMissing.c */ SEXP anyMissing(SEXP x); /* SEXP_utils.c */ const char *_get_classname(SEXP x); SEXP sapply_NROW(SEXP x); /* int_utils.c */ SEXP Integer_any_missing_or_outside(SEXP x, SEXP lower, SEXP upper); int _sum_non_neg_ints( const int *x, int x_len, const char *varname ); SEXP Integer_sum_non_neg_vals(SEXP x); SEXP Integer_diff_with_0(SEXP x); SEXP Integer_diff_with_last(SEXP x, SEXP last); SEXP Integer_order( SEXP x, SEXP decreasing ); int _check_integer_pairs( SEXP a, SEXP b, const int **a_p, const int **b_p, const char *a_argname, const char *b_argname ); SEXP Integer_order2( SEXP a, SEXP b, SEXP decreasing ); SEXP Integer_match2_quick( SEXP a1, SEXP b1, SEXP a2, SEXP b2, SEXP nomatch ); SEXP Integer_selfmatch2_quick( SEXP a, SEXP b ); SEXP Integer_match2_hash( SEXP a1, SEXP b1, SEXP a2, SEXP b2, SEXP nomatch ); SEXP Integer_selfmatch2_hash( SEXP a, SEXP b ); int _check_integer_quads( SEXP a, SEXP b, SEXP c, SEXP d, const int **a_p, const int **b_p, const int **c_p, const int **d_p, const char *a_argname, const char *b_argname, const char *c_argname, const char *d_argname ); SEXP Integer_order4( SEXP a, SEXP b, SEXP c, SEXP d, SEXP decreasing ); SEXP Integer_match4_quick( SEXP a1, SEXP b1, SEXP c1, SEXP d1, SEXP a2, SEXP b2, SEXP c2, SEXP d2, SEXP nomatch ); SEXP Integer_selfmatch4_quick( SEXP a, SEXP b, SEXP c, SEXP d ); SEXP Integer_match4_hash( SEXP a1, SEXP b1, SEXP c1, SEXP d1, SEXP a2, SEXP b2, SEXP c2, SEXP d2, SEXP nomatch ); SEXP Integer_selfmatch4_hash( SEXP a, SEXP b, SEXP c, SEXP d ); SEXP Integer_tabulate2( SEXP x, SEXP nbins, SEXP weight, SEXP strict ); SEXP Integer_explode_bits( SEXP x, SEXP bitpos ); SEXP Integer_sorted_merge( SEXP x, SEXP y ); SEXP Integer_mseq( SEXP from, SEXP to ); SEXP Integer_fancy_mseq( SEXP lengths, SEXP offset, SEXP rev ); SEXP _find_interv_and_start_from_width( const int *x, int x_len, const int *width, int width_len ); SEXP findIntervalAndStartFromWidth( SEXP x, SEXP vec ); /* str_utils.c */ SEXP safe_strexplode(SEXP s); SEXP strsplit_as_list_of_ints(SEXP x, SEXP sep); SEXP svn_time(); /* compact_bitvector.c */ SEXP logical_as_compact_bitvector(SEXP x); SEXP compact_bitvector_as_logical(SEXP x, SEXP length_out); SEXP subset_compact_bitvector(SEXP x, SEXP subscript); SEXP compact_bitvector_bit_count(SEXP x); SEXP compact_bitvector_last_bit(SEXP x); SEXP compact_bitvector_set_op(SEXP query, SEXP ref, SEXP align); /* Vector_class.c */ const char *_get_List_elementType(SEXP x); void _set_List_elementType( SEXP x, const char *type ); int _vector_memcmp( SEXP x1, int x1_offset, SEXP x2, int x2_offset, int nelt ); void _vector_memcpy( SEXP out, int out_offset, SEXP in, int in_offset, int nelt ); SEXP vector_subsetByRanges( SEXP x, SEXP start, SEXP width ); SEXP vector_seqselect( SEXP x, SEXP start, SEXP width ); /* Ranges_comparison.c */ int _overlap_code( int x_start, int x_width, int y_start, int y_width ); int _invert_overlap_code( int code ); SEXP Ranges_compare( SEXP x_start, SEXP x_width, SEXP y_start, SEXP y_width ); /* IRanges_class.c */ SEXP debug_IRanges_class(); SEXP _get_IRanges_start(SEXP x); SEXP _get_IRanges_width(SEXP x); SEXP _get_IRanges_names(SEXP x); int _get_IRanges_length(SEXP x); cachedIRanges _cache_IRanges(SEXP x); int _get_cachedIRanges_length(const cachedIRanges *cached_x); int _get_cachedIRanges_elt_width( const cachedIRanges *cached_x, int i ); int _get_cachedIRanges_elt_start( const cachedIRanges *cached_x, int i ); int _get_cachedIRanges_elt_end( const cachedIRanges *cached_x, int i ); SEXP _get_cachedIRanges_elt_name( const cachedIRanges *cached_x, int i ); cachedIRanges _sub_cachedIRanges( const cachedIRanges *cached_x, int offset, int length ); void _set_IRanges_names( SEXP x, SEXP names ); void _copy_IRanges_slots( SEXP x, SEXP x0 ); SEXP _new_IRanges( const char *classname, SEXP start, SEXP width, SEXP names ); SEXP _new_IRanges_from_RangeAE( const char *classname, const RangeAE *range_ae ); SEXP _new_list_of_IRanges_from_RangeAEAE( const char *element_type, const RangeAEAE *range_aeae ); SEXP _alloc_IRanges( const char *classname, int length ); int _is_normal_cachedIRanges(const cachedIRanges *cached_ir); SEXP IRanges_isNormal(SEXP x); SEXP IRanges_from_integer(SEXP x); SEXP NormalIRanges_from_logical(SEXP x); /* IRanges_constructor.c */ SEXP solve_user_SEW0( SEXP start, SEXP end, SEXP width ); SEXP solve_user_SEW( SEXP refwidths, SEXP start, SEXP end, SEXP width, SEXP translate_negative_coord, SEXP allow_nonnarrowing ); /* Grouping_class.c */ SEXP debug_Grouping_class(); SEXP _get_H2LGrouping_high2low(SEXP x); SEXP _get_H2LGrouping_low2high(SEXP x); SEXP _get_Partitioning_names(SEXP x); SEXP _get_PartitioningByEnd_end(SEXP x); SEXP _new_PartitioningByEnd( const char *classname, SEXP end, SEXP names ); SEXP H2LGrouping_members( SEXP x, SEXP group_ids ); SEXP H2LGrouping_vmembers( SEXP x, SEXP group_ids_list ); /* SimpleList_class.c */ SEXP _new_SimpleList( const char *classname, SEXP listData ); /* DataFrame_class.c */ SEXP _new_DataFrame( const char *classname, SEXP vars, SEXP rownames, SEXP nrows ); /* SimpleIRangesList_class.c */ SEXP SimpleIRangesList_isNormal(SEXP x); SEXP SimpleNormalIRangesList_min(SEXP x); SEXP SimpleNormalIRangesList_max(SEXP x); /* CompressedList_class.c */ SEXP _get_CompressedList_unlistData(SEXP x); SEXP _get_CompressedList_partitioning(SEXP x); int _get_CompressedList_length(SEXP x); SEXP _get_CompressedList_names(SEXP x); SEXP _new_CompressedList( const char *classname, SEXP unlistData, SEXP partitioning ); /* Rle_class.c */ SEXP _logical_Rle_constructor( const int *values, int nvalues, const int *lengths, int buflength ); SEXP _integer_Rle_constructor( const int *values, int nvalues, const int *lengths, int buflength ); SEXP _numeric_Rle_constructor( const double *values, int nvalues, const int *lengths, int buflength ); SEXP _complex_Rle_constructor( const Rcomplex *values, int nvalues, const int *lengths, int buflength ); SEXP _character_Rle_constructor( SEXP values, const int *lengths, int buflength ); SEXP _raw_Rle_constructor( const Rbyte *values, int nvalues, const int *lengths, int buflength ); SEXP Rle_constructor( SEXP values, SEXP lengths, SEXP check, SEXP buflength ); SEXP Rle_start(SEXP x); SEXP Rle_end(SEXP x); SEXP Rle_getStartEndRunAndOffset( SEXP x, SEXP start, SEXP end ); SEXP Rle_window_aslist( SEXP x, SEXP runStart, SEXP runEnd, SEXP offsetStart, SEXP offsetEnd ); SEXP Rle_window( SEXP x, SEXP runStart, SEXP runEnd, SEXP offsetStart, SEXP offsetEnd, SEXP ans ); SEXP _seqselect_Rle( SEXP x, const int *start, const int *width, int length ); SEXP Rle_seqselect( SEXP x, SEXP start, SEXP width ); /* Rle_utils.c */ SEXP Rle_runsum( SEXP x, SEXP k, SEXP na_rm ); SEXP Rle_runwtsum( SEXP x, SEXP k, SEXP wt, SEXP na_rm ); SEXP Rle_runq( SEXP x, SEXP k, SEXP which, SEXP na_rm ); /* RleViews_utils.c */ SEXP RleViews_viewMins( SEXP x, SEXP na_rm ); SEXP RleViews_viewMaxs( SEXP x, SEXP na_rm ); SEXP RleViews_viewSums( SEXP x, SEXP na_rm ); SEXP RleViews_viewMeans( SEXP x, SEXP na_rm ); SEXP RleViews_viewWhichMins( SEXP x, SEXP na_rm ); SEXP RleViews_viewWhichMaxs( SEXP x, SEXP na_rm ); /* CompressedIRangesList_class.c */ cachedCompressedIRangesList _cache_CompressedIRangesList(SEXP x); int _get_cachedCompressedIRangesList_length( const cachedCompressedIRangesList *cached_x ); cachedIRanges _get_cachedCompressedIRangesList_elt( const cachedCompressedIRangesList *cached_x, int i ); int _get_cachedCompressedIRangesList_eltLength( const cachedCompressedIRangesList *cached_x, int i ); SEXP CompressedIRangesList_isNormal( SEXP x, SEXP use_names ); SEXP CompressedIRangesList_summary( SEXP object ); SEXP CompressedNormalIRangesList_min( SEXP x, SEXP use_names ); SEXP CompressedNormalIRangesList_max( SEXP x, SEXP use_names ); /* GappedRanges_class.c */ SEXP valid_GappedRanges(SEXP x, SEXP ans_type); /* RangedData_class.c */ SEXP _new_RangedData( const char *classname, SEXP ranges, SEXP values ); /* Hits_class.c */ SEXP make_all_group_inner_hits( SEXP group_sizes, SEXP hit_type ); /* inter_range_methods.c */ SEXP debug_inter_range_methods(); SEXP IRanges_range(SEXP x); SEXP Ranges_reduce( SEXP x_start, SEXP x_width, SEXP drop_empty_ranges, SEXP min_gapwidth, SEXP with_mapping, SEXP with_inframe_start ); SEXP CompressedIRangesList_reduce( SEXP x, SEXP drop_empty_ranges, SEXP min_gapwidth, SEXP with_mapping ); SEXP IRanges_gaps( SEXP x_start, SEXP x_width, SEXP start, SEXP end ); SEXP CompressedIRangesList_gaps( SEXP x, SEXP start, SEXP end ); SEXP Ranges_disjointBins( SEXP x_start, SEXP x_width ); /* encodeOverlaps_methods.c */ SEXP encode_overlaps1( SEXP query_start, SEXP query_width, SEXP query_space, SEXP query_break, SEXP flip_query, SEXP subject_start, SEXP subject_width, SEXP subject_space, SEXP as_matrix, SEXP as_raw ); SEXP RangesList_encode_overlaps( SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces ); SEXP Hits_encode_overlaps( SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces, SEXP query_hits, SEXP subject_hits, SEXP flip_query ); /* coverage_methods.c */ SEXP IRanges_coverage( SEXP x, SEXP shift, SEXP width, SEXP weight, SEXP circle_len, SEXP method ); SEXP CompressedIRangesList_coverage( SEXP x, SEXP shift, SEXP width, SEXP weight, SEXP circle_lens, SEXP method ); IRanges/src/IRanges_class.c0000644000126300012640000002410112234075662017142 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of IRanges objects * * Author: Herve Pages * ****************************************************************************/ #include "IRanges.h" static int debug = 0; SEXP debug_IRanges_class() { #ifdef DEBUG_IRANGES debug = !debug; Rprintf("Debug mode turned %s in file %s\n", debug ? "on" : "off", __FILE__); #else Rprintf("Debug mode not available in file %s\n", __FILE__); #endif return R_NilValue; } /**************************************************************************** * C-level slot getters. * * Be careful that these functions do NOT duplicate the returned slot. * Thus they cannot be made .Call entry points! */ static SEXP start_symbol = NULL, width_symbol = NULL, NAMES_symbol = NULL; SEXP _get_IRanges_start(SEXP x) { INIT_STATIC_SYMBOL(start) return GET_SLOT(x, start_symbol); } SEXP _get_IRanges_width(SEXP x) { INIT_STATIC_SYMBOL(width) return GET_SLOT(x, width_symbol); } SEXP _get_IRanges_names(SEXP x) { INIT_STATIC_SYMBOL(NAMES) return GET_SLOT(x, NAMES_symbol); } /* Not a strict "slot getter" but very much like. */ int _get_IRanges_length(SEXP x) { return LENGTH(_get_IRanges_start(x)); } /**************************************************************************** * C-level abstract getters. */ cachedIRanges _cache_IRanges(SEXP x) { cachedIRanges cached_x; cached_x.classname = _get_classname(x); cached_x.is_constant_width = 0; cached_x.offset = 0; cached_x.length = _get_IRanges_length(x); cached_x.width = INTEGER(_get_IRanges_width(x)); cached_x.start = INTEGER(_get_IRanges_start(x)); cached_x.end = NULL; cached_x.names = _get_IRanges_names(x); return cached_x; } int _get_cachedIRanges_length(const cachedIRanges *cached_x) { return cached_x->length; } int _get_cachedIRanges_elt_width(const cachedIRanges *cached_x, int i) { return cached_x->is_constant_width ? cached_x->width[0] : cached_x->width[i]; } int _get_cachedIRanges_elt_start(const cachedIRanges *cached_x, int i) { if (cached_x->start) return cached_x->start[i]; return cached_x->end[i] - _get_cachedIRanges_elt_width(cached_x, i) + 1; } int _get_cachedIRanges_elt_end(const cachedIRanges *cached_x, int i) { if (cached_x->end) return cached_x->end[i]; return cached_x->start[i] + _get_cachedIRanges_elt_width(cached_x, i) - 1; } SEXP _get_cachedIRanges_elt_name(const cachedIRanges *cached_x, int i) { return STRING_ELT(cached_x->names, cached_x->offset + i); } cachedIRanges _sub_cachedIRanges(const cachedIRanges *cached_x, int offset, int length) { cachedIRanges cached_y; cached_y = *cached_x; cached_y.offset += offset; cached_y.length = length; cached_y.start += offset; if (!cached_y.is_constant_width) cached_y.width += offset; return cached_y; } /**************************************************************************** * C-level slot setters. * * Be careful that these functions do NOT duplicate the assigned value! */ static void set_IRanges_start(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(start) SET_SLOT(x, start_symbol, value); return; } static void set_IRanges_width(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(width) SET_SLOT(x, width_symbol, value); /* Rprintf("set_IRanges_width(): value=%p _get_IRanges_width(x)=%p\n", value, _get_IRanges_width(x)); */ return; } static void set_IRanges_names(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(NAMES) SET_SLOT(x, NAMES_symbol, value); return; } /* WARNING: Use only AFTER 'x@start' has been set! Because this setter is trying to figure out what the length of 'x' is. */ void _set_IRanges_names(SEXP x, SEXP names) { if (names == NULL) names = R_NilValue; else if (names != R_NilValue && LENGTH(names) != _get_IRanges_length(x)) error("_set_IRanges_names(): " "number of names and number of elements differ"); set_IRanges_names(x, names); return; } /* Note that 'start' and 'width' must NOT contain NAs. set_IRanges_slots() trusts the caller and does NOT check this! */ static void set_IRanges_slots(SEXP x, SEXP start, SEXP width, SEXP names) { if (LENGTH(width) != LENGTH(start)) error("set_IRanges_slots(): " "number of starts and number of widths differ"); set_IRanges_start(x, start); set_IRanges_width(x, width); _set_IRanges_names(x, names); return; } void _copy_IRanges_slots(SEXP x, SEXP x0) { SEXP slot; PROTECT(slot = duplicate(_get_IRanges_start(x0))); set_IRanges_start(x, slot); UNPROTECT(1); PROTECT(slot = duplicate(_get_IRanges_width(x0))); set_IRanges_width(x, slot); UNPROTECT(1); PROTECT(slot = duplicate(_get_IRanges_names(x0))); set_IRanges_names(x, slot); UNPROTECT(1); return; } /**************************************************************************** * C-level constructors. */ /* Be careful that this constructor does NOT duplicate its arguments before putting them in the slots of the returned object. So don't try to make it a .Call entry point! */ SEXP _new_IRanges(const char *classname, SEXP start, SEXP width, SEXP names) { SEXP classdef, ans; PROTECT(classdef = MAKE_CLASS(classname)); PROTECT(ans = NEW_OBJECT(classdef)); set_IRanges_slots(ans, start, width, names); UNPROTECT(2); return ans; } SEXP _new_IRanges_from_RangeAE(const char *classname, const RangeAE *range_ae) { SEXP ans, start, width; PROTECT(start = _new_INTEGER_from_IntAE(&(range_ae->start))); PROTECT(width = _new_INTEGER_from_IntAE(&(range_ae->width))); PROTECT(ans = _new_IRanges(classname, start, width, R_NilValue)); UNPROTECT(3); return ans; } /* TODO: Try to make this faster by making only 1 call to _new_IRanges() (or _alloc_IRanges()) and cloning and modifying this initial object inside the for loop. */ SEXP _new_list_of_IRanges_from_RangeAEAE(const char *element_type, const RangeAEAE *range_aeae) { SEXP ans, ans_elt; int nelt, i; const RangeAE *elt; nelt = _RangeAEAE_get_nelt(range_aeae); PROTECT(ans = NEW_LIST(nelt)); for (i = 0, elt = range_aeae->elts; i < nelt; i++, elt++) { PROTECT(ans_elt = _new_IRanges_from_RangeAE(element_type, elt)); SET_VECTOR_ELT(ans, i, ans_elt); UNPROTECT(1); } UNPROTECT(1); return ans; } /* Allocation WITHOUT initialization. The 'start' and 'width' slots are not initialized (they contain junk). */ SEXP _alloc_IRanges(const char *classname, int length) { SEXP start, width, ans; PROTECT(start = NEW_INTEGER(length)); PROTECT(width = NEW_INTEGER(length)); PROTECT(ans = _new_IRanges(classname, start, width, R_NilValue)); UNPROTECT(3); return ans; } /**************************************************************************** * Validity functions. */ int _is_normal_cachedIRanges(const cachedIRanges *cached_ir) { int ir_length, i; ir_length = _get_cachedIRanges_length(cached_ir); if (ir_length == 0) return 1; if (_get_cachedIRanges_elt_width(cached_ir, 0) <= 0) return 0; for (i = 1; i < ir_length; i++) { if (_get_cachedIRanges_elt_width(cached_ir, i) <= 0) return 0; if (_get_cachedIRanges_elt_start(cached_ir, i) <= _get_cachedIRanges_elt_end(cached_ir, i - 1) + 1) return 0; } return 1; } /* --- .Call ENTRY POINT --- */ SEXP IRanges_isNormal(SEXP x) { cachedIRanges cached_ir; cached_ir = _cache_IRanges(x); return ScalarLogical(_is_normal_cachedIRanges(&cached_ir)); } /**************************************************************************** * Coercion functions. */ /* --- .Call ENTRY POINT --- */ SEXP IRanges_from_integer(SEXP x) { SEXP ans, ans_start, ans_width; int i, x_length, ans_length; int *start_buf, *width_buf; int *x_elt, *start_elt, *width_elt, prev_elt_plus1; x_length = LENGTH(x); if (x_length == 0) { PROTECT(ans_start = NEW_INTEGER(0)); PROTECT(ans_width = NEW_INTEGER(0)); } else { ans_length = 1; start_buf = (int *) R_alloc((long) x_length, sizeof(int)); width_buf = (int *) R_alloc((long) x_length, sizeof(int)); start_buf[0] = INTEGER(x)[0]; width_buf[0] = 1; prev_elt_plus1 = start_buf[0] + 1; start_elt = start_buf; width_elt = width_buf; for (i = 1, x_elt = (INTEGER(x)+1); i < x_length; i++, x_elt++) { if (*x_elt == NA_INTEGER) error("cannot create an IRanges object from an integer vector with missing values"); if (*x_elt == prev_elt_plus1) { *width_elt += 1; } else { ans_length++; start_elt++; width_elt++; *start_elt = *x_elt; *width_elt = 1; prev_elt_plus1 = *x_elt; } prev_elt_plus1++; } PROTECT(ans_start = NEW_INTEGER(ans_length)); PROTECT(ans_width = NEW_INTEGER(ans_length)); memcpy(INTEGER(ans_start), start_buf, sizeof(int) * ans_length); memcpy(INTEGER(ans_width), width_buf, sizeof(int) * ans_length); } PROTECT(ans = _new_IRanges("IRanges", ans_start, ans_width, R_NilValue)); UNPROTECT(3); return ans; } /* --- .Call ENTRY POINT --- */ SEXP NormalIRanges_from_logical(SEXP x) { SEXP ans, ans_start, ans_width; int i, x_length, buf_length, ans_length; int *start_buf, *width_buf; int *x_elt, *start_elt, *width_elt, prev_elt; x_length = LENGTH(x); if (x_length == 0) { PROTECT(ans_start = NEW_INTEGER(0)); PROTECT(ans_width = NEW_INTEGER(0)); } else { buf_length = x_length / 2 + 1; ans_length = 0; start_buf = (int *) R_alloc((long) buf_length, sizeof(int)); width_buf = (int *) R_alloc((long) buf_length, sizeof(int)); prev_elt = 0; start_elt = start_buf - 1; width_elt = width_buf - 1; for (i = 1, x_elt = LOGICAL(x); i <= x_length; i++, x_elt++) { if (*x_elt == NA_LOGICAL) error("cannot create an IRanges object from a logical vector with missing values"); if (*x_elt == 1) { if (prev_elt) { *width_elt += 1; } else { ans_length++; start_elt++; width_elt++; *start_elt = i; *width_elt = 1; } } prev_elt = *x_elt; } PROTECT(ans_start = NEW_INTEGER(ans_length)); PROTECT(ans_width = NEW_INTEGER(ans_length)); memcpy(INTEGER(ans_start), start_buf, sizeof(int) * ans_length); memcpy(INTEGER(ans_width), width_buf, sizeof(int) * ans_length); } PROTECT(ans = _new_IRanges("NormalIRanges", ans_start, ans_width, R_NilValue)); UNPROTECT(3); return ans; } IRanges/src/IRanges_constructor.c0000644000126300012640000001326612234075662020434 0ustar00biocbuildphs_compbio/**************************************************************************** * Support functions for the IRanges constructor * ****************************************************************************/ #include "IRanges.h" static char errmsg_buf[200]; /**************************************************************************** * solve_user_SEW0() */ static int solve_user_SEW0_row(int start, int end, int width, int *solved_start, int *solved_width) { int nb_of_unknowns; nb_of_unknowns = (start == NA_INTEGER) + (end == NA_INTEGER) + (width == NA_INTEGER); if (nb_of_unknowns >= 2) { snprintf(errmsg_buf, sizeof(errmsg_buf), "range cannot be determined from the supplied arguments (too many NAs)"); return -1; } if (start == NA_INTEGER) { start = end - width + 1; } else if (width == NA_INTEGER) { width = end - start + 1; } else if (end != NA_INTEGER && end != start + width - 1) { snprintf(errmsg_buf, sizeof(errmsg_buf), "supplied arguments are incompatible"); return -1; } if (width < 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "negative widths are not allowed"); return -1; } *solved_start = start; *solved_width = width; return 0; } SEXP solve_user_SEW0(SEXP start, SEXP end, SEXP width) { SEXP ans, ans_start, ans_width; int ans_length, i; ans_length = LENGTH(start); PROTECT(ans_start = NEW_INTEGER(ans_length)); PROTECT(ans_width = NEW_INTEGER(ans_length)); for (i = 0; i < ans_length; i++) { if (solve_user_SEW0_row(INTEGER(start)[i], INTEGER(end)[i], INTEGER(width)[i], INTEGER(ans_start) + i, INTEGER(ans_width) + i) != 0) { UNPROTECT(2); error("solving row %d: %s", i + 1, errmsg_buf); } } PROTECT(ans = _new_IRanges("IRanges", ans_start, ans_width, R_NilValue)); UNPROTECT(3); return ans; } /**************************************************************************** * solve_user_SEW() */ static int translate_negative_coord0; static int nonnarrowing_is_OK; static int translate_negative_startorend(int refwidth, int startorend) { if (startorend < 0) startorend += refwidth + 1; return startorend; } static int check_start(int refwidth, int start, const char *what) { if (nonnarrowing_is_OK) return 0; if (start < 1) { snprintf(errmsg_buf, sizeof(errmsg_buf), "'allow.nonnarrowing' is FALSE and the %s start " "(%d) is < 1", what, start); return -1; } if (start > refwidth + 1) { snprintf(errmsg_buf, sizeof(errmsg_buf), "'allow.nonnarrowing' is FALSE and the %s start " "(%d) is > refwidth + 1", what, start); return -1; } return 0; } static int check_end(int refwidth, int end, const char *what) { if (nonnarrowing_is_OK) return 0; if (end < 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "'allow.nonnarrowing' is FALSE and the %s end " "(%d) is < 0", what, end); return -1; } if (end > refwidth) { snprintf(errmsg_buf, sizeof(errmsg_buf), "'allow.nonnarrowing' is FALSE and the %s end " "(%d) is > refwidth", what, end); return -1; } return 0; } static int solve_user_SEW_row(int refwidth, int start, int end, int width, int *solved_start, int *solved_width) { if (refwidth == NA_INTEGER || refwidth < 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "negative values or NAs are not allowed in 'refwidths'"); return -1; } if (start != NA_INTEGER) { if (translate_negative_coord0) start = translate_negative_startorend(refwidth, start); if (check_start(refwidth, start, "supplied") != 0) return -1; } if (end != NA_INTEGER) { if (translate_negative_coord0) end = translate_negative_startorend(refwidth, end); if (check_end(refwidth, end, "supplied") != 0) return -1; } if (width == NA_INTEGER) { if (start == NA_INTEGER) start = 1; if (end == NA_INTEGER) end = refwidth; width = end - start + 1; if (width < 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "the supplied start/end lead to a " "negative width"); return -1; } } else if (width < 0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "negative values are not allowed in 'width'"); return -1; } else if ((start == NA_INTEGER) == (end == NA_INTEGER)) { snprintf(errmsg_buf, sizeof(errmsg_buf), "either the supplied start or the supplied end " "(but not both) must be NA when the supplied width " "is not NA"); return -1; } else { // Either 'start' or 'end' is NA if (start == NA_INTEGER) { start = end - width + 1; if (check_start(refwidth, start, "solved") != 0) return -1; } else { end = start + width - 1; if (check_end(refwidth, end, "solved") != 0) return -1; } } *solved_start = start; *solved_width = width; return 0; } /* * --- .Call ENTRY POINT --- */ SEXP solve_user_SEW(SEXP refwidths, SEXP start, SEXP end, SEXP width, SEXP translate_negative_coord, SEXP allow_nonnarrowing) { SEXP ans, ans_start, ans_width; int ans_length, i0, i1, i2, i3; translate_negative_coord0 = LOGICAL(translate_negative_coord)[0]; nonnarrowing_is_OK = LOGICAL(allow_nonnarrowing)[0]; ans_length = LENGTH(refwidths); PROTECT(ans_start = NEW_INTEGER(ans_length)); PROTECT(ans_width = NEW_INTEGER(ans_length)); for (i0 = i1 = i2 = i3 = 0; i0 < ans_length; i0++, i1++, i2++, i3++) { /* recycling */ if (i1 >= LENGTH(start)) i1 = 0; if (i2 >= LENGTH(end)) i2 = 0; if (i3 >= LENGTH(width)) i3 = 0; if (solve_user_SEW_row(INTEGER(refwidths)[i0], INTEGER(start)[i1], INTEGER(end)[i2], INTEGER(width)[i3], INTEGER(ans_start) + i0, INTEGER(ans_width) + i0) != 0) { UNPROTECT(2); error("solving row %d: %s", i0 + 1, errmsg_buf); } } PROTECT(ans = _new_IRanges("IRanges", ans_start, ans_width, R_NilValue)); UNPROTECT(3); return ans; } IRanges/src/IntervalTree.c0000644000126300012640000007513712234075662017050 0ustar00biocbuildphs_compbio#include "IRanges.h" #include "common.h" #include "rbTree.h" #include "localmem.h" #include "ucsc_handlers.h" #include /* for Salloc() */ #define MAX(a, b) (((a) > (b)) ? (a) : (b)) #define FIND_ALL 1 #define FIND_ANY 2 #define FIND_ARBITRARY 3 typedef struct _IntegerInterval { int start; int end; } IntegerInterval; typedef struct _IntegerIntervalNode { IntegerInterval interval; unsigned int index; /* identifies the interval */ int maxEnd; /* maximum end value in children */ unsigned int indexPosition; } IntegerIntervalNode; typedef struct _IntegerIntervalForest { struct rbTree **trees; int npartitions; int n; struct lm *lm; } IntervalForest; struct rbTree *_IntegerIntervalForest_getTree(IntervalForest *forest, int i) { return forest->trees[i]; } static int compare_interval(void *a, void *b) { IntegerInterval *ra = (IntegerInterval *)a; IntegerInterval *rb = (IntegerInterval *)b; if (rb->start < ra->start) return 1; /* if (ra->start < rb->start) return -1; if (rb->start == ra->start && ra->end != rb->end) return -1; return 0; */ return -1; } static void _IntegerIntervalTree_free(SEXP r_tree) { struct rbTree *tree = (struct rbTree *)R_ExternalPtrAddr(r_tree); if (tree) { pushRHandlers(); rbTreeFree(&tree); popRHandlers(); R_ClearExternalPtr(r_tree); } } static void _IntegerIntervalForest_free(SEXP r_forest) { int npartitions; IntervalForest *forest = (IntervalForest *)R_ExternalPtrAddr(r_forest); struct rbTree *tree; int i; if (forest) { npartitions = forest->npartitions; pushRHandlers(); for (i = 0; ilm); popRHandlers(); R_ClearExternalPtr(r_forest); } } static void _IntegerIntervalTree_add(struct rbTree *tree, int start, int end, unsigned int index) { IntegerIntervalNode tmpInterval = { { start, end }, index, 0, index }; IntegerIntervalNode *interval = lmCloneMem(tree->lm, &tmpInterval, sizeof(tmpInterval)); rbTreeAdd(tree, interval); } /* need non-recursive implementation */ static void _IntegerIntervalNode_calc_max_end(struct rbTreeNode *node) { int maxEnd; maxEnd = ((IntegerInterval *)node->item)->end; if (node->left) _IntegerIntervalNode_calc_max_end(node->left); if (node->right) _IntegerIntervalNode_calc_max_end(node->right); if (node->left && node->right) { int childMax = MAX(((IntegerIntervalNode *)node->left->item)->maxEnd, ((IntegerIntervalNode *)node->right->item)->maxEnd); maxEnd = MAX(childMax, maxEnd); } else if (node->left) maxEnd = MAX(((IntegerIntervalNode *)node->left->item)->maxEnd, maxEnd); else if (node->right) maxEnd = MAX(((IntegerIntervalNode *)node->right->item)->maxEnd, maxEnd); ((IntegerIntervalNode *)node->item)->maxEnd = maxEnd; } static void _IntegerIntervalTree_calc_max_end(struct rbTree *tree) { if (tree->root) _IntegerIntervalNode_calc_max_end(tree->root); } struct rbTree *_IntegerIntervalTree_new(void) { return rbTreeNew(compare_interval); } SEXP IntegerIntervalTree_new(SEXP r_ranges) { struct rbTree *tree = _IntegerIntervalTree_new(); cachedIRanges cached_r_ranges = _cache_IRanges(r_ranges); int nranges = _get_cachedIRanges_length(&cached_r_ranges); int i, start, end; SEXP r_tree; pushRHandlers(); for (i = 0; i < nranges; i++) { start = _get_cachedIRanges_elt_start(&cached_r_ranges, i); end = _get_cachedIRanges_elt_end(&cached_r_ranges, i); if (end >= start) /* only add non-empty ranges */ _IntegerIntervalTree_add(tree, start, end, i+1); } popRHandlers(); tree->n = nranges; /* kind of a hack - includes empty ranges */ _IntegerIntervalTree_calc_max_end(tree); r_tree = R_MakeExternalPtr(tree, R_NilValue, R_NilValue); R_RegisterCFinalizer(r_tree, _IntegerIntervalTree_free); return r_tree; } IntervalForest *_IntegerIntervalForest_new(int npartitions) { int i; struct lm *lm = lmInit(0); IntervalForest *forest; AllocVar(forest); forest->npartitions = npartitions; forest->lm = lm; forest->n = 0; lmAllocArray(forest->lm, forest->trees, npartitions * sizeof(struct rbTree *)); for (i = 0; ilm, 128 * sizeof(stack[0])); forest->trees[i] = rbTreeNewDetailed(compare_interval, forest->lm, stack); } return forest; } SEXP IntegerIntervalForest_new(SEXP r_ranges, SEXP r_partitionLengths, SEXP r_npartitions) { SEXP r_forest; cachedIRanges cached_r_ranges = _cache_IRanges(r_ranges); int i, m, last, start, end; int npartitions = *INTEGER(r_npartitions); int *partitionLengths = INTEGER(r_partitionLengths); IntervalForest *forest = _IntegerIntervalForest_new(npartitions); int treeSizes[npartitions]; for (i = 0; i < npartitions; i++) { treeSizes[i] = 0; } struct rbTree *tree; pushRHandlers(); for (i = 0, last = 0; i < npartitions; i++, partitionLengths++) { for (m = 0; m < *partitionLengths; m++) { start = _get_cachedIRanges_elt_start(&cached_r_ranges, last + m); end = _get_cachedIRanges_elt_end(&cached_r_ranges, last + m); tree = _IntegerIntervalForest_getTree(forest, i); if (end >= start) _IntegerIntervalTree_add(tree, start, end, last+m+1); } treeSizes[i] = m; last += m; } popRHandlers(); for (i = 0; i < npartitions; i++) { tree = _IntegerIntervalForest_getTree(forest, i); tree->n = treeSizes[i]; forest->n += treeSizes[i]; _IntegerIntervalTree_calc_max_end(tree); } r_forest = R_MakeExternalPtr(forest, R_NilValue, R_NilValue); R_RegisterCFinalizer(r_forest, _IntegerIntervalForest_free); return r_forest; } /* If result_ints is NULL, returns (via r_elt pointer) a logical vector of with * length(r_ranges) elements whose values indicate whether or at * least one overlap was found. * If result_ints != NULL, adds every hit to result_ints and returns * (via r_elt pointer) an integer vector of length(r_ranges) + 1 elements, where * the first length(r_ranges) contain a 0-based "partioning by end" * of overlap hit indices and the last element is the total number * of overlaps. * Running time: less than O(mk + mlogn) */ void _IntegerIntervalTree_overlapHelper(struct rbTree *tree, cachedIRanges cached_r_ranges, int nranges, int offset, int **r_elt, int find_type, struct slRef **result_ints) { struct rbTreeNode *p = tree->root; struct slRef *active = NULL, *active_head = NULL; int /* stack height */ height = 0, /* query counter */ m; Rboolean hit = FALSE; /* already hit current node? */ if (!p) { /* tree is empty */ return; } for (m = 0; m < nranges; m++, (*r_elt)++) { int start = _get_cachedIRanges_elt_start(&cached_r_ranges, m+offset); int end = _get_cachedIRanges_elt_end(&cached_r_ranges, m+offset); if (end < start) { /* empty query range */ if (find_type == FIND_ALL) *((*r_elt)+1) = *(*r_elt); continue; } int count = 0; /* add hits from previous query, if still valid */ /* this trick lets us avoid restarting the search for every query */ if (find_type == FIND_ALL) { struct slRef *prev = NULL; for (struct slRef *a = active_head; a != NULL;) { IntegerInterval *interval = a->val; if (interval->end < start) { /* never see this again */ /* Rprintf("LINE %d -- goodbye: %d\n", __LINE__, ((IntegerIntervalNode*)interval)->index); */ struct slRef *next = a->next; if (prev) prev->next = next; else active_head = next; freeMem(a); a = next; } else { if (interval->start > end) /* no more hits here */ break; struct slRef *resultNode = slRefNew(interval); /* Rprintf("LINE %d -- p hit: %d\n", __LINE__, ((IntegerIntervalNode*)interval)->index); */ slAddHead(result_ints, resultNode); /* owns Node */ count++; prev = a; a = a->next; } } active = prev; /* active is the tail of the list (when it matters) */ } while(1) { IntegerInterval *interval = (IntegerInterval *)p->item; /* is node on top of stack? */ Rboolean visited = height && p == tree->stack[height-1]; /* have to retry nodes on stack after query switch */ /* Rprintf("LINE %d -- subject: %d,%d,%d / query: %d,%d, stack: %d\n", __LINE__, interval->start, interval->end, ((IntegerIntervalNode *)interval)->maxEnd, start, end, height); */ /* in-order traversal of tree */ /* go left if node not yet visited and max end satisfied */ if(p->left && !visited && ((IntegerIntervalNode *)p->left->item)->maxEnd >= start) { tree->stack[height++] = p; p = p->left; /*Rprintf("left\n");*/ } else { /* consider current node if not already checked */ if (interval->start <= end && interval->end >= start) { /* Rprintf("hit: %d\n", ((IntegerIntervalNode *)interval)->index); */ if (find_type == FIND_ALL) { if (!hit) { struct slRef *resultNode = slRefNew(interval); slAddHead(result_ints, resultNode); resultNode = slRefNew(interval); if (active == NULL) active_head = resultNode; else active->next = resultNode; active = resultNode; count++; } } else if (find_type == FIND_ANY) { *(*r_elt) = 1; break; } else if (find_type == FIND_ARBITRARY) { *(*r_elt) = ((IntegerIntervalNode *)interval)->index; break; } hit = TRUE; } if (visited) { /* pop already visited node */ height--; /*if (dirty) *//* retried this one */ /* dirty_level--;*/ } /* go right if sensible */ if (p->right && interval->start <= end && ((IntegerIntervalNode *)p->right->item)->maxEnd >= start) { /* Rprintf("right\n"); */ p = p->right; hit = FALSE; } else if (interval->start > end || !height) { /* no more hits */ if (visited) height++; /* repush -- don't go left again */ if (find_type == FIND_ALL) { *((*r_elt)+1) = *(*r_elt) + count; } break; } else { p = tree->stack[height-1]; /* return to ancestor */ hit = FALSE; /* Rprintf("up\n"); */ } } } } } SEXP _IntegerIntervalTree_overlap(struct rbTree *tree, SEXP r_ranges, int find_type, struct slRef **result_ints) { SEXP result_inds; cachedIRanges cached_r_ranges = _cache_IRanges(r_ranges); int nranges = _get_cachedIRanges_length(&cached_r_ranges); if (find_type == FIND_ALL) { PROTECT(result_inds = allocVector(INTSXP, nranges + 1)); } else if (find_type == FIND_ANY) { PROTECT(result_inds = allocVector(LGLSXP, nranges)); } else if (find_type == FIND_ARBITRARY) { PROTECT(result_inds = allocVector(INTSXP, nranges)); } memset(INTEGER(result_inds), 0, LENGTH(result_inds) * sizeof(int)); int *r_elt = INTEGER(result_inds); _IntegerIntervalTree_overlapHelper(tree, cached_r_ranges, nranges, 0, &r_elt, find_type, result_ints); UNPROTECT(1); return result_inds; } SEXP _IntegerIntervalForest_overlap(IntervalForest *forest, SEXP r_ranges, SEXP r_partitionIndices, SEXP r_partitionLengths, int find_type, struct slRef **result_ints) { struct rbTree *tree; /* keep track of partitions */ int *p_partitionIndices = INTEGER(r_partitionIndices); int *p_partitionLengths = INTEGER(r_partitionLengths); int cur_partition; /* result vector */ SEXP result_inds; int *r_elt; /* result vector pointer */ int m; /* query counter */ int k; /* helper counter */ cachedIRanges cached_r_ranges = _cache_IRanges(r_ranges); int nranges = _get_cachedIRanges_length(&cached_r_ranges); if (find_type == FIND_ALL) { PROTECT(result_inds = allocVector(INTSXP, nranges + 1)); } else if (find_type == FIND_ANY) { PROTECT(result_inds = allocVector(LGLSXP, nranges)); } else if (find_type == FIND_ARBITRARY) { PROTECT(result_inds = allocVector(INTSXP, nranges)); } memset(INTEGER(result_inds), 0, LENGTH(result_inds) * sizeof(int)); if (!forest->n) { UNPROTECT(1); return result_inds; } for (m = 0, r_elt = INTEGER(result_inds); m < nranges; p_partitionLengths++, p_partitionIndices++, r_elt++) { cur_partition = *p_partitionIndices; if (cur_partition != NA_INTEGER && (tree = forest->trees[cur_partition-1])->n > 0) { _IntegerIntervalTree_overlapHelper(tree, cached_r_ranges, *p_partitionLengths, m, &r_elt, find_type, result_ints); } else { for (k=0; k<*p_partitionLengths; k++) { *(r_elt+1) = *r_elt; r_elt++; } } m += *p_partitionLengths; r_elt--; /* need to move back after overlapHelper call */ } UNPROTECT(1); return result_inds; } static SEXP _IntegerIntervalTree_overlap_any(SEXP r_unordered, SEXP r_order, int nranges) { int i, *left, *right, *o_elt; PROTECT(r_unordered); SEXP r_ordered = allocVector(LGLSXP, nranges); left = INTEGER(r_ordered); for (i = 0, right = INTEGER(r_unordered), o_elt = INTEGER(r_order); i < nranges; i++, right++, o_elt++) { left[*o_elt - 1] = *right; } UNPROTECT(1); return r_ordered; } SEXP IntegerIntervalTree_overlap_any(SEXP r_tree, SEXP r_ranges, SEXP r_order) { int nranges = _get_IRanges_length(r_ranges); struct rbTree *tree = R_ExternalPtrAddr(r_tree); pushRHandlers(); SEXP r_unordered = _IntegerIntervalTree_overlap(tree, r_ranges, FIND_ANY, NULL); popRHandlers(); return _IntegerIntervalTree_overlap_any(r_unordered, r_order, nranges); } SEXP IntegerIntervalForest_overlap_any(SEXP r_forest, SEXP r_ranges, SEXP r_partitionIndices, SEXP r_partitionLengths, SEXP r_order) { int nranges = _get_IRanges_length(r_ranges); IntervalForest *forest = R_ExternalPtrAddr(r_forest); pushRHandlers(); SEXP r_unordered = _IntegerIntervalForest_overlap(forest, r_ranges, r_partitionIndices, r_partitionLengths, FIND_ANY, NULL); popRHandlers(); return _IntegerIntervalTree_overlap_any(r_unordered, r_order, nranges); } SEXP _IntegerIntervalTree_overlap_arbitrary(SEXP r_unordered, SEXP r_order, int nranges) { int i, *left, *right, *o_elt; PROTECT(r_unordered); SEXP r_ordered = allocVector(INTSXP, nranges); left = INTEGER(r_ordered); for (i = 0, right = INTEGER(r_unordered), o_elt = INTEGER(r_order); i < nranges; i++, right++, o_elt++) { left[*o_elt - 1] = *right > 0 ? *right : NA_INTEGER; } UNPROTECT(1); return r_ordered; } SEXP IntegerIntervalTree_overlap_arbitrary(SEXP r_tree, SEXP r_ranges, SEXP r_order) { int nranges = _get_IRanges_length(r_ranges); struct rbTree *tree = R_ExternalPtrAddr(r_tree); pushRHandlers(); SEXP r_unordered = _IntegerIntervalTree_overlap(tree, r_ranges, FIND_ARBITRARY, NULL); popRHandlers(); return _IntegerIntervalTree_overlap_arbitrary(r_unordered, r_order, nranges); } SEXP IntegerIntervalForest_overlap_arbitrary(SEXP r_forest, SEXP r_ranges, SEXP r_partitionIndices, SEXP r_partitionLengths, SEXP r_order) { int nranges = _get_IRanges_length(r_ranges); IntervalForest *forest = R_ExternalPtrAddr(r_forest); pushRHandlers(); SEXP r_unordered = _IntegerIntervalForest_overlap(forest, r_ranges, r_partitionIndices, r_partitionLengths, FIND_ARBITRARY, NULL); popRHandlers(); return _IntegerIntervalTree_overlap_arbitrary(r_unordered, r_order, nranges); } SEXP _IntegerIntervalTree_overlap_first(SEXP r_query_start, SEXP r_order, struct slRef *results, int nranges) { SEXP r_results; struct slRef *result; int i, j, index, nhits; int *left, *right, *r_vector, *r_elt, *o_elt; nhits = INTEGER(r_query_start)[nranges]; PROTECT(r_results = allocVector(INTSXP, nranges)); for (i = 0, r_elt = INTEGER(r_results); i < nranges; i++, r_elt++) *r_elt = NA_INTEGER; result = results; r_vector = INTEGER(r_results); for (i = 0, o_elt = INTEGER(r_order), left = INTEGER(r_query_start), right = INTEGER(r_query_start) + 1; i < nranges; i++, o_elt++, left++, right++) { r_elt = r_vector + (*o_elt - 1); for (j = *left; j < *right; j++) { index = ((IntegerIntervalNode *)result->val)->indexPosition; if (*r_elt == NA_INTEGER || (*r_elt > index)) *r_elt = index; result = result->next; } } UNPROTECT(1); return r_results; } SEXP IntegerIntervalTree_overlap_first(SEXP r_tree, SEXP r_ranges, SEXP r_order) { struct rbTree *tree = R_ExternalPtrAddr(r_tree); struct slRef *results = NULL; SEXP r_query_start, r_results; int nranges = _get_IRanges_length(r_ranges); pushRHandlers(); r_query_start = _IntegerIntervalTree_overlap(tree, r_ranges, FIND_ALL, &results); PROTECT(r_query_start); slReverse(&results); r_results = _IntegerIntervalTree_overlap_first(r_query_start, r_order, results, nranges); slFreeList(&results); popRHandlers(); UNPROTECT(1); return r_results; } SEXP IntegerIntervalForest_overlap_first(SEXP r_forest, SEXP r_ranges, SEXP r_partitionIndices, SEXP r_partitionLengths, SEXP r_order) { IntervalForest *forest = R_ExternalPtrAddr(r_forest); struct slRef *results = NULL; SEXP r_query_start, r_results; int nranges = _get_IRanges_length(r_ranges); pushRHandlers(); r_query_start = _IntegerIntervalForest_overlap(forest, r_ranges, r_partitionIndices, r_partitionLengths, FIND_ALL, &results); PROTECT(r_query_start); slReverse(&results); r_results = _IntegerIntervalTree_overlap_first(r_query_start, r_order, results, nranges); slFreeList(&results); popRHandlers(); UNPROTECT(1); return r_results; } SEXP _IntegerIntervalTree_overlap_last(SEXP r_query_start, SEXP r_order, struct slRef *results, int nranges) { struct slRef *result; SEXP r_results; int i, j, index, nhits; int *left, *right, *r_vector, *r_elt, *o_elt; nhits = INTEGER(r_query_start)[nranges]; PROTECT(r_results = allocVector(INTSXP, nranges)); for (i = 0, r_elt = INTEGER(r_results); i < nranges; i++, r_elt++) *r_elt = NA_INTEGER; result = results; r_vector = INTEGER(r_results); for (i = 0, o_elt = INTEGER(r_order), left = INTEGER(r_query_start), right = INTEGER(r_query_start) + 1; i < nranges; i++, o_elt++, left++, right++) { r_elt = r_vector + (*o_elt - 1); for (j = *left; j < *right; j++) { index = ((IntegerIntervalNode *)result->val)->indexPosition; if (*r_elt == NA_INTEGER || (*r_elt < index)) *r_elt = index; result = result->next; } } UNPROTECT(1); return r_results; } SEXP IntegerIntervalTree_overlap_last(SEXP r_tree, SEXP r_ranges, SEXP r_order) { struct rbTree *tree = R_ExternalPtrAddr(r_tree); struct slRef *results = NULL; SEXP r_query_start, r_results; int nranges = _get_IRanges_length(r_ranges); pushRHandlers(); r_query_start = _IntegerIntervalTree_overlap(tree, r_ranges, FIND_ALL, &results); PROTECT(r_query_start); slReverse(&results); r_results = _IntegerIntervalTree_overlap_last(r_query_start, r_order, results, nranges); slFreeList(&results); popRHandlers(); UNPROTECT(1); return r_results; } SEXP IntegerIntervalForest_overlap_last(SEXP r_forest, SEXP r_ranges, SEXP r_partitionIndices, SEXP r_partitionLengths, SEXP r_order) { IntervalForest *forest = R_ExternalPtrAddr(r_forest); struct slRef *results = NULL; SEXP r_query_start, r_results; int nranges = _get_IRanges_length(r_ranges); pushRHandlers(); r_query_start = _IntegerIntervalForest_overlap(forest, r_ranges, r_partitionIndices, r_partitionLengths, FIND_ALL, &results); PROTECT(r_query_start); slReverse(&results); r_results = _IntegerIntervalTree_overlap_last(r_query_start, r_order, results, nranges); slFreeList(&results); popRHandlers(); UNPROTECT(1); return r_results; } SEXP _IntegerIntervalTree_overlap_all(SEXP r_query_start, SEXP r_order, struct slRef *results, int nranges, int subjectLength) { struct slRef *result; SEXP r_results, r_query_hits, r_subject_hits; int i, j, nhits; int *left, *right, *r_elt, *o_elt; nhits = INTEGER(r_query_start)[nranges]; int *r_query_col = (int *) R_alloc((long) nhits, sizeof(int)); r_elt = r_query_col; for (i = 1, o_elt = INTEGER(r_order), left = INTEGER(r_query_start), right = INTEGER(r_query_start) + 1; i < LENGTH(r_query_start); i++, o_elt++, left++, right++) { for (j = *left; j < *right; j++) { *r_elt = *o_elt; r_elt++; } } int *r_subject_col = (int *) R_alloc((long) nhits, sizeof(int)); for (result = results, r_elt = r_subject_col; result != NULL; result = result->next, r_elt++) *r_elt = ((IntegerIntervalNode *)result->val)->indexPosition; int *row = (int *) R_alloc((long) nhits, sizeof(int)); _get_order_of_int_pairs(r_query_col, r_subject_col, nhits, 0, row, 0); PROTECT(r_results = NEW_OBJECT(MAKE_CLASS("Hits"))); r_query_hits = NEW_INTEGER(nhits); SET_SLOT(r_results, install("queryHits"), r_query_hits); r_subject_hits = NEW_INTEGER(nhits); SET_SLOT(r_results, install("subjectHits"), r_subject_hits); for (i = 0, left = INTEGER(r_query_hits), right = INTEGER(r_subject_hits), o_elt = row; i < nhits; i++, left++, right++, o_elt++) { *left = r_query_col[*o_elt]; *right = r_subject_col[*o_elt]; } SET_SLOT(r_results, install("queryLength"), ScalarInteger(nranges)); SET_SLOT(r_results, install("subjectLength"), ScalarInteger(subjectLength)); UNPROTECT(1); return r_results; } SEXP IntegerIntervalTree_overlap_all(SEXP r_tree, SEXP r_ranges, SEXP r_order) { struct rbTree *tree = R_ExternalPtrAddr(r_tree); struct slRef *results = NULL; SEXP r_query_start, r_results; int nranges = _get_IRanges_length(r_ranges); pushRHandlers(); r_query_start = _IntegerIntervalTree_overlap(tree, r_ranges, FIND_ALL, &results); PROTECT(r_query_start); slReverse(&results); r_results = _IntegerIntervalTree_overlap_all(r_query_start, r_order, results, nranges, tree->n); slFreeList(&results); popRHandlers(); UNPROTECT(1); return r_results; } SEXP IntegerIntervalForest_overlap_all(SEXP r_forest, SEXP r_ranges, SEXP r_partitionIndices, SEXP r_partitionLengths, SEXP r_order) { IntervalForest *forest = R_ExternalPtrAddr(r_forest); struct slRef *results = NULL; SEXP r_query_start, r_results; int nranges = _get_IRanges_length(r_ranges); pushRHandlers(); r_query_start = _IntegerIntervalForest_overlap(forest, r_ranges, r_partitionIndices, r_partitionLengths, FIND_ALL, &results); PROTECT(r_query_start); slReverse(&results); r_results = _IntegerIntervalTree_overlap_all(r_query_start, r_order, results, nranges, forest->n); slFreeList(&results); popRHandlers(); UNPROTECT(1); return r_results; } // finds the node to the right of each element of sorted query /* struct rbTreeNode** _IntegerIntervalTree_nearest(struct rbTree *tree, int *query, int len, Rboolean self) { struct rbTreeNode *p, *nextP; int i = 0; rbTreeNode **result = R_alloc(len, sizeof(struct rbTreeNode *)); for (i = 0, p = tree->root; p != NULL && i < len; p = nextP) { IntegerInterval *subject = (IntegerInterval *)p->item; Rboolean visited = height && p == tree->stack[height-1]; int sep = subject->start - query[i]; nextP = NULL; if(sep > 0 && !visited) { // can go left tree->stack[height++] = p; nextP = p->left; } else { if (visited) height--; // pop handled node if on stack if(sep <= 0) nextP = p->right; } if (!nextP) { nextP = height ? tree->stack[height-1] : p; IntegerInterval *other = (IntegerInterval *)nextP->item; result[i++] = other->start; } } return result_ind; } */ /* SEXP IntegerIntervalTree_nearest(SEXP r_tree, SEXP r_ranges, SEXP r_self) { struct rbTree *tree = R_ExternalPtrAddr(r_tree); cachedIRanges cached_r_ranges = _cache_IRanges(r_ranges); int nranges = _get_cachedIRanges_length(&cached_r_ranges); int *end = R_alloc(nranges, sizeof(int)); for (i = 0; i < nranges; i++) end[i] = _get_cachedIRanges_elt_end(&cached_r_ranges, i); } */ int _IntegerIntervalTree_intervalsHelper(struct rbTree *tree, IntegerInterval **intervals, int nintervals) { struct rbTreeNode *p = tree->root; int height = 0, curIndex; if (tree->n && p) while(1) { /* is node on top of stack? */ Rboolean visited = height && p == tree->stack[height-1]; /* first, check for overlap */ if (!visited && p->left) { /* push current node onto stack */ tree->stack[height++] = p; /* go left */ p = p->left; } else { /* can't go left, handle this node */ curIndex = ((IntegerIntervalNode *)p->item)->index - 1; if (curIndex < 0 || curIndex > nintervals) { return -1; } intervals[curIndex] = (IntegerInterval *)p->item; if (visited) height--; /* pop handled node if on stack */ if (p->right) /* go right if possible */ p = p->right; else if (height) /* more on stack */ p = tree->stack[height-1]; else break; /* nothing left on stack, we're finished */ } } return 0; } /* Traverses the tree, pulling out the intervals, in order */ IntegerInterval **_IntegerIntervalTree_intervals(struct rbTree *tree) { IntegerInterval **intervals = Salloc(tree->n, IntegerInterval *); int result = _IntegerIntervalTree_intervalsHelper(tree, intervals, tree->n); if (result) { /* error */ Rprintf("LINE %d -- result %d\n", __LINE__, result); return NULL; } return intervals; } /* Traverses the forest, pulling out the intervals, in order */ /* this should be cleaned up as it duplicates a lot of code above */ IntegerInterval **_IntegerIntervalForest_intervals(IntervalForest *forest) { struct rbTree *tree; int cur_partition, result; IntegerInterval **intervals = Salloc(forest->n, IntegerInterval *); for (cur_partition = 0; cur_partition < forest->npartitions; cur_partition++) { tree = _IntegerIntervalForest_getTree(forest, cur_partition); result = _IntegerIntervalTree_intervalsHelper(tree, intervals, forest->n); if (result) { return NULL; } } return intervals; } SEXP _IntegerIntervalTree_asIRanges(IntegerInterval **intervals, int nranges) { SEXP r_start, r_width, r_ranges; int i, *s_elt, *w_elt; /* Rprintf("tree size %d\n", tree->n); */ PROTECT(r_start = allocVector(INTSXP, nranges)); PROTECT(r_width = allocVector(INTSXP, nranges)); for(i = 0, s_elt = INTEGER(r_start), w_elt = INTEGER(r_width); i < nranges; i++, s_elt++, w_elt++) { if (intervals[i]) { *s_elt = intervals[i]->start; *w_elt = intervals[i]->end - intervals[i]->start + 1; } else { *s_elt = 1; *w_elt = 0; } } r_ranges = _new_IRanges("IRanges", r_start, r_width, R_NilValue); UNPROTECT(2); return r_ranges; } SEXP IntegerIntervalTree_asIRanges(SEXP r_tree) { struct rbTree *tree = R_ExternalPtrAddr(r_tree); pushRHandlers(); IntegerInterval **intervals = _IntegerIntervalTree_intervals(tree); popRHandlers(); return _IntegerIntervalTree_asIRanges(intervals, tree->n); } SEXP IntegerIntervalForest_asIRanges(SEXP r_forest) { IntervalForest *forest = R_ExternalPtrAddr(r_forest); pushRHandlers(); IntegerInterval **intervals = _IntegerIntervalForest_intervals(forest); popRHandlers(); return _IntegerIntervalTree_asIRanges(intervals, forest->n); } SEXP IntegerIntervalTree_start(SEXP r_tree) { SEXP r_start; struct rbTree *tree = R_ExternalPtrAddr(r_tree); pushRHandlers(); IntegerInterval **intervals = _IntegerIntervalTree_intervals(tree); popRHandlers(); int i, *r_elt; r_start = allocVector(INTSXP, tree->n); for(i = 0, r_elt = INTEGER(r_start); i < tree->n; i++, r_elt++) *r_elt = intervals[i] ? intervals[i]->start : 1; return r_start; } SEXP IntegerIntervalForest_start(SEXP r_forest) { SEXP r_start; IntervalForest *forest = R_ExternalPtrAddr(r_forest); pushRHandlers(); IntegerInterval **intervals = _IntegerIntervalForest_intervals(forest); popRHandlers(); int i, *r_elt; r_start = allocVector(INTSXP, forest->n); for (i = 0, r_elt = INTEGER(r_start); i < forest->n; i++, r_elt++) { *r_elt = intervals[i] ? intervals[i]->start : 1; } return r_start; } SEXP IntegerIntervalTree_end(SEXP r_tree) { SEXP r_end; struct rbTree *tree = R_ExternalPtrAddr(r_tree); pushRHandlers(); IntegerInterval **intervals = _IntegerIntervalTree_intervals(tree); popRHandlers(); int i, *r_elt; r_end = allocVector(INTSXP, tree->n); for(i = 0, r_elt = INTEGER(r_end); i < tree->n; i++, r_elt++) *r_elt = intervals[i] ? intervals[i]->end : 0; return r_end; } SEXP IntegerIntervalForest_end(SEXP r_forest) { SEXP r_end; IntervalForest *forest = R_ExternalPtrAddr(r_forest); pushRHandlers(); IntegerInterval **intervals = _IntegerIntervalForest_intervals(forest); popRHandlers(); int i, *r_elt; r_end = allocVector(INTSXP, forest->n); for (i = 0, r_elt = INTEGER(r_end); i < forest->n; i++, r_elt++) { *r_elt = intervals[i] ? intervals[i]->end : 0; } return r_end; } SEXP IntegerIntervalTree_length(SEXP r_tree) { struct rbTree *tree = R_ExternalPtrAddr(r_tree); return ScalarInteger(tree->n); } SEXP IntegerIntervalForest_nobj(SEXP r_forest) { IntervalForest *forest = R_ExternalPtrAddr(r_forest); return ScalarInteger(forest->n); } static void _IntegerIntervalTreeNode_dump(void *item, FILE *file) { IntegerInterval *node = (IntegerInterval *)item; fprintf(file, "index %d -- %d:%d / %d", ((IntegerIntervalNode *)node)->index, node->start, node->end, ((IntegerIntervalNode *)node)->maxEnd); } SEXP IntegerIntervalTree_dump(SEXP r_tree) { struct rbTree *tree = R_ExternalPtrAddr(r_tree); pushRHandlers(); rbTreeDump(tree, stdout, _IntegerIntervalTreeNode_dump); popRHandlers(); return R_NilValue; } SEXP IntegerIntervalForest_dump(SEXP r_forest) { IntervalForest *forest = R_ExternalPtrAddr(r_forest); for (int i = 0; i < forest->npartitions; i++) { struct rbTree *tree = forest->trees[i]; fprintf(stdout, "Partition: %d length: %d\n", i, tree->n); pushRHandlers(); rbTreeDump(tree, stdout, _IntegerIntervalTreeNode_dump); popRHandlers(); fprintf(stdout, "\n"); } return R_NilValue; } IRanges/src/R_init_IRanges.c0000644000126300012640000002052012234075662017262 0ustar00biocbuildphs_compbio#include "IRanges.h" #define CALLMETHOD_DEF(fun, numArgs) {#fun, (DL_FUNC) &fun, numArgs} #define REGISTER_CCALLABLE(fun) \ R_RegisterCCallable("IRanges", #fun, (DL_FUNC) &fun) static const R_CallMethodDef callMethods[] = { /* AEbufs.c */ CALLMETHOD_DEF(debug_AEbufs, 0), CALLMETHOD_DEF(AEbufs_use_malloc, 1), CALLMETHOD_DEF(AEbufs_free, 0), /* anyMissing.c */ CALLMETHOD_DEF(anyMissing, 1), /* SEXP_utils.c */ CALLMETHOD_DEF(sapply_NROW, 1), /* int_utils.c */ CALLMETHOD_DEF(Integer_any_missing_or_outside, 3), CALLMETHOD_DEF(Integer_sum_non_neg_vals, 1), CALLMETHOD_DEF(Integer_diff_with_0, 1), CALLMETHOD_DEF(Integer_diff_with_last, 2), CALLMETHOD_DEF(Integer_order, 2), CALLMETHOD_DEF(Integer_order2, 3), CALLMETHOD_DEF(Integer_match2_quick, 5), CALLMETHOD_DEF(Integer_selfmatch2_quick, 2), CALLMETHOD_DEF(Integer_match2_hash, 5), CALLMETHOD_DEF(Integer_selfmatch2_hash, 2), CALLMETHOD_DEF(Integer_order4, 5), CALLMETHOD_DEF(Integer_match4_quick, 9), CALLMETHOD_DEF(Integer_selfmatch4_quick, 4), CALLMETHOD_DEF(Integer_match4_hash, 9), CALLMETHOD_DEF(Integer_selfmatch4_hash, 4), CALLMETHOD_DEF(Integer_tabulate2, 4), CALLMETHOD_DEF(Integer_explode_bits, 2), CALLMETHOD_DEF(Integer_sorted_merge, 2), CALLMETHOD_DEF(Integer_mseq, 2), CALLMETHOD_DEF(Integer_fancy_mseq, 3), CALLMETHOD_DEF(findIntervalAndStartFromWidth, 2), /* str_utils.c */ CALLMETHOD_DEF(safe_strexplode, 1), CALLMETHOD_DEF(strsplit_as_list_of_ints, 2), CALLMETHOD_DEF(svn_time, 0), /* compact_bitvector.c */ CALLMETHOD_DEF(logical_as_compact_bitvector, 1), CALLMETHOD_DEF(compact_bitvector_as_logical, 2), CALLMETHOD_DEF(subset_compact_bitvector, 2), CALLMETHOD_DEF(compact_bitvector_bit_count, 1), CALLMETHOD_DEF(compact_bitvector_last_bit, 1), CALLMETHOD_DEF(compact_bitvector_set_op, 3), /* Vector_class.c */ CALLMETHOD_DEF(vector_subsetByRanges, 3), CALLMETHOD_DEF(vector_seqselect, 3), /* Ranges_comparison.c */ CALLMETHOD_DEF(Ranges_compare, 4), /* IRanges_class.c */ CALLMETHOD_DEF(debug_IRanges_class, 0), CALLMETHOD_DEF(IRanges_isNormal, 1), CALLMETHOD_DEF(IRanges_from_integer, 1), CALLMETHOD_DEF(NormalIRanges_from_logical, 1), /* IRanges_constructor.c */ CALLMETHOD_DEF(solve_user_SEW0, 3), CALLMETHOD_DEF(solve_user_SEW, 6), /* Grouping_class.c */ CALLMETHOD_DEF(debug_Grouping_class, 0), CALLMETHOD_DEF(H2LGrouping_members, 2), CALLMETHOD_DEF(H2LGrouping_vmembers, 2), /* Rle_class.c */ CALLMETHOD_DEF(Rle_constructor, 4), CALLMETHOD_DEF(Rle_start, 1), CALLMETHOD_DEF(Rle_end, 1), CALLMETHOD_DEF(Rle_getStartEndRunAndOffset, 3), CALLMETHOD_DEF(Rle_window_aslist, 5), CALLMETHOD_DEF(Rle_window, 6), CALLMETHOD_DEF(Rle_seqselect, 3), /* Rle_utils.c */ CALLMETHOD_DEF(Rle_runsum, 3), CALLMETHOD_DEF(Rle_runwtsum, 4), CALLMETHOD_DEF(Rle_runq, 4), /* RleViews_utils.c */ CALLMETHOD_DEF(RleViews_viewMins, 2), CALLMETHOD_DEF(RleViews_viewMaxs, 2), CALLMETHOD_DEF(RleViews_viewSums, 2), CALLMETHOD_DEF(RleViews_viewMeans, 2), CALLMETHOD_DEF(RleViews_viewWhichMins, 2), CALLMETHOD_DEF(RleViews_viewWhichMaxs, 2), /* SimpleIRangesList_class.c */ CALLMETHOD_DEF(SimpleIRangesList_isNormal, 1), CALLMETHOD_DEF(SimpleNormalIRangesList_min, 1), CALLMETHOD_DEF(SimpleNormalIRangesList_max, 1), /* CompressedIRangesList_class.c */ CALLMETHOD_DEF(CompressedIRangesList_isNormal, 2), CALLMETHOD_DEF(CompressedIRangesList_summary, 1), CALLMETHOD_DEF(CompressedNormalIRangesList_min, 2), CALLMETHOD_DEF(CompressedNormalIRangesList_max, 2), /* GappedRanges_class.c */ CALLMETHOD_DEF(valid_GappedRanges, 2), /* Hits_class.c */ CALLMETHOD_DEF(make_all_group_inner_hits, 2), /* inter_range_methods.c */ CALLMETHOD_DEF(debug_inter_range_methods, 0), CALLMETHOD_DEF(IRanges_range, 1), CALLMETHOD_DEF(Ranges_reduce, 6), CALLMETHOD_DEF(CompressedIRangesList_reduce, 4), CALLMETHOD_DEF(IRanges_gaps, 4), CALLMETHOD_DEF(CompressedIRangesList_gaps, 3), CALLMETHOD_DEF(Ranges_disjointBins, 2), /* encodeOverlaps_methods.c */ CALLMETHOD_DEF(encode_overlaps1, 10), CALLMETHOD_DEF(RangesList_encode_overlaps, 7), CALLMETHOD_DEF(Hits_encode_overlaps, 10), /* coverage_methods.c */ CALLMETHOD_DEF(IRanges_coverage, 6), CALLMETHOD_DEF(CompressedIRangesList_coverage, 6), {NULL, NULL, 0} }; void R_init_IRanges(DllInfo *info) { R_registerRoutines(info, NULL, callMethods, NULL, NULL); /* sort_utils.c */ REGISTER_CCALLABLE(_sort_int_array); REGISTER_CCALLABLE(_get_order_of_int_array); REGISTER_CCALLABLE(_get_order_of_int_pairs); REGISTER_CCALLABLE(_get_order_of_int_quads); /* hash_utils.c */ REGISTER_CCALLABLE(_new_htab); REGISTER_CCALLABLE(_get_hbucket_val); REGISTER_CCALLABLE(_set_hbucket_val); /* AEbufs.c */ REGISTER_CCALLABLE(_get_new_buflength); REGISTER_CCALLABLE(_IntAE_get_nelt); REGISTER_CCALLABLE(_IntAE_set_nelt); REGISTER_CCALLABLE(_IntAE_set_val); REGISTER_CCALLABLE(_new_IntAE); REGISTER_CCALLABLE(_IntAE_insert_at); REGISTER_CCALLABLE(_IntAE_append); REGISTER_CCALLABLE(_IntAE_delete_at); REGISTER_CCALLABLE(_IntAE_shift); REGISTER_CCALLABLE(_IntAE_sum_and_shift); REGISTER_CCALLABLE(_IntAE_append_shifted_vals); REGISTER_CCALLABLE(_IntAE_qsort); REGISTER_CCALLABLE(_IntAE_delete_adjdups); REGISTER_CCALLABLE(_new_INTEGER_from_IntAE); REGISTER_CCALLABLE(_new_IntAE_from_INTEGER); REGISTER_CCALLABLE(_new_IntAE_from_CHARACTER); REGISTER_CCALLABLE(_IntAEAE_get_nelt); REGISTER_CCALLABLE(_IntAEAE_set_nelt); REGISTER_CCALLABLE(_new_IntAEAE); REGISTER_CCALLABLE(_IntAEAE_insert_at); REGISTER_CCALLABLE(_IntAEAE_eltwise_append); REGISTER_CCALLABLE(_IntAEAE_shift); REGISTER_CCALLABLE(_IntAEAE_sum_and_shift); REGISTER_CCALLABLE(_new_LIST_from_IntAEAE); REGISTER_CCALLABLE(_new_IntAEAE_from_LIST); REGISTER_CCALLABLE(_IntAEAE_toEnvir); REGISTER_CCALLABLE(_RangeAE_get_nelt); REGISTER_CCALLABLE(_RangeAE_set_nelt); REGISTER_CCALLABLE(_new_RangeAE); REGISTER_CCALLABLE(_RangeAE_insert_at); REGISTER_CCALLABLE(_RangeAEAE_get_nelt); REGISTER_CCALLABLE(_RangeAEAE_set_nelt); REGISTER_CCALLABLE(_new_RangeAEAE); REGISTER_CCALLABLE(_RangeAEAE_insert_at); REGISTER_CCALLABLE(_CharAE_get_nelt); REGISTER_CCALLABLE(_CharAE_set_nelt); REGISTER_CCALLABLE(_new_CharAE); REGISTER_CCALLABLE(_new_CharAE_from_string); REGISTER_CCALLABLE(_CharAE_insert_at); REGISTER_CCALLABLE(_append_string_to_CharAE); REGISTER_CCALLABLE(_CharAE_delete_at); REGISTER_CCALLABLE(_new_RAW_from_CharAE); REGISTER_CCALLABLE(_new_LOGICAL_from_CharAE); REGISTER_CCALLABLE(_CharAEAE_get_nelt); REGISTER_CCALLABLE(_CharAEAE_set_nelt); REGISTER_CCALLABLE(_new_CharAEAE); REGISTER_CCALLABLE(_CharAEAE_insert_at); REGISTER_CCALLABLE(_append_string_to_CharAEAE); REGISTER_CCALLABLE(_new_CHARACTER_from_CharAEAE); /* SEXP_utils.c */ REGISTER_CCALLABLE(_get_classname); /* int_utils.c */ REGISTER_CCALLABLE(_check_integer_pairs); /* Vector_class.c */ REGISTER_CCALLABLE(_get_List_elementType); REGISTER_CCALLABLE(_set_List_elementType); REGISTER_CCALLABLE(_vector_memcmp); REGISTER_CCALLABLE(_vector_memcpy); /* IRanges_class.c */ REGISTER_CCALLABLE(_get_IRanges_start); REGISTER_CCALLABLE(_get_IRanges_width); REGISTER_CCALLABLE(_get_IRanges_names); REGISTER_CCALLABLE(_get_IRanges_length); REGISTER_CCALLABLE(_cache_IRanges); REGISTER_CCALLABLE(_get_cachedIRanges_length); REGISTER_CCALLABLE(_get_cachedIRanges_elt_width); REGISTER_CCALLABLE(_get_cachedIRanges_elt_start); REGISTER_CCALLABLE(_get_cachedIRanges_elt_end); REGISTER_CCALLABLE(_get_cachedIRanges_elt_name); REGISTER_CCALLABLE(_sub_cachedIRanges); REGISTER_CCALLABLE(_set_IRanges_names); REGISTER_CCALLABLE(_copy_IRanges_slots); REGISTER_CCALLABLE(_new_IRanges); REGISTER_CCALLABLE(_new_IRanges_from_RangeAE); REGISTER_CCALLABLE(_new_list_of_IRanges_from_RangeAEAE); REGISTER_CCALLABLE(_alloc_IRanges); /* Grouping_class.c */ REGISTER_CCALLABLE(_get_H2LGrouping_high2low); REGISTER_CCALLABLE(_get_H2LGrouping_low2high); REGISTER_CCALLABLE(_get_Partitioning_names); REGISTER_CCALLABLE(_get_PartitioningByEnd_end); REGISTER_CCALLABLE(_new_PartitioningByEnd); /* SimpleList_class.c */ REGISTER_CCALLABLE(_new_SimpleList); /* DataFrame_class.c */ REGISTER_CCALLABLE(_new_DataFrame); /* CompressedList_class.c */ REGISTER_CCALLABLE(_new_CompressedList); /* CompressedIRangesList_class.c */ REGISTER_CCALLABLE(_cache_CompressedIRangesList); REGISTER_CCALLABLE(_get_cachedCompressedIRangesList_elt); /* RangedData_class.c */ REGISTER_CCALLABLE(_new_RangedData); /* Rle_class.c */ REGISTER_CCALLABLE(_seqselect_Rle); return; } IRanges/src/RangedData_class.c0000644000126300012640000000150512234075662017607 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of RangedData objects ****************************************************************************/ #include "IRanges.h" static SEXP ranges_symbol = NULL, values_symbol = NULL; static void set_RangedData_ranges(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(ranges) SET_SLOT(x, ranges_symbol, value); } static void set_RangedData_values(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(values) SET_SLOT(x, values_symbol, value); } SEXP _new_RangedData(const char *classname, SEXP ranges, SEXP values) { SEXP rdClass, rd; PROTECT(rdClass = MAKE_CLASS(classname)); PROTECT(rd = NEW_OBJECT(rdClass)); set_RangedData_ranges(rd, ranges); set_RangedData_values(rd, values); UNPROTECT(2); return rd; } IRanges/src/Ranges_comparison.c0000644000126300012640000001530612234075662020105 0ustar00biocbuildphs_compbio/**************************************************************************** * Range-wise comparison of 2 Ranges objects * * Author: Herve Pages * ****************************************************************************/ #include "IRanges.h" /**************************************************************************** * Generalized comparison of 2 integer ranges. * * There are 13 different ways 2 integer ranges x and y can be positioned * with respect to each other. They are summarized in the following table * together with the codes we assign them: * * numeric code & | numeric code & * 1-letter code & | 1-letter code & * long code | long code * --------------- --------------- | --------------- --------------- * x: .oooo....... -6 'a' "x y" | x: .......oooo. 6 'm' "y x" * y: .......oooo. | y: .oooo....... * --------------- --------------- | --------------- --------------- * x: ..oooo...... -5 'b' "xy" | x: ......oooo.. 5 'l' "yx" * y: ......oooo.. | y: ..oooo...... * --------------- --------------- | --------------- --------------- * x: ...oooo..... -4 'c' "x=y" | x: .....oooo... 4 'k' "y=x" * y: .....oooo... | y: ...oooo..... * --------------- --------------- | --------------- --------------- * x: ...oooooo... -3 'd' "x=" | x: .....oooo... 3 'j' "y=" * y: .....oooo... | y: ...oooooo... * --------------- --------------- | --------------- --------------- * x: ..oooooooo.. -2 'e' "x=x" | x: ....oooo.... 2 'i' "y=y" * y: ....oooo.... | y: ..oooooooo.. * --------------- --------------- | --------------- --------------- * x: ...oooo..... -1 'f' "=y" | x: ...oooooo... 1 'h' "=x" * y: ...oooooo... | y: ...oooo..... * --------------- --------------------------------- --------------- * \ x: ...oooooo... 0 'g' "=" / * \ y: ...oooooo... / * \---------------------------------/ * Notes: * o This way of comparing ranges is a refinement over the standard ranges * comparison defined by the ==, !=, <=, >=, < and > operators. In * particular a numeric code that is < 0, = 0, or > 0 corresponds to * x < y, x == y, or x > y, respectively. * o In this file we use the term "overlap" in a loose way even when there * is actually no overlap between ranges x and y. Real overlaps correspond * to numeric codes >= -4 and <= 4, and to long codes that contain an * equal ("="). * o Long codes are designed to be user-friendly whereas numeric and * 1-letter codes are designed to be more compact and memory efficient. * Typically the formers will be exposed to the end-user and translated * internally into the latters. * o Swapping x and y changes the sign of the corresponding numeric code and * substitutes "x" by "y" and "y" by "x" in the corresponding long code. * o Reflecting ranges x and y relative to an arbitrary position (i.e. doing * a symetry with respect to a vertical axis) has the effect of reversing * the associated long code e.g. "x=y" becomes "y=x". The effect on the * numeric code is implemented by the _invert_overlap_code() function. * * 'x_start', 'x_width', 'y_start' and 'y_width' are assumed to be non NA (not * checked). 'x_start' and 'y_start' must be 1-based. 'x_width' and 'y_width' * are assumed to be >= 0 (not checked). */ int _overlap_code(int x_start, int x_width, int y_start, int y_width) { int x_end_plus1, y_end_plus1; x_end_plus1 = x_start + x_width; if (x_end_plus1 < y_start) return -6; if (x_end_plus1 == y_start) { if (x_width == 0 && y_width == 0) return 0; return -5; } y_end_plus1 = y_start + y_width; if (y_end_plus1 < x_start) return 6; if (y_end_plus1 == x_start) return 5; if (x_start < y_start) { if (x_end_plus1 < y_end_plus1) return -4; if (x_end_plus1 == y_end_plus1) return -3; return -2; } if (x_start == y_start) { if (x_end_plus1 < y_end_plus1) return -1; if (x_end_plus1 == y_end_plus1) return 0; return 1; } if (x_end_plus1 < y_end_plus1) return 2; if (x_end_plus1 == y_end_plus1) return 3; return 4; } int _invert_overlap_code(int code) { if (code == -2 || code == 0 || code == 2) return code; if (code <= -4 || code >= 4) return - code; /* Only possible values left: -3, -1, 1, 3 */ return code < 0 ? code + 4 : code - 4; } /* "Parallel" generalized comparison of 2 Ranges objects. */ static void ranges_pcompar( const int *x_start, const int *x_width, int x_len, const int *y_start, const int *y_width, int y_len, int *out, int out_len, int with_warning) { int i, j, k; for (i = j = k = 0; k < out_len; i++, j++, k++) { if (i >= x_len) i = 0; /* recycle i */ if (j >= y_len) j = 0; /* recycle j */ out[k] = _overlap_code(x_start[i], x_width[i], y_start[j], y_width[j]); } /* Warning message appropriate only when 'out_len' is 'max(x_len, y_len)' */ if (with_warning && out_len != 0 && (i != x_len || j != y_len)) warning("longer object length is not a multiple " "of shorter object length"); return; } /* --- .Call ENTRY POINT --- * 'x_start' and 'x_width': integer vectors of the same length M. * 'y_start' and 'y_width': integer vectors of the same length N. * If M != N then the shorter object is recycled to the length of the longer * object, except if M or N is 0 in which case the object with length != 0 is * truncated to length 0. * The 4 integer vectors are assumed to be NA free and 'x_width' and * 'y_width' are assumed to contain non-negative values. For efficiency * reasons, those assumptions are not checked. */ SEXP Ranges_compare(SEXP x_start, SEXP x_width, SEXP y_start, SEXP y_width) { int x_len, y_len, ans_len; const int *x_start_p, *x_width_p, *y_start_p, *y_width_p; SEXP ans; x_len = _check_integer_pairs(x_start, x_width, &x_start_p, &x_width_p, "start(x)", "width(x)"); y_len = _check_integer_pairs(y_start, y_width, &y_start_p, &y_width_p, "start(y)", "width(y)"); if (x_len == 0 || y_len == 0) ans_len = 0; else ans_len = x_len >= y_len ? x_len : y_len; PROTECT(ans = NEW_INTEGER(ans_len)); ranges_pcompar(x_start_p, x_width_p, x_len, y_start_p, y_width_p, y_len, INTEGER(ans), ans_len, 1); UNPROTECT(1); return ans; } IRanges/src/RleViews_utils.c0000644000126300012640000005166612234075662017425 0ustar00biocbuildphs_compbio#include "IRanges.h" #include #include #include #define R_INT_MIN (1+INT_MIN) /* * --- .Call ENTRY POINT --- */ SEXP RleViews_viewMins(SEXP x, SEXP na_rm) { char type = '?'; int i, start, width, ans_length, index, lower_run, upper_run, upper_bound; int max_index, *lengths_elt; SEXP ans, subject, values, lengths, ranges, names; cachedIRanges cached_ranges; subject = GET_SLOT(x, install("subject")); values = GET_SLOT(subject, install("values")); lengths = GET_SLOT(subject, install("lengths")); ranges = GET_SLOT(x, install("ranges")); cached_ranges = _cache_IRanges(ranges); ans_length = _get_cachedIRanges_length(&cached_ranges); ans = R_NilValue; switch (TYPEOF(values)) { case LGLSXP: case INTSXP: type = 'i'; PROTECT(ans = NEW_INTEGER(ans_length)); break; case REALSXP: type = 'r'; PROTECT(ans = NEW_NUMERIC(ans_length)); break; default: error("Rle must contain either 'integer' or 'numeric' values"); } if (!IS_LOGICAL(na_rm) || LENGTH(na_rm) != 1 || LOGICAL(na_rm)[0] == NA_LOGICAL) error("'na.rm' must be TRUE or FALSE"); lengths_elt = INTEGER(lengths); max_index = LENGTH(lengths) - 1; index = 0; upper_run = *lengths_elt; for (i = 0; i < ans_length; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); start = _get_cachedIRanges_elt_start(&cached_ranges, i); width = _get_cachedIRanges_elt_width(&cached_ranges, i); if (type == 'i') { INTEGER(ans)[i] = INT_MAX; } else if (type == 'r') { REAL(ans)[i] = R_PosInf; } if (width > 0) { while (index > 0 && upper_run > start) { upper_run -= *lengths_elt; lengths_elt--; index--; } while (upper_run < start) { lengths_elt++; index++; upper_run += *lengths_elt; } lower_run = upper_run - *lengths_elt + 1; upper_bound = start + width - 1; if (type == 'i') { while (lower_run <= upper_bound) { if (INTEGER(values)[index] == NA_INTEGER) { if (!LOGICAL(na_rm)[0]) { INTEGER(ans)[i] = NA_INTEGER; break; } } else if (INTEGER(values)[index] < INTEGER(ans)[i]) { INTEGER(ans)[i] = INTEGER(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; upper_run += *lengths_elt; } else { break; } } } else if (type == 'r') { while (lower_run <= upper_bound) { if (ISNAN(REAL(values)[index])) { if (!LOGICAL(na_rm)[0]) { REAL(ans)[i] = NA_REAL; break; } } else if (REAL(values)[index] < REAL(ans)[i]) { REAL(ans)[i] = REAL(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; upper_run += *lengths_elt; } else { break; } } } } } PROTECT(names = duplicate(_get_IRanges_names(ranges))); SET_NAMES(ans, names); UNPROTECT(2); return ans; } /* * --- .Call ENTRY POINT --- */ SEXP RleViews_viewMaxs(SEXP x, SEXP na_rm) { char type = '?'; int i, start, width, ans_length, index, lower_run, upper_run, upper_bound; int max_index, *lengths_elt; SEXP ans, subject, values, lengths, ranges, names; cachedIRanges cached_ranges; subject = GET_SLOT(x, install("subject")); values = GET_SLOT(subject, install("values")); lengths = GET_SLOT(subject, install("lengths")); ranges = GET_SLOT(x, install("ranges")); cached_ranges = _cache_IRanges(ranges); ans_length = _get_cachedIRanges_length(&cached_ranges); ans = R_NilValue; switch (TYPEOF(values)) { case LGLSXP: case INTSXP: type = 'i'; PROTECT(ans = NEW_INTEGER(ans_length)); break; case REALSXP: type = 'r'; PROTECT(ans = NEW_NUMERIC(ans_length)); break; default: error("Rle must contain either 'integer' or 'numeric' values"); } if (!IS_LOGICAL(na_rm) || LENGTH(na_rm) != 1 || LOGICAL(na_rm)[0] == NA_LOGICAL) error("'na.rm' must be TRUE or FALSE"); lengths_elt = INTEGER(lengths); max_index = LENGTH(lengths) - 1; index = 0; upper_run = *lengths_elt; for (i = 0; i < ans_length; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); start = _get_cachedIRanges_elt_start(&cached_ranges, i); width = _get_cachedIRanges_elt_width(&cached_ranges, i); if (type == 'i') { INTEGER(ans)[i] = R_INT_MIN; } else if (type == 'r') { REAL(ans)[i] = R_NegInf; } if (width > 0) { while (index > 0 && upper_run > start) { upper_run -= *lengths_elt; lengths_elt--; index--; } while (upper_run < start) { lengths_elt++; index++; upper_run += *lengths_elt; } lower_run = upper_run - *lengths_elt + 1; upper_bound = start + width - 1; if (type == 'i') { while (lower_run <= upper_bound) { if (INTEGER(values)[index] == NA_INTEGER) { if (!LOGICAL(na_rm)[0]) { INTEGER(ans)[i] = NA_INTEGER; break; } } else if (INTEGER(values)[index] > INTEGER(ans)[i]) { INTEGER(ans)[i] = INTEGER(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; upper_run += *lengths_elt; } else { break; } } } else if (type == 'r') { while (lower_run <= upper_bound) { if (ISNAN(REAL(values)[index])) { if (!LOGICAL(na_rm)[0]) { REAL(ans)[i] = NA_REAL; break; } } else if (REAL(values)[index] > REAL(ans)[i]) { REAL(ans)[i] = REAL(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; upper_run += *lengths_elt; } else { break; } } } } } PROTECT(names = duplicate(_get_IRanges_names(ranges))); SET_NAMES(ans, names); UNPROTECT(2); return ans; } /* * --- .Call ENTRY POINT --- */ SEXP RleViews_viewSums(SEXP x, SEXP na_rm) { char type = '?'; int i, start, width, ans_length, index, lower_run, upper_run, lower_bound, upper_bound; int max_index, *lengths_elt; SEXP ans, subject, values, lengths, ranges, names; cachedIRanges cached_ranges; subject = GET_SLOT(x, install("subject")); values = GET_SLOT(subject, install("values")); lengths = GET_SLOT(subject, install("lengths")); ranges = GET_SLOT(x, install("ranges")); cached_ranges = _cache_IRanges(ranges); ans_length = _get_cachedIRanges_length(&cached_ranges); ans = R_NilValue; switch (TYPEOF(values)) { case LGLSXP: case INTSXP: type = 'i'; PROTECT(ans = NEW_INTEGER(ans_length)); break; case REALSXP: type = 'r'; PROTECT(ans = NEW_NUMERIC(ans_length)); break; case CPLXSXP: type = 'c'; PROTECT(ans = NEW_COMPLEX(ans_length)); break; default: error("Rle must contain either 'integer', 'numeric', or 'complex' values"); } if (!IS_LOGICAL(na_rm) || LENGTH(na_rm) != 1 || LOGICAL(na_rm)[0] == NA_LOGICAL) error("'na.rm' must be TRUE or FALSE"); lengths_elt = INTEGER(lengths); max_index = LENGTH(lengths) - 1; index = 0; upper_run = *lengths_elt; for (i = 0; i < ans_length; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); start = _get_cachedIRanges_elt_start(&cached_ranges, i); width = _get_cachedIRanges_elt_width(&cached_ranges, i); if (type == 'i') { INTEGER(ans)[i] = 0; } else if (type == 'r') { REAL(ans)[i] = 0; } else if (type == 'c') { COMPLEX(ans)[i].r = 0; COMPLEX(ans)[i].i = 0; } if (width > 0) { while (index > 0 && upper_run > start) { upper_run -= *lengths_elt; lengths_elt--; index--; } while (upper_run < start) { lengths_elt++; index++; upper_run += *lengths_elt; } lower_run = upper_run - *lengths_elt + 1; lower_bound = start; upper_bound = start + width - 1; if (type == 'i') { while (lower_run <= upper_bound) { if (INTEGER(values)[index] == NA_INTEGER) { if (!LOGICAL(na_rm)[0]) { INTEGER(ans)[i] = NA_INTEGER; break; } } else { INTEGER(ans)[i] += INTEGER(values)[index] * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } if (INTEGER(ans)[i] != NA_INTEGER && (INTEGER(ans)[i] > INT_MAX || INTEGER(ans)[i] < R_INT_MIN)) error("Integer overflow"); } else if (type == 'r') { while (lower_run <= upper_bound) { if (ISNAN(REAL(values)[index])) { if (!LOGICAL(na_rm)[0]) { REAL(ans)[i] = NA_REAL; break; } } else { REAL(ans)[i] += REAL(values)[index] * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } } else if (type == 'c') { while (lower_run <= upper_bound) { if (ISNAN(COMPLEX(values)[index].r) || ISNAN(COMPLEX(values)[index].i)) { if (!LOGICAL(na_rm)[0]) { COMPLEX(ans)[i].r = NA_REAL; COMPLEX(ans)[i].i = NA_REAL; break; } } else { COMPLEX(ans)[i].r += COMPLEX(values)[index].r * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); COMPLEX(ans)[i].i += COMPLEX(values)[index].i * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } } } } PROTECT(names = duplicate(_get_IRanges_names(ranges))); SET_NAMES(ans, names); UNPROTECT(2); return ans; } /* * --- .Call ENTRY POINT --- */ SEXP RleViews_viewMeans(SEXP x, SEXP na_rm) { char type = '?'; int i, n, start, width, ans_length, index, lower_run, upper_run, lower_bound, upper_bound; int max_index, *lengths_elt; SEXP ans, subject, values, lengths, ranges, names; cachedIRanges cached_ranges; subject = GET_SLOT(x, install("subject")); values = GET_SLOT(subject, install("values")); lengths = GET_SLOT(subject, install("lengths")); ranges = GET_SLOT(x, install("ranges")); cached_ranges = _cache_IRanges(ranges); ans_length = _get_cachedIRanges_length(&cached_ranges); ans = R_NilValue; switch (TYPEOF(values)) { case LGLSXP: case INTSXP: type = 'i'; PROTECT(ans = NEW_NUMERIC(ans_length)); break; case REALSXP: type = 'r'; PROTECT(ans = NEW_NUMERIC(ans_length)); break; case CPLXSXP: type = 'c'; PROTECT(ans = NEW_COMPLEX(ans_length)); break; default: error("Rle must contain either 'integer', 'numeric', or 'complex' values"); } if (!IS_LOGICAL(na_rm) || LENGTH(na_rm) != 1 || LOGICAL(na_rm)[0] == NA_LOGICAL) error("'na.rm' must be TRUE or FALSE"); lengths_elt = INTEGER(lengths); max_index = LENGTH(lengths) - 1; index = 0; upper_run = *lengths_elt; for (i = 0; i < ans_length; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); start = _get_cachedIRanges_elt_start(&cached_ranges, i); width = _get_cachedIRanges_elt_width(&cached_ranges, i); if (width <= 0) { if (type == 'i') { REAL(ans)[i] = R_NaN; } else if (type == 'r') { REAL(ans)[i] = R_NaN; } else if (type == 'c') { COMPLEX(ans)[i].r = R_NaN; COMPLEX(ans)[i].i = R_NaN; } } else { n = width; if (type == 'i') { REAL(ans)[i] = 0; } else if (type == 'r') { REAL(ans)[i] = 0; } else if (type == 'c') { COMPLEX(ans)[i].r = 0; COMPLEX(ans)[i].i = 0; } while (index > 0 && upper_run > start) { upper_run -= *lengths_elt; lengths_elt--; index--; } while (upper_run < start) { lengths_elt++; index++; upper_run += *lengths_elt; } lower_run = upper_run - *lengths_elt + 1; lower_bound = start; upper_bound = start + width - 1; if (type == 'i') { while (lower_run <= upper_bound) { if (INTEGER(values)[index] == NA_INTEGER) { if (!LOGICAL(na_rm)[0]) { REAL(ans)[i] = NA_REAL; break; } n -= (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } else { REAL(ans)[i] += INTEGER(values)[index] * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } if (n == 0) { REAL(ans)[i] = R_NaN; } else if (REAL(ans)[i] != NA_REAL) { REAL(ans)[i] /= n; } } else if (type == 'r') { while (lower_run <= upper_bound) { if (ISNAN(REAL(values)[index])) { if (!LOGICAL(na_rm)[0]) { REAL(ans)[i] = NA_REAL; break; } n -= (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } else { REAL(ans)[i] += REAL(values)[index] * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } if (n == 0) { REAL(ans)[i] = R_NaN; } else if (REAL(ans)[i] != NA_REAL) { REAL(ans)[i] /= n; } } else if (type == 'c') { while (lower_run <= upper_bound) { if (ISNAN(COMPLEX(values)[index].r) || ISNAN(COMPLEX(values)[index].i)) { if (!LOGICAL(na_rm)[0]) { COMPLEX(ans)[i].r = NA_REAL; COMPLEX(ans)[i].i = NA_REAL; break; } n -= (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } else { COMPLEX(ans)[i].r += COMPLEX(values)[index].r * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); COMPLEX(ans)[i].i += COMPLEX(values)[index].i * (1 + (upper_bound < upper_run ? upper_bound : upper_run) - (lower_bound > lower_run ? lower_bound : lower_run)); } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } if (n == 0) { COMPLEX(ans)[i].r = R_NaN; COMPLEX(ans)[i].i = R_NaN; } else if (COMPLEX(ans)[i].r != NA_REAL) { COMPLEX(ans)[i].r /= n; COMPLEX(ans)[i].i /= n; } } } } PROTECT(names = duplicate(_get_IRanges_names(ranges))); SET_NAMES(ans, names); UNPROTECT(2); return ans; } /* * --- .Call ENTRY POINT --- */ SEXP RleViews_viewWhichMins(SEXP x, SEXP na_rm) { char type = '?'; int i, start, width, ans_length, index, lower_run, upper_run, lower_bound, upper_bound; int max_index, *ans_elt, *lengths_elt; SEXP curr, ans, subject, values, lengths, ranges, names; cachedIRanges cached_ranges; subject = GET_SLOT(x, install("subject")); values = GET_SLOT(subject, install("values")); lengths = GET_SLOT(subject, install("lengths")); ranges = GET_SLOT(x, install("ranges")); cached_ranges = _cache_IRanges(ranges); ans_length = _get_cachedIRanges_length(&cached_ranges); curr = R_NilValue; switch (TYPEOF(values)) { case LGLSXP: case INTSXP: type = 'i'; PROTECT(curr = NEW_INTEGER(1)); break; case REALSXP: type = 'r'; PROTECT(curr = NEW_NUMERIC(1)); break; default: error("Rle must contain either 'integer' or 'numeric' values"); } if (!IS_LOGICAL(na_rm) || LENGTH(na_rm) != 1 || LOGICAL(na_rm)[0] == NA_LOGICAL) error("'na.rm' must be TRUE or FALSE"); PROTECT(ans = NEW_INTEGER(ans_length)); lengths_elt = INTEGER(lengths); max_index = LENGTH(lengths) - 1; index = 0; upper_run = *lengths_elt; for (i = 0, ans_elt = INTEGER(ans); i < ans_length; i++, ans_elt++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); start = _get_cachedIRanges_elt_start(&cached_ranges, i); width = _get_cachedIRanges_elt_width(&cached_ranges, i); *ans_elt = NA_INTEGER; if (width > 0) { if (type == 'i') { INTEGER(curr)[0] = INT_MAX; } else if (type == 'r') { REAL(curr)[0] = R_PosInf; } while (index > 0 && upper_run > start) { upper_run -= *lengths_elt; lengths_elt--; index--; } while (upper_run < start) { lengths_elt++; index++; upper_run += *lengths_elt; } lower_run = upper_run - *lengths_elt + 1; lower_bound = start; upper_bound = start + width - 1; if (type == 'i') { while (lower_run <= upper_bound) { if (INTEGER(values)[index] == NA_INTEGER) { if (!LOGICAL(na_rm)[0]) { break; } } else if (INTEGER(values)[index] < INTEGER(curr)[0]) { *ans_elt = lower_bound; INTEGER(curr)[0] = INTEGER(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } } else if (type == 'r') { while (lower_run <= upper_bound) { if (ISNAN(REAL(values)[index])) { if (!LOGICAL(na_rm)[0]) { break; } } else if (REAL(values)[index] < REAL(curr)[0]) { *ans_elt = lower_bound; REAL(curr)[0] = REAL(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } } } } PROTECT(names = duplicate(_get_IRanges_names(ranges))); SET_NAMES(ans, names); UNPROTECT(3); return ans; } /* * --- .Call ENTRY POINT --- */ SEXP RleViews_viewWhichMaxs(SEXP x, SEXP na_rm) { char type = '?'; int i, start, width, ans_length, index, lower_run, upper_run, lower_bound, upper_bound; int max_index, *ans_elt, *lengths_elt; SEXP curr, ans, subject, values, lengths, ranges, names; cachedIRanges cached_ranges; subject = GET_SLOT(x, install("subject")); values = GET_SLOT(subject, install("values")); lengths = GET_SLOT(subject, install("lengths")); ranges = GET_SLOT(x, install("ranges")); cached_ranges = _cache_IRanges(ranges); ans_length = _get_cachedIRanges_length(&cached_ranges); curr = R_NilValue; switch (TYPEOF(values)) { case LGLSXP: case INTSXP: type = 'i'; PROTECT(curr = NEW_INTEGER(1)); break; case REALSXP: type = 'r'; PROTECT(curr = NEW_NUMERIC(1)); break; default: error("Rle must contain either 'integer' or 'numeric' values"); } if (!IS_LOGICAL(na_rm) || LENGTH(na_rm) != 1 || LOGICAL(na_rm)[0] == NA_LOGICAL) error("'na.rm' must be TRUE or FALSE"); PROTECT(ans = NEW_INTEGER(ans_length)); lengths_elt = INTEGER(lengths); max_index = LENGTH(lengths) - 1; index = 0; upper_run = *lengths_elt; for (i = 0, ans_elt = INTEGER(ans); i < ans_length; i++, ans_elt++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); start = _get_cachedIRanges_elt_start(&cached_ranges, i); width = _get_cachedIRanges_elt_width(&cached_ranges, i); *ans_elt = NA_INTEGER; if (width > 0) { if (type == 'i') { INTEGER(curr)[0] = R_INT_MIN; } else if (type == 'r') { REAL(curr)[0] = R_NegInf; } while (index > 0 && upper_run > start) { upper_run -= *lengths_elt; lengths_elt--; index--; } while (upper_run < start) { lengths_elt++; index++; upper_run += *lengths_elt; } lower_run = upper_run - *lengths_elt + 1; lower_bound = start; upper_bound = start + width - 1; if (type == 'i') { while (lower_run <= upper_bound) { if (INTEGER(values)[index] == NA_INTEGER) { if (!LOGICAL(na_rm)[0]) { break; } } else if (INTEGER(values)[index] > INTEGER(curr)[0]) { *ans_elt = lower_bound; INTEGER(curr)[0] = INTEGER(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } } else if (type == 'r') { while (lower_run <= upper_bound) { if (ISNAN(REAL(values)[index])) { if (!LOGICAL(na_rm)[0]) { break; } } else if (REAL(values)[index] > REAL(curr)[0]) { *ans_elt = lower_bound; REAL(curr)[0] = REAL(values)[index]; } if (index < max_index) { lengths_elt++; index++; lower_run = upper_run + 1; lower_bound = lower_run; upper_run += *lengths_elt; } else { break; } } } } } PROTECT(names = duplicate(_get_IRanges_names(ranges))); SET_NAMES(ans, names); UNPROTECT(3); return ans; } IRanges/src/Rle_class.c0000644000126300012640000005024612234075662016345 0ustar00biocbuildphs_compbio#include "IRanges.h" static SEXP _new_Rle(SEXP values, SEXP lengths) { SEXP classdef, ans; PROTECT(classdef = MAKE_CLASS("Rle")); PROTECT(ans = NEW_OBJECT(classdef)); SET_SLOT(ans, install("values"), values); SET_SLOT(ans, install("lengths"), lengths); UNPROTECT(2); return ans; } /**************************************************************************** * The compute__runs() low-level helper functions. * * To compute only the nb of runs without actually computing the runs * (degraded mode), set 'run_lengths' to NULL. */ static int compute_int_runs(const int *values, int nvalues, const int *lengths, int *run_values, int *run_lengths) { int i, nrun, lengths_elt; int val0; for (i = nrun = 0, lengths_elt = 1; i < nvalues; i++, values++) { if (lengths != NULL) { lengths_elt = lengths[i]; if (lengths_elt == 0) continue; } if (nrun != 0 && *values == val0) { if (run_lengths != NULL) run_lengths[nrun - 1] += lengths_elt; continue; } val0 = *values; if (run_lengths != NULL) { run_lengths[nrun] = lengths_elt; run_values[nrun] = val0; } nrun++; } return nrun; } static int compute_double_runs(const double *values, int nvalues, const int *lengths, double *run_values, int *run_lengths) { int i, nrun, lengths_elt; double val0; for (i = nrun = 0, lengths_elt = 1; i < nvalues; i++, values++) { if (lengths != NULL) { lengths_elt = lengths[i]; if (lengths_elt == 0) continue; } if (nrun != 0 && ((*values == val0) || (R_IsNA(*values) && R_IsNA(val0)) || (R_IsNaN(*values) && R_IsNaN(val0)))) { if (run_lengths != NULL) run_lengths[nrun - 1] += lengths_elt; continue; } val0 = *values; if (run_lengths != NULL) { run_lengths[nrun] = lengths_elt; run_values[nrun] = val0; } nrun++; } return nrun; } static int compute_Rcomplex_runs(const Rcomplex *values, int nvalues, const int *lengths, Rcomplex *run_values, int *run_lengths) { int i, nrun, lengths_elt; Rcomplex val0; for (i = nrun = 0, lengths_elt = 1; i < nvalues; i++, values++) { if (lengths != NULL) { lengths_elt = lengths[i]; if (lengths_elt == 0) continue; } if (nrun != 0 && ((values->r == val0.r) || (R_IsNA(values->r) && R_IsNA(val0.r)) || (R_IsNaN(values->r) && R_IsNaN(val0.r))) && ((values->i == val0.i) || (R_IsNA(values->i) && R_IsNA(val0.i)) || (R_IsNaN(values->i) && R_IsNaN(val0.i)))) { if (run_lengths != NULL) run_lengths[nrun - 1] += lengths_elt; continue; } val0 = *values; if (run_lengths != NULL) { run_lengths[nrun] = lengths_elt; run_values[nrun] = val0; } nrun++; } return nrun; } static int compute_CHARSXP_runs(SEXP values, const int *lengths, SEXP run_values, int *run_lengths) { int nvalues, i, nrun, lengths_elt; SEXP values_elt, val0; nvalues = LENGTH(values); for (i = nrun = 0, lengths_elt = 1; i < nvalues; i++) { if (lengths != NULL) { lengths_elt = lengths[i]; if (lengths_elt == 0) continue; } values_elt = STRING_ELT(values, i); if (nrun != 0 && values_elt == val0) { if (run_lengths != NULL) run_lengths[nrun - 1] += lengths_elt; continue; } val0 = values_elt; if (run_lengths != NULL) { run_lengths[nrun] = lengths_elt; SET_STRING_ELT(run_values, nrun, val0); } nrun++; } return nrun; } static int compute_Rbyte_runs(const Rbyte *values, int nvalues, const int *lengths, Rbyte *run_values, int *run_lengths) { int i, nrun, lengths_elt; Rbyte val0; for (i = nrun = 0, lengths_elt = 1; i < nvalues; i++, values++) { if (lengths != NULL) { lengths_elt = lengths[i]; if (lengths_elt == 0) continue; } if (nrun != 0 && *values == val0) { if (run_lengths != NULL) run_lengths[nrun - 1] += lengths_elt; continue; } val0 = *values; if (run_lengths != NULL) { run_lengths[nrun] = lengths_elt; run_values[nrun] = val0; } nrun++; } return nrun; } /**************************************************************************** * The C level Rle smart constructors. * * 'lengths' must be either (a) an int array of length 'nvalues' with no NA * or negative values, or (b) NULL. If (b) then it's treated as an array of * length 'nvalues' filled with 1's (i.e. each element is set to 1). * 'buflength' is the length of the temporary buffers allocated internally by * the smart constructor for computing the runs. If set to 0, then a 2-pass * algo is used that doesn't use any temporary buffer, typically leading to * 20%-30% less memory used (it also seems slightly faster on my machine). * Setting 'buflength' to 'nvalues' is safe because the number of runs can * only be <= 'nvalues'. If 'buflength' is > 'nvalues', then 'nvalues' is used * instead. * WARNING: Avoid using a 'buflength' that is > 0 and < 'nvalues' unless you * know what you are doing! */ SEXP _logical_Rle_constructor(const int *values, int nvalues, const int *lengths, int buflength) { int nrun, *buf_lengths; int *buf_values; SEXP ans_lengths, ans_values, ans; if (buflength > nvalues) buflength = nvalues; if (buflength == 0) { /* 1st pass: compute only the nb of runs */ buf_values = NULL; buf_lengths = NULL; } else { buf_values = (int *) R_alloc(buflength, sizeof(int)); buf_lengths = (int *) R_alloc(buflength, sizeof(int)); } nrun = compute_int_runs(values, nvalues, lengths, buf_values, buf_lengths); PROTECT(ans_values = NEW_LOGICAL(nrun)); PROTECT(ans_lengths = NEW_INTEGER(nrun)); if (buflength == 0) { /* 2nd pass: fill 'ans_values' and 'ans_lengths' */ compute_int_runs(values, nvalues, lengths, LOGICAL(ans_values), INTEGER(ans_lengths)); } else { memcpy(LOGICAL(ans_values), buf_values, nrun * sizeof(int)); memcpy(INTEGER(ans_lengths), buf_lengths, nrun * sizeof(int)); } PROTECT(ans = _new_Rle(ans_values, ans_lengths)); UNPROTECT(3); return ans; } SEXP _integer_Rle_constructor(const int *values, int nvalues, const int *lengths, int buflength) { int nrun, *buf_lengths; int *buf_values; SEXP ans_lengths, ans_values, ans; if (buflength > nvalues) buflength = nvalues; if (buflength == 0) { /* 1st pass: compute only the nb of runs */ buf_values = NULL; buf_lengths = NULL; } else { buf_values = (int *) R_alloc(buflength, sizeof(int)); buf_lengths = (int *) R_alloc(buflength, sizeof(int)); } nrun = compute_int_runs(values, nvalues, lengths, buf_values, buf_lengths); PROTECT(ans_values = NEW_INTEGER(nrun)); PROTECT(ans_lengths = NEW_INTEGER(nrun)); if (buflength == 0) { /* 2nd pass: fill 'ans_values' and 'ans_lengths' */ compute_int_runs(values, nvalues, lengths, INTEGER(ans_values), INTEGER(ans_lengths)); } else { memcpy(INTEGER(ans_values), buf_values, nrun * sizeof(int)); memcpy(INTEGER(ans_lengths), buf_lengths, nrun * sizeof(int)); } PROTECT(ans = _new_Rle(ans_values, ans_lengths)); UNPROTECT(3); return ans; } SEXP _numeric_Rle_constructor(const double *values, int nvalues, const int *lengths, int buflength) { int nrun, *buf_lengths; double *buf_values; SEXP ans_lengths, ans_values, ans; if (buflength > nvalues) buflength = nvalues; if (buflength == 0) { /* 1st pass: compute only the nb of runs */ buf_values = NULL; buf_lengths = NULL; } else { buf_values = (double *) R_alloc(buflength, sizeof(double)); buf_lengths = (int *) R_alloc(buflength, sizeof(int)); } nrun = compute_double_runs(values, nvalues, lengths, buf_values, buf_lengths); PROTECT(ans_values = NEW_NUMERIC(nrun)); PROTECT(ans_lengths = NEW_INTEGER(nrun)); if (buflength == 0) { /* 2nd pass: fill 'ans_values' and 'ans_lengths' */ compute_double_runs(values, nvalues, lengths, REAL(ans_values), INTEGER(ans_lengths)); } else { memcpy(REAL(ans_values), buf_values, nrun * sizeof(double)); memcpy(INTEGER(ans_lengths), buf_lengths, nrun * sizeof(int)); } PROTECT(ans = _new_Rle(ans_values, ans_lengths)); UNPROTECT(3); return ans; } SEXP _complex_Rle_constructor(const Rcomplex *values, int nvalues, const int *lengths, int buflength) { int nrun, *buf_lengths; Rcomplex *buf_values; SEXP ans_lengths, ans_values, ans; if (buflength > nvalues) buflength = nvalues; if (buflength == 0) { /* 1st pass: compute only the nb of runs */ buf_values = NULL; buf_lengths = NULL; } else { buf_values = (Rcomplex *) R_alloc(buflength, sizeof(Rcomplex)); buf_lengths = (int *) R_alloc(buflength, sizeof(int)); } nrun = compute_Rcomplex_runs(values, nvalues, lengths, buf_values, buf_lengths); PROTECT(ans_values = NEW_COMPLEX(nrun)); PROTECT(ans_lengths = NEW_INTEGER(nrun)); if (buflength == 0) { /* 2nd pass: fill 'ans_values' and 'ans_lengths' */ compute_Rcomplex_runs(values, nvalues, lengths, COMPLEX(ans_values), INTEGER(ans_lengths)); } else { memcpy(COMPLEX(ans_values), buf_values, nrun * sizeof(Rcomplex)); memcpy(INTEGER(ans_lengths), buf_lengths, nrun * sizeof(int)); } PROTECT(ans = _new_Rle(ans_values, ans_lengths)); UNPROTECT(3); return ans; } SEXP _character_Rle_constructor(SEXP values, const int *lengths, int buflength) { int nvalues, nrun, *buf_lengths, i; SEXP buf_values, ans_lengths, ans_values, ans; nvalues = LENGTH(values); if (buflength > nvalues) buflength = nvalues; if (buflength == 0) { /* 1st pass: compute only the nb of runs */ buf_values = NULL; buf_lengths = NULL; } else { PROTECT(buf_values = NEW_CHARACTER(buflength)); buf_lengths = (int *) R_alloc(buflength, sizeof(int)); } nrun = compute_CHARSXP_runs(values, lengths, buf_values, buf_lengths); PROTECT(ans_values = NEW_CHARACTER(nrun)); PROTECT(ans_lengths = NEW_INTEGER(nrun)); if (buflength == 0) { /* 2nd pass: fill 'ans_values' and 'ans_lengths' */ compute_CHARSXP_runs(values, lengths, ans_values, INTEGER(ans_lengths)); } else { for (i = 0; i < nrun; i++) SET_STRING_ELT(ans_values, i, STRING_ELT(buf_values, i)); memcpy(INTEGER(ans_lengths), buf_lengths, nrun * sizeof(int)); } PROTECT(ans = _new_Rle(ans_values, ans_lengths)); UNPROTECT(buflength == 0 ? 3 : 4); return ans; } SEXP _raw_Rle_constructor(const Rbyte *values, int nvalues, const int *lengths, int buflength) { int nrun, *buf_lengths; Rbyte *buf_values; SEXP ans_lengths, ans_values, ans; if (buflength > nvalues) buflength = nvalues; if (buflength == 0) { /* 1st pass: compute only the nb of runs */ buf_values = NULL; buf_lengths = NULL; } else { buf_values = (Rbyte *) R_alloc(buflength, sizeof(Rbyte)); buf_lengths = (int *) R_alloc(buflength, sizeof(int)); } nrun = compute_Rbyte_runs(values, nvalues, lengths, buf_values, buf_lengths); PROTECT(ans_values = NEW_RAW(nrun)); PROTECT(ans_lengths = NEW_INTEGER(nrun)); if (buflength == 0) { /* 2nd pass: fill 'ans_values' and 'ans_lengths' */ compute_Rbyte_runs(values, nvalues, lengths, RAW(ans_values), INTEGER(ans_lengths)); } else { memcpy(RAW(ans_values), buf_values, nrun * sizeof(Rbyte)); memcpy(INTEGER(ans_lengths), buf_lengths, nrun * sizeof(int)); } PROTECT(ans = _new_Rle(ans_values, ans_lengths)); UNPROTECT(3); return ans; } /**************************************************************************** * The Rle constructor (.Call ENTRY POINT). */ SEXP Rle_constructor(SEXP values, SEXP lengths, SEXP check, SEXP buflength) { int nvalues, buflength0; const int *lengths_p; nvalues = LENGTH(values); if (LOGICAL(check)[0] && LENGTH(lengths) > 0) { if (LENGTH(lengths) != nvalues) error("'length(lengths)' != 'length(values)'"); _sum_non_neg_ints(INTEGER(lengths), LENGTH(lengths), "lengths"); } lengths_p = LENGTH(lengths) > 0 ? INTEGER(lengths) : NULL; buflength0 = INTEGER(buflength)[0]; switch (TYPEOF(values)) { case LGLSXP: return _logical_Rle_constructor(LOGICAL(values), nvalues, lengths_p, buflength0); case INTSXP: return _integer_Rle_constructor(INTEGER(values), nvalues, lengths_p, buflength0); case REALSXP: return _numeric_Rle_constructor(REAL(values), nvalues, lengths_p, buflength0); case CPLXSXP: return _complex_Rle_constructor(COMPLEX(values), nvalues, lengths_p, buflength0); case STRSXP: return _character_Rle_constructor(values, lengths_p, buflength0); case RAWSXP: return _raw_Rle_constructor(RAW(values), nvalues, lengths_p, buflength0); } error("Rle of type '%s' is not supported", CHAR(type2str(TYPEOF(values)))); return R_NilValue; } /**************************************************************************** * The Rle start() and end() getters (.Call ENTRY POINTS). */ SEXP Rle_start(SEXP x) { int i, nrun, *len_elt, *prev_start, *curr_start; SEXP lengths, ans; lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); PROTECT(ans = NEW_INTEGER(nrun)); if (nrun > 0) { INTEGER(ans)[0] = 1; for(i = 1, len_elt = INTEGER(lengths), prev_start = INTEGER(ans), curr_start = INTEGER(ans) + 1; i < nrun; i++, len_elt++, prev_start++, curr_start++) { *curr_start = *prev_start + *len_elt; } } UNPROTECT(1); return ans; } SEXP Rle_end(SEXP x) { int i, nrun, *len_elt, *prev_end, *curr_end; SEXP lengths, ans; lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); PROTECT(ans = NEW_INTEGER(nrun)); if (nrun > 0) { INTEGER(ans)[0] = INTEGER(lengths)[0]; for(i = 1, len_elt = INTEGER(lengths) + 1, prev_end = INTEGER(ans), curr_end = INTEGER(ans) + 1; i < nrun; i++, len_elt++, prev_end++, curr_end++) { *curr_end = *prev_end + *len_elt; } } UNPROTECT(1); return ans; } /**************************************************************************** * Rle_getStartEndRunAndOffset() */ static SEXP get_StartEndRunAndOffset_from_runLength( const int *runlength, int runlength_len, const int *start, const int *end, int length) { int i, *soff_elt, *eoff_elt; const int *start_elt, *end_elt, *erun_elt; SEXP info_start, info_end, ans, ans_names; SEXP ans_start, ans_start_names, ans_end, ans_end_names; SEXP start_run, start_offset, end_run, end_offset; PROTECT(info_start = _find_interv_and_start_from_width(start, length, runlength, runlength_len)); PROTECT(info_end = _find_interv_and_start_from_width(end, length, runlength, runlength_len)); start_run = VECTOR_ELT(info_start, 0); start_offset = VECTOR_ELT(info_start, 1); end_run = VECTOR_ELT(info_end, 0); end_offset = VECTOR_ELT(info_end, 1); for (i = 0, start_elt = start, end_elt = end, soff_elt = INTEGER(start_offset), eoff_elt = INTEGER(end_offset), erun_elt = INTEGER(end_run); i < length; i++, start_elt++, end_elt++, soff_elt++, eoff_elt++, erun_elt++) { *soff_elt = *start_elt - *soff_elt; *eoff_elt = *eoff_elt + runlength[*erun_elt - 1] - 1 - *end_elt; } PROTECT(ans_start = NEW_LIST(2)); PROTECT(ans_start_names = NEW_CHARACTER(2)); SET_VECTOR_ELT(ans_start, 0, start_run); SET_VECTOR_ELT(ans_start, 1, start_offset); SET_STRING_ELT(ans_start_names, 0, mkChar("run")); SET_STRING_ELT(ans_start_names, 1, mkChar("offset")); SET_NAMES(ans_start, ans_start_names); PROTECT(ans_end = NEW_LIST(2)); PROTECT(ans_end_names = NEW_CHARACTER(2)); SET_VECTOR_ELT(ans_end, 0, end_run); SET_VECTOR_ELT(ans_end, 1, end_offset); SET_STRING_ELT(ans_end_names, 0, mkChar("run")); SET_STRING_ELT(ans_end_names, 1, mkChar("offset")); SET_NAMES(ans_end, ans_end_names); PROTECT(ans = NEW_LIST(2)); PROTECT(ans_names = NEW_CHARACTER(2)); SET_VECTOR_ELT(ans, 0, ans_start); SET_VECTOR_ELT(ans, 1, ans_end); SET_STRING_ELT(ans_names, 0, mkChar("start")); SET_STRING_ELT(ans_names, 1, mkChar("end")); SET_NAMES(ans, ans_names); UNPROTECT(8); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Rle_getStartEndRunAndOffset(SEXP x, SEXP start, SEXP end) { int n; SEXP lengths; n = LENGTH(start); if (LENGTH(end) != n) error("length of 'start' must equal length of 'end'"); lengths = GET_SLOT(x, install("lengths")); return get_StartEndRunAndOffset_from_runLength( INTEGER(lengths), LENGTH(lengths), INTEGER(start), INTEGER(end), n); } /* * --- .Call ENTRY POINT --- */ SEXP Rle_window_aslist(SEXP x, SEXP runStart, SEXP runEnd, SEXP offsetStart, SEXP offsetEnd) { SEXP values, lengths, runWidth, ans, ans_names, ans_values, ans_lengths; values = GET_SLOT(x, install("values")); lengths = GET_SLOT(x, install("lengths")); if (!IS_INTEGER(runStart) || LENGTH(runStart) != 1 || INTEGER(runStart)[0] == NA_INTEGER || INTEGER(runStart)[0] < 1) error("invalid 'runStart' argument"); if (!IS_INTEGER(runEnd) || LENGTH(runEnd) != 1 || INTEGER(runEnd)[0] == NA_INTEGER || (INTEGER(runEnd)[0] + 1) < INTEGER(runStart)[0] || INTEGER(runEnd)[0] > LENGTH(values)) error("invalid 'runWidth' argument"); PROTECT(runWidth = NEW_INTEGER(1)); INTEGER(runWidth)[0] = INTEGER(runEnd)[0] - INTEGER(runStart)[0] + 1; PROTECT(ans = NEW_LIST(2)); PROTECT(ans_names = NEW_CHARACTER(2)); PROTECT(ans_values = vector_seqselect(values, runStart, runWidth)); PROTECT(ans_lengths = vector_seqselect(lengths, runStart, runWidth)); if (INTEGER(runWidth)[0] > 0) { INTEGER(ans_lengths)[0] -= INTEGER(offsetStart)[0]; INTEGER(ans_lengths)[INTEGER(runWidth)[0] - 1] -= INTEGER(offsetEnd)[0]; } SET_VECTOR_ELT(ans, 0, ans_values); SET_VECTOR_ELT(ans, 1, ans_lengths); SET_STRING_ELT(ans_names, 0, mkChar("values")); SET_STRING_ELT(ans_names, 1, mkChar("lengths")); SET_NAMES(ans, ans_names); UNPROTECT(5); return ans; } /* * --- .Call ENTRY POINT --- */ /* * Rle_window accepts an Rle object to support fast R-level aggregate usage */ SEXP Rle_window(SEXP x, SEXP runStart, SEXP runEnd, SEXP offsetStart, SEXP offsetEnd, SEXP ans) { SEXP ans_list; PROTECT(ans_list = Rle_window_aslist(x, runStart, runEnd, offsetStart, offsetEnd)); ans = Rf_duplicate(ans); SET_SLOT(ans, install("values"), VECTOR_ELT(ans_list, 0)); SET_SLOT(ans, install("lengths"), VECTOR_ELT(ans_list, 1)); UNPROTECT(1); return ans; } /**************************************************************************** * Rle_seqselect() */ SEXP _seqselect_Rle(SEXP x, const int *start, const int *width, int length) { int i, index, *end_elt, *width_run_elt, *len_elt; const int *start_elt, *width_elt, *soff_elt, *eoff_elt; SEXP values, lengths, end; SEXP info, info_start, info_end; SEXP start_run, end_run, width_run, start_offset, end_offset; SEXP ans, ans_names, ans_values, ans_lengths; values = GET_SLOT(x, install("values")); lengths = GET_SLOT(x, install("lengths")); PROTECT(end = NEW_INTEGER(length)); for (i = 0, start_elt = start, end_elt = INTEGER(end), width_elt = width; i < length; i++, start_elt++, end_elt++, width_elt++) { *end_elt = *start_elt + *width_elt - 1; } PROTECT(info = get_StartEndRunAndOffset_from_runLength( INTEGER(lengths), LENGTH(lengths), start, INTEGER(end), length)); info_start = VECTOR_ELT(info, 0); start_run = VECTOR_ELT(info_start, 0); start_offset = VECTOR_ELT(info_start, 1); info_end = VECTOR_ELT(info, 1); end_run = VECTOR_ELT(info_end, 0); end_offset = VECTOR_ELT(info_end, 1); PROTECT(width_run = NEW_INTEGER(length)); for (i = 0, start_elt = INTEGER(start_run), end_elt = INTEGER(end_run), width_run_elt = INTEGER(width_run); i < length; i++, start_elt++, end_elt++, width_run_elt++) { *width_run_elt = *end_elt - *start_elt + 1; } PROTECT(ans_values = vector_seqselect(values, start_run, width_run)); PROTECT(ans_lengths = vector_seqselect(lengths, start_run, width_run)); index = 0; len_elt = INTEGER(ans_lengths); for (i = 0, soff_elt = INTEGER(start_offset), eoff_elt = INTEGER(end_offset), width_elt = INTEGER(width_run); i < length; i++, soff_elt++, eoff_elt++, width_elt++) { if (*width_elt > 0) { len_elt[index] -= *soff_elt; index += *width_elt; len_elt[index - 1] -= *eoff_elt; } } PROTECT(ans = NEW_LIST(2)); PROTECT(ans_names = NEW_CHARACTER(2)); SET_VECTOR_ELT(ans, 0, ans_values); SET_VECTOR_ELT(ans, 1, ans_lengths); SET_STRING_ELT(ans_names, 0, mkChar("values")); SET_STRING_ELT(ans_names, 1, mkChar("lengths")); SET_NAMES(ans, ans_names); UNPROTECT(7); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Rle_seqselect(SEXP x, SEXP start, SEXP width) { int n; n = LENGTH(start); if (LENGTH(width) != n) error("length of 'start' must equal length of 'width'"); return _seqselect_Rle(x, INTEGER(start), INTEGER(width), n); } IRanges/src/Rle_utils.c0000644000126300012640000006017612234075662016403 0ustar00biocbuildphs_compbio#include "IRanges.h" #include "common.h" /* roundingScale */ #include SEXP Rle_integer_runsum(SEXP x, SEXP k, SEXP na_rm) { int i, j, nrun, window_len, buf_len, x_vec_len, ans_len; int prev_offset, curr_offset; int stat, stat_na; int *prev_length, *curr_length, *buf_lengths, *buf_lengths_elt; int *prev_value, *curr_value, *buf_values, *buf_values_elt; int *prev_value_na, *curr_value_na; SEXP values, lengths; SEXP orig_values, na_index; const int narm = LOGICAL(na_rm)[0]; if (!IS_INTEGER(k) || LENGTH(k) != 1 || INTEGER(k)[0] == NA_INTEGER || INTEGER(k)[0] <= 0) error("'k' must be a positive integer"); /* Set NA values to 0 * Create NA index : 1 = NA; 0 = not NA */ orig_values = GET_SLOT(x, install("values")); values = PROTECT(Rf_allocVector(INTSXP, LENGTH(orig_values))); na_index = PROTECT(Rf_allocVector(INTSXP, LENGTH(orig_values))); int *vlu = INTEGER(orig_values); for(i = 0; i < LENGTH(orig_values); i++) { if (vlu[i] == NA_INTEGER) { INTEGER(na_index)[i] = 1; INTEGER(values)[i] = 0; } else { INTEGER(na_index)[i] = 0; INTEGER(values)[i] = INTEGER(orig_values)[i]; } } lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); window_len = INTEGER(k)[0]; ans_len = 0; x_vec_len = 0; buf_len = - window_len + 1; for(i = 0, curr_length = INTEGER(lengths); i < nrun; i++, curr_length++) { x_vec_len += *curr_length; buf_len += *curr_length; if (window_len < *curr_length) buf_len -= *curr_length - window_len; } buf_values = NULL; buf_lengths = NULL; if (buf_len > 0) { buf_values = (int *) R_alloc((long) buf_len, sizeof(int)); buf_lengths = (int *) R_alloc((long) buf_len, sizeof(int)); memset(buf_lengths, 0, buf_len * sizeof(int)); stat = 0; stat_na = 0; buf_values_elt = buf_values; buf_lengths_elt = buf_lengths; prev_value = INTEGER(values); curr_value = INTEGER(values); prev_length = INTEGER(lengths); curr_length = INTEGER(lengths); prev_offset = INTEGER(lengths)[0]; curr_offset = INTEGER(lengths)[0]; prev_value_na = INTEGER(na_index); curr_value_na = INTEGER(na_index); for (i = 0; i < buf_len; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); /* calculate stat */ if (i == 0) { j = 0; ans_len = 1; while (j < window_len) { if (curr_offset == 0) { curr_value++; curr_value_na++; curr_length++; curr_offset = *curr_length; } int times = curr_offset < window_len - j ? curr_offset : window_len - j; stat += times * (*curr_value); stat_na += times * (*curr_value_na); curr_offset -= times; j += times; } } else { stat += (*curr_value - *prev_value); stat_na += (*curr_value_na - *prev_value_na); /* increment values and lengths based on stat */ if (narm | (stat_na == 0)) { if (stat != *buf_values_elt) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } else { if ((stat_na != 0) && (*buf_values_elt != NA_INTEGER)) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } } /* NA handling */ if (!narm && (stat_na != 0)) *buf_values_elt = NA_INTEGER; else *buf_values_elt = stat; /* determine length */ if (i == 0) { if (prev_value == curr_value) { /* NA handling */ if (!narm && (*curr_value_na == 1)) { if (prev_value_na == curr_value_na) *buf_lengths_elt += *curr_length - window_len + 1; else *buf_lengths_elt += *curr_length - window_len + 1; } else { *buf_lengths_elt += *curr_length - window_len + 1; } prev_offset = window_len; curr_offset = 0; } else { *buf_lengths_elt += 1; } } else { if ((prev_offset == 1) && (window_len < *curr_length) && ((prev_value + 1) == curr_value)) { /* moving through run lengths > window size */ *buf_lengths_elt += *curr_length - window_len + 1; prev_offset = window_len; curr_offset = 0; prev_value++; prev_value_na++; prev_length++; } else { /* NA handling */ if (!narm && (*curr_value_na == 1)) { if (prev_value_na == curr_value_na) *buf_lengths_elt += *curr_length - window_len + 1; else *buf_lengths_elt += 1; } else { *buf_lengths_elt += 1; } prev_offset--; curr_offset--; if (prev_offset == 0) { prev_value++; prev_value_na++; prev_length++; prev_offset = *prev_length; } } } if ((curr_offset == 0) && (i != buf_len - 1)) { curr_value++; curr_value_na++; curr_length++; curr_offset = *curr_length; } } } UNPROTECT(2); return _integer_Rle_constructor(buf_values, ans_len, buf_lengths, 0); } SEXP Rle_real_runsum(SEXP x, SEXP k, SEXP na_rm) { int i, j, nrun, window_len, buf_len, x_vec_len, ans_len; int prev_offset, curr_offset, m_offset; double stat; int *prev_length, *curr_length, *buf_lengths, *buf_lengths_elt; double *prev_value, *curr_value, *buf_values, *buf_values_elt; double *m_value; int *m_length; SEXP values, lengths; SEXP orig_values; const int narm = LOGICAL(na_rm)[0]; if (!IS_INTEGER(k) || LENGTH(k) != 1 || INTEGER(k)[0] == NA_INTEGER || INTEGER(k)[0] <= 0) error("'k' must be a positive integer"); if (narm) { /* set NA and NaN values to 0 */ orig_values = GET_SLOT(x, install("values")); values = PROTECT(Rf_allocVector(REALSXP, LENGTH(orig_values))); double *vlu = REAL(orig_values); for(i = 0; i < LENGTH(orig_values); i++) { if (ISNAN(vlu[i])) { REAL(values)[i] = 0; } else { REAL(values)[i] = REAL(orig_values)[i]; } } } else { values = GET_SLOT(x, install("values")); } lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); window_len = INTEGER(k)[0]; ans_len = 0; x_vec_len = 0; buf_len = - window_len + 1; for(i = 0, curr_length = INTEGER(lengths); i < nrun; i++, curr_length++) { x_vec_len += *curr_length; buf_len += *curr_length; if (window_len < *curr_length) buf_len -= *curr_length - window_len; } buf_values = NULL; buf_lengths = NULL; if (buf_len > 0) { buf_values = (double *) R_alloc((long) buf_len, sizeof(double)); buf_lengths = (int *) R_alloc((long) buf_len, sizeof(int)); memset(buf_lengths, 0, buf_len * sizeof(int)); stat = 0; buf_values_elt = buf_values; buf_lengths_elt = buf_lengths; prev_value = REAL(values); curr_value = REAL(values); prev_length = INTEGER(lengths); curr_length = INTEGER(lengths); prev_offset = INTEGER(lengths)[0]; curr_offset = INTEGER(lengths)[0]; for (i = 0; i < buf_len; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); /* calculate stat */ if (i == 0) { j = 0; stat = 0; ans_len = 1; while (j < window_len) { if (curr_offset == 0) { curr_value++; curr_length++; curr_offset = *curr_length; } int times = curr_offset < window_len - j ? curr_offset : window_len - j; stat += times * (*curr_value); curr_offset -= times; j += times; } } else { j = 0; stat = 0; m_offset = prev_offset - 1; m_value = prev_value; m_length = prev_length; while (j < window_len) { if (m_offset == 0) { m_value++; m_length++; m_offset = *m_length; } int times = m_offset < window_len - j ? m_offset : window_len - j; stat += times * (*m_value); m_offset -= times; j += times; } if (!R_FINITE(stat) && !R_FINITE(*buf_values_elt)) { if ((R_IsNA(stat) && !R_IsNA(*buf_values_elt)) || (!R_IsNA(stat) && R_IsNA(*buf_values_elt)) || (R_IsNaN(stat) && !R_IsNaN(*buf_values_elt)) || (!R_IsNaN(stat) && R_IsNaN(*buf_values_elt)) || ((stat == R_PosInf) && (*buf_values_elt != R_PosInf)) || ((stat != R_PosInf) && (*buf_values_elt == R_PosInf)) || ((stat == R_NegInf) && (*buf_values_elt != R_NegInf)) || ((stat != R_NegInf) && (*buf_values_elt == R_NegInf))) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } else { if (stat != *buf_values_elt) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } } *buf_values_elt = stat; /* determine length */ if (i == 0) { if (prev_value == curr_value) { *buf_lengths_elt += *curr_length - window_len + 1; prev_offset = window_len; curr_offset = 0; } else { *buf_lengths_elt += 1; } } else { if ((prev_offset == 1) && (window_len < *curr_length) && ((prev_value + 1) == curr_value)) { /* moving through run lengths > window size */ *buf_lengths_elt += *curr_length - window_len + 1; prev_offset = window_len; curr_offset = 0; prev_value++; prev_length++; } else { *buf_lengths_elt += 1; prev_offset--; curr_offset--; if (prev_offset == 0) { prev_value++; prev_length++; prev_offset = *prev_length; } } } if ((curr_offset == 0) && (i != buf_len - 1)) { curr_value++; curr_length++; curr_offset = *curr_length; } } } if (narm) UNPROTECT(1); return _numeric_Rle_constructor(buf_values, ans_len, buf_lengths, 0); } /* * --- .Call ENTRY POINT --- */ SEXP Rle_runsum(SEXP x, SEXP k, SEXP na_rm) { SEXP ans = R_NilValue; switch(TYPEOF(GET_SLOT(x, install("values")))) { case INTSXP: PROTECT(ans = Rle_integer_runsum(x, k, na_rm)); break; case REALSXP: PROTECT(ans = Rle_real_runsum(x, k, na_rm)); break; default: error("runsum only supported for integer and numeric Rle objects"); } UNPROTECT(1); return ans; } SEXP Rle_integer_runwtsum(SEXP x, SEXP k, SEXP wt, SEXP na_rm) { int i, j, nrun, window_len, buf_len, x_vec_len, ans_len; int start_offset, curr_offset; double stat; int stat_na; int *curr_value_na, *values_elt_na; int *lengths_elt, *curr_length, *buf_lengths, *buf_lengths_elt; int *values_elt, *curr_value; double *wt_elt, *buf_values, *buf_values_elt; SEXP values, lengths; SEXP orig_values, na_index; const int narm = LOGICAL(na_rm)[0]; if (!IS_INTEGER(k) || LENGTH(k) != 1 || INTEGER(k)[0] == NA_INTEGER || INTEGER(k)[0] <= 0) error("'k' must be a positive integer"); /* Set NA values to 0 * Create NA index : 1 = NA; 0 = not NA */ orig_values = GET_SLOT(x, install("values")); values = PROTECT(Rf_allocVector(INTSXP, LENGTH(orig_values))); na_index = PROTECT(Rf_allocVector(INTSXP, LENGTH(orig_values))); int *vlu = INTEGER(orig_values); for(i = 0; i < LENGTH(orig_values); i++) { if (vlu[i] == NA_INTEGER) { INTEGER(na_index)[i] = 1; INTEGER(values)[i] = 0; } else { INTEGER(na_index)[i] = 0; INTEGER(values)[i] = INTEGER(orig_values)[i]; } } lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); window_len = INTEGER(k)[0]; if (!IS_NUMERIC(wt) || LENGTH(wt) != window_len) error("'wt' must be a numeric vector of length 'k'"); ans_len = 0; x_vec_len = 0; buf_len = - window_len + 1; for(i = 0, lengths_elt = INTEGER(lengths); i < nrun; i++, lengths_elt++) { x_vec_len += *lengths_elt; buf_len += *lengths_elt; if (window_len < *lengths_elt) buf_len -= *lengths_elt - window_len; } buf_values = NULL; buf_lengths = NULL; if (buf_len > 0) { buf_values = (double *) R_alloc((long) buf_len, sizeof(double)); buf_lengths = (int *) R_alloc((long) buf_len, sizeof(int)); memset(buf_lengths, 0, buf_len * sizeof(int)); buf_values_elt = buf_values; buf_lengths_elt = buf_lengths; values_elt = INTEGER(values); values_elt_na = INTEGER(na_index); lengths_elt = INTEGER(lengths); start_offset = INTEGER(lengths)[0]; for (i = 0; i < buf_len; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); /* calculate stat */ stat = 0; stat_na = 0; curr_value = values_elt; curr_value_na = values_elt_na; curr_length = lengths_elt; curr_offset = start_offset; for (j = 0, wt_elt = REAL(wt); j < window_len; j++, wt_elt++) { stat += (*wt_elt) * (*curr_value); stat_na += *curr_value_na; curr_offset--; if (curr_offset == 0) { curr_value++; curr_value_na++; curr_length++; curr_offset = *curr_length; } } /* assign value */ if (ans_len == 0) { ans_len = 1; } else { /* increment values and lengths based on stat */ if (narm | (stat_na == 0)) { if (stat != *buf_values_elt) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } else { if ((stat_na != 0) && (*buf_values_elt != NA_REAL)) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } } /* NA handling */ if (!narm && (stat_na != 0)) *buf_values_elt = NA_REAL; else *buf_values_elt = stat; /* determine length */ if (window_len < start_offset) { *buf_lengths_elt += *lengths_elt - window_len + 1; start_offset = window_len - 1; } else { *buf_lengths_elt += 1; start_offset--; } /* move pointers if end of run */ if (start_offset == 0) { values_elt++; values_elt_na++; lengths_elt++; start_offset = *lengths_elt; } } } UNPROTECT(2); return _numeric_Rle_constructor(buf_values, ans_len, buf_lengths, 0); } SEXP Rle_real_runwtsum(SEXP x, SEXP k, SEXP wt, SEXP na_rm) { int i, j, nrun, window_len, buf_len, x_vec_len, ans_len; int start_offset, curr_offset; double stat; int *lengths_elt, *curr_length, *buf_lengths, *buf_lengths_elt; double *values_elt, *curr_value; double *wt_elt, *buf_values, *buf_values_elt; SEXP values, lengths; SEXP orig_values; const int narm = LOGICAL(na_rm)[0]; if (!IS_INTEGER(k) || LENGTH(k) != 1 || INTEGER(k)[0] == NA_INTEGER || INTEGER(k)[0] <= 0) error("'k' must be a positive integer"); window_len = INTEGER(k)[0]; if (!IS_NUMERIC(wt) || LENGTH(wt) != window_len) error("'wt' must be a numeric vector of length 'k'"); if (narm) { /* set NA and NaN values to 0 */ orig_values = GET_SLOT(x, install("values")); values = PROTECT(Rf_allocVector(REALSXP, LENGTH(orig_values))); double *vlu = REAL(orig_values); for(i = 0; i < LENGTH(orig_values); i++) { if (ISNAN(vlu[i])) REAL(values)[i] = 0; else REAL(values)[i] = REAL(orig_values)[i]; } } else { values = GET_SLOT(x, install("values")); } lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); ans_len = 0; x_vec_len = 0; buf_len = - window_len + 1; for(i = 0, lengths_elt = INTEGER(lengths); i < nrun; i++, lengths_elt++) { x_vec_len += *lengths_elt; buf_len += *lengths_elt; if (window_len < *lengths_elt) buf_len -= *lengths_elt - window_len; } buf_values = NULL; buf_lengths = NULL; if (buf_len > 0) { buf_values = (double *) R_alloc((long) buf_len, sizeof(double)); buf_lengths = (int *) R_alloc((long) buf_len, sizeof(int)); memset(buf_lengths, 0, buf_len * sizeof(int)); buf_values_elt = buf_values; buf_lengths_elt = buf_lengths; values_elt = REAL(values); lengths_elt = INTEGER(lengths); start_offset = INTEGER(lengths)[0]; for (i = 0; i < buf_len; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); /* calculate stat */ stat = 0; curr_value = values_elt; curr_length = lengths_elt; curr_offset = start_offset; for (j = 0, wt_elt = REAL(wt); j < window_len; j++, wt_elt++) { stat += (*wt_elt) * (*curr_value); curr_offset--; if (curr_offset == 0) { curr_value++; curr_length++; curr_offset = *curr_length; } } /* assign value */ if (ans_len == 0) { ans_len = 1; } else if (!R_FINITE(stat) && !R_FINITE(*buf_values_elt)) { if ((R_IsNA(stat) && !R_IsNA(*buf_values_elt)) || (!R_IsNA(stat) && R_IsNA(*buf_values_elt)) || (R_IsNaN(stat) && !R_IsNaN(*buf_values_elt)) || (!R_IsNaN(stat) && R_IsNaN(*buf_values_elt)) || ((stat == R_PosInf) && (*buf_values_elt != R_PosInf)) || ((stat != R_PosInf) && (*buf_values_elt == R_PosInf)) || ((stat == R_NegInf) && (*buf_values_elt != R_NegInf)) || ((stat != R_NegInf) && (*buf_values_elt == R_NegInf))) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } else { if (stat != *buf_values_elt) { ans_len++; buf_values_elt++; buf_lengths_elt++; } } *buf_values_elt = stat; /* determine length */ if (window_len < start_offset) { *buf_lengths_elt += *lengths_elt - window_len + 1; start_offset = window_len - 1; } else { *buf_lengths_elt += 1; start_offset--; } /* move pointers if end of run */ if (start_offset == 0) { values_elt++; lengths_elt++; start_offset = *lengths_elt; } } } if (narm) UNPROTECT(1); return _numeric_Rle_constructor(buf_values, ans_len, buf_lengths, 0); } /* * --- .Call ENTRY POINT --- */ SEXP Rle_runwtsum(SEXP x, SEXP k, SEXP wt, SEXP na_rm) { SEXP ans = R_NilValue; switch(TYPEOF(GET_SLOT(x, install("values")))) { case INTSXP: PROTECT(ans = Rle_integer_runwtsum(x, k, wt, na_rm)); break; case REALSXP: PROTECT(ans = Rle_real_runwtsum(x, k, wt, na_rm)); break; default: error("runwtsum only supported for integer and numeric Rle objects"); } UNPROTECT(1); return ans; } SEXP Rle_integer_runq(SEXP x, SEXP k, SEXP which, SEXP na_rm) { int i, j, nrun, window_len, buf_len, x_vec_len, ans_len; int start_offset, curr_offset; int q_index; int stat, count_na, window_len_na; int *lengths_elt, *curr_length, *buf_lengths, *buf_lengths_elt; int *window, *values_elt, *curr_value, *buf_values, *buf_values_elt; SEXP values, lengths; const int narm = LOGICAL(na_rm)[0]; const int constw = INTEGER(which)[0]; const int constk = INTEGER(k)[0]; if (!IS_INTEGER(k) || LENGTH(k) != 1 || INTEGER(k)[0] == NA_INTEGER || INTEGER(k)[0] <= 0) error("'k' must be a positive integer"); if (!IS_INTEGER(which) || LENGTH(which) != 1 || INTEGER(which)[0] == NA_INTEGER || INTEGER(which)[0] < 1 || INTEGER(which)[0] > INTEGER(k)[0]) error("'i' must be an integer in [0, k]"); values = GET_SLOT(x, install("values")); lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); window_len = INTEGER(k)[0]; ans_len = 0; x_vec_len = 0; buf_len = - window_len + 1; for(i = 0, lengths_elt = INTEGER(lengths); i < nrun; i++, lengths_elt++) { x_vec_len += *lengths_elt; buf_len += *lengths_elt; if (window_len < *lengths_elt) buf_len -= *lengths_elt - window_len; } buf_values = NULL; buf_lengths = NULL; if (buf_len > 0) { window = (int *) R_alloc(window_len, sizeof(int)); buf_values = (int *) R_alloc((long) buf_len, sizeof(int)); buf_lengths = (int *) R_alloc((long) buf_len, sizeof(int)); memset(buf_lengths, 0, buf_len * sizeof(int)); buf_values_elt = buf_values; buf_lengths_elt = buf_lengths; values_elt = INTEGER(values); lengths_elt = INTEGER(lengths); start_offset = INTEGER(lengths)[0]; for (i = 0; i < buf_len; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); /* create window */ count_na = 0; curr_value = values_elt; curr_length = lengths_elt; curr_offset = start_offset; window_len_na = INTEGER(k)[0]; q_index = INTEGER(which)[0] - 1; for(j = 0; j < window_len; j++) { if (*curr_value == NA_INTEGER) count_na += 1; window[j] = *curr_value; curr_offset--; if (curr_offset == 0) { curr_value++; curr_length++; curr_offset = *curr_length; } } /* calculate stat */ if (!narm && count_na > 0) { stat = NA_INTEGER; } else { /* NA handling */ if (count_na != 0) { window_len_na = window_len - count_na; q_index = roundingScale(window_len_na, constw, constk); if (q_index > 0) q_index = q_index - 1; } /* If window shrank to 0, return NA. */ if (window_len_na == 0) { stat = NA_INTEGER; } else { /* NA's sorted last in iPsort */ iPsort(window, window_len, q_index); stat = window[q_index]; } } if (ans_len == 0) { ans_len = 1; } else if (stat != *buf_values_elt) { ans_len++; buf_values_elt++; buf_lengths_elt++; } *buf_values_elt = stat; /* determine length */ if (window_len < start_offset) { *buf_lengths_elt += *lengths_elt - window_len + 1; start_offset = window_len - 1; } else { *buf_lengths_elt += 1; start_offset--; } /* move pointers if end of run */ if (start_offset == 0) { values_elt++; lengths_elt++; start_offset = *lengths_elt; } } } return _integer_Rle_constructor(buf_values, ans_len, buf_lengths, 0); } SEXP Rle_real_runq(SEXP x, SEXP k, SEXP which, SEXP na_rm) { int i, j, nrun, window_len, buf_len, x_vec_len, ans_len; int start_offset, curr_offset; int q_index; double stat; int count_na, window_len_na; int *lengths_elt, *curr_length, *buf_lengths, *buf_lengths_elt; double *window, *values_elt, *curr_value, *buf_values, *buf_values_elt; SEXP values, lengths; const int narm = LOGICAL(na_rm)[0]; const int constw = INTEGER(which)[0]; const int constk = INTEGER(k)[0]; if (!IS_INTEGER(k) || LENGTH(k) != 1 || INTEGER(k)[0] == NA_INTEGER || INTEGER(k)[0] <= 0) error("'k' must be a positive integer"); if (!IS_INTEGER(which) || LENGTH(which) != 1 || INTEGER(which)[0] == NA_INTEGER || INTEGER(which)[0] < 1 || INTEGER(which)[0] > INTEGER(k)[0]) error("'which' must be an integer in [0, k]"); values = GET_SLOT(x, install("values")); lengths = GET_SLOT(x, install("lengths")); nrun = LENGTH(lengths); window_len = INTEGER(k)[0]; ans_len = 0; x_vec_len = 0; buf_len = - window_len + 1; for(i = 0, lengths_elt = INTEGER(lengths); i < nrun; i++, lengths_elt++) { x_vec_len += *lengths_elt; buf_len += *lengths_elt; if (window_len < *lengths_elt) buf_len -= *lengths_elt - window_len; } buf_values = NULL; buf_lengths = NULL; if (buf_len > 0) { window = (double *) R_alloc(window_len, sizeof(double)); buf_values = (double *) R_alloc((long) buf_len, sizeof(double)); buf_lengths = (int *) R_alloc((long) buf_len, sizeof(int)); memset(buf_lengths, 0, buf_len * sizeof(int)); buf_values_elt = buf_values; buf_lengths_elt = buf_lengths; values_elt = REAL(values); lengths_elt = INTEGER(lengths); start_offset = INTEGER(lengths)[0]; for (i = 0; i < buf_len; i++) { if (i % 100000 == 99999) R_CheckUserInterrupt(); /* create window */ count_na = 0; curr_value = values_elt; curr_length = lengths_elt; curr_offset = start_offset; window_len_na = INTEGER(k)[0]; q_index = INTEGER(which)[0] - 1; for(j = 0; j < window_len; j++) { if (ISNAN(*curr_value)) count_na += 1; window[j] = *curr_value; curr_offset--; if (curr_offset == 0) { curr_value++; curr_length++; curr_offset = *curr_length; } } /* calculate stat */ if (!narm && count_na > 0) { stat = NA_REAL; } else { /* NA handling */ if (count_na != 0) window_len_na = window_len - count_na; q_index = roundingScale(window_len_na, constw, constk); if (q_index >0) q_index = q_index - 1; /* If window shrank to 0, return NA. */ if (window_len_na == 0) { stat = NA_REAL; } else { /* NA's sorted last in rPsort */ rPsort(window, window_len, q_index); stat = window[q_index]; } } if (ans_len == 0) { ans_len = 1; } else if (stat != *buf_values_elt) { ans_len++; buf_values_elt++; buf_lengths_elt++; } *buf_values_elt = stat; /* determine length */ if (window_len < start_offset) { *buf_lengths_elt += *lengths_elt - window_len + 1; start_offset = window_len - 1; } else { *buf_lengths_elt += 1; start_offset--; } /* move pointers if end of run */ if (start_offset == 0) { values_elt++; lengths_elt++; start_offset = *lengths_elt; } } } return _numeric_Rle_constructor(buf_values, ans_len, buf_lengths, 0); } /* * --- .Call ENTRY POINT --- */ SEXP Rle_runq(SEXP x, SEXP k, SEXP which, SEXP na_rm) { SEXP ans = R_NilValue; switch(TYPEOF(GET_SLOT(x, install("values")))) { case INTSXP: PROTECT(ans = Rle_integer_runq(x, k, which, na_rm)); break; case REALSXP: PROTECT(ans = Rle_real_runq(x, k, which, na_rm)); break; default: error("runq only supported for integer and numeric Rle objects"); } UNPROTECT(1); return ans; } IRanges/src/SEXP_utils.c0000644000126300012640000000222712234075662016431 0ustar00biocbuildphs_compbio#include "IRanges.h" const char *_get_classname(SEXP x) { return CHAR(STRING_ELT(GET_CLASS(x), 0)); } static int get_NROW(SEXP x) { SEXP x_dim, x_rownames; if (x == R_NilValue) return 0; if (!IS_VECTOR(x)) error("get_NROW() defined only on a vector (or NULL)"); /* A data.frame doesn't have a "dim" attribute but the dimensions can be inferred from the "names" and "row.names" attributes. */ x_rownames = getAttrib(x, R_RowNamesSymbol); if (x_rownames != R_NilValue) return LENGTH(x_rownames); x_dim = GET_DIM(x); if (x_dim == R_NilValue || LENGTH(x_dim) == 0) return LENGTH(x); return INTEGER(x_dim)[0]; } /* * --- .Call ENTRY POINT --- * A C implementation of 'sapply(x, NROW)' that works only on a list of * vectors (or NULLs). */ SEXP sapply_NROW(SEXP x) { SEXP ans, x_elt; int x_len, i, *ans_elt; x_len = LENGTH(x); PROTECT(ans = NEW_INTEGER(x_len)); for (i = 0, ans_elt = INTEGER(ans); i < x_len; i++, ans_elt++) { x_elt = VECTOR_ELT(x, i); if (x_elt != R_NilValue && !IS_VECTOR(x_elt)) { UNPROTECT(1); error("element %d not a vector (or NULL)", i + 1); } *ans_elt = get_NROW(x_elt); } UNPROTECT(1); return ans; } IRanges/src/SimpleList_class.c0000644000126300012640000000123712234075662017704 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of SimpleList objects ****************************************************************************/ #include "IRanges.h" static SEXP listData_symbol = NULL; static void set_SimpleList_listData(SEXP x, SEXP value) { INIT_STATIC_SYMBOL(listData) SET_SLOT(x, listData_symbol, value); return; } SEXP _new_SimpleList(const char *classname, SEXP listData) { SEXP classdef, ans; PROTECT(classdef = MAKE_CLASS(classname)); PROTECT(ans = NEW_OBJECT(classdef)); set_SimpleList_listData(ans, listData); UNPROTECT(2); return ans; } IRanges/src/SimpleRangesList_class.c0000644000126300012640000000432312234075662021043 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of SimpleRangesList objects * ****************************************************************************/ #include "IRanges.h" #include #define R_INT_MIN (1+INT_MIN) /* * --- .Call ENTRY POINT --- */ SEXP SimpleIRangesList_isNormal(SEXP x) { SEXP list_ir, ans, ans_names; cachedIRanges cached_ir; int x_length, i; list_ir = GET_SLOT(x, install("listData")); x_length = LENGTH(list_ir); PROTECT(ans = NEW_LOGICAL(x_length)); for (i = 0; i < x_length; i++) { cached_ir = _cache_IRanges(VECTOR_ELT(list_ir, i)); LOGICAL(ans)[i] = _is_normal_cachedIRanges(&cached_ir); } PROTECT(ans_names = duplicate(GET_NAMES(list_ir))); SET_NAMES(ans, ans_names); UNPROTECT(2); return ans; } /* * --- .Call ENTRY POINT --- */ SEXP SimpleNormalIRangesList_min(SEXP x) { SEXP list_ir, ans, ans_names; cachedIRanges cached_ir; int x_length, ir_length, i; int *ans_elt; list_ir = GET_SLOT(x, install("listData")); x_length = LENGTH(list_ir); PROTECT(ans = NEW_INTEGER(x_length)); for (i = 0, ans_elt = INTEGER(ans); i < x_length; i++, ans_elt++) { cached_ir = _cache_IRanges(VECTOR_ELT(list_ir, i)); ir_length = _get_cachedIRanges_length(&cached_ir); if (ir_length == 0) { *ans_elt = INT_MAX; } else { *ans_elt = _get_cachedIRanges_elt_start(&cached_ir, 0); } } PROTECT(ans_names = duplicate(GET_NAMES(list_ir))); SET_NAMES(ans, ans_names); UNPROTECT(2); return ans; } /* * --- .Call ENTRY POINT --- */ SEXP SimpleNormalIRangesList_max(SEXP x) { SEXP list_ir, ans, ans_names; cachedIRanges cached_ir; int x_length, ir_length, i; int *ans_elt; list_ir = GET_SLOT(x, install("listData")); x_length = LENGTH(list_ir); PROTECT(ans = NEW_INTEGER(x_length)); for (i = 0, ans_elt = INTEGER(ans); i < x_length; i++, ans_elt++) { cached_ir = _cache_IRanges(VECTOR_ELT(list_ir, i)); ir_length = _get_cachedIRanges_length(&cached_ir); if (ir_length == 0) { *ans_elt = R_INT_MIN; } else { *ans_elt = _get_cachedIRanges_elt_end(&cached_ir, ir_length - 1); } } PROTECT(ans_names = duplicate(GET_NAMES(list_ir))); SET_NAMES(ans, ans_names); UNPROTECT(2); return ans; } IRanges/src/Vector_class.c0000644000126300012640000001723712234075662017070 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level manipulation of Vector and List objects * * Authors: Patrick Aboyoun, Michael Lawrence, Herve Pages * ****************************************************************************/ #include "IRanges.h" /**************************************************************************** * C-level slot getters. */ static SEXP elementType_symbol = NULL; const char *_get_List_elementType(SEXP x) { INIT_STATIC_SYMBOL(elementType) return CHAR(STRING_ELT(GET_SLOT(x, elementType_symbol), 0)); } /**************************************************************************** * C-level slot setters. */ void _set_List_elementType(SEXP x, const char *type) { SEXP value; INIT_STATIC_SYMBOL(elementType) PROTECT(value = mkString(type)); SET_SLOT(x, elementType_symbol, value); UNPROTECT(1); return; } /**************************************************************************** * Other stuff. */ /* * memcmp()-based comparison of 2 vectors of the same type. * NOTE: Doesn't support STRSXP and VECSXP. */ int _vector_memcmp(SEXP x1, int x1_offset, SEXP x2, int x2_offset, int nelt) { const void *s1 = NULL, *s2 = NULL; /* gcc -Wall */ size_t eltsize = 0; /* gcc -Wall */ if (x1_offset < 0 || x1_offset + nelt > LENGTH(x1) || x2_offset < 0 || x2_offset + nelt > LENGTH(x2)) error("IRanges internal error in _vector_memcmp(): " "elements to compare are out of vector bounds"); switch (TYPEOF(x1)) { case RAWSXP: s1 = (const void *) (RAW(x1) + x1_offset); s2 = (const void *) (RAW(x2) + x2_offset); eltsize = sizeof(Rbyte); break; case LGLSXP: case INTSXP: s1 = (const void *) (INTEGER(x1) + x1_offset); s2 = (const void *) (INTEGER(x2) + x2_offset); eltsize = sizeof(int); break; case REALSXP: s1 = (const void *) (REAL(x1) + x1_offset); s2 = (const void *) (REAL(x2) + x2_offset); eltsize = sizeof(double); break; case CPLXSXP: s1 = (const void *) (COMPLEX(x1) + x1_offset); s2 = (const void *) (COMPLEX(x2) + x2_offset); eltsize = sizeof(Rcomplex); break; default: error("IRanges internal error in _vector_memcmp(): " "%s type not supported", CHAR(type2str(TYPEOF(x1)))); } return s1 == s2 ? 0 : memcmp(s1, s2, nelt * eltsize); } /* * memcpy()-based copy of data from a vector to a vector of the same type. */ void _vector_memcpy(SEXP out, int out_offset, SEXP in, int in_offset, int nelt) { void *dest; const void *src; size_t eltsize; int i; SEXP in_elt; // out_elt; if (out_offset < 0 || out_offset + nelt > LENGTH(out) || in_offset < 0 || in_offset + nelt > LENGTH(in)) error("subscripts out of bounds"); switch (TYPEOF(out)) { case RAWSXP: dest = (void *) (RAW(out) + out_offset); src = (const void *) (RAW(in) + in_offset); eltsize = sizeof(Rbyte); break; case LGLSXP: dest = (void *) (LOGICAL(out) + out_offset); src = (const void *) (LOGICAL(in) + in_offset); eltsize = sizeof(int); break; case INTSXP: dest = (void *) (INTEGER(out) + out_offset); src = (const void *) (INTEGER(in) + in_offset); eltsize = sizeof(int); break; case REALSXP: dest = (void *) (REAL(out) + out_offset); src = (const void *) (REAL(in) + in_offset); eltsize = sizeof(double); break; case CPLXSXP: dest = (void *) (COMPLEX(out) + out_offset); src = (const void *) (COMPLEX(in) + in_offset); eltsize = sizeof(Rcomplex); break; case STRSXP: for (i = 0; i < nelt; i++) { in_elt = STRING_ELT(in, in_offset + i); SET_STRING_ELT(out, out_offset + i, in_elt); //PROTECT(out_elt = duplicate(in_elt)); //SET_STRING_ELT(out, out_offset + i, out_elt); //UNPROTECT(1); } return; case VECSXP: for (i = 0; i < nelt; i++) { in_elt = VECTOR_ELT(in, in_offset + i); SET_VECTOR_ELT(out, out_offset + i, in_elt); //PROTECT(out_elt = duplicate(in_elt)); //SET_VECTOR_ELT(out, out_offset + i, out_elt); //UNPROTECT(1); } return; default: error("IRanges internal error in _vector_memcpy(): " "%s type not supported", CHAR(type2str(TYPEOF(out)))); return; // gcc -Wall } memcpy(dest, src, nelt * eltsize); return; } static void vector_copy_ranges(SEXP out, SEXP in, const int *start, const int *width, int nranges) { int i, out_offset, in_offset, nelt; out_offset = 0; for (i = 0; i < nranges; i++) { in_offset = start[i] - 1; nelt = width[i]; if (nelt < 0) error("negative widths are not allowed"); _vector_memcpy(out, out_offset, in, in_offset, nelt); out_offset += nelt; } return; } /* --- .Call ENTRY POINT --- * 'start' and 'width': integer vectors of the same length. They are assumed * to come from a valid Ranges object i.e. no NAs and values in 'width' must * be >= 0. */ SEXP vector_subsetByRanges(SEXP x, SEXP start, SEXP width) { int x_len, nranges, ans_len, i, offset_i, width_i, end_i; const int *start_p, *width_p; SEXP ans, x_names, ans_names; x_len = LENGTH(x); nranges = _check_integer_pairs(start, width, &start_p, &width_p, "start", "width"); for (i = ans_len = 0; i < nranges; i++) { width_i = width_p[i]; if (width_i == NA_INTEGER || width_i < 0) error("'width' cannot contain NAs or negative values"); offset_i = start_p[i] - 1; end_i = offset_i + width_i; if (offset_i < 0 || end_i > x_len) error("some ranges are out of bounds"); ans_len += width_i; } PROTECT(ans = allocVector(TYPEOF(x), ans_len)); vector_copy_ranges(ans, x, start_p, width_p, nranges); x_names = GET_NAMES(x); if (x_names != R_NilValue) { PROTECT(ans_names = NEW_CHARACTER(ans_len)); vector_copy_ranges(ans_names, x_names, start_p, width_p, nranges); SET_NAMES(ans, ans_names); UNPROTECT(1); } UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- * TODO: Remove this at some point (use vector_subsetByRanges instead). */ SEXP vector_seqselect(SEXP x, SEXP start, SEXP width) { int ans_offset, i, j, s, w; SEXP ans, ans_names; if (!IS_INTEGER(start)) error("'start' must be an integer vector"); if (!IS_INTEGER(width)) error("'width' must be an integer vector"); if (LENGTH(start) != LENGTH(width)) error("length of 'start' must equal length of 'width'"); for (i = ans_offset = 0; i < LENGTH(start); i++, ans_offset += w) { s = INTEGER(start)[i]; w = INTEGER(width)[i]; if (s == NA_INTEGER || s < 1) error("each element in 'start' must be a positive integer"); if (w == NA_INTEGER || w < 0) error("each element in 'width' must be a non-negative integer"); if (LENGTH(x) < s + w - 1) error("some ranges are out of bounds"); } PROTECT(ans = allocVector(TYPEOF(x), ans_offset)); for (i = ans_offset = 0; i < LENGTH(start); i++, ans_offset += w) { s = INTEGER(start)[i] - 1; w = INTEGER(width)[i]; switch (TYPEOF(x)) { case LGLSXP: case INTSXP: memcpy(INTEGER(ans) + ans_offset, INTEGER(x) + s, w * sizeof(int)); break; case REALSXP: memcpy(REAL(ans) + ans_offset, REAL(x) + s, w * sizeof(double)); break; case CPLXSXP: memcpy(COMPLEX(ans) + ans_offset, COMPLEX(x) + s, w * sizeof(Rcomplex)); break; case STRSXP: for (j = 0; j < w; j++) SET_STRING_ELT(ans, ans_offset + j, STRING_ELT(x, s + j)); break; case VECSXP: for (j = 0; j < w; j++) SET_VECTOR_ELT(ans, ans_offset + j, VECTOR_ELT(x, s + j)); break; case RAWSXP: memcpy(RAW(ans) + ans_offset, RAW(x) + s, w * sizeof(char)); break; default: error("IRanges internal error in vector_seqselect(): " "%s type not supported", CHAR(type2str(TYPEOF(x)))); } } ans_names = GET_NAMES(x); if (ans_names != R_NilValue) SET_NAMES(ans, vector_seqselect(ans_names, start, width)); UNPROTECT(1); return ans; } IRanges/src/anyMissing.c0000644000126300012640000000403412234075662016551 0ustar00biocbuildphs_compbio/*************************************************************************** Public methods: anyMissing(SEXP x) TO DO: Support list():s too. Copyright Henrik Bengtsson, 2007 **************************************************************************/ /* Include R packages */ #include SEXP anyMissing(SEXP x) { SEXP ans; int n, ii; PROTECT(ans = allocVector(LGLSXP, 1)); LOGICAL(ans)[0] = 0; n = length(x); /* anyMissing() on zero-length objects should always return FALSE, just like any(double(0)). */ if (n == 0) { UNPROTECT(1); return(ans); } switch (TYPEOF(x)) { case REALSXP: for (ii=0; ii < n; ii++) { if ISNAN(REAL(x)[ii]) { LOGICAL(ans)[0] = 1; break; } } break; case INTSXP: for (ii=0; ii < n; ii++) { if (INTEGER(x)[ii] == NA_INTEGER) { LOGICAL(ans)[0] = 1; break; } } break; case LGLSXP: for (ii=0; ii < n; ii++) { if (LOGICAL(x)[ii] == NA_LOGICAL) { LOGICAL(ans)[0] = 1; break; } } break; case CPLXSXP: for (ii=0; ii < n; ii++) { if (ISNAN(COMPLEX(x)[ii].r) || ISNAN(COMPLEX(x)[ii].i)) { LOGICAL(ans)[0] = 1; break; } } break; case STRSXP: for (ii=0; ii < n; ii++) { if (STRING_ELT(x, ii) == NA_STRING) { LOGICAL(ans)[0] = 1; break; } } break; case RAWSXP: /* no such thing as a raw NA */ break; default: break; /* warningcall(call, _("%s() applied to non-vector of type '%s'"), "anyMissing", type2char(TYPEOF(x))); */ } /* switch() */ UNPROTECT(1); /* ans */ return(ans); } // anyMissing() /*************************************************************************** HISTORY: 2007-08-14 [HB] o Created using do_isna() in src/main/coerce.c as a template. **************************************************************************/ IRanges/src/common.c0000644000126300012640000012740612234075662015731 0ustar00biocbuildphs_compbio/* Commonly used routines in a wide range of applications. * Strings, singly-linked lists, and a little file i/o. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #include "common.h" #include "errabort.h" #ifdef NOT_NEEDED_UCSC_STUFF #include "portable.h" #endif static char const rcsid[] = "$Id: common.c,v 1.117 2008/05/31 07:39:20 galt Exp $"; void *cloneMem(void *pt, size_t size) /* Allocate a new buffer of given size, and copy pt to it. */ { void *newPt = needLargeMem(size); memcpy(newPt, pt, size); return newPt; } static char *cloneStringZExt(char *s, int size, int copySize) /* Make a zero terminated copy of string in memory */ { char *d = needMem(copySize+1); copySize = min(size,copySize); memcpy(d, s, copySize); d[copySize] = 0; return d; } char *cloneStringZ(char *s, int size) /* Make a zero terminated copy of string in memory */ { return cloneStringZExt(s, strlen(s), size); } char *cloneString(char *s) /* Make copy of string in dynamic memory */ { int size = 0; if (s == NULL) return NULL; size = strlen(s); return cloneStringZExt(s, size, size); } char *cloneLongString(char *s) /* Make clone of long string. */ { size_t size = strlen(s); return cloneMem(s, size+1); } /* fill a specified area of memory with zeroes */ void zeroBytes(void *vpt, int count) { char *pt = (char*)vpt; while (--count>=0) *pt++=0; } /* Reverse the order of the bytes. */ void reverseBytes(char *bytes, long length) { long halfLen = (length>>1); char *end = bytes+length; char c; while (--halfLen >= 0) { c = *bytes; *bytes++ = *--end; *end = c; } } void reverseInts(int *a, int length) /* Reverse the order of the integer array. */ { int halfLen = (length>>1); int *end = a+length; int c; while (--halfLen >= 0) { c = *a; *a++ = *--end; *end = c; } } void reverseUnsigned(unsigned *a, int length) /* Reverse the order of the unsigned array. */ { int halfLen = (length>>1); unsigned *end = a+length; unsigned c; while (--halfLen >= 0) { c = *a; *a++ = *--end; *end = c; } } void reverseDoubles(double *a, int length) /* Reverse the order of the double array. */ { int halfLen = (length>>1); double *end = a+length; double c; while (--halfLen >= 0) { c = *a; *a++ = *--end; *end = c; } } void reverseStrings(char **a, int length) /* Reverse the order of the char* array. */ { int halfLen = (length>>1); char **end = a+length; char *c; while (--halfLen >= 0) { c = *a; *a++ = *--end; *end = c; } } /* Swap buffers a and b. */ void swapBytes(char *a, char *b, int length) { char c; int i; for (i=0; inext; } return len; } void *slElementFromIx(void *list, int ix) /* Return the ix'th element in list. Returns NULL * if no such element. */ { struct slList *pt = (struct slList *)list; int i; for (i=0;inext; } return pt; } int slIxFromElement(void *list, void *el) /* Return index of el in list. Returns -1 if not on list. */ { struct slList *pt; int ix = 0; for (pt = list, ix=0; pt != NULL; pt = pt->next, ++ix) if (el == (void*)pt) return ix; return -1; } void *slLastEl(void *list) /* Returns last element in list or NULL if none. */ { struct slList *next, *el; if ((el = list) == NULL) return NULL; while ((next = el->next) != NULL) el = next; return el; } /* Add new node to tail of list. * Usage: * slAddTail(&list, node); * where list and nodes are both pointers to structure * that begin with a next pointer. */ void slAddTail(void *listPt, void *node) { struct slList **ppt = (struct slList **)listPt; struct slList *n = (struct slList *)node; while (*ppt != NULL) { ppt = &((*ppt)->next); } n->next = NULL; *ppt = n; } /* Add new node to start of list. * Usage: * slAddHead(&list, node); * where list and nodes are both pointers to structure * that begin with a next pointer. */ void slSafeAddHead(void *listPt, void *node) { struct slList **ppt = (struct slList **)listPt; struct slList *n = (struct slList *)node; n->next = *ppt; *ppt = n; } void *slPopHead(void *vListPt) /* Return head of list and remove it from list. (Fast) */ { struct slList **listPt = (struct slList **)vListPt; struct slList *el = *listPt; if (el != NULL) { *listPt = el->next; el->next = NULL; } return el; } void *slPopTail(void *vListPt) /* Return tail of list and remove it from list. (Not so fast) */ { struct slList **listPt = (struct slList **)vListPt; struct slList *el = *listPt; if (el != NULL) { for (;;) { if (el->next == NULL) { *listPt = NULL; break; } listPt = &el->next; el = el->next; } } return el; } void *slCat(void *va, void *vb) /* Return concatenation of lists a and b. * Example Usage: * struct slName *a = getNames("a"); * struct slName *b = getNames("b"); * struct slName *ab = slCat(a,b) */ { struct slList *a = va; struct slList *b = vb; struct slList *end; if (a == NULL) return b; for (end = a; end->next != NULL; end = end->next) ; end->next = b; return a; } void slReverse(void *listPt) /* Reverse order of a list. * Usage: * slReverse(&list); */ { struct slList **ppt = (struct slList **)listPt; struct slList *newList = NULL; struct slList *el, *next; next = *ppt; while (next != NULL) { el = next; next = el->next; el->next = newList; newList = el; } *ppt = newList; } void slFreeList(void *listPt) /* Free list */ { struct slList **ppt = (struct slList**)listPt; struct slList *next = *ppt; struct slList *el; while (next != NULL) { el = next; next = el->next; freeMem((char*)el); } *ppt = NULL; } void slSort(void *pList, int (*compare )(const void *elem1, const void *elem2)) /* Sort a singly linked list with Qsort and a temporary array. */ { struct slList **pL = (struct slList **)pList; struct slList *list = *pL; int count; count = slCount(list); if (count > 1) { struct slList *el; struct slList **array; int i; array = needLargeMem(count * sizeof(*array)); for (el = list, i=0; el != NULL; el = el->next, i++) array[i] = el; qsort(array, count, sizeof(array[0]), compare); list = NULL; for (i=0; inext = list; list = array[i]; } freeMem(array); slReverse(&list); *pL = list; } } void slUniqify(void *pList, int (*compare )(const void *elem1, const void *elem2), void (*free)()) /* Return sorted list with duplicates removed. * Compare should be same type of function as slSort's compare (taking * pointers to pointers to elements. Free should take a simple * pointer to dispose of duplicate element, and can be NULL. */ { struct slList **pSlList = (struct slList **)pList; struct slList *oldList = *pSlList; struct slList *newList = NULL, *el; slSort(&oldList, compare); while ((el = slPopHead(&oldList)) != NULL) { if ((newList == NULL) || (compare(&newList, &el) != 0)) slAddHead(&newList, el); else if (free != NULL) free(el); } slReverse(&newList); *pSlList = newList; } boolean slRemoveEl(void *vpList, void *vToRemove) /* Remove element from doubly linked list. Usage: * slRemove(&list, el); * Returns TRUE if element in list. */ { struct slList **pList = vpList; struct slList *toRemove = vToRemove; struct slList *el, *next, *newList = NULL; boolean didRemove = FALSE; for (el = *pList; el != NULL; el = next) { next = el->next; if (el != toRemove) { slAddHead(&newList, el); } else didRemove = TRUE; } slReverse(&newList); *pList = newList; return didRemove; } struct slInt *slIntNew(int x) /* Return a new int. */ { struct slInt *a; AllocVar(a); a->val = x; return a; } int slIntCmp(const void *va, const void *vb) /* Compare two slInts. */ { const struct slInt *a = *((struct slInt **)va); const struct slInt *b = *((struct slInt **)vb); return a->val - b->val; } int slIntCmpRev(const void *va, const void *vb) /* Compare two slInts in reverse direction. */ { const struct slInt *a = *((struct slInt **)va); const struct slInt *b = *((struct slInt **)vb); return b->val - a->val; } struct slInt * slIntFind(struct slInt *list, int target) /* Find target in slInt list or return NULL */ { struct slInt *i; for (i=list;i;i=i->next) if (i->val == target) return i; return NULL; } static int doubleCmp(const void *va, const void *vb) /* Compare function to sort array of doubles. */ { const double *a = va; const double *b = vb; double diff = *a - *b; if (diff < 0) return -1; else if (diff > 0) return 1; else return 0; } void doubleSort(int count, double *array) /* Sort an array of doubles. */ { if (count > 1) qsort(array, count, sizeof(array[0]), doubleCmp); } double doubleMedian(int count, double *array) /* Return median value in array. This will sort * the array as a side effect. */ { double median; doubleSort(count, array); if ((count&1) == 1) median = array[count>>1]; else { count >>= 1; median = (array[count] + array[count-1]) * 0.5; } return median; } struct slDouble *slDoubleNew(double x) /* Return a new double. */ { struct slDouble *a; AllocVar(a); a->val = x; return a; } int slDoubleCmp(const void *va, const void *vb) /* Compare two slDoubles. */ { const struct slDouble *a = *((struct slDouble **)va); const struct slDouble *b = *((struct slDouble **)vb); double diff = a->val - b->val; if (diff < 0) return -1; else if (diff > 0) return 1; else return 0; } double slDoubleMedian(struct slDouble *list) /* Return median value on list. */ { int i,count = slCount(list); struct slDouble *el; double *array, median; if (count == 0) errAbort("Can't take median of empty list"); AllocArray(array,count); for (i=0, el=list; inext) array[i] = el->val; median = doubleMedian(count, array); freeMem(array); return median; } static int intCmp(const void *va, const void *vb) /* Compare function to sort array of ints. */ { const int *a = va; const int *b = vb; int diff = *a - *b; if (diff < 0) return -1; else if (diff > 0) return 1; else return 0; } void intSort(int count, int *array) /* Sort an array of ints. */ { if (count > 1) qsort(array, count, sizeof(array[0]), intCmp); } int intMedian(int count, int *array) /* Return median value in array. This will sort * the array as a side effect. */ { int median; intSort(count, array); if ((count&1) == 1) median = array[count>>1]; else { count >>= 1; median = (array[count] + array[count-1]) * 0.5; } return median; } struct slName *newSlName(char *name) /* Return a new name. */ { struct slName *sn; if (name != NULL) { int len = strlen(name); sn = needMem(sizeof(*sn)+len); strcpy(sn->name, name); return sn; } else { AllocVar(sn); } return sn; } struct slName *slNameNewN(char *name, int size) /* Return new slName of given size. */ { struct slName *sn = needMem(sizeof(*sn) + size); memcpy(sn->name, name, size); return sn; } int slNameCmpCase(const void *va, const void *vb) /* Compare two slNames, ignore case. */ { const struct slName *a = *((struct slName **)va); const struct slName *b = *((struct slName **)vb); return strcasecmp(a->name, b->name); } void slNameSortCase(struct slName **pList) /* Sort slName list, ignore case. */ { slSort(pList, slNameCmpCase); } int slNameCmp(const void *va, const void *vb) /* Compare two slNames. */ { const struct slName *a = *((struct slName **)va); const struct slName *b = *((struct slName **)vb); return strcmp(a->name, b->name); } void slNameSort(struct slName **pList) /* Sort slName list. */ { slSort(pList, slNameCmp); } boolean slNameInList(struct slName *list, char *string) /* Return true if string is in name list */ { struct slName *el; for (el = list; el != NULL; el = el->next) if (sameWord(string, el->name)) return TRUE; return FALSE; } void *slNameFind(void *list, char *string) /* Return first element of slName list (or any other list starting * with next/name fields) that matches string. */ { struct slName *el; for (el = list; el != NULL; el = el->next) if (sameWord(string, el->name)) return el; return NULL; } int slNameFindIx(struct slName *list, char *string) /* Return index of first element of slName list (or any other * list starting with next/name fields) that matches string. * Return -1 if not found. */ { struct slName *el; int ix = 0; for (el = list; el != NULL; el = el->next, ix++) if (sameString(string, el->name)) return ix; return -1; } char *slNameStore(struct slName **pList, char *string) /* Put string into list if it's not there already. * Return the version of string stored in list. */ { struct slName *el; for (el = *pList; el != NULL; el = el->next) { if (sameString(string, el->name)) return el->name; } el = newSlName(string); slAddHead(pList, el); return el->name; } struct slName *slNameAddHead(struct slName **pList, char *name) /* Add name to start of list and return it. */ { struct slName *el = slNameNew(name); slAddHead(pList, el); return el; } struct slName *slNameAddTail(struct slName **pList, char *name) /* Add name to end of list (not efficient for long lists), * and return it. */ { struct slName *el = slNameNew(name); slAddTail(pList, el); return el; } struct slName *slNameCloneList(struct slName *list) /* Return clone of list. */ { struct slName *el, *newEl, *newList = NULL; for (el = list; el != NULL; el = el->next) { newEl = slNameNew(el->name); slAddHead(&newList, newEl); } slReverse(&newList); return newList; } struct slName *slNameListFromString(char *s, char delimiter) /* Return list of slNames gotten from parsing delimited string. * The final delimiter is optional. a,b,c and a,b,c, are equivalent * for comma-delimited lists. */ { char *e; struct slName *list = NULL, *el; while (s != NULL && s[0] != 0) { e = strchr(s, delimiter); if (e == NULL) el = slNameNew(s); else { el = slNameNewN(s, e-s); e += 1; } slAddHead(&list, el); s = e; } slReverse(&list); return list; } struct slName *slNameListFromStringArray(char *stringArray[], int arraySize) /* Return list of slNames from an array of strings of length arraySize. * If a string in the array is NULL, the array will be treated as * NULL-terminated (shorter than arraySize). */ { char *s; struct slName *list = NULL, *el; int i; if (stringArray == NULL) return NULL; for (i = 0; i < arraySize; i++) { s = stringArray[i]; if (s == NULL) break; el = slNameNew(s); slAddHead(&list, el); } slReverse(&list); return list; } char *slNameListToString(struct slName *list, char delimiter) /* Return string created by joining all names with the delimiter. */ { struct slName *el; int elCount = 0; int len = 0; char del[2]; char *s; del[0] = delimiter; del[1] = '\0'; for (el = list; el != NULL; el = el->next, elCount++) len += strlen(el->name); len += elCount; AllocArray(s, len); for (el = list; el != NULL; el = el->next) { strcat(s, el->name); if (el->next != NULL) strcat(s, del); } return s; } struct slRef *refOnList(struct slRef *refList, void *val) /* Return ref if val is already on list, otherwise NULL. */ { struct slRef *ref; for (ref = refList; ref != NULL; ref = ref->next) if (ref->val == val) return ref; return NULL; } struct slRef *slRefNew(void *val) /* Create new slRef element. */ { struct slRef *ref; AllocVar(ref); ref->val = val; return ref; } void refAdd(struct slRef **pRefList, void *val) /* Add reference to list. */ { struct slRef *ref; AllocVar(ref); ref->val = val; slAddHead(pRefList, ref); } void refAddUnique(struct slRef **pRefList, void *val) /* Add reference to list if not already on list. */ { if (refOnList(*pRefList, val) == NULL) { refAdd(pRefList, val); } } struct slRef *refListFromSlList(void *list) /* Make a reference list that mirrors a singly-linked list. */ { struct slList *el; struct slRef *refList = NULL, *ref; for (el= list; el != NULL; el = el->next) { ref = slRefNew(el); slAddHead(&refList, ref); } slReverse(&refList); return refList; } struct slPair *slPairNew(char *name, void *val) /* Allocate new name/value pair. */ { struct slPair *el; AllocVar(el); el->name = cloneString(name); el->val = val; return el; } void slPairAdd(struct slPair **pList, char *name, void *val) /* Add new slPair to head of list. */ { struct slPair *el = slPairNew(name, val); slAddHead(pList, el); } void slPairFree(struct slPair **pEl) /* Free up struct and name. (Don't free up values.) */ { struct slPair *el = *pEl; if (el != NULL) { freeMem(el->name); freez(pEl); } } void slPairFreeList(struct slPair **pList) /* Free up list. (Don't free up values.) */ { struct slPair *el, *next; for (el = *pList; el != NULL; el = next) { next = el->next; slPairFree(&el); } *pList = NULL; } void slPairFreeVals(struct slPair *list) /* Free up all values on list. */ { struct slPair *el; for (el = list; el != NULL; el = el->next) freez(&el->val); } void slPairFreeValsAndList(struct slPair **pList) /* Free up all values on list and list itself */ { slPairFreeVals(*pList); slPairFreeList(pList); } struct slPair *slPairFind(struct slPair *list, char *name) /* Return list element of given name, or NULL if not found. */ { struct slPair *el; for (el = list; el != NULL; el = el->next) if (sameString(name, el->name)) break; return el; } void *slPairFindVal(struct slPair *list, char *name) /* Return value associated with name in list, or NULL if not found. */ { struct slPair *el = slPairFind(list, name); if (el == NULL) return NULL; return el->val; } struct slPair *slPairFromString(char *s) /* Return slPair list parsed from list in string s * name1=val1 name2=val2 ... * Returns NULL if parse error */ { struct slPair *list = NULL; char *name; char *ss = cloneString(s); char *word = ss; while((name = nextWord(&word))) { char *val = strchr(name,'='); if (!val) { warn("missing equals sign in name=value pair: [%s]\n", name); return NULL; } *val++ = 0; slPairAdd(&list, name, cloneString(val)); } freez(&ss); slReverse(&list); return list; } void gentleFree(void *pt) { if (pt != NULL) freeMem((char*)pt); } int differentWord(char *s1, char *s2) /* strcmp ignoring case - returns zero if strings are * the same (ignoring case) otherwise returns difference * between first non-matching characters. */ { char c1, c2; for (;;) { c1 = toupper(*s1++); c2 = toupper(*s2++); if (c1 != c2) /* Takes care of end of string in one but not the other too */ return c2-c1; if (c1 == 0) /* Take care of end of string in both. */ return 0; } } int differentStringNullOk(char *a, char *b) /* Returns 0 if two strings (either of which may be NULL) * are the same. Otherwise it returns a positive or negative * number depending on the alphabetical order of the two * strings. * This is basically a strcmp that can handle NULLs in * the input. If used in a sort the NULLs will end * up before any of the cases with data. */ { if (a == b) return FALSE; else if (a == NULL) return -1; else if (b == NULL) return 1; else return strcmp(a,b) != 0; } boolean startsWith(char *start,char *string) /* Returns TRUE if string begins with start. */ { char c; int i; for (i=0; ;i += 1) { if ((c = start[i]) == 0) return TRUE; if (string[i] != c) return FALSE; } } boolean startsWithWord(char *firstWord, char *line) /* Return TRUE if first white-space-delimited word in line * is same as firstWord. Comparison is case sensitive. */ { int len = strlen(firstWord); int i; for (i=0; i= haystack; pos -= 1) { if (memcmp(needle, pos, nSize) == 0) return pos; } return NULL; } char *stringBetween(char *start, char *end, char *haystack) /* Return string between start and end strings, or NULL if * none found. The first such instance is returned. * String must be freed by caller. */ { char *pos, *p; int len; if ((p = stringIn(start, haystack)) != NULL) { pos = p + strlen(start); if ((p = stringIn(end, pos)) != NULL) { len = p - pos; pos = cloneMem(pos, len + 1); pos[len] = 0; return pos; } } return NULL; } boolean endsWith(char *string, char *end) /* Returns TRUE if string ends with end. */ { int sLen, eLen, offset; sLen = strlen(string); eLen = strlen(end); offset = sLen - eLen; if (offset < 0) return FALSE; return sameString(string+offset, end); } char lastChar(char *s) /* Return last character in string. */ { if (s == NULL || s[0] == 0) return 0; return s[strlen(s)-1]; } char *memMatch(char *needle, int nLen, char *haystack, int hLen) /* Returns first place where needle (of nLen chars) matches * haystack (of hLen chars) */ { char c = *needle++; nLen -= 1; hLen -= nLen; while (--hLen >= 0) { if (*haystack++ == c && memcmp(needle, haystack, nLen) == 0) { return haystack-1; } } return NULL; } void toUpperN(char *s, int n) /* Convert a section of memory to upper case. */ { int i; for (i=0; i= outSize) break; /* Skip initial separators. */ in += strspn(in, sep); if (*in == 0) break; if (outArray != NULL) outArray[recordCount] = in; recordCount += 1; in += strcspn(in, sep); if (*in == 0) break; if (outArray != NULL) *in = 0; in += 1; } return recordCount; } int chopByWhite(char *in, char *outArray[], int outSize) /* Like chopString, but specialized for white space separators. */ { int recordCount = 0; char c; for (;;) { if (outArray != NULL && recordCount >= outSize) break; /* Skip initial separators. */ while (isspace(*in)) ++in; if (*in == 0) break; /* Store start of word and look for end of word. */ if (outArray != NULL) outArray[recordCount] = in; recordCount += 1; for (;;) { if ((c = *in) == 0) break; if (isspace(c)) break; ++in; } if (*in == 0) break; /* Tag end of word with zero. */ if (outArray != NULL) *in = 0; /* And skip over the zero. */ in += 1; } return recordCount; } int chopByChar(char *in, char chopper, char *outArray[], int outSize) /* Chop based on a single character. */ { int i; char c; if (*in == 0) return 0; for (i=0; (i=0; --i) { c = s[i]; if (isspace(c)) s[i] = 0; else break; } } /* Remove white space from a string */ void eraseWhiteSpace(char *s) { char *in, *out; char c; in = out = s; for (;;) { c = *in++; if (c == 0) break; if (!isspace(c)) *out++ = c; } *out++ = 0; } char *trimSpaces(char *s) /* Remove leading and trailing white space. */ { if (s != NULL) { s = skipLeadingSpaces(s); eraseTrailingSpaces(s); } return s; } void spaceOut(FILE *f, int count) /* Put out some spaces to file. */ { while (--count >= 0) fputc(' ', f); } void starOut(FILE *f, int count) /* Put out some asterisks to file. */ { while (--count >= 0) fputc('*', f); } boolean hasWhiteSpace(char *s) /* Return TRUE if there is white space in string. */ { char c; while ((c = *s++) != 0) if (isspace(c)) return TRUE; return FALSE; } char *firstWordInLine(char *line) /* Returns first word in line if any (white space separated). * Puts 0 in place of white space after word. */ { char *e; line = skipLeadingSpaces(line); if ((e = skipToSpaces(line)) != NULL) *e = 0; return line; } char *lastWordInLine(char *line) /* Returns last word in line if any (white space separated). * Returns NULL if string is empty. Removes any terminating white space * from line. */ { char *s = line; char *word = NULL, *wordEnd = NULL; for (;;) { s = skipLeadingSpaces(s); if (s == NULL || s[0] == 0) break; word = s; s = wordEnd = skipToSpaces(s); if (s == NULL) break; } if (wordEnd != NULL) *wordEnd = 0; return word; } char *nextWord(char **pLine) /* Return next word in *pLine and advance *pLine to next * word. */ { char *s = *pLine, *e; if (s == NULL || s[0] == 0) return NULL; s = skipLeadingSpaces(s); if (s[0] == 0) return NULL; e = skipToSpaces(s); if (e != NULL) *e++ = 0; *pLine = e; return s; } char *nextTabWord(char **pLine) /* Return next tab-separated word. */ { char *s = *pLine; char *e; if (s == NULL || *s == '\n' || *s == 0) { *pLine = NULL; return NULL; } e = strchr(s, '\t'); if (e == NULL) { e = strchr(s, '\n'); if (e != NULL) *e = 0; *pLine = NULL; } else { *e++ = 0; *pLine = e; } return s; } int stringArrayIx(char *string, char *array[], int arraySize) /* Return index of string in array or -1 if not there. */ { int i; for (i=0; i 255) { warn("String too long in writeString (%d chars):\n%s", len, s); len = 255; } bLen = len; writeOne(f, bLen); mustWrite(f, s, len); } char *readString(FILE *f) /* Read a string (written with writeString) into * memory. freeMem the result when done. */ { UBYTE bLen; int len; char *s; if (!readOne(f, bLen)) return NULL; len = bLen; s = needMem(len+1); if (len > 0) mustRead(f, s, len); return s; } char *mustReadString(FILE *f) /* Read a string. Squawk and die at EOF or if any problem. */ { char *s = readString(f); if (s == NULL) errAbort("Couldn't read string"); return s; } boolean fastReadString(FILE *f, char buf[256]) /* Read a string into buffer, which must be long enough * to hold it. String is in 'writeString' format. */ { UBYTE bLen; int len; if (!readOne(f, bLen)) return FALSE; if ((len = bLen)> 0) mustRead(f, buf, len); buf[len] = 0; return TRUE; } void writeBits64(FILE *f, bits64 x) /* Write out 64 bit number in manner that is portable across architectures */ { int i; UBYTE buf[8]; for (i=7; i>=0; --i) { buf[i] = (UBYTE)(x&0xff); x >>= 8; } mustWrite(f, buf, 8); } bits64 readBits64(FILE *f) /* Write out 64 bit number in manner that is portable across architectures */ { int i; UBYTE buf[8]; bits64 x = 0; mustRead(f, buf, 8); for (i=0; i<8; ++i) { x <<= 8; x |= buf[i]; } return x; } char *addSuffix(char *head, char *suffix) /* Return a needMem'd string containing "headsuffix". Should be free'd when finished. */ { char *ret = NULL; int size = strlen(head) + strlen(suffix) +1; ret = needMem(sizeof(char)*size); snprintf(ret, size, "%s%s", head, suffix); return ret; } void chopSuffix(char *s) /* Remove suffix (last . in string and beyond) if any. */ { char *e = strrchr(s, '.'); if (e != NULL) *e = 0; } void chopSuffixAt(char *s, char c) /* Remove end of string from first occurrence of char c. * chopSuffixAt(s, '.') is equivalent to regular chopSuffix. */ { char *e = strrchr(s, c); if (e != NULL) *e = 0; } char *chopPrefixAt(char *s, char c) /* Like chopPrefix, but can chop on any character, not just '.' */ { char *e = strchr(s, c); if (e == NULL) return s; *e++ = 0; return e; } char *chopPrefix(char *s) /* This will replace the first '.' in a string with * 0, and return the character after this. If there * is no '.' in the string this will just return the * unchanged s passed in. */ { return chopPrefixAt(s, '.'); } boolean carefulCloseWarn(FILE **pFile) /* Close file if open and null out handle to it. * Return FALSE and print a warning message if there * is a problem.*/ { FILE *f; boolean ok = TRUE; if ((pFile != NULL) && ((f = *pFile) != NULL)) { if (f != stdin && f != stdout) { if (fclose(f) != 0) { errnoWarn("fclose failed"); ok = FALSE; } } *pFile = NULL; } return ok; } void carefulClose(FILE **pFile) /* Close file if open and null out handle to it. * Warn and abort if there's a problem. */ { if (!carefulCloseWarn(pFile)) noWarnAbort(); } char *firstWordInFile(char *fileName, char *wordBuf, int wordBufSize) /* Read the first word in file into wordBuf. */ { FILE *f = mustOpen(fileName, "r"); fgets(wordBuf, wordBufSize, f); fclose(f); return trimSpaces(wordBuf); } int roundingScale(int a, int p, int q) /* returns rounded a*p/q */ { if (a > 100000 || p > 100000) { double x = a; x *= p; x /= q; return round(x); } else return (a*p + q/2)/q; } int intAbs(int a) /* Return integer absolute value */ { return (a >= 0 ? a : -a); } int rangeIntersection(int start1, int end1, int start2, int end2) /* Return amount of bases two ranges intersect over, 0 or negative if no * intersection. */ { int s = max(start1,start2); int e = min(end1,end2); return e-s; } int positiveRangeIntersection(int start1, int end1, int start2, int end2) /* Return number of bases in intersection of two ranges, or * zero if they don't intersect. */ { int ret = rangeIntersection(start1,end1,start2,end2); if (ret < 0) ret = 0; return ret; } bits32 byteSwap32(bits32 a) /* Return byte-swapped version of a */ { union {bits32 whole; UBYTE bytes[4];} u,v; u.whole = a; v.bytes[0] = u.bytes[3]; v.bytes[1] = u.bytes[2]; v.bytes[2] = u.bytes[1]; v.bytes[3] = u.bytes[0]; return v.whole; } void removeReturns(char *dest, char *src) /* Removes the '\r' character from a string. * The source and destination strings can be the same, if there are * no other threads */ { int i = 0; int j = 0; /* until the end of the string */ for (;;) { /* skip the returns */ while(src[j] == '\r') j++; /* copy the characters */ dest[i] = src[j]; /* check to see if done */ if(src[j] == '\0') break; /* advance the counters */ i++; j++; } } char* readLine(FILE* fh) /* Read a line of any size into dynamic memory, return null on EOF */ { int bufCapacity = 256; int bufSize = 0; char* buf = needMem(bufCapacity); int ch; /* loop until EOF of EOLN */ while (((ch = getc(fh)) != EOF) && (ch != '\n')) { /* expand if almost full, always keep one extra char for * zero termination */ if (bufSize >= bufCapacity-2) { bufCapacity *= 2; buf = realloc(buf, bufCapacity); if (buf == NULL) { errAbort("Out of memory in readline - request size %d bytes", bufCapacity); } } buf[bufSize++] = ch; } /* only return EOF if no data was read */ if ((ch == EOF) && (bufSize == 0)) { freeMem(buf); return NULL; } buf[bufSize] = '\0'; return buf; } #ifdef NOT_NEEDED_UCSC_STUFF boolean fileExists(char *fileName) /* Return TRUE if file exists (may replace this with non- * portable faster way some day). */ { /* To make piping easier stdin and stdout always exist. */ if (sameString(fileName, "stdin")) return TRUE; if (sameString(fileName, "stdout")) return TRUE; return fileSize(fileName) != -1; } #endif /* Friendly name for strstrNoCase */ char *containsStringNoCase(char *haystack, char *needle) { return strstrNoCase(haystack, needle); } char *strstrNoCase(char *haystack, char *needle) /* A case-insensitive strstr function Will also robustly handle null strings param haystack - The string to be searched param needle - The string to look for in the haystack string return - The position of the first occurence of the desired substring or -1 if it is not found */ { char *haystackCopy = NULL; char *needleCopy = NULL; int index = 0; int haystackLen = 0; int needleLen = 0; char *p, *q; if (NULL == haystack || NULL == needle) { return NULL; } haystackLen = strlen(haystack); needleLen = strlen(needle); haystackCopy = (char*) needMem(haystackLen + 1); needleCopy = (char*) needMem(needleLen + 1); for(index = 0; index < haystackLen; index++) { haystackCopy[index] = tolower(haystack[index]); } haystackCopy[haystackLen] = 0; /* Null terminate */ for(index = 0; index < needleLen; index++) { needleCopy[index] = tolower(needle[index]); } needleCopy[needleLen] = 0; /* Null terminate */ p=strstr(haystackCopy, needleCopy); q=haystackCopy; freeMem(haystackCopy); freeMem(needleCopy); if(p==NULL) return NULL; return p-q+haystack; } int vasafef(char* buffer, int bufSize, char *format, va_list args) /* Format string to buffer, vsprintf style, only with buffer overflow * checking. The resulting string is always terminated with zero byte. */ { int sz = vsnprintf(buffer, bufSize, format, args); /* note that some version return -1 if too small */ if ((sz < 0) || (sz >= bufSize)) errAbort("buffer overflow, size %d, format: %s", bufSize, format); return sz; } int safef(char* buffer, int bufSize, char *format, ...) /* Format string to buffer, vsprintf style, only with buffer overflow * checking. The resulting string is always terminated with zero byte. */ { int sz; va_list args; va_start(args, format); sz = vasafef(buffer, bufSize, format, args); va_end(args); return sz; } void safecpy(char *buf, size_t bufSize, const char *src) /* copy a string to a buffer, with bounds checking.*/ { size_t slen = strlen(src); if (slen > bufSize-1) errAbort("buffer overflow, size %lld, string size: %lld", (long long)bufSize, (long long)slen); strcpy(buf, src); } void safencpy(char *buf, size_t bufSize, const char *src, size_t n) /* copy n characters from a string to a buffer, with bounds checking. * Unlike strncpy, always null terminates the result */ { if (n > bufSize-1) errAbort("buffer overflow, size %lld, substring size: %lld", (long long)bufSize, (long long)n); size_t slen = strlen(src); if (slen > n) slen = n; strncpy(buf, src, n); buf[slen] = '\0'; } void safecat(char *buf, size_t bufSize, const char *src) /* Append a string to a buffer, with bounds checking.*/ { size_t blen = strlen(buf); size_t slen = strlen(src); if (blen+slen > bufSize-1) errAbort("buffer overflow, size %lld, new string size: %lld", (long long)bufSize, (long long)(blen+slen)); strcat(buf, src); } void safencat(char *buf, size_t bufSize, const char *src, size_t n) /* append n characters from a string to a buffer, with bounds checking. */ { size_t blen = strlen(buf); if (blen+n > bufSize-1) errAbort("buffer overflow, size %lld, new string size: %lld", (long long)bufSize, (long long)(blen+n)); size_t slen = strlen(src); if (slen > n) slen = n; strncat(buf, src, n); buf[blen+slen] = '\0'; } static char *naStr = "n/a"; static char *emptyStr = ""; char *naForNull(char *s) /* Return 'n/a' if s is NULL, otherwise s. */ { if (s == NULL) s = naStr; return s; } char *naForEmpty(char *s) /* Return n/a if s is "" or NULL, otherwise s. */ { if (s == NULL || s[0] == 0) s = naStr; return s; } char *emptyForNull(char *s) /* Return "" if s is NULL, otherwise s. */ { if (s == NULL) s = emptyStr; return s; } char *nullIfAllSpace(char *s) /* Return NULL if s is all spaces, otherwise s. */ { s = skipLeadingSpaces(s); if (s != NULL) if (s[0] == 0) s = NULL; return s; } char *trueFalseString(boolean b) /* Return "true" or "false" */ { return (b ? "true" : "false"); } #ifdef NOT_NEEDED_UCSC_STUFF void uglyTime(char *label, ...) /* Print label and how long it's been since last call. Call with * a NULL label to initialize. */ { static long lastTime = 0; long time = clock1000(); va_list args; va_start(args, label); if (label != NULL) { vfprintf(stdout, label, args); fprintf(stdout, ": %ld millis
\n", time - lastTime); } lastTime = time; va_end(args); } void makeDirs(char* path) /* make a directory, including parent directories */ { char pathBuf[PATH_LEN]; char* next = pathBuf; strcpy(pathBuf, path); if (*next == '/') next++; while((*next != '\0') && (next = strchr(next, '/')) != NULL) { *next = '\0'; makeDir(pathBuf); *next = '/'; next++; } makeDir(pathBuf); } #endif char *skipNumeric(char *s) /* Return first char of s that's not a digit */ { while (isdigit(*s)) ++s; return s; } char *skipToNumeric(char *s) /* skip up to where numeric digits appear */ { while (*s != 0 && !isdigit(*s)) ++s; return s; } char *splitOffNonNumeric(char *s) /* Split off non-numeric part, e.g. mm of mm8. Result should be freed when done */ { return cloneStringZ(s,skipToNumeric(s)-s); } char *splitOffNumber(char *db) /* Split off number part, e.g. 8 of mm8. Result should be freed when done */ { return cloneString(skipToNumeric(db)); } int digitsBaseTwo(unsigned long x) /* Return base two # of digits. */ { int digits = 0; while (x) { digits += 1; x >>= 1; } return digits; } int digitsBaseTen(int x) /* Return number of digits base 10. */ { int digCount = 1; if (x < 0) { digCount = 2; x = -x; } while (x >= 10) { digCount += 1; x /= 10; } return digCount; } void *intToPt(int i) /* Convert integer to pointer. Use when really want to store an * int in a pointer field. */ { char *pt = NULL; return pt+i; } int ptToInt(void *pt) /* Convert pointer to integer. Use when really want to store a * pointer in an int. */ { char *a = NULL, *b = pt; return b - a; } void *sizetToPt(size_t i) /* Convert size_t to pointer. Use when really want to store a * size_t in a pointer. */ { char *pt = NULL; return pt+i; } size_t ptToSizet(void *pt) /* Convert pointer to size_t. Use when really want to store a * pointer in a size_t. */ { char *a = NULL, *b = pt; return b - a; } IRanges/src/common.h0000644000126300012640000010055112234075662015726 0ustar00biocbuildphs_compbio/* Common.h - functions that are commonly used. Includes * routines for managing singly linked lists, some basic * string manipulation stuff, and other stuff of the * short but useful nature. * * This file is copyright 2002-2005 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #ifndef COMMON_H /* Wrapper to avoid including this twice. */ #define COMMON_H /* Some stuff to support large files in Linux. */ #ifndef _LARGEFILE_SOURCE #define _LARGEFILE_SOURCE 1 #endif #ifndef _GNU_SOURCE #define _GNU_SOURCE #endif #ifndef _FILE_OFFSET_BITS #define _FILE_OFFSET_BITS 64 #endif /* Some stuff for safer pthreads. */ #ifndef _REENTRANT #define _REENTRANT #endif #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #if defined(MACHTYPE_ppc) #include #endif #if defined(__APPLE__) #if defined(__i686__) /* The i686 apple math library defines warn. */ #define warn jkWarn #endif #endif #ifndef NAN #define NAN (0.0 / 0.0) #endif #ifndef WIFEXITED #define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0) #endif #ifndef WEXITSTATUS #define WEXITSTATUS(stat) (short)(((*((int *) &(stat))) >> 8) & 0xffff) #endif #ifndef WIFSIGNALED #define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) &0x00ff))) #endif #ifndef WTERMSIG #define WTERMSIG(stat) ((*((int *) &(stat))) & 0x7f) #endif #ifndef WIFSTOPPED #define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177) #endif #ifndef WSTOPSIG #define WSTOPSIG(stat) (((*((int *) &(stat))) >> 8) & 0xff) #endif #ifndef HUGE #define HUGE MAXFLOAT #endif /* Let's pretend C has a boolean type. */ #define TRUE 1 #define FALSE 0 #define boolean int #ifndef __cplusplus #ifndef bool #define bool char #endif #endif /* Some other type synonyms */ #define UBYTE unsigned char /* Wants to be unsigned 8 bits. */ #define BYTE signed char /* Wants to be signed 8 bits. */ #define UWORD unsigned short /* Wants to be unsigned 16 bits. */ #define WORD short /* Wants to be signed 16 bits. */ #define bits64 unsigned long long /* Wants to be unsigned 64 bits. */ #define bits32 unsigned /* Wants to be unsigned 32 bits. */ #define bits16 unsigned short /* Wants to be unsigned 16 bits. */ #define bits8 unsigned char /* Wants to be unsigned 8 bits. */ #define signed32 int /* Wants to be signed 32 bits. */ #define bits8 unsigned char /* Wants to be unsigned 8 bits. */ #define BIGNUM 0x3fffffff /* A really big number */ #define LIMIT_2or8GB (2147483647 * ((sizeof(size_t)/4)*(sizeof(size_t)/4))) /* == 2 Gb for 32 bit machines, 8 Gb for 64 bit machines */ #define LIMIT_2or6GB (2147483647 + (2147483647 * ((sizeof(size_t)/4)-1)) + \ (2147483647 * ((sizeof(size_t)/4)-1))) /* == 2 Gb for 32 bit machines, 6 Gb for 64 bit machines */ /* Default size of directory path, file name and extension string buffers */ #define PATH_LEN 512 #define FILENAME_LEN 128 #define FILEEXT_LEN 64 /* inline functions: To declare a function inline, place the entire function * in a header file and prefix it with the INLINE macro. If used with a * compiler that doesn't support inline, change the INLINE marco to be simply * `static'. */ #ifndef INLINE #define INLINE static inline #endif /* stdargs compatibility: in a unix universe a long time ago, types of va_list * were passed by value. It was assume one could do things like: * * va_start(args); * vfprintf(fh1, fmt, args); * vfprintf(fh2, fmt, args); * va_end(args); * * and life would good. However this is not true on some modern systems (for * instance gcc/glibc on x86_64), where va_args can be a pointer to some type * of object). The second call to vfprintf() would then crash, since the * first call modified the object that va_args was pointing to. C99 adds a * va_copy macro that to address this issue. Many non-C99 system include this * macro, sometimes called __va_copy. Here we ensure that va_copy is defined. * If if doesn't exist, we try to define it in terms of __va_copy. If that is * not available, we make the assumption that va_list can be copied by value * and create our own. Our implementation is the same as used on Solaris. */ #if defined(__va_copy) && !defined(va_copy) # define va_copy __va_copy #endif #if !defined(va_copy) # define va_copy(to, from) ((to) = (from)) #endif /* Cast a pointer to a long long. Use to printf format points as long-longs * in a 32/64bit portable manner. Format should use %llx for the result. * Needed because casting a pointer to a different sized number cause a * warning with gcc */ #define ptrToLL(p) ((long long)((size_t)p)) /* How big is this array? */ #define ArraySize(a) (sizeof(a)/sizeof((a)[0])) #define uglyf printf /* debugging printf */ #define uglyAbort errAbort /* debugging error abort. */ #define uglyOut stdout /* debugging fprintf target. */ void *needMem(size_t size); /* Need mem calls abort if the memory allocation fails. The memory * is initialized to zero. */ void *needLargeMem(size_t size); /* This calls abort if the memory allocation fails. The memory is * not initialized to zero. */ void *needLargeZeroedMem(size_t size); /* Request a large block of memory and zero it. */ void *needLargeMemResize(void* vp, size_t size); /* Adjust memory size on a block, possibly relocating it. If vp is NULL, * a new memory block is allocated. Memory not initted. */ void *needLargeZeroedMemResize(void* vp, size_t oldSize, size_t newSize); /* Adjust memory size on a block, possibly relocating it. If vp is NULL, a * new memory block is allocated. If block is grown, new memory is zeroed. */ void *needHugeMem(size_t size); /* No checking on size. Memory not initted to 0. */ void *needHugeZeroedMem(size_t size); /* Request a large block of memory and zero it. */ void *needHugeMemResize(void* vp, size_t size); /* Adjust memory size on a block, possibly relocating it. If vp is NULL, * a new memory block is allocated. No checking on size. Memory not * initted. */ void *needHugeZeroedMemResize(void* vp, size_t oldSize, size_t newSize); /* Adjust memory size on a block, possibly relocating it. If vp is NULL, a * new memory block is allocated. No checking on size. If block is grown, * new memory is zeroed. */ void *needMoreMem(void *old, size_t copySize, size_t newSize); /* Allocate a new buffer, copy old buffer to it, free old buffer. */ void *cloneMem(void *pt, size_t size); /* Allocate a new buffer of given size, and copy pt to it. */ #define CloneVar(pt) cloneMem(pt, sizeof((pt)[0])) /* Allocate copy of a structure. */ void *wantMem(size_t size); /* Want mem just calls malloc - no zeroing of memory, no * aborting if request fails. */ void freeMem(void *pt); /* Free memory will check for null before freeing. */ void freez(void *ppt); /* Pass address of pointer. Will free pointer and set it * to NULL. Typical use: * s = needMem(1024); * ... * freez(&s); */ #define AllocVar(pt) (pt = needMem(sizeof(*pt))) /* Shortcut to allocating a single variable on the heap and * assigning pointer to it. */ #define AllocArray(pt, size) (pt = needLargeZeroedMem(sizeof(*pt) * (size))) #define AllocA(type) needMem(sizeof(type)) /* Shortcut to allocating a variable on heap of a specific type. */ #define AllocN(type,count) ((type*)needLargeZeroedMem(sizeof(type) * (count))) /* Shortcut to allocating an array on the heap of a specific type. */ #define ExpandArray(array, oldCount, newCount) \ (array = needMoreMem((array), (oldCount)*sizeof((array)[0]), (newCount)*sizeof((array)[0]))) /* Expand size of dynamically allocated array. */ #define CopyArray(source, dest,count) memcpy(dest,source,(count)*sizeof(dest[0])) /* Copy count elements of array from source to dest. */ #define CloneArray(a, count) cloneMem(a, (count)*sizeof(a[0])) /* Make new dynamic array initialized with count elements of a */ void errAbort(char *format, ...) /* Abort function, with optional (printf formatted) error message. */ #if defined(__GNUC__) __attribute__((format(printf, 1, 2))) #endif ; void errnoAbort(char *format, ...) /* Prints error message from UNIX errno first, then does errAbort. */ #if defined(__GNUC__) __attribute__((format(printf, 1, 2))) #endif ; #define internalErr() errAbort("Internal error %s %d", __FILE__, __LINE__) /* Generic internal error message */ void warn(char *format, ...) /* Issue a warning message. */ #if defined(__GNUC__) __attribute__((format(printf, 1, 2))) #endif ; void verbose(int verbosity, char *format, ...) /* Write printf formatted message to log (which by * default is stdout) if global verbose variable * is set to verbosity or higher. Default level is 1. */ #if defined(__GNUC__) __attribute__((format(printf, 2, 3))) #endif ; void verboseDot(); /* Write I'm alive dot (at verbosity level 1) */ int verboseLevel(); /* Get verbosity level. */ void verboseSetLevel(int verbosity); /* Set verbosity level in log. 0 for no logging, * higher number for increasing verbosity. */ void zeroBytes(void *vpt, int count); /* fill a specified area of memory with zeroes */ #define ZeroVar(v) zeroBytes(v, sizeof(*v)) void reverseBytes(char *bytes, long length); /* Reverse the order of the bytes. */ void reverseInts(int *a, int length); /* Reverse the order of the integer array. */ void reverseUnsigned(unsigned *a, int length); /* Reverse the order of the unsigned array. */ void reverseDoubles(double *a, int length); /* Reverse the order of the double array. */ void reverseStrings(char **a, int length); /* Reverse the order of the char* array. */ void swapBytes(char *a, char *b, int length); /* Swap buffers a and b. */ /* Some things to manage simple lists - structures that begin * with a pointer to the next element in the list. */ struct slList { struct slList *next; }; int slCount(void *list); /* Return # of elements in list. */ void *slElementFromIx(void *list, int ix); /* Return the ix'th element in list. Returns NULL * if no such element. */ int slIxFromElement(void *list, void *el); /* Return index of el in list. Returns -1 if not on list. */ void slSafeAddHead(void *listPt, void *node); /* Add new node to start of list. * Usage: * slSafeAddHead(&list, node); * where list and nodes are both pointers to structure * that begin with a next pointer. */ /* Add new node to start of list, this macro is faster * than slSafeAddHead, but has standard macro restriction * on what can be safely passed as arguments. */ #define slAddHead(listPt, node) \ ((node)->next = *(listPt), *(listPt) = (node)) void slAddTail(void *listPt, void *node); /* Add new node to tail of list. * Usage: * slAddTail(&list, node); * where list and nodes are both pointers to structure * that begin with a next pointer. This is sometimes * convenient but relatively slow. For longer lists * it's better to slAddHead, and slReverse when done. */ void *slPopHead(void *listPt); /* Return head of list and remove it from list. (Fast) */ void *slPopTail(void *listPt); /* Return tail of list and remove it from list. (Not so fast) */ void *slCat(void *a, void *b); /* Return concatenation of lists a and b. * Example Usage: * struct slName *a = getNames("a"); * struct slName *b = getNames("b"); * struct slName *ab = slCat(a,b) * After this it is no longer safe to use a or b. */ void *slLastEl(void *list); /* Returns last element in list or NULL if none. */ void slReverse(void *listPt); /* Reverse order of a list. * Usage: * slReverse(&list); */ typedef int CmpFunction(const void *elem1, const void *elem2); void slSort(void *pList, CmpFunction *compare); /* Sort a singly linked list with Qsort and a temporary array. * The arguments to the compare function in real, non-void, life * are pointers to pointers. */ void slUniqify(void *pList, CmpFunction *compare, void (*free)()); /* Return sorted list with duplicates removed. * Compare should be same type of function as slSort's compare (taking * pointers to pointers to elements. Free should take a simple * pointer to dispose of duplicate element, and can be NULL. */ boolean slRemoveEl(void *vpList, void *vToRemove); /* Remove element from doubly linked list. Usage: * slRemove(&list, el); * Returns TRUE if element in list. */ void slFreeList(void *listPt); /* Free all elements in list and set list pointer to null. * Usage: * slFreeList(&list); */ struct slInt /* List of integers. */ { struct slInt *next; /* Next in list. */ int val; /* Integer value. */ }; struct slInt *slIntNew(int x); #define newSlInt slIntNew /* Return a new double. */ int slIntCmp(const void *va, const void *vb); /* Compare two slInts. */ int slIntCmpRev(const void *va, const void *vb); /* Compare two slInts in reverse direction. */ struct slInt * slIntFind(struct slInt *list, int target); /* Find target in slInt list or return NULL */ void doubleSort(int count, double *array); /* Sort an array of doubles. */ double doubleMedian(int count, double *array); /* Return median value in array. This will sort * the array as a side effect. */ struct slDouble /* List of double-precision numbers. */ { struct slDouble *next; /* Next in list. */ double val; /* Double-precision value. */ }; struct slDouble *slDoubleNew(double x); #define newSlDouble slDoubleNew /* Return a new int. */ int slDoubleCmp(const void *va, const void *vb); /* Compare two slDoubles. */ double slDoubleMedian(struct slDouble *list); /* Return median value on list. */ void intSort(int count, int *array); /* Sort an array of ints. */ int intMedian(int count, int *array); /* Return median value in array. This will sort * the array as a side effect. */ struct slName /* List of names. The name array is allocated to accommodate full name */ { struct slName *next; /* Next in list. */ char name[1]; /* Allocated at run time to length of string. */ }; struct slName *newSlName(char *name); #define slNameNew newSlName /* Return a new slName. */ #define slNameFree freez /* Free a single slName */ #define slNameFreeList slFreeList /* Free a list of slNames */ struct slName *slNameNewN(char *name, int size); /* Return new slName of given size. */ int slNameCmpCase(const void *va, const void *vb); /* Compare two slNames, ignore case. */ int slNameCmp(const void *va, const void *vb); /* Compare two slNames. */ void slNameSortCase(struct slName **pList); /* Sort slName list, ignore case. */ void slNameSort(struct slName **pList); /* Sort slName list. */ boolean slNameInList(struct slName *list, char *string); /* Return true if string is in name list */ void *slNameFind(void *list, char *string); /* Return first element of slName list (or any other list starting * with next/name fields) that matches string. */ int slNameFindIx(struct slName *list, char *string); /* Return index of first element of slName list (or any other * list starting with next/name fields) that matches string. * ... Return -1 if not found. */ char *slNameStore(struct slName **pList, char *string); /* Put string into list if it's not there already. * Return the version of string stored in list. */ struct slName *slNameAddHead(struct slName **pList, char *name); /* Add name to start of list and return it. */ struct slName *slNameAddTail(struct slName **pList, char *name); /* Add name to end of list (not efficient for long lists), * and return it. */ struct slName *slNameCloneList(struct slName *list); /* Return clone of list. */ struct slName *slNameListFromString(char *s, char delimiter); /* Return list of slNames gotten from parsing delimited string. * The final delimiter is optional. a,b,c and a,b,c, are equivalent * for comma-delimited lists. */ #define slNameListFromComma(s) slNameListFromString(s, ',') /* Parse out comma-separated list. */ struct slName *slNameListFromStringArray(char *stringArray[], int arraySize); /* Return list of slNames from an array of strings of length arraySize. * If a string in the array is NULL, the array will be treated as * NULL-terminated. */ char *slNameListToString(struct slName *list, char delimiter); /* Return string created by joining all names with the delimiter. */ struct slName *slNameLoadReal(char *fileName); /* load file lines that are not blank or start with a '#' into a slName * list */ struct slRef /* Singly linked list of generic references. */ { struct slRef *next; /* Next in list. */ void *val; /* A reference to something. */ }; struct slRef *slRefNew(void *val); /* Create new slRef element. */ struct slRef *refOnList(struct slRef *refList, void *val); /* Return ref if val is already on list, otherwise NULL. */ void refAdd(struct slRef **pRefList, void *val); /* Add reference to list. */ void refAddUnique(struct slRef **pRefList, void *val); /* Add reference to list if not already on list. */ struct slRef *refListFromSlList(void *list); /* Make a reference list that mirrors a singly-linked list. */ struct slPair /* A name/value pair. */ { struct slPair *next; /* Next in list. */ char *name; /* Name of item. */ void *val; /* Pointer to item data. */ }; struct slPair *slPairNew(char *name, void *val); /* Allocate new name/value pair. */ void slPairAdd(struct slPair **pList, char *name, void *val); /* Add new slPair to head of list. */ void slPairFree(struct slPair **pEl); /* Free up struct and name. (Don't free up values.) */ void slPairFreeList(struct slPair **pList); /* Free up list. (Don't free up values.) */ void slPairFreeVals(struct slPair *list); /* Free up all values on list. */ void slPairFreeValsAndList(struct slPair **pList); /* Free up all values on list and list itself */ struct slPair *slPairFind(struct slPair *list, char *name); /* Return list element of given name, or NULL if not found. */ void *slPairFindVal(struct slPair *list, char *name); /* Return value associated with name in list, or NULL if not found. */ struct slPair *slPairFromString(char *s); /* Return slPair list parsed from list in string s * name1=val1 name2=val2 ... * Returns NULL if parse error */ void gentleFree(void *pt); /* check pointer for NULL before freeing. * (Actually plain old freeMem does that these days.) */ /******* Some stuff for processing strings. *******/ char *cloneStringZ(char *s, int size); /* Make a zero terminated copy of string in memory */ char *cloneString(char *s); /* Make copy of string in dynamic memory */ char *cloneLongString(char *s); /* Make clone of long string. */ int differentWord(char *s1, char *s2); /* strcmp ignoring case - returns zero if strings are * the same (ignoring case) otherwise returns difference * between first non-matching characters. */ #define sameWord(a,b) (!differentWord(a,b)) /* Return TRUE if two strings are same ignoring case */ #define differentString(a,b) (strcmp(a,b)) /* Returns FALSE if two strings same. */ int differentStringNullOk(char *a, char *b); /* Returns 0 if two strings (either of which may be NULL) * are the same. Otherwise it returns a positive or negative * number depending on the alphabetical order of the two * strings. * This is basically a strcmp that can handle NULLs in * the input. If used in a sort the NULLs will end * up before any of the cases with data. */ #define sameOk(a,b) (differentStringNullOk(a,b) == 0) /* returns TRUE if two strings same, NULLs OK */ #define sameString(a,b) (strcmp(a,b)==0) /* Returns TRUE if two strings same. */ #define sameStringN(a,b,c) (strncmp(a,b,c)==0) /* Returns TRUE if two strings start with the same c characters. */ #define isEmpty(string) (string == NULL || string[0] == 0) #define isNotEmpty(string) (! isEmpty(string)) boolean startsWith(char *start,char *string); /* Returns TRUE if string begins with start. */ boolean startsWithWord(char *firstWord, char *line); /* Return TRUE if first white-space-delimited word in line * is same as firstWord. Comparison is case sensitive. */ #define stringIn(needle, haystack) strstr(haystack, needle) /* Returns position of needle in haystack or NULL if it's not there. */ /* char *stringIn(char *needle, char *haystack); */ char *rStringIn(char *needle, char *haystack); /* Return last position of needle in haystack, or NULL if it's not there. */ char *stringBetween(char *start, char *end, char *haystack); /* Return string between start and end strings, or NULL if * none found. The first such instance is returned. * String must be freed by caller. */ boolean endsWith(char *string, char *end); /* Returns TRUE if string ends with end. */ char lastChar(char *s); /* Return last character in string. */ boolean wildMatch(char *wildCard, char *string); /* does a case insensitive wild card match with a string. * * matches any string or no character. * ? matches any single character. * anything else etc must match the character exactly. */ char *memMatch(char *needle, int nLen, char *haystack, int hLen); /* Returns first place where needle (of nLen chars) matches * haystack (of hLen chars) */ void toUpperN(char *s, int n); /* Convert a section of memory to upper case. */ void toLowerN(char *s, int n); /* Convert a section of memory to lower case. */ void toggleCase(char *s, int size); /* toggle upper and lower case chars in string. */ void touppers(char *s); /* Convert entire string to upper case. */ void tolowers(char *s); /* Convert entire string to lower case */ char *replaceChars(char *string, char *oldStr, char *newStr); /* Replaces the old with the new. The old and new string need not be of equal size Can take any length string. Return value needs to be freeMem'd. */ void subChar(char *s, char oldChar, char newChar); /* Substitute newChar for oldChar throughout string s. */ char * memSwapChar(char *s, int len, char oldChar, char newChar); /* Substitute newChar for oldChar throughout memory of given length. old or new may be null */ #define strSwapChar(s,old,new) memSwapChar((s),strlen(s),(old),(new)) void stripChar(char *s, char c); /* Remove all occurences of c from s. */ void stripString(char *s, char *strip); /* Remove all occurences of strip from s. */ int countChars(char *s, char c); /* Return number of characters c in string s. */ int countCharsN(char *s, char c, int size); /* Return number of characters c in string s of given size. */ int countLeadingChars(char *s, char c); /* Count number of characters c at start of string. */ int countSame(char *a, char *b); /* Count number of characters that from start in a,b that are same. */ int chopString(char *in, char *sep, char *outArray[], int outSize); /* int chopString(in, sep, outArray, outSize); */ /* This chops up the input string (cannabilizing it) * into an array of zero terminated strings in * outArray. It returns the number of strings. * If you pass in NULL for outArray, it will just * return the number of strings that it *would* * chop. */ extern char crLfChopper[]; extern char whiteSpaceChopper[]; /* Some handy predefined separators. */ int chopByWhite(char *in, char *outArray[], int outSize); /* Like chopString, but specialized for white space separators. */ #define chopLine(line, words) chopByWhite(line, words, ArraySize(words)) /* Chop line by white space. */ int chopByChar(char *in, char chopper, char *outArray[], int outSize); /* Chop based on a single character. */ #define chopTabs(string, words) chopByChar(string, '\t', words, ArraySize(words)) /* Chop string by tabs. */ #define chopCommas(string, words) chopByChar(string, ',', words, ArraySize(words)) /* Chop string by commas. */ char *skipLeadingSpaces(char *s); /* Return first non-white space */ char *skipToSpaces(char *s); /* Return first white space. */ void eraseTrailingSpaces(char *s); /* Replace trailing white space with zeroes. */ void eraseWhiteSpace(char *s); /* Remove white space from a string */ char *trimSpaces(char *s); /* Remove leading and trailing white space. */ void spaceOut(FILE *f, int count); /* Put out some spaces to file. */ void starOut(FILE *f, int count); /* Put out some asterisks to file. */ boolean hasWhiteSpace(char *s); /* Return TRUE if there is white space in string. */ char *firstWordInLine(char *line); /* Returns first word in line if any (white space separated). * Puts 0 in place of white space after word. */ char *lastWordInLine(char *line); /* Returns last word in line if any (white space separated). * Returns NULL if string is empty. Removes any terminating white space * from line. */ char *nextWord(char **pLine); /* Return next word in *pLine and advance *pLine to next * word. Returns NULL when no more words. */ char *nextTabWord(char **pLine); /* Return next tab-separated word. */ int stringArrayIx(char *string, char *array[], int arraySize); /* Return index of string in array or -1 if not there. */ int ptArrayIx(void *pt, void *array, int arraySize); /* Return index of pt in array or -1 if not there. */ #define stringIx(string, array) stringArrayIx( (string), (array), ArraySize(array)) /* Some stuff that is left out of GNU .h files!? */ #ifndef SEEK_SET #define SEEK_SET 0 #endif #ifndef SEEK_CUR #define SEEK_CUR 1 #endif #ifndef SEEK_END #define SEEK_END 2 #endif #ifndef FILEPATH_H void splitPath(char *path, char dir[PATH_LEN], char name[FILENAME_LEN], char extension[FILEEXT_LEN]); /* Split a full path into components. The dir component will include the * trailing / if any. The extension component will include the starting * . if any. Pass in NULL for dir, name, or extension if you don't care about * that part. */ #endif /* FILEPATH_H */ char *addSuffix(char *head, char *suffix); /* Return a needMem'd string containing "headsuffix". Should be free'd when finished. */ void chopSuffix(char *s); /* Remove suffix (last . in string and beyond) if any. */ void chopSuffixAt(char *s, char c); /* Remove end of string from last occurrence of char c. * chopSuffixAt(s, '.') is equivalent to regular chopSuffix. */ char *chopPrefix(char *s); /* This will replace the first '.' in a string with * 0, and return the character after this. If there * is no '.' in the string this will just return the * unchanged s passed in. */ char *chopPrefixAt(char *s, char c); /* Like chopPrefix, but can chop on any character, not just '.' */ FILE *mustOpen(char *fileName, char *mode); /* Open a file - or squawk and die. */ void mustWrite(FILE *file, void *buf, size_t size); /* Write to file or squawk and die. */ #define writeOne(file, var) mustWrite((file), &(var), sizeof(var)) /* Write out one variable to file. */ void mustRead(FILE *file, void *buf, size_t size); /* Read from a file or squawk and die. */ #define mustReadOne(file, var) mustRead((file), &(var), sizeof(var)) /* Read one variable from file or die. */ #define readOne(file, var) (fread(&(var), sizeof(var), 1, (file)) == 1) /* Read one variable from file. Returns FALSE if can't do it. */ void writeString(FILE *f, char *s); /* Write a 255 or less character string to a file. * This will write the length of the string in the first * byte then the string itself. */ char *readString(FILE *f); /* Read a string (written with writeString) into * memory. freeMem the result when done. Returns * NULL at EOF. */ char *mustReadString(FILE *f); /* Read a string. Squawk and die at EOF or if any problem. */ boolean fastReadString(FILE *f, char buf[256]); /* Read a string into buffer, which must be long enough * to hold it. String is in 'writeString' format. * Returns FALSE at EOF. */ void writeBits64(FILE *f, bits64 x); /* Write out 64 bit number in manner that is portable across architectures */ bits64 readBits64(FILE *f); /* Write out 64 bit number in manner that is portable across architectures */ void carefulClose(FILE **pFile); /* Close file if open and null out handle to it. */ boolean carefulCloseWarn(FILE **pFile); /* Close file if open and null out handle to it. * Return FALSE and print a warning message if there * is a problem.*/ char *firstWordInFile(char *fileName, char *wordBuf, int wordBufSize); /* Read the first word in file into wordBuf. */ int roundingScale(int a, int p, int q); /* returns rounded a*p/q */ int intAbs(int a); /* Return integer absolute value */ #define logBase2(x)(log(x)/log(2)) /* return log base two of number */ #define round(a) ((int)((a)+0.5)) /* Round floating point val to nearest integer. */ #define roundll(a) ((long long)((a)+0.5)) /* Round floating point val to nearest long long. */ #ifndef min #define min(a,b) ( (a) < (b) ? (a) : (b) ) /* Return min of a and b. */ #endif #ifndef max #define max(a,b) ( (a) > (b) ? (a) : (b) ) /* Return max of a and b. */ #endif int rangeIntersection(int start1, int end1, int start2, int end2); /* Return amount of bases two ranges intersect over, 0 or negative if no * intersection. */ int positiveRangeIntersection(int start1, int end1, int start2, int end2); /* Return amount of bases two ranges intersect over, 0 if no * intersection. */ bits32 byteSwap32(bits32 a); /* Swap from intel to sparc order of a 32 bit quantity. */ void removeReturns(char* dest, char* src); /* Removes the '\r' character from a string. * the source and destination strings can be the same, * if there are no threads */ int intExp(char *text); /* Convert text to integer expression and evaluate. * Throws if it finds a non-number. */ double doubleExp(char *text); /* Convert text to floating point expression and * evaluate. */ char* readLine(FILE* fh); /* Read a line of any size into dynamic memory, return null on EOF */ off_t fileSize(char *fileName); /* The size of a file. */ boolean fileExists(char *fileName); /* Does a file exist? */ /* Friendly name for strstrNoCase */ char *containsStringNoCase(char *haystack, char *needle); char *strstrNoCase(char *haystack, char *needle); /* A case-insensitive strstr */ int vasafef(char* buffer, int bufSize, char *format, va_list args); /* Format string to buffer, vsprintf style, only with buffer overflow * checking. The resulting string is always terminated with zero byte. */ int safef(char* buffer, int bufSize, char *format, ...) /* Format string to buffer, vsprintf style, only with buffer overflow * checking. The resulting string is always terminated with zero byte. */ #ifdef __GNUC__ __attribute__((format(printf, 3, 4))) #endif ; void safecpy(char *buf, size_t bufSize, const char *src); /* copy a string to a buffer, with bounds checking.*/ void safencpy(char *buf, size_t bufSize, const char *src, size_t n); /* copy n characters from a string to a buffer, with bounds checking. * Unlike strncpy, always null terminates the result */ void safecat(char *buf, size_t bufSize, const char *src); /* Append a string to a buffer, with bounds checking.*/ void safencat(char *buf, size_t bufSize, const char *src, size_t n); /* append n characters from a string to a buffer, with bounds checking. */ char *naForNull(char *s); /* Return 'n/a' if s is NULL, otherwise s. */ char *naForEmpty(char *s); /* Return n/a if s is "" or NULL, otherwise s. */ char *emptyForNull(char *s); /* Return "" if s is NULL, otherwise s. */ char *nullIfAllSpace(char *s); /* Return NULL if s is all spaces, otherwise s. */ char *trueFalseString(boolean b); /* Return "true" or "false" */ void uglyTime(char *label, ...); /* Print label and how long it's been since last call. Call with * a NULL label to initialize. */ /* In case the development environment does not supply INFINITY */ #if !defined(INFINITY) #define INFINITY (1.0/0.0) #endif void makeDirs(char* path); /* make a directory, including parent directories */ char *skipNumeric(char *s); /* Return first char of s that's not a digit */ char *skipToNumeric(char *s); /* skip up to where numeric digits appear */ char *splitOffNonNumeric(char *s); /* Split off non-numeric part, e.g. mm of mm8. Result should be freed when done */ char *splitOffNumber(char *db); /* Split off number part, e.g. 8 of mm8. Result should be freed when done */ int digitsBaseTwo(unsigned long x); /* Return base two # of digits. */ int digitsBaseTen(int x); /* Return number of digits base 10. */ void *intToPt(int i); /* Convert integer to pointer. Use when really want to store an * int in a pointer field. */ int ptToInt(void *pt); /* Convert pointer to integer. Use when really want to store a * pointer in an int. */ void *sizetToPt(size_t i); /* Convert size_t to pointer. Use when really want to store a * size_t in a pointer. */ size_t ptToSizet(void *pt); /* Convert pointer to size_t. Use when really want to store a * pointer in a size_t. */ #endif /* COMMON_H */ IRanges/src/compact_bitvector.c0000644000126300012640000001063412234075662020142 0ustar00biocbuildphs_compbio#include "IRanges.h" #include /* for CHAR_BIT */ #include /* for div() */ #define BIT7_MASK (1 << (CHAR_BIT-1)) #define END_OP 0 #define S_H_OP 1 #define N_OP 2 #define BAD_OP 3 #define P_OP 4 #define I_OP 5 #define D_OP 6 #define M_OP 7 static const unsigned char BitsSetTable256[256] = { # define B2(n) n, n+1, n+1, n+2 # define B4(n) B2(n), B2(n+1), B2(n+1), B2(n+2) # define B6(n) B4(n), B4(n+1), B4(n+1), B4(n+2) B6(0), B6(1), B6(1), B6(2) }; /* Turns a logical vector into a "compact bit vector" */ SEXP logical_as_compact_bitvector(SEXP x) { SEXP ans; Rbyte *ans_elt; int x_length, ans_length, i, j, x_elt; div_t q; x_length = LENGTH(x); q = div(x_length, CHAR_BIT); ans_length = q.quot; if (q.rem != 0) ans_length++; PROTECT(ans = NEW_RAW(ans_length)); for (i = j = 0, ans_elt = RAW(ans); i < x_length; i++, j++) { if (j >= CHAR_BIT) { j = 0; ans_elt++; } *ans_elt <<= 1; x_elt = LOGICAL(x)[i]; if (x_elt == NA_INTEGER) { UNPROTECT(1); error("'x' contains NAs"); } if (x_elt) *ans_elt |= 1; } if (q.rem != 0) *ans_elt <<= CHAR_BIT - q.rem; UNPROTECT(1); return ans; } /* Turns a "compact bit vector" into a logical vector */ SEXP compact_bitvector_as_logical(SEXP x, SEXP length_out) { SEXP ans; Rbyte x_elt; int ans_length, x_length, i, j, k; ans_length = INTEGER(length_out)[0]; x_length = LENGTH(x); if (ans_length > x_length * CHAR_BIT) error("'length_out' is > 'length(x)' * %d", CHAR_BIT); PROTECT(ans = NEW_LOGICAL(ans_length)); for (i = j = 0, x_elt = RAW(x)[k = 0]; i < ans_length; i++, j++) { if (j >= CHAR_BIT) { j = 0; x_elt = RAW(x)[++k]; } LOGICAL(ans)[i] = (x_elt & BIT7_MASK) != 0; x_elt <<= 1; } UNPROTECT(1); return ans; } /* Subsets a "compact bit vector" */ SEXP subset_compact_bitvector(SEXP x, SEXP subscript) { SEXP ans; Rbyte *ans_elt; int x_length, subscript_length, ans_length, i, j, sub_i; div_t q, q2; x_length = LENGTH(x); subscript_length = LENGTH(subscript); q = div(subscript_length, CHAR_BIT); ans_length = q.quot; if (q.rem != 0) ans_length++; PROTECT(ans = NEW_RAW(ans_length)); for (i = j = 0, ans_elt = RAW(ans); i < subscript_length; i++, j++) { if (j >= CHAR_BIT) { j = 0; ans_elt++; } *ans_elt <<= 1; sub_i = INTEGER(subscript)[i]; if (sub_i == NA_INTEGER) { UNPROTECT(1); error("subscript contains NAs"); } sub_i--; q2 = div(sub_i, CHAR_BIT); if (sub_i < 0 || q2.quot >= x_length) { UNPROTECT(1); error("subscript out of bounds"); } if (RAW(x)[q2.quot] & (BIT7_MASK >> q2.rem)) *ans_elt |= 1; } if (q.rem != 0) *ans_elt <<= CHAR_BIT - q.rem; UNPROTECT(1); return ans; } SEXP compact_bitvector_bit_count(SEXP x) { SEXP ans; Rbyte *x_elt; int *ans_elt, ans_length, i; ans_length = LENGTH(x); PROTECT(ans = NEW_INTEGER(ans_length)); for (i = 0, x_elt = RAW(x), ans_elt = INTEGER(ans); i < ans_length; i++, x_elt++, ans_elt++) { *ans_elt = BitsSetTable256[*x_elt]; } UNPROTECT(1); return(ans); } SEXP compact_bitvector_last_bit(SEXP x) { SEXP ans; Rbyte LAST_MASK, *x_elt; int *ans_elt, ans_length, i; LAST_MASK = BIT7_MASK >> 7; ans_length = LENGTH(x); PROTECT(ans = NEW_INTEGER(ans_length)); for (i = 0, x_elt = RAW(x), ans_elt = INTEGER(ans); i < ans_length; i++, x_elt++, ans_elt++) { *ans_elt = (*x_elt & LAST_MASK) != 0; } UNPROTECT(1); return(ans); } SEXP compact_bitvector_set_op(SEXP query, SEXP ref, SEXP align) { SEXP ans; Rbyte *ans_elt, query_elt, ref_elt, align_elt; int ans_length, i, j, k, op; ans_length = 8 * LENGTH(query); PROTECT(ans = NEW_RAW(ans_length)); j = k = 0; query_elt = RAW(query)[0]; ref_elt = RAW(ref)[0]; align_elt = RAW(align)[0]; for (i = 0, ans_elt = RAW(ans); i < ans_length; i++, ans_elt++) { if (j >= CHAR_BIT) { j = 0; k++; query_elt = RAW(query)[k]; ref_elt = RAW(ref)[k]; align_elt = RAW(align)[k]; } op = ((query_elt & BIT7_MASK) != 0) + (((ref_elt & BIT7_MASK) != 0) << 1) + (((align_elt & BIT7_MASK) != 0) << 2); switch (op) { case M_OP: *ans_elt = 'M'; break; case I_OP: *ans_elt = 'I'; break; case D_OP: *ans_elt = 'D'; break; case N_OP: *ans_elt = 'N'; break; case S_H_OP: *ans_elt = 'S'; break; case P_OP: *ans_elt = 'P'; break; case END_OP: *ans_elt = '|'; break; case BAD_OP: *ans_elt = '?'; break; } query_elt <<= 1; ref_elt <<= 1; align_elt <<= 1; j++; } UNPROTECT(1); return(ans); } IRanges/src/coverage_methods.c0000644000126300012640000005672512234075662017764 0ustar00biocbuildphs_compbio/**************************************************************************** * * * Weighted coverage of a set of integer ranges * * -------------------------------------------- * * * * Authors: Herve Pages and Patrick Aboyoun * * Code for "sort" method based on timing enhancements * * by Charles C. Berry * * * ****************************************************************************/ #include "IRanges.h" #include /* for qsort() */ #include /* for R_CheckUserInterrupt() */ static const char *x_label, *shift_label, *width_label, *weight_label; static void check_recycling_was_round(int last_pos_in_current, int current_len, const char *current_label, const char *target_label) { if (current_len >= 2 && last_pos_in_current < current_len) warning("'%s' length is not a divisor of '%s' length", current_label, target_label); return; } /**************************************************************************** * "sort" method * ****************************************************************************/ /**************************************************************************** * Basic manipulation of the SEids buffer (Start/End ids). */ #define SEid_TO_1BASED_INDEX(SEid) ((SEid) >= 0 ? (SEid) : -(SEid)) #define SEid_IS_END(SEid) ((SEid) >= 0) static const int *base_start; static const int *base_width; static int compar_SEids_for_asc_order(const void *p1, const void *p2) { int SEid1, SEid2, index1, index2, s1, s2; SEid1 = *((const int *) p1); SEid2 = *((const int *) p2); index1 = SEid_TO_1BASED_INDEX(SEid1); index2 = SEid_TO_1BASED_INDEX(SEid2); /* If SEid is a Start id, then s = start If SEid is an End id, then s = end + 1 */ s1 = base_start[index1]; if (SEid_IS_END(SEid1)) s1 += base_width[index1]; s2 = base_start[index2]; if (SEid_IS_END(SEid2)) s2 += base_width[index2]; return s1 - s2; } /* Initialize the SEids buffer (integer weights). */ static int init_SEids_int_weight(int *SEids, const int *x_width, int x_len, const int *weight, int weight_len) { int SEids_len, i, j, index; SEids_len = 0; for (i = j = 0, index = 1; i < x_len; i++, j++, index++) { if (j >= weight_len) j = 0; /* recycle j */ if (x_width[i] == 0 || weight[j] == 0) continue; *(SEids++) = index; /* Start id */ *(SEids++) = - index; /* End id */ SEids_len += 2; } check_recycling_was_round(j, weight_len, weight_label, x_label); return SEids_len; } /* Initialize the SEids buffer (numeric weights). */ static int init_SEids_double_weight(int *SEids, const int *x_width, int x_len, const double *weight, int weight_len) { int SEids_len, i, j, index; SEids_len = 0; for (i = j = 0, index = 1; i < x_len; i++, j++, index++) { if (j >= weight_len) j = 0; /* recycle j */ if (x_width[i] == 0 || weight[j] == 0.0) continue; *(SEids++) = index; /* Start id */ *(SEids++) = - index; /* End id */ SEids_len += 2; } check_recycling_was_round(j, weight_len, weight_label, x_label); return SEids_len; } /* Sort the SEids buffer. */ static void sort_SEids(int *SEids, int SEids_len, const int *x_start, const int *x_width) { base_start = x_start - 1; base_width = x_width - 1; qsort(SEids, SEids_len, sizeof(int), compar_SEids_for_asc_order); return; } /**************************************************************************** * int_coverage_sort(), double_coverage_sort() */ /* 'values_buf' and 'lengths_buf' must have a length >= SEids_len + 1 */ static void compute_int_coverage_in_bufs(const int *SEids, int SEids_len, const int *x_start, const int *x_width, const int *weight, int weight_len, int cvg_len, int *values_buf, int *lengths_buf) { int curr_val, curr_weight, curr_pos, i, prev_pos, index; *(values_buf++) = curr_val = 0; curr_pos = 1; _reset_ovflow_flag(); /* we use _safe_int_add() in loop below */ for (i = 0; i < SEids_len; i++, SEids++) { if (i % 500000 == 499999) R_CheckUserInterrupt(); prev_pos = curr_pos; index = SEid_TO_1BASED_INDEX(*SEids) - 1; curr_pos = x_start[index]; curr_weight = weight[index % weight_len]; if (SEid_IS_END(*SEids)) { curr_weight = - curr_weight; curr_pos += x_width[index]; } curr_val = _safe_int_add(curr_val, curr_weight); *(values_buf++) = curr_val; *(lengths_buf++) = curr_pos - prev_pos; } if (_get_ovflow_flag()) warning("NAs produced by integer overflow"); *lengths_buf = cvg_len + 1 - curr_pos; return; } static void compute_double_coverage_in_bufs(const int *SEids, int SEids_len, const int *x_start, const int *x_width, const double *weight, int weight_len, int cvg_len, double *values_buf, int *lengths_buf) { double curr_val, curr_weight; int curr_pos, i, prev_pos, index; *(values_buf++) = curr_val = 0.0; curr_pos = 1; for (i = 0; i < SEids_len; i++, SEids++) { if (i % 500000 == 499999) R_CheckUserInterrupt(); prev_pos = curr_pos; index = SEid_TO_1BASED_INDEX(*SEids) - 1; curr_pos = x_start[index]; curr_weight = weight[index % weight_len]; if (SEid_IS_END(*SEids)) { curr_weight = - curr_weight; curr_pos += x_width[index]; } curr_val += curr_weight; *(values_buf++) = curr_val; *(lengths_buf++) = curr_pos - prev_pos; } *lengths_buf = cvg_len + 1 - curr_pos; return; } static SEXP int_coverage_sort(const int *x_start, const int *x_width, int x_len, const int *weight, int weight_len, int cvg_len) { int *SEids, SEids_len, zero, buf_len, *values_buf, *lengths_buf; SEids = (int *) R_alloc((long) 2 * x_len, sizeof(int)); SEids_len = init_SEids_int_weight(SEids, x_width, x_len, weight, weight_len); if (SEids_len == 0) { //return an Rle with one run of 0's zero = 0; return _integer_Rle_constructor(&zero, 1, &cvg_len, 0); } sort_SEids(SEids, SEids_len, x_start, x_width); buf_len = SEids_len + 1; values_buf = (int *) R_alloc((long) buf_len, sizeof(int)); lengths_buf = (int *) R_alloc((long) buf_len, sizeof(int)); compute_int_coverage_in_bufs(SEids, SEids_len, x_start, x_width, weight, weight_len, cvg_len, values_buf, lengths_buf); return _integer_Rle_constructor(values_buf, buf_len, lengths_buf, 0); } static SEXP double_coverage_sort(const int *x_start, const int *x_width, int x_len, const double *weight, int weight_len, int cvg_len) { int *SEids, SEids_len, buf_len, *lengths_buf; double zero, *values_buf; SEids = (int *) R_alloc((long) 2 * x_len, sizeof(int)); SEids_len = init_SEids_double_weight(SEids, x_width, x_len, weight, weight_len); if (SEids_len == 0) { //return an Rle with one run of 0's zero = 0.0; return _numeric_Rle_constructor(&zero, 1, &cvg_len, 0); } sort_SEids(SEids, SEids_len, x_start, x_width); buf_len = SEids_len + 1; values_buf = (double *) R_alloc((long) buf_len, sizeof(double)); lengths_buf = (int *) R_alloc((long) buf_len, sizeof(int)); compute_double_coverage_in_bufs(SEids, SEids_len, x_start, x_width, weight, weight_len, cvg_len, values_buf, lengths_buf); return _numeric_Rle_constructor(values_buf, buf_len, lengths_buf, 0); } static SEXP coverage_sort(const int *x_start, const int *x_width, int x_len, SEXP weight, int cvg_len) { int weight_len; weight_len = LENGTH(weight); return IS_INTEGER(weight) ? int_coverage_sort(x_start, x_width, x_len, INTEGER(weight), weight_len, cvg_len) : double_coverage_sort(x_start, x_width, x_len, REAL(weight), weight_len, cvg_len); } /**************************************************************************** * "hash" method * ****************************************************************************/ static SEXP int_coverage_hash( const int *x_start, const int *x_width, int x_len, const int *weight, int weight_len, int cvg_len) { int *cvg_buf, *cvg_p, w, cumsum, i, j; cvg_buf = (int *) R_alloc((long) cvg_len + 1, sizeof(int)); memset(cvg_buf, 0, cvg_len * sizeof(int)); _reset_ovflow_flag(); /* we use _safe_int_add() in loop below */ for (i = j = 0; i < x_len; i++, j++, x_start++, x_width++) { if (i % 500000 == 499999) R_CheckUserInterrupt(); if (j >= weight_len) j = 0; /* recycle j */ cvg_p = cvg_buf + *x_start - 1; w = weight[j]; *cvg_p = _safe_int_add(*cvg_p, w); cvg_p += *x_width; *cvg_p = _safe_int_add(*cvg_p, - w); } check_recycling_was_round(j, weight_len, weight_label, x_label); cumsum = 0; for (i = 0, cvg_p = cvg_buf; i < cvg_len; i++, cvg_p++) { cumsum = _safe_int_add(*cvg_p, cumsum); *cvg_p = cumsum; } if (_get_ovflow_flag()) warning("NAs produced by integer overflow"); return _integer_Rle_constructor(cvg_buf, cvg_len, NULL, 0); } static SEXP double_coverage_hash( const int *x_start, const int *x_width, int x_len, const double *weight, int weight_len, int cvg_len) { double *cvg_buf, *cvg_p, w, cumsum; int i, j; cvg_buf = (double *) R_alloc((long) cvg_len + 1, sizeof(double)); for (i = 0, cvg_p = cvg_buf; i < cvg_len; i++, cvg_p++) *cvg_p = 0.0; for (i = j = 0; i < x_len; i++, j++, x_start++, x_width++) { if (i % 500000 == 499999) R_CheckUserInterrupt(); if (j >= weight_len) j = 0; /* recycle j */ cvg_p = cvg_buf + *x_start - 1; w = weight[j]; *cvg_p += w; cvg_p += *x_width; *cvg_p -= w; } check_recycling_was_round(j, weight_len, weight_label, x_label); cumsum = 0.0; for (i = 0, cvg_p = cvg_buf; i < cvg_len; i++, cvg_p++) { cumsum += *cvg_p; *cvg_p = cumsum; } return _numeric_Rle_constructor(cvg_buf, cvg_len, NULL, 0); } static SEXP coverage_hash(const int *x_start, const int *x_width, int x_len, SEXP weight, int cvg_len) { int weight_len; weight_len = LENGTH(weight); return IS_INTEGER(weight) ? int_coverage_hash(x_start, x_width, x_len, INTEGER(weight), weight_len, cvg_len) : double_coverage_hash(x_start, x_width, x_len, REAL(weight), weight_len, cvg_len); } /**************************************************************************** * Helper functions for checking args of type SEXP. * * They either pass (and return nothing) or raise an error with an * * informative message. * ****************************************************************************/ static void check_arg_is_integer(SEXP arg, const char *arg_label) { if (!IS_INTEGER(arg)) error("'%s' must be an integer vector", arg_label); return; } static void check_arg_is_numeric(SEXP arg, const char *arg_label) { if (!(IS_INTEGER(arg) || IS_NUMERIC(arg))) error("'%s' must be an integer or numeric vector", arg_label); return; } static void check_arg_is_list(SEXP arg, const char *arg_label) { if (!IS_LIST(arg)) error("'%s' must be a list", arg_label); return; } /* * Check that 'arg_len' is equal to 'x_len', or that it's the length of an * argument that can be recycled to the length of 'x'. * Assumes that 'arg_len' and 'x_len' are >= 0. */ static void check_arg_is_recyclable(int arg_len, int x_len, const char *arg_label, const char *x_label) { if (arg_len < x_len) { if (arg_len == 0) error("cannot recycle zero-length '%s' " "to the length of '%s'", arg_label, x_label); } else if (arg_len > x_len) { if (arg_len >= 2) error("'%s' is longer than '%s'", arg_label, x_label); } return; } /**************************************************************************** * cachedIRanges_coverage() * ****************************************************************************/ /* * This is probably overly cautious. Could be that the cast from double to int * with (int) already does exactly this (i.e. produces an NA_INTEGER for all * the cases explicitely handled here) and is portable. */ static int double2int(double x) { if (x == R_PosInf || x == R_NegInf || ISNAN(x) /* NA or NaN */ || x >= (double) INT_MAX + 1.00 || x <= (double) INT_MIN) return NA_INTEGER; return (int) x; } /* * Args: * cached_x: A cachedIRanges struct holding the input ranges, those * ranges being those of a fictive IRanges object 'x'. * shift: A numeric (integer or double) vector parallel to 'x' (will * get recycled if necessary) with no NAs. * width: A single integer. NA or >= 0. * circle_len: A single integer. NA or > 0. * After the input ranges are shifted: * - If 'width' is a non-negative integer, then the ranges are clipped with * respect to the [1, width] interval and the function returns 'width'. * - If 'width' is NA, then the ranges are clipped with respect to the * [1, +inf) interval (i.e. they're only clipped on the left) and the * function returns 'max(end(x))' or 0 if 'x' is empty. * The shifted and clipped ranges are returned in 'out_ranges'. * Let's call 'cvg_len' the value returned by the function. If the output * ranges are in a tiling configuration with respect to the [1, cvg_len] * interval (i.e. they're non-overlapping, ordered from left to right, and * they fully cover the interval), then '*out_ranges_are_tiles' is set to 1. * Otherwise, it's set to 0. */ static int shift_and_clip_ranges(const cachedIRanges *cached_x, SEXP shift, int width, int circle_len, RangeAE *out_ranges, int *out_ranges_are_tiles) { int x_len, shift_len, cvg_len, auto_cvg_len, prev_end, i, j, x_start, x_end, shift_elt, tmp; x_len = _get_cachedIRanges_length(cached_x); /* Check 'shift'. */ check_arg_is_numeric(shift, shift_label); shift_len = LENGTH(shift); check_arg_is_recyclable(shift_len, x_len, shift_label, x_label); /* Infer 'cvg_len' from 'width' and 'circle_len'. */ *out_ranges_are_tiles = 1; if (width == NA_INTEGER) { auto_cvg_len = 1; } else if (width < 0) { error("'%s' cannot be negative", width_label); } else if (width == 0) { return width; } else if (circle_len == NA_INTEGER) { auto_cvg_len = 0; } else if (circle_len <= 0) { error("length of underlying circular sequence is <= 0"); } else if (width > circle_len) { error("'%s' cannot be greater than length of " "underlying circular sequence", width_label); } else { auto_cvg_len = 1; } cvg_len = auto_cvg_len ? 0 : width; if (x_len == 0) { if (cvg_len != 0) *out_ranges_are_tiles = 0; return cvg_len; } _RangeAE_set_nelt(out_ranges, 0); prev_end = 0; for (i = j = 0; i < x_len; i++, j++) { if (j >= shift_len) j = 0; /* recycle j */ x_start = _get_cachedIRanges_elt_start(cached_x, i); x_end = _get_cachedIRanges_elt_end(cached_x, i); if (IS_INTEGER(shift)) { shift_elt = INTEGER(shift)[j]; if (shift_elt == NA_INTEGER) error("'%s' contains NAs", shift_label); } else { shift_elt = double2int(REAL(shift)[j]); if (shift_elt == NA_INTEGER) error("'%s' contains NAs, NaNs, or numbers " "that cannot be turned into integers", shift_label); } /* Risk of integer overflow! */ x_start += shift_elt; x_end += shift_elt; if (circle_len != NA_INTEGER) { tmp = x_start % circle_len; if (tmp <= 0) tmp += circle_len; x_end += tmp - x_start; x_start = tmp; } if (x_end < 0) { x_end = 0; } else if (x_end > cvg_len) { if (auto_cvg_len) cvg_len = x_end; else x_end = cvg_len; } if (x_start < 1) x_start = 1; else if (x_start > (tmp = cvg_len + 1)) x_start = tmp; if (*out_ranges_are_tiles) { if (x_start == prev_end + 1) prev_end = x_end; else *out_ranges_are_tiles = 0; } _RangeAE_insert_at(out_ranges, i, x_start, x_end - x_start + 1); } check_recycling_was_round(j, shift_len, shift_label, x_label); if (*out_ranges_are_tiles && x_end != cvg_len) *out_ranges_are_tiles = 0; return cvg_len; } /* * Args: * cached_x: A cachedIRanges struct holding the input ranges, those * ranges being those of a fictive IRanges object 'x'. * shift: A numeric (integer or double) vector parallel to 'x' (will * get recycled if necessary) with no NAs. * width: A single integer. NA or >= 0. * weight: A numeric (integer or double) vector parallel to 'x' (will * get recycled if necessary). * circle_len: A single integer. NA or > 0. * method: Either "auto", "sort", or "hash". * Returns an Rle object. */ static SEXP cachedIRanges_coverage(const cachedIRanges *cached_x, SEXP shift, int width, SEXP weight, int circle_len, SEXP method, RangeAE *ranges_buf) { int x_len, cvg_len, out_ranges_are_tiles, weight_len, effective_method, take_short_path; const int *x_start, *x_width; const char *method0; x_len = _get_cachedIRanges_length(cached_x); cvg_len = shift_and_clip_ranges(cached_x, shift, width, circle_len, ranges_buf, &out_ranges_are_tiles); x_start = ranges_buf->start.elts; x_width = ranges_buf->width.elts; /* Check 'weight'. */ check_arg_is_numeric(weight, weight_label); weight_len = LENGTH(weight); check_arg_is_recyclable(weight_len, x_len, weight_label, x_label); /* Infer 'effective_method' from 'method' and 'cvg_len'. */ if (!IS_CHARACTER(method) || LENGTH(method) != 1) error("'method' must be a single string"); method = STRING_ELT(method, 0); if (method == NA_STRING) error("'method' cannot be NA"); method0 = CHAR(method); if (strcmp(method0, "auto") == 0) { /* Based on empirical observation. */ effective_method = x_len <= 0.25 * cvg_len ? 1 : 2; } else if (strcmp(method0, "sort") == 0) { effective_method = 1; } else if (strcmp(method0, "hash") == 0) { effective_method = 2; } else { error("'method' must be \"auto\", \"sort\", or \"hash\""); } //Rprintf("out_ranges_are_tiles = %d\n", out_ranges_are_tiles); //Rprintf("x_len = %d\n", x_len); //Rprintf("cvg_len = %d\n", cvg_len); if (out_ranges_are_tiles) { if (cvg_len == 0) { take_short_path = 1; x_len = 0; } else if (weight_len == 1) { take_short_path = 1; x_len = 1; x_width = &cvg_len; } else if (weight_len == x_len) { take_short_path = 1; } else { take_short_path = 0; } if (take_short_path) { /* Short path for the tiling case. */ //Rprintf("taking short path\n"); return IS_INTEGER(weight) ? _integer_Rle_constructor(INTEGER(weight), x_len, x_width, 0) : _numeric_Rle_constructor(REAL(weight), x_len, x_width, 0); } } //Rprintf("taking normal path\n"); return effective_method == 1 ? coverage_sort(x_start, x_width, x_len, weight, cvg_len) : coverage_hash(x_start, x_width, x_len, weight, cvg_len); } /* --- .Call ENTRY POINT --- * Args: * x: An IRanges object. * shift: A numeric (integer or double) vector parallel to 'x' (will * get recycled if necessary) with no NAs. * width: A single integer. NA or >= 0. * weight: A numeric (integer or double) vector parallel to 'x' (will * get recycled if necessary). * circle_len: A single integer. NA or > 0. * method: Either "auto", "sort", or "hash". * Returns an Rle object. */ SEXP IRanges_coverage(SEXP x, SEXP shift, SEXP width, SEXP weight, SEXP circle_len, SEXP method) { cachedIRanges cached_x; int x_len; RangeAE ranges_buf; cached_x = _cache_IRanges(x); x_len = _get_cachedIRanges_length(&cached_x); /* Check 'width'. */ check_arg_is_integer(width, "width"); if (LENGTH(width) != 1) error("'%s' must be a single integer", "width"); /* Check 'circle_len'. */ check_arg_is_integer(circle_len, "circle.length"); if (LENGTH(circle_len) != 1) error("'%s' must be a single integer", "circle.length"); ranges_buf = _new_RangeAE(x_len, 0); x_label = "x"; shift_label = "shift"; width_label = "width"; weight_label = "weight"; return cachedIRanges_coverage(&cached_x, shift, INTEGER(width)[0], weight, INTEGER(circle_len)[0], method, &ranges_buf); } /* --- .Call ENTRY POINT --- * Args: * x: A CompressedIRangesList object of length N. * shift: A list of length N (will get recycled if necessary). After * recycling, each list element must be a numeric (integer or * double) vector parallel to x[[i]] that will itself get * recycled if necessary, and with no NAs. * width: An integer vector of length N (will get recycled if * necessary). Values must be NAs or >= 0. * or a single non-negative number. * weight: A list of length N (will get recycled if necessary). After * recycling, each list element must be a numeric (integer or * double) vector parallel to x[[i]] that will itself get * recycled if necessary. * circle_lens: An integer vector of length N (will get recycled if * necessary). Values must be NAs or > 0. * method: Either "auto", "sort", or "hash". * Returns a list of N RleList objects. */ SEXP CompressedIRangesList_coverage(SEXP x, SEXP shift, SEXP width, SEXP weight, SEXP circle_lens, SEXP method) { cachedCompressedIRangesList cached_x; int x_len, shift_len, width_len, weight_len, circle_lens_len, i, j, k, l, m; RangeAE ranges_buf; SEXP ans, ans_elt, shift_elt, weight_elt; cachedIRanges cached_x_elt; char x_label_buf[40], shift_label_buf[40], width_label_buf[40], weight_label_buf[40]; cached_x = _cache_CompressedIRangesList(x); x_len = _get_cachedCompressedIRangesList_length(&cached_x); /* Check 'shift'. */ check_arg_is_list(shift, "shift"); shift_len = LENGTH(shift); check_arg_is_recyclable(shift_len, x_len, "shift", "x"); /* Check 'width'. */ check_arg_is_integer(width, "width"); width_len = LENGTH(width); check_arg_is_recyclable(width_len, x_len, "width", "x"); /* Check 'weight'. */ check_arg_is_list(weight, "weight"); weight_len = LENGTH(weight); check_arg_is_recyclable(weight_len, x_len, "weight", "x"); /* Check 'circle_lens'. */ check_arg_is_integer(circle_lens, "circle.length"); circle_lens_len = LENGTH(circle_lens); check_arg_is_recyclable(circle_lens_len, x_len, "circle.length", "x"); ranges_buf = _new_RangeAE(0, 0); x_label = x_label_buf; shift_label = shift_label_buf; width_label = width_label_buf; weight_label = weight_label_buf; PROTECT(ans = NEW_LIST(x_len)); for (i = j = k = l = m = 0; i < x_len; i++, j++, k++, l++, m++) { if (j >= shift_len) j = 0; /* recycle j */ if (k >= width_len) k = 0; /* recycle k */ if (l >= weight_len) l = 0; /* recycle l */ if (m >= circle_lens_len) m = 0; /* recycle m */ snprintf(x_label_buf, sizeof(x_label_buf), "x[[%d]]", i + 1); snprintf(shift_label_buf, sizeof(shift_label_buf), "shift[[%d]]", j + 1); snprintf(width_label_buf, sizeof(width_label_buf), "width[%d]", k + 1); snprintf(weight_label_buf, sizeof(weight_label_buf), "weight[[%d]]", l + 1); cached_x_elt = _get_cachedCompressedIRangesList_elt(&cached_x, i); shift_elt = VECTOR_ELT(shift, j); weight_elt = VECTOR_ELT(weight, l); PROTECT(ans_elt = cachedIRanges_coverage(&cached_x_elt, shift_elt, INTEGER(width)[k], weight_elt, INTEGER(circle_lens)[m], method, &ranges_buf)); SET_VECTOR_ELT(ans, i, ans_elt); UNPROTECT(1); } check_recycling_was_round(j, shift_len, "shift", "x"); check_recycling_was_round(k, width_len, "width", "x"); check_recycling_was_round(l, weight_len, "weight", "x"); check_recycling_was_round(m, circle_lens_len, "circle.length", "x"); UNPROTECT(1); return ans; } IRanges/src/dlist.c0000644000126300012640000001572012234075662015553 0ustar00biocbuildphs_compbio/* dlist.c - Doubly-linked list routines. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #include "common.h" #include "dlist.h" static char const rcsid[] = "$Id: dlist.c,v 1.11 2005/07/04 18:44:09 markd Exp $"; void dlListInit(struct dlList *dl) /* Initialize list to be empty */ { dl->head = (struct dlNode *)(&dl->nullMiddle); dl->nullMiddle = NULL; dl->tail = (struct dlNode *)(&dl->head); } struct dlList *newDlList() /* Return a new doubly linked list. */ { struct dlList *dl; AllocVar(dl); dl->head = (struct dlNode *)(&dl->nullMiddle); dl->tail = (struct dlNode *)(&dl->head); return dl; } void dlListReset(struct dlList *dl) /* Reset a list to the empty state (does not free values) */ { struct dlNode *node, *next; for (node = dl->head; node->next != NULL; node = next) { next = node->next; freeMem(node); } dl->head = (struct dlNode *)(&dl->nullMiddle); dl->nullMiddle = NULL; dl->tail = (struct dlNode *)(&dl->head); } void freeDlList(struct dlList **pList) /* Free up a doubly linked list and it's nodes (but not the node values). */ { struct dlList *list = *pList; if (list != NULL) { dlListReset(list); freez(pList); } } void freeDlListAndVals(struct dlList **pList) /* Free all values in doubly linked list and the list itself. (Just calls * freeMem on all values. */ { struct dlList *list = *pList; if (list != NULL) { struct dlNode *node; for (node = list->head; node->next != NULL; node = node->next) freeMem(node->val); freeDlList(pList); } } void dlInsertBetween(struct dlNode *before, struct dlNode *after, struct dlNode *newNode) { before->next = newNode; newNode->prev = before; newNode->next = after; after->prev = newNode; } void dlAddBefore(struct dlNode *anchor, struct dlNode *newNode) /* Add a node to list before anchor member. */ { dlInsertBetween(anchor->prev, anchor, newNode); } void dlAddAfter(struct dlNode *anchor, struct dlNode *newNode) /* Add a node to list after anchor member. */ { dlInsertBetween(anchor, anchor->next, newNode); } void dlAddHead(struct dlList *list, struct dlNode *newNode) /* Add a node to head of list. */ { struct dlNode *head = list->head; dlInsertBetween(head->prev, head, newNode); } void dlAddTail(struct dlList *list, struct dlNode *newNode) /* Add a node to tail of list. */ { struct dlNode *tail = list->tail; dlInsertBetween(tail, tail->next, newNode); } struct dlNode *dlAddValBefore(struct dlNode *anchor, void *val) /* Create a node containing val and add to list before anchor member. */ { struct dlNode *node = AllocA(struct dlNode); node->val = val; dlAddBefore(anchor, node); return node; } struct dlNode *dlAddValAfter(struct dlNode *anchor, void *val) /* Create a node containing val and add to list after anchor member. */ { struct dlNode *node = AllocA(struct dlNode); node->val = val; dlAddAfter(anchor, node); return node; } struct dlNode *dlAddValHead(struct dlList *list, void *val) /* Create a node containing val and add to head of list. */ { struct dlNode *node = AllocA(struct dlNode); node->val = val; dlAddHead(list, node); return node; } struct dlNode *dlAddValTail(struct dlList *list, void *val) /* Create a node containing val and add to tail of list. */ { struct dlNode *node = AllocA(struct dlNode); node->val = val; dlAddTail(list, node); return node; } void dlRemove(struct dlNode *node) /* Removes a node from list. Node is not freed. */ { struct dlNode *before = node->prev; struct dlNode *after = node->next; before->next = after; after->prev = before; node->prev = NULL; node->next = NULL; } void dlRemoveHead(struct dlList *list) /* Removes head from list. Node is not freed. */ { dlRemove(list->head); } void dlRemoveTail(struct dlList *list) /* Remove tail from list. Node is not freed. */ { dlRemove(list->tail); } struct dlNode *dlPopHead(struct dlList *list) /* Remove first node from list and return it. */ { struct dlNode *node = list->head; if (node->next == NULL) return NULL; dlRemove(node); return node; } struct dlNode *dlPopTail(struct dlList *list) /* Remove last node from list and return it. */ { struct dlNode *node = list->tail; if (node->prev == NULL) return NULL; dlRemove(node); return node; } void dlDelete(struct dlNode **nodePtr) /* Removes a node from list and frees it. */ { struct dlNode *node = *nodePtr; if (node != NULL) { dlRemove(node); freeMem(node); } } int dlCount(struct dlList *list) /* Return length of list. */ { return slCount(list->head) - 1; } struct dlSorter /* Helper structure for sorting dlNodes preserving order */ { struct dlNode *node; }; static int (*compareFunc)(const void *elem1, const void *elem2); /* Node comparison pointer, just used by dlSortNodes and helpers. */ static int dlNodeCmp(const void *elem1, const void *elem2) /* Compare two dlSorters indirectly, by calling compareFunc. */ { struct dlSorter *a = (struct dlSorter *)elem1; struct dlSorter *b = (struct dlSorter *)elem2; return compareFunc(&a->node->val, &b->node->val); } void dlSort(struct dlList *list, int (*compare )(const void *elem1, const void *elem2)) /* Sort a singly linked list with Qsort and a temporary array. * The arguments to the compare function in real, non-void, life * are pointers to pointers of the type that is in the val field of * the nodes of the list. */ { int len = dlCount(list); if (len > 1) { /* Move val's onto an array, sort, and then put back into list. */ struct dlSorter *sorter = needLargeMem(len * sizeof(sorter[0])), *s; struct dlNode *node; int i; for (i=0, node = list->head; inext) { s = &sorter[i]; s->node = node; } compareFunc = compare; qsort(sorter, len, sizeof(sorter[0]), dlNodeCmp); dlListInit(list); for (i=0; ihead; else return list->head->prev; } struct dlNode *dlGetAfterTail(struct dlList *list) /* Get the node after the tail of the list */ { if (dlEmpty(list)) return list->tail; else return list->tail->next; } void *dlListToSlList(struct dlList *dList) /* Return slList from dlList. */ { struct slList *list = NULL, *el; struct dlNode *node; for (node = dList->tail; node->prev != NULL; node = node->prev) { el = node->val; slAddHead(&list, el); } return list; } void dlCat(struct dlList *a, struct dlList *b) /* Move items from b to end of a. */ { struct dlNode *node; while ((node = dlPopHead(b)) != NULL) dlAddTail(a, node); } struct dlNode *dlValInList(struct dlList *list, void *val) /* Return node on list if any that has associated val. */ { struct dlNode *node; for (node = list->head; !dlEnd(node); node = node->next) if (node->val == val) return node; return NULL; } IRanges/src/dlist.h0000644000126300012640000001000312234075662015545 0ustar00biocbuildphs_compbio/* dlist.h - Headers for generic doubly-linked list routines. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #ifndef DLIST_H #define DLIST_H #ifndef COMMON_H #include "common.h" #endif struct dlNode /* An element on a doubly linked list. */ { struct dlNode *next; struct dlNode *prev; void *val; }; struct dlList /* A doubly linked list. */ { struct dlNode *head; struct dlNode *nullMiddle; struct dlNode *tail; }; #define dlEnd(node) (node->next == NULL) /* True if node past end. */ #define dlStart(node) (node->prev == NULL) /* True if node before start. */ /* Iterate on a doubly linked list as so: for (el = list->head; !dlEnd(el); el = el->next) val = el->val; or for (el = list->tail; !dlStart(el); el = el->prev) val = el->val; */ struct dlList *newDlList(); /* Return a new doubly linked list. */ #define dlListNew newDlList /* Add object-first synonym. */ void dlListInit(struct dlList *dl); /* Initialize list to be empty */ void dlListReset(struct dlList *dl); /* Reset a list to the empty state (does not free values) */ void freeDlList(struct dlList **pList); /* Free up a doubly linked list and it's nodes (but not the node values). */ #define dlListFree freeDlList void freeDlListAndVals(struct dlList **pList); /* Free all values in doubly linked list and the list itself. (Just calls * freeMem on all values. */ #define dlListFreeAndVals freeDlListAndVals void dlAddBefore(struct dlNode *anchor, struct dlNode *newNode); /* Add a node to list before anchor member. */ void dlAddAfter(struct dlNode *anchor, struct dlNode *newNode); /* Add a node to list after anchor member. */ void dlAddHead(struct dlList *list, struct dlNode *newNode); /* Add a node to head of list. */ void dlAddTail(struct dlList *list, struct dlNode *newNode); /* Add a node to tail of list. */ struct dlNode *dlAddValBefore(struct dlNode *anchor, void *val); /* Create a node containing val and add to list before anchor member. */ struct dlNode *dlAddValAfter(struct dlNode *anchor, void *val); /* Create a node containing val and add to list after anchor member. */ struct dlNode *dlAddValHead(struct dlList *list, void *val); /* Create a node containing val and add to head of list. */ struct dlNode *dlAddValTail(struct dlList *list, void *val); /* Create a node containing val and add to tail of list. */ void dlRemove(struct dlNode *node); /* Removes a node from list. Node is not freed. */ void dlRemoveHead(struct dlList *list); /* Removes head from list. Node is not freed. */ void dlRemoveTail(struct dlList *list); /* Remove tail from list. Node is not freed. */ struct dlNode *dlPopHead(struct dlList *list); /* Remove first node from list and return it. */ struct dlNode *dlPopTail(struct dlList *list); /* Remove last node from list and return it. */ void dlDelete(struct dlNode **nodePtr); /* Removes a node from list and frees it. */ int dlCount(struct dlList *list); /* Return length of list. */ boolean dlEmpty(struct dlList *list); /* Return TRUE if list is empty. */ #define dlIsEmpty(list) ((list)->head->next == NULL) /* Return TRUE if list is empty. Macro version of above. */ struct dlNode *dlGetBeforeHead(struct dlList *list); /* Get the node before the head of the list */ struct dlNode *dlGetAfterTail(struct dlList *list); /* Get the node after the tail of the list */ void dlSort(struct dlList *list, int (*compare )(const void *elem1, const void *elem2)); /* Sort a doubly linked list with Qsort and a temporary array. * The arguments to the compare function in real, non-void, life * are pointers to pointers of the type that is in the val field of * the nodes of the list. */ void *dlListToSlList(struct dlList *dList); /* Return slList from dlList. */ void dlCat(struct dlList *a, struct dlList *b); /* Move items from b to end of a. */ struct dlNode *dlValInList(struct dlList *list, void *val); /* Return node on list if any that has associated val. */ #endif /* DLIST_H */ IRanges/src/encodeOverlaps_methods.c0000644000126300012640000003665312234075662021140 0ustar00biocbuildphs_compbio/**************************************************************************** * Encode overlaps * * Author: Herve Pages * ****************************************************************************/ #include "IRanges.h" /* * A low-level helper for "superficial" checking of the 'space' vector * associated with a Ranges object. */ static const int *check_Ranges_space(SEXP space, int len, const char *what) { if (space == R_NilValue) return NULL; if (!IS_INTEGER(space)) error("'%s_space' must be an integer vector or NULL", what); if (LENGTH(space) != len) error("when not NULL, '%s_space' must have " "the same length as 'start(%s)'", what, what); return INTEGER(space); } static void CharAE_append_char(CharAE *char_ae, char c, int times) { int i; for (i = 0; i < times; i++) _CharAE_insert_at(char_ae, _CharAE_get_nelt(char_ae), c); return; } static void CharAE_append_int(CharAE *char_ae, int d) { static char buf[12]; /* should be enough for 32-bit ints */ int ret; ret = snprintf(buf, sizeof(buf), "%d", d); if (ret < 0) /* should never happen */ error("IRanges internal error in CharAE_append_int(): " "snprintf() returned value < 0"); if (ret >= sizeof(buf)) /* could happen with ints > 32-bit */ error("IRanges internal error in CharAE_append_int(): " "output of snprintf() was truncated"); _append_string_to_CharAE(char_ae, buf); return; } /* * A special 1-letter code 'X' is used for ranges that are not on the same * space. */ static char overlap_letter(int x_start, int x_width, int x_space, int y_start, int y_width, int y_space) { int code; if (x_space != y_space) return 'X'; code = _overlap_code(x_start, x_width, y_start, y_width); if (x_space < 0) code = _invert_overlap_code(code); return 'g' + code; } /* * q_start, q_width: int arrays of length q_len. No NAs. * q_space: NULL or an int array of length q_len. No NAs. * q_len: nb of ranges in the query. * q_break: 0 if all the ranges in the query are coming from the same * segment (single-end read), or, an int >= 1 and < q_len specifying * the position of the break between the ranges coming from one * segment and the ranges coming from the other if the query is a * paired-end read. * flip_query: if non-zero, then the query is "flipped" before the encoding is * computed. * s_start, s_width: int arrays of length s_len. No NAs. * s_space: NULL or an int array of length s_len. No NAs. * s_len: nb of ranges in the subject. * as_matrix, Loffset, Roffset: if as_matrix, then the full matrix of codes * is returned and the returned values for Loffset and Roffset are * undefined. Otherwise, the matrix is trimmed and the returned values * for Loffset and Roffset are the number of cols removed on the left * and right sides of the matrix, respectively. * out: character array containing the matrix of codes (possibly trimmed) */ static void unsafe_overlap_encoding( const int *q_start, const int *q_width, const int *q_space, int q_len, int q_break, int flip_query, const int *s_start, const int *s_width, const int *s_space, int s_len, int as_matrix, int *Loffset, int *Roffset, CharAE *out) { int out_nelt0, i, starti, widthi, spacei, j, startj, widthj, spacej, j1, j2, nrow; char letter; if (!as_matrix) { if (q_break != 0) { if (flip_query) { CharAE_append_int(out, q_len - q_break); CharAE_append_char(out, '-', 2); CharAE_append_int(out, q_break); } else { CharAE_append_int(out, q_break); CharAE_append_char(out, '-', 2); CharAE_append_int(out, q_len - q_break); } } else { CharAE_append_int(out, q_len); } CharAE_append_char(out, ':', 1); out_nelt0 = _CharAE_get_nelt(out); } /* j1: 0-based index of first (i.e. leftmost) col with a non-"m", or 's_len' if there is no such col. j2: 0-based index of last (i.e. rightmost) col with a non-"a", or -1 if there is no such col. */ j1 = s_len; j2 = -1; /* Walk col by col. */ for (j = 0; j < s_len; j++) { startj = s_start[j]; widthj = s_width[j]; spacej = s_space == NULL ? 0 : s_space[j]; if (flip_query) { for (i = q_len - 1; i >= 0; i--) { starti = q_start[i]; widthi = q_width[i]; spacei = q_space == NULL ? 0 : - q_space[i]; letter = overlap_letter(starti, widthi, spacei, startj, widthj, spacej); CharAE_append_char(out, letter, 1); if (j1 == s_len && letter != 'm') j1 = j; if (letter != 'a') j2 = j; if (q_break != 0 && i == q_break) CharAE_append_char(out, '-', 2); } } else { for (i = 0; i < q_len; i++) { if (q_break != 0 && i == q_break) CharAE_append_char(out, '-', 2); starti = q_start[i]; widthi = q_width[i]; spacei = q_space == NULL ? 0 : q_space[i]; letter = overlap_letter(starti, widthi, spacei, startj, widthj, spacej); CharAE_append_char(out, letter, 1); if (j1 == s_len && letter != 'm') j1 = j; if (letter != 'a') j2 = j; } } } if (as_matrix) return; /* By making 'j2' a 1-based index we will then have 0 <= j1 <= j2 <= s_len, which will simplify further arithmetic/logic. */ if (q_len == 0) { /* A 0-row matrix needs special treatment. */ j2 = s_len; } else { j2++; } *Loffset = j1; *Roffset = s_len - j2; nrow = q_len; if (q_break != 0) nrow += 2; /* Remove "a"-cols on the right. */ _CharAE_set_nelt(out, out_nelt0 + j2 * nrow); /* Remove "m"-cols on the left. */ _CharAE_delete_at(out, out_nelt0, j1 * nrow); /* Insert ":" at the end of each remaining col. */ for (j = j2 - j1; j >= 1; j--) _CharAE_insert_at(out, out_nelt0 + j * nrow, ':'); return; } static void overlap_encoding( SEXP query_start, SEXP query_width, SEXP query_space, int query_break, int flip_query, SEXP subject_start, SEXP subject_width, SEXP subject_space, int as_matrix, int *Loffset, int *Roffset, CharAE *out) { int q_len, s_len; const int *q_start, *q_width, *q_space, *s_start, *s_width, *s_space; q_len = _check_integer_pairs(query_start, query_width, &q_start, &q_width, "start(query)", "width(query)"); if (query_break != 0 && (query_break < 1 || query_break >= q_len)) error("the position of the break in the query " "must be >= 1 and < length(query)"); q_space = check_Ranges_space(query_space, q_len, "query"); s_len = _check_integer_pairs(subject_start, subject_width, &s_start, &s_width, "start(subject)", "width(subject)"); s_space = check_Ranges_space(subject_space, s_len, "subject"); unsafe_overlap_encoding(q_start, q_width, q_space, q_len, query_break, flip_query, s_start, s_width, s_space, s_len, as_matrix, Loffset, Roffset, out); return; } /* type: 0=CHARSXP, 1=STRSXP, 2=RAWSXP as_matrix: 0 or 1, ignored when type is 0 q_len, q_break, s_len: ignored when type is 0 */ static SEXP make_encoding_from_CharAE(const CharAE *buf, int type, int as_matrix, int q_len, int q_break, int s_len) { SEXP ans, ans_elt, ans_dim; int buf_nelt, i, nrow; buf_nelt = _CharAE_get_nelt(buf); if (type == 0 || (type == 1 && !as_matrix)) { PROTECT(ans = mkCharLen(buf->elts, buf_nelt)); if (type == 1) { PROTECT(ans = ScalarString(ans)); UNPROTECT(1); } UNPROTECT(1); return ans; } if (type == 1) { PROTECT(ans = NEW_CHARACTER(buf_nelt)); for (i = 0; i < buf_nelt; i++) { PROTECT(ans_elt = mkCharLen(buf->elts + i, 1)); SET_STRING_ELT(ans, i, ans_elt); UNPROTECT(1); } } else { PROTECT(ans = _new_RAW_from_CharAE(buf)); } if (as_matrix) { nrow = q_len; if (q_break != 0) nrow += 2; PROTECT(ans_dim = NEW_INTEGER(2)); INTEGER(ans_dim)[0] = nrow; INTEGER(ans_dim)[1] = s_len; SET_DIM(ans, ans_dim); UNPROTECT(1); } UNPROTECT(1); return ans; } static SEXP make_LIST_from_ovenc_parts(SEXP Loffset, SEXP Roffset, SEXP encoding) { SEXP ans, ans_names, ans_names_elt; PROTECT(ans = NEW_LIST(3)); PROTECT(ans_names = NEW_CHARACTER(3)); PROTECT(ans_names_elt = mkChar("Loffset")); SET_STRING_ELT(ans_names, 0, ans_names_elt); UNPROTECT(1); PROTECT(ans_names_elt = mkChar("Roffset")); SET_STRING_ELT(ans_names, 1, ans_names_elt); UNPROTECT(1); PROTECT(ans_names_elt = mkChar("encoding")); SET_STRING_ELT(ans_names, 2, ans_names_elt); UNPROTECT(1); SET_NAMES(ans, ans_names); UNPROTECT(1); SET_VECTOR_ELT(ans, 0, Loffset); SET_VECTOR_ELT(ans, 1, Roffset); SET_VECTOR_ELT(ans, 2, encoding); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- * 'query_start', 'query_width', 'query_space': integer vectors of the same * length M (or NULL for 'query_space'). * 'query_break': single integer. * 'subject_start', 'subject_width', 'subject_space': integer vectors of the * same length N (or NULL for 'subject_space'). * Integer vectors 'query_start', 'query_width', 'subject_start' and * 'subject_width' are assumed to be NA free. 'query_width' and 'subject_width' * are assumed to contain non-negative values. For efficiency reasons, those * assumptions are not checked. * Return the matrix of 1-letter codes (if 'as_matrix' is TRUE), otherwise a * named list with the 3 following components: * 1. Loffset: single integer; * 2. Roffset: single integer; * 3. encoding: the compact encoding as a single string (if 'as_raw' is * FALSE) or a raw vector (if 'as_raw' is TRUE). */ SEXP encode_overlaps1(SEXP query_start, SEXP query_width, SEXP query_space, SEXP query_break, SEXP flip_query, SEXP subject_start, SEXP subject_width, SEXP subject_space, SEXP as_matrix, SEXP as_raw) { int query_break0, flip_query0, as_matrix0, as_raw0, Loffset, Roffset; CharAE buf; SEXP encoding, ans_Loffset, ans_Roffset, ans; query_break0 = INTEGER(query_break)[0]; flip_query0 = LOGICAL(flip_query)[0]; as_matrix0 = as_matrix != R_NilValue && LOGICAL(as_matrix)[0]; as_raw0 = as_raw != R_NilValue && LOGICAL(as_raw)[0]; buf = _new_CharAE(0); overlap_encoding( query_start, query_width, query_space, query_break0, flip_query0, subject_start, subject_width, subject_space, as_matrix0, &Loffset, &Roffset, &buf); PROTECT(encoding = make_encoding_from_CharAE(&buf, as_raw0 ? 2 : 1, as_matrix0, LENGTH(query_start), query_break0, LENGTH(subject_start))); if (as_matrix0) { UNPROTECT(1); return encoding; } PROTECT(ans_Loffset = ScalarInteger(Loffset)); PROTECT(ans_Roffset = ScalarInteger(Roffset)); PROTECT(ans = make_LIST_from_ovenc_parts(ans_Loffset, ans_Roffset, encoding)); UNPROTECT(4); return ans; } static SEXP RangesList_encode_overlaps_ij( SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces, int i, int j, int flip_query, int *Loffset, int *Roffset, CharAE *buf) { SEXP query_start, query_width, query_space, subject_start, subject_width, subject_space; int query_break; query_start = VECTOR_ELT(query_starts, i); query_width = VECTOR_ELT(query_widths, i); if (query_spaces == R_NilValue) query_space = R_NilValue; else query_space = VECTOR_ELT(query_spaces, i); if (query_breaks == R_NilValue) query_break = 0; else query_break = INTEGER(query_breaks)[i]; subject_start = VECTOR_ELT(subject_starts, j); subject_width = VECTOR_ELT(subject_widths, j); if (subject_spaces == R_NilValue) subject_space = R_NilValue; else subject_space = VECTOR_ELT(subject_spaces, j); overlap_encoding( query_start, query_width, query_space, query_break, flip_query, subject_start, subject_width, subject_space, 0, Loffset, Roffset, buf); return make_encoding_from_CharAE(buf, 0, 0, 0, 0, 0); } /* --- .Call ENTRY POINT ---/ * 'query_starts', 'query_widths', 'query_spaces': lists of integer vectors. * The 3 lists are assumed to have the same length (M) and shape. * 'query_breaks': NULL or integer vector of length M. * 'subject_starts', 'subject_widths', 'subject_spaces': lists of integer * vectors. The 3 lists are assumed to have the same length (N) and shape. * Return a named list with the 3 following components (all of the same * length): * 1. Loffset: integer vector; * 2. Roffset: integer vector; * 3. encoding: character vector containing the compact encodings (type * II). */ SEXP RangesList_encode_overlaps(SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces) { int q_len, s_len, ans_len, i, j, k; SEXP ans_Loffset, ans_Roffset, ans_encoding, ans_encoding_elt, ans; CharAE buf; /* TODO: Add some basic checking of the input values. */ q_len = LENGTH(query_starts); s_len = LENGTH(subject_starts); if (q_len == 0 || s_len == 0) ans_len = 0; else ans_len = q_len >= s_len ? q_len : s_len; PROTECT(ans_Loffset = NEW_INTEGER(ans_len)); PROTECT(ans_Roffset = NEW_INTEGER(ans_len)); PROTECT(ans_encoding = NEW_CHARACTER(ans_len)); buf = _new_CharAE(0); for (i = j = k = 0; k < ans_len; i++, j++, k++) { if (i >= q_len) i = 0; /* recycle i */ if (j >= s_len) j = 0; /* recycle j */ PROTECT(ans_encoding_elt = RangesList_encode_overlaps_ij( query_starts, query_widths, query_spaces, query_breaks, subject_starts, subject_widths, subject_spaces, i, j, 0, INTEGER(ans_Loffset) + k, INTEGER(ans_Roffset) + k, &buf)); SET_STRING_ELT(ans_encoding, k, ans_encoding_elt); UNPROTECT(1); _CharAE_set_nelt(&buf, 0); } if (ans_len != 0 && (i != q_len || j != s_len)) warning("longer object length is not a multiple " "of shorter object length"); PROTECT(ans = make_LIST_from_ovenc_parts(ans_Loffset, ans_Roffset, ans_encoding)); UNPROTECT(4); return ans; } /* --- .Call ENTRY POINT ---/ * Same arguments as RangesList_encode_overlaps() plus: * 'query_hits', 'subject_hits': integer vectors of the same length. * 'flip_query': logical vector of the same length as 'query_hits'. */ SEXP Hits_encode_overlaps(SEXP query_starts, SEXP query_widths, SEXP query_spaces, SEXP query_breaks, SEXP subject_starts, SEXP subject_widths, SEXP subject_spaces, SEXP query_hits, SEXP subject_hits, SEXP flip_query) { int q_len, s_len, ans_len, i, j, k; const int *q_hits, *s_hits; SEXP ans_Loffset, ans_Roffset, ans_encoding, ans_encoding_elt, ans; CharAE buf; /* TODO: Add some basic checking of the input values. */ q_len = LENGTH(query_starts); s_len = LENGTH(subject_starts); ans_len = _check_integer_pairs(query_hits, subject_hits, &q_hits, &s_hits, "queryHits(hits)", "subjectHits(hits)"); PROTECT(ans_Loffset = NEW_INTEGER(ans_len)); PROTECT(ans_Roffset = NEW_INTEGER(ans_len)); PROTECT(ans_encoding = NEW_CHARACTER(ans_len)); buf = _new_CharAE(0); for (k = 0; k < ans_len; k++) { i = q_hits[k]; j = s_hits[k]; if (i == NA_INTEGER || i < 1 || i > q_len || j == NA_INTEGER || j < 1 || j > s_len) { UNPROTECT(3); error("'queryHits(hits)' or 'subjectHits(hits)' " "contain invalid indices"); } i--; j--; PROTECT(ans_encoding_elt = RangesList_encode_overlaps_ij( query_starts, query_widths, query_spaces, query_breaks, subject_starts, subject_widths, subject_spaces, i, j, LOGICAL(flip_query)[k], INTEGER(ans_Loffset) + k, INTEGER(ans_Roffset) + k, &buf)); SET_STRING_ELT(ans_encoding, k, ans_encoding_elt); UNPROTECT(1); _CharAE_set_nelt(&buf, 0); } PROTECT(ans = make_LIST_from_ovenc_parts(ans_Loffset, ans_Roffset, ans_encoding)); UNPROTECT(4); return ans; } IRanges/src/errCatch.h0000644000126300012640000000337212234075662016174 0ustar00biocbuildphs_compbio/* errCatch - help catch errors so that errAborts aren't * fatal, and warn's don't necessarily get printed immediately. * Note that error conditions caught this way will tend to * leak resources unless there are additional wrappers. * * Typical usage is * errCatch = errCatchNew(); * if (errCatchStart(errCatch)) * doFlakyStuff(); * errCatchEnd(errCatch); * if (errCatch->gotError) * warn(errCatch->message->string); * errCatchFree(&errCatch); * cleanupFlakyStuff(); */ #ifndef ERRCATCH_H #define ERRCATCH_H #ifndef DYSTRING_H #include "dystring.h" #endif struct errCatch /* Something to help catch errors. */ { struct errCatch *next; /* Next in stack. */ jmp_buf jmpBuf; /* Where to jump back to for recovery. */ struct dyString *message; /* Error message if any */ boolean gotError; /* Some sort of error was caught. */ }; struct errCatch *errCatchNew(); /* Return new error catching structure. */ void errCatchFree(struct errCatch **pErrCatch); /* Free up resources associated with errCatch */ #define errCatchStart(e) (errCatchPushHandlers(e) && setjmp(e->jmpBuf) == 0) /* Little wrapper around setjmp. This returns TRUE * on the main execution thread, FALSE after abort. */ boolean errCatchPushHandlers(struct errCatch *errCatch); /* Push error handlers. Not usually called directly. * but rather through errCatchStart() macro. Always * returns TRUE. */ void errCatchEnd(struct errCatch *errCatch); /* Restore error handlers and pop self off of catching stack. */ boolean errCatchFinish(struct errCatch **pErrCatch); /* Finish up error catching. Report error if there is a * problem and return FALSE. If no problem return TRUE. * This handles errCatchEnd and errCatchFree. */ #endif /* ERRCATCH_H */ IRanges/src/errabort.c0000644000126300012640000000721312234075662016252 0ustar00biocbuildphs_compbio/* ErrAbort.c - our error handler. * * This maintains two stacks - a warning message printer * stack, and a "abort handler" stack. * * By default the warnings will go to stderr, and * aborts will exit the program. You can push a * function on to the appropriate stack to change * this behavior. The top function on the stack * gets called. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #include "common.h" #include "errabort.h" static char const rcsid[] = "$Id: errabort.c,v 1.13 2004/11/10 00:10:50 markd Exp $"; static void defaultVaWarn(char *format, va_list args) /* Default error message handler. */ { if (format != NULL) { fflush(stdout); vfprintf(stderr, format, args); fprintf(stderr, "\n"); } } #define maxWarnHandlers 20 static WarnHandler warnArray[maxWarnHandlers] = {defaultVaWarn,}; static int warnIx = 0; void vaWarn(char *format, va_list args) /* Call top of warning stack to issue warning. */ { warnArray[warnIx](format, args); } void warn(char *format, ...) /* Issue a warning message. */ { va_list args; va_start(args, format); vaWarn(format, args); va_end(args); } void errnoWarn(char *format, ...) /* Prints error message from UNIX errno first, then does rest of warning. */ { char fbuf[512]; va_list args; va_start(args, format); sprintf(fbuf, "%s\n%s", strerror(errno), format); vaWarn(fbuf, args); va_end(args); } void pushWarnHandler(WarnHandler handler) /* Set abort handler */ { if (warnIx >= maxWarnHandlers-1) errAbort("Too many pushWarnHandlers, can only handle %d\n", maxWarnHandlers-1); warnArray[++warnIx] = handler; } void popWarnHandler() /* Revert to old warn handler. */ { if (warnIx <= 0) errAbort("Too many popWarnHandlers\n"); --warnIx; } static void defaultAbort() /* Default error handler exits program. */ { if ((getenv("ERRASSERT") != NULL) || (getenv("ERRABORT") != NULL)) abort(); else exit(-1); } #define maxAbortHandlers 12 static AbortHandler abortArray[maxAbortHandlers] = {defaultAbort,}; static int abortIx = 0; void noWarnAbort() /* Abort without message. */ { abortArray[abortIx](); exit(-1); /* This is just to make compiler happy. * We have already exited or longjmped by now. */ } void vaErrAbort(char *format, va_list args) /* Abort function, with optional (vprintf formatted) error message. */ { vaWarn(format, args); noWarnAbort(); } void errAbort(char *format, ...) /* Abort function, with optional (printf formatted) error message. */ { va_list args; va_start(args, format); vaErrAbort(format, args); va_end(args); } void errnoAbort(char *format, ...) /* Prints error message from UNIX errno first, then does errAbort. */ { char fbuf[512]; va_list args; va_start(args, format); sprintf(fbuf, "%s\n%s", strerror(errno), format); vaErrAbort(fbuf, args); va_end(args); } void pushAbortHandler(AbortHandler handler) /* Set abort handler */ { if (abortIx >= maxAbortHandlers-1) errAbort("Too many pushAbortHandlers, can only handle %d\n", maxAbortHandlers-1); abortArray[++abortIx] = handler; } void popAbortHandler() /* Revert to old abort handler. */ { if (abortIx <= 0) errAbort("Too many popAbortHandlers\n"); --abortIx; } static void debugAbort() /* Call the debugger. */ { fflush(stdout); assert(FALSE); defaultAbort(); } void pushDebugAbort() /* Push abort handler that will invoke debugger. */ { pushAbortHandler(debugAbort); } static void warnAbortHandler(char *format, va_list args) /* warn handler that also aborts. */ { defaultVaWarn(format, args); noWarnAbort(); } void pushWarnAbort() /* Push handler that will abort on warnings. */ { pushWarnHandler(warnAbortHandler); } IRanges/src/errabort.h0000644000126300012640000000407112234075662016256 0ustar00biocbuildphs_compbio/* ErrAbort.h - our error handler. * * This maintains two stacks - a warning message printer * stack, and a "abort handler" stack. * * By default the warnings will go to stderr, and * aborts will exit the program. You can push a * function on to the appropriate stack to change * this behavior. The top function on the stack * gets called. * * Most functions in this library will call errAbort() * if they run out of memory. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #ifndef ERRABORT_H #define ERRABORT_H void errAbort(char *format, ...) /* Abort function, with optional (printf formatted) error message. */ #if defined(__GNUC__) __attribute__((format(printf, 1, 2))) #endif ; void vaErrAbort(char *format, va_list args); /* Abort function, with optional (vprintf formatted) error message. */ void errnoAbort(char *format, ...) /* Prints error message from UNIX errno first, then does errAbort. */ #if defined(__GNUC__) __attribute__((format(printf, 1, 2))) #endif ; typedef void (*AbortHandler)(); /* Function that can abort. */ void pushAbortHandler(AbortHandler handler); /* Set abort handler */ void popAbortHandler(); /* Revert to old abort handler. */ void noWarnAbort(); /* Abort without message. */ void pushDebugAbort(); /* Push abort handler that will invoke debugger. */ void vaWarn(char *format, va_list args); /* Call top of warning stack to issue warning. */ void warn(char *format, ...) /* Issue a warning message. */ #if defined(__GNUC__) __attribute__((format(printf, 1, 2))) #endif ; void errnoWarn(char *format, ...) /* Prints error message from UNIX errno first, then does rest of warning. */ #if defined(__GNUC__) __attribute__((format(printf, 1, 2))) #endif ; typedef void (*WarnHandler)(char *format, va_list args); /* Function that can warn. */ void pushWarnHandler(WarnHandler handler); /* Set warning handler */ void popWarnHandler(); /* Revert to old warn handler. */ void pushWarnAbort(); /* Push handler that will abort on warnings. */ #endif /* ERRABORT_H */ IRanges/src/hash_utils.c0000644000126300012640000000214012234075662016567 0ustar00biocbuildphs_compbio/**************************************************************************** * Hash table management * ****************************************************************************/ #include "IRanges.h" /* * Author: Martin Morgan * Modified from R_HOME/src/main/unique.c */ static void htab_init(struct htab *htab, int n) { int n2, i; /* max supported value for n is 2^29 */ if (n < 0 || n > 536870912) /* protect against overflow to -ve */ error("length %d is too large for hashing", n); n2 = 2 * n; htab->M = 2; htab->K = 1; while (htab->M < n2) { htab->M *= 2; htab->K += 1; } htab->Mminus1 = htab->M - 1; htab->buckets = (int *) R_alloc(sizeof(int), htab->M); for (i = 0; i < htab->M; i++) htab->buckets[i] = NA_INTEGER; return; } struct htab _new_htab(int n) { struct htab htab; htab_init(&htab, n); return htab; } int _get_hbucket_val(const struct htab *htab, int bucket_idx) { return htab->buckets[bucket_idx]; } void _set_hbucket_val(struct htab *htab, int bucket_idx, int val) { htab->buckets[bucket_idx] = val; return; } IRanges/src/int_utils.c0000644000126300012640000005546212234075662016455 0ustar00biocbuildphs_compbio#include "IRanges.h" #include /* for INT_MAX */ static int get_bucket_idx_for_int_pair(const struct htab *htab, int a1, int b1, const int *a2, const int *b2) { unsigned int hval; int bucket_idx, i2; const int *buckets; /* use 2 consecutive prime numbers (seems to work well, no serious justification for it) */ hval = 3951551U * a1 + 3951553U * b1; bucket_idx = hval & htab->Mminus1; buckets = htab->buckets; while ((i2 = buckets[bucket_idx]) != NA_INTEGER) { if (a2[i2] == a1 && b2[i2] == b1) break; bucket_idx = (bucket_idx + 1) % htab->M; } return bucket_idx; } static int get_bucket_idx_for_int_quad(const struct htab *htab, int a1, int b1, int c1, int d1, const int *a2, const int *b2, const int *c2, const int *d2) { unsigned int hval; int bucket_idx, i2; const int *buckets; /* use 4 consecutive prime numbers (seems to work well, no serious justification for it) */ hval = 3951551U * a1 + 3951553U * b1 + 3951557U * c1 + 3951559U * d1; bucket_idx = hval & htab->Mminus1; buckets = htab->buckets; while ((i2 = buckets[bucket_idx]) != NA_INTEGER) { if (a2[i2] == a1 && b2[i2] == b1 && c2[i2] == c1 && d2[i2] == d1) break; bucket_idx = (bucket_idx + 1) % htab->M; } return bucket_idx; } /**************************************************************************** * --- .Call ENTRY POINT --- * any(is.na(x) | x < lower | x > upper) */ SEXP Integer_any_missing_or_outside(SEXP x, SEXP lower, SEXP upper) { int x_len, lower0, upper0, ans, i; const int *x_p; x_len = length(x); lower0 = INTEGER(lower)[0]; upper0 = INTEGER(upper)[0]; ans = 0; for (i = 0, x_p = INTEGER(x); i < x_len; i++, x_p++) { if (*x_p == NA_INTEGER || *x_p < lower0 || *x_p > upper0) { ans = 1; break; } } return ScalarLogical(ans); } /**************************************************************************** * Sum non-negative integers. */ /* * Walk 'x' and sum its elements. Stop walking at the first occurence of one * of the 3 following conditions: (1) the element is NA, or (2) the element is * negative, or (3) the partial sum is > INT_MAX (integer overflow). * How the function handles those conditions depends on 'varname'. If it's NULL * then no error is raised and a negative code is returned (indicating the kind * of condition that occured). Otherwise an error is raised (when not NULL, * 'varname' must be a C string i.e. 0-terminated). * If none of the 3 above conditions happen, then 'sum(x)' is returned. */ int _sum_non_neg_ints(const int *x, int x_len, const char *varname) { int i; unsigned int sum; for (i = sum = 0; i < x_len; i++, x++) { if (*x == NA_INTEGER || *x < 0) { if (varname == NULL) return -1; error("'%s' contains NAs or negative values", varname); } sum += *x; if (sum > (unsigned int) INT_MAX) { if (varname == NULL) return -2; error("integer overflow while summing elements " "in '%s'", varname); } } return sum; } /* * --- .Call ENTRY POINT --- */ SEXP Integer_sum_non_neg_vals(SEXP x) { return ScalarInteger(_sum_non_neg_ints(INTEGER(x), LENGTH(x), "x")); } /**************************************************************************** * --- .Call ENTRY POINT --- * diff(c(0L, x)) */ SEXP Integer_diff_with_0(SEXP x) { int i, len, *x_ptr1, *x_ptr2, *ans_ptr; SEXP ans; len = LENGTH(x); PROTECT(ans = NEW_INTEGER(len)); if (len > 0) { INTEGER(ans)[0] = INTEGER(x)[0]; if (len > 1) { for (i = 1, x_ptr1 = INTEGER(x), x_ptr2 = INTEGER(x) + 1, ans_ptr = INTEGER(ans) + 1; i < len; i++, x_ptr1++, x_ptr2++, ans_ptr++) { *ans_ptr = *x_ptr2 - *x_ptr1; } } } UNPROTECT(1); return ans; } /**************************************************************************** * --- .Call ENTRY POINT --- * diff(c(x, last)) */ SEXP Integer_diff_with_last(SEXP x, SEXP last) { int i, len, *x_ptr1, *x_ptr2, *ans_ptr; SEXP ans; len = LENGTH(x); PROTECT(ans = NEW_INTEGER(len)); if (len > 0) { for (i = 1, x_ptr1 = INTEGER(x), x_ptr2 = INTEGER(x) + 1, ans_ptr = INTEGER(ans); i < len; i++, x_ptr1++, x_ptr2++, ans_ptr++) { *ans_ptr = *x_ptr2 - *x_ptr1; } INTEGER(ans)[len - 1] = INTEGER(last)[0] - INTEGER(x)[len - 1]; } UNPROTECT(1); return ans; } /**************************************************************************** * The .Call entry points in this section are the workhorses behind * orderInteger(), orderIntegerPairs(), matchIntegerPairs(), and * duplicatedIntegerPairs(). */ /* * Nothing deep, just checking that 'a' and 'b' are integer vectors of the * same length. We don't look at the individual elements in them, and, * in particular, we don't check for NAs. */ int _check_integer_pairs(SEXP a, SEXP b, const int **a_p, const int **b_p, const char *a_argname, const char *b_argname) { int len; if (!IS_INTEGER(a) || !IS_INTEGER(b)) error("'%s' and '%s' must be integer vectors", a_argname, b_argname); len = LENGTH(a); if (LENGTH(b) != len) error("'%s' and '%s' must have the same length", a_argname, b_argname); *a_p = INTEGER(a); *b_p = INTEGER(b); return len; } /* --- .Call ENTRY POINT --- */ SEXP Integer_order(SEXP x, SEXP decreasing) { int ans_length; SEXP ans; ans_length = LENGTH(x); PROTECT(ans = NEW_INTEGER(ans_length)); _get_order_of_int_array(INTEGER(x), ans_length, LOGICAL(decreasing)[0], INTEGER(ans), 1); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_order2(SEXP a, SEXP b, SEXP decreasing) { int ans_length; const int *a_p, *b_p; SEXP ans; ans_length = _check_integer_pairs(a, b, &a_p, &b_p, "a", "b"); PROTECT(ans = NEW_INTEGER(ans_length)); _get_order_of_int_pairs(a_p, b_p, ans_length, LOGICAL(decreasing)[0], INTEGER(ans), 1); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_match2_quick(SEXP a1, SEXP b1, SEXP a2, SEXP b2, SEXP nomatch) { int len1, len2, nomatch0, *o1, *o2; const int *a1_p, *b1_p, *a2_p, *b2_p; SEXP ans; len1 = _check_integer_pairs(a1, b1, &a1_p, &b1_p, "a1", "b1"); len2 = _check_integer_pairs(a2, b2, &a2_p, &b2_p, "a2", "b2"); nomatch0 = INTEGER(nomatch)[0]; o1 = (int *) R_alloc(sizeof(int), len1); o2 = (int *) R_alloc(sizeof(int), len2); _get_order_of_int_pairs(a1_p, b1_p, len1, 0, o1, 0); _get_order_of_int_pairs(a2_p, b2_p, len2, 0, o2, 0); PROTECT(ans = NEW_INTEGER(len1)); _get_matches_of_ordered_int_pairs(a1_p, b1_p, o1, len1, a2_p, b2_p, o2, len2, nomatch0, INTEGER(ans), 1); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_selfmatch2_quick(SEXP a, SEXP b) { int len, *o1; const int *a_p, *b_p; SEXP ans; len = _check_integer_pairs(a, b, &a_p, &b_p, "a", "b"); o1 = (int *) R_alloc(sizeof(int), len); _get_order_of_int_pairs(a_p, b_p, len, 0, o1, 0); PROTECT(ans = NEW_INTEGER(len)); _get_matches_of_ordered_int_pairs(a_p, b_p, o1, len, a_p, b_p, o1, len, -1, INTEGER(ans), 1); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_match2_hash(SEXP a1, SEXP b1, SEXP a2, SEXP b2, SEXP nomatch) { int len1, len2, nomatch0, *ans0, i, bucket_idx, i2; const int *a1_p, *b1_p, *a2_p, *b2_p; struct htab htab; SEXP ans; len1 = _check_integer_pairs(a1, b1, &a1_p, &b1_p, "a1", "b1"); len2 = _check_integer_pairs(a2, b2, &a2_p, &b2_p, "a2", "b2"); nomatch0 = INTEGER(nomatch)[0]; htab = _new_htab(len2); for (i = 0; i < len2; i++) { bucket_idx = get_bucket_idx_for_int_pair(&htab, a2_p[i], b2_p[i], a2_p, b2_p); if (_get_hbucket_val(&htab, bucket_idx) == NA_INTEGER) _set_hbucket_val(&htab, bucket_idx, i); } PROTECT(ans = NEW_INTEGER(len1)); ans0 = INTEGER(ans); for (i = 0; i < len1; i++) { bucket_idx = get_bucket_idx_for_int_pair(&htab, a1_p[i], b1_p[i], a2_p, b2_p); i2 = _get_hbucket_val(&htab, bucket_idx); if (i2 == NA_INTEGER) ans0[i] = nomatch0; else ans0[i] = i2 + 1; } UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_selfmatch2_hash(SEXP a, SEXP b) { int ans_length, *ans0, i, bucket_idx, i2; const int *a_p, *b_p; struct htab htab; SEXP ans; ans_length = _check_integer_pairs(a, b, &a_p, &b_p, "a", "b"); htab = _new_htab(ans_length); PROTECT(ans = NEW_INTEGER(ans_length)); ans0 = INTEGER(ans); for (i = 0; i < ans_length; i++) { bucket_idx = get_bucket_idx_for_int_pair(&htab, a_p[i], b_p[i], a_p, b_p); i2 = _get_hbucket_val(&htab, bucket_idx); if (i2 == NA_INTEGER) { _set_hbucket_val(&htab, bucket_idx, i); ans0[i] = i + 1; } else { ans0[i] = i2 + 1; } } UNPROTECT(1); return ans; } /**************************************************************************** * The .Call entry points in this section are the workhorses behind * orderIntegerQuads(), matchIntegerQuads() and duplicatedIntegerQuads(). */ /* * Nothing deep, just checking that 'a', 'b', 'c' and 'd' are integer vectors * of the same length. We don't look at the individual elements in them, and, * in particular, we don't check for NAs. */ int _check_integer_quads(SEXP a, SEXP b, SEXP c, SEXP d, const int **a_p, const int **b_p, const int **c_p, const int **d_p, const char *a_argname, const char *b_argname, const char *c_argname, const char *d_argname) { int len; if (!IS_INTEGER(a) || !IS_INTEGER(b) || !IS_INTEGER(c) || !IS_INTEGER(d)) error("'%s', '%s', '%s' and '%s' must be integer vectors", a_argname, b_argname, c_argname, d_argname); len = LENGTH(a); if (LENGTH(b) != len || LENGTH(c) != len || LENGTH(d) != len) error("'%s', '%s', '%s' and '%s' must have the same length", a_argname, b_argname, c_argname, d_argname); *a_p = INTEGER(a); *b_p = INTEGER(b); *c_p = INTEGER(c); *d_p = INTEGER(d); return len; } /* --- .Call ENTRY POINT --- */ SEXP Integer_order4(SEXP a, SEXP b, SEXP c, SEXP d, SEXP decreasing) { int ans_length; const int *a_p, *b_p, *c_p, *d_p; SEXP ans; ans_length = _check_integer_quads(a, b, c, d, &a_p, &b_p, &c_p, &d_p, "a", "b", "c", "d"); PROTECT(ans = NEW_INTEGER(ans_length)); _get_order_of_int_quads(a_p, b_p, c_p, d_p, ans_length, LOGICAL(decreasing)[0], INTEGER(ans), 1); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_match4_quick(SEXP a1, SEXP b1, SEXP c1, SEXP d1, SEXP a2, SEXP b2, SEXP c2, SEXP d2, SEXP nomatch) { int len1, len2, nomatch0, *o1, *o2; const int *a1_p, *b1_p, *c1_p, *d1_p, *a2_p, *b2_p, *c2_p, *d2_p; SEXP ans; len1 = _check_integer_quads(a1, b1, c1, d1, &a1_p, &b1_p, &c1_p, &d1_p, "a1", "b1", "c1", "d1"); len2 = _check_integer_quads(a2, b2, c2, d2, &a2_p, &b2_p, &c2_p, &d2_p, "a2", "b2", "c2", "d2"); nomatch0 = INTEGER(nomatch)[0]; o1 = (int *) R_alloc(sizeof(int), len1); o2 = (int *) R_alloc(sizeof(int), len2); _get_order_of_int_quads(a1_p, b1_p, c1_p, d1_p, len1, 0, o1, 0); _get_order_of_int_quads(a2_p, b2_p, c2_p, d2_p, len2, 0, o2, 0); PROTECT(ans = NEW_INTEGER(len1)); _get_matches_of_ordered_int_quads(a1_p, b1_p, c1_p, d1_p, o1, len1, a2_p, b2_p, c2_p, d2_p, o2, len2, nomatch0, INTEGER(ans), 1); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_selfmatch4_quick(SEXP a, SEXP b, SEXP c, SEXP d) { int len, *o1; const int *a_p, *b_p, *c_p, *d_p; SEXP ans; len = _check_integer_quads(a, b, c, d, &a_p, &b_p, &c_p, &d_p, "a", "b", "c", "d"); o1 = (int *) R_alloc(sizeof(int), len); _get_order_of_int_quads(a_p, b_p, c_p, d_p, len, 0, o1, 0); PROTECT(ans = NEW_INTEGER(len)); _get_matches_of_ordered_int_quads(a_p, b_p, c_p, d_p, o1, len, a_p, b_p, c_p, d_p, o1, len, -1, INTEGER(ans), 1); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_match4_hash(SEXP a1, SEXP b1, SEXP c1, SEXP d1, SEXP a2, SEXP b2, SEXP c2, SEXP d2, SEXP nomatch) { int len1, len2, nomatch0, *ans0, i, bucket_idx, i2; const int *a1_p, *b1_p, *c1_p, *d1_p, *a2_p, *b2_p, *c2_p, *d2_p; struct htab htab; SEXP ans; len1 = _check_integer_quads(a1, b1, c1, d1, &a1_p, &b1_p, &c1_p, &d1_p, "a1", "b1", "c1", "d1"); len2 = _check_integer_quads(a2, b2, c2, d2, &a2_p, &b2_p, &c2_p, &d2_p, "a2", "b2", "c2", "d2"); nomatch0 = INTEGER(nomatch)[0]; htab = _new_htab(len2); for (i = 0; i < len2; i++) { bucket_idx = get_bucket_idx_for_int_quad(&htab, a2_p[i], b2_p[i], c2_p[i], d2_p[i], a2_p, b2_p, c2_p, d2_p); if (_get_hbucket_val(&htab, bucket_idx) == NA_INTEGER) _set_hbucket_val(&htab, bucket_idx, i); } PROTECT(ans = NEW_INTEGER(len1)); ans0 = INTEGER(ans); for (i = 0; i < len1; i++) { bucket_idx = get_bucket_idx_for_int_quad(&htab, a1_p[i], b1_p[i], c1_p[i], d1_p[i], a2_p, b2_p, c2_p, d2_p); i2 = _get_hbucket_val(&htab, bucket_idx); if (i2 == NA_INTEGER) ans0[i] = nomatch0; else ans0[i] = i2 + 1; } UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP Integer_selfmatch4_hash(SEXP a, SEXP b, SEXP c, SEXP d) { int ans_length, *ans0, i, bucket_idx, i2; const int *a_p, *b_p, *c_p, *d_p; struct htab htab; SEXP ans; ans_length = _check_integer_quads(a, b, c, d, &a_p, &b_p, &c_p, &d_p, "a", "b", "c", "d"); htab = _new_htab(ans_length); PROTECT(ans = NEW_INTEGER(ans_length)); ans0 = INTEGER(ans); for (i = 0; i < ans_length; i++) { bucket_idx = get_bucket_idx_for_int_quad(&htab, a_p[i], b_p[i], c_p[i], d_p[i], a_p, b_p, c_p, d_p); i2 = _get_hbucket_val(&htab, bucket_idx); if (i2 == NA_INTEGER) { _set_hbucket_val(&htab, bucket_idx, i); ans0[i] = i + 1; } else { ans0[i] = i2 + 1; } } UNPROTECT(1); return ans; } /**************************************************************************** * An enhanced version of base::tabulate() that: (1) handles integer weights * (NA and negative weights are OK), and (2) throws an error if 'strict' is * TRUE and if 'x' contains NAs or values not in the [1, 'nbins'] interval. */ SEXP Integer_tabulate2(SEXP x, SEXP nbins, SEXP weight, SEXP strict) { SEXP ans; int x_len, nbins0, weight_len, strict0, *one_based_ans_p, i, j, x_elt, weight_elt; const int *x_p, *weight_p; x_len = LENGTH(x); nbins0 = INTEGER(nbins)[0]; weight_len = LENGTH(weight); weight_p = INTEGER(weight); strict0 = LOGICAL(strict)[0]; j = 0; PROTECT(ans = NEW_INTEGER(nbins0)); memset(INTEGER(ans), 0, nbins0 * sizeof(int)); one_based_ans_p = INTEGER(ans) - 1; // We do unsafe arithmetic, which is 40% faster than safe arithmetic. // For now, the only use case for tabulate2() is fast tabulation of // integer- and factor-Rle's (passing the run values and run lengths // to 'x' and 'weight', respectively), so we are safe (the cumulated // run lengths of an Rle must be < 2^31). //_reset_ovflow_flag(); for (i = j = 0, x_p = INTEGER(x); i < x_len; i++, j++, x_p++) { if (j >= weight_len) j = 0; /* recycle */ x_elt = *x_p; if (x_elt == NA_INTEGER || x_elt < 1 || x_elt > nbins0) { if (!strict0) continue; UNPROTECT(1); error("'x' contains NAs or values not in the " "[1, 'nbins'] interval"); } weight_elt = weight_p[j]; //ans_elt = one_based_ans_p[x_elt]; //one_based_ans_p[x_elt] = _safe_int_add(ans_elt, weight_elt); one_based_ans_p[x_elt] += weight_elt; } //if (_get_ovflow_flag()) // warning("NAs produced by integer overflow"); UNPROTECT(1); return ans; } /**************************************************************************** * Bitwise operations. */ SEXP Integer_explode_bits(SEXP x, SEXP bitpos) { SEXP ans; int ans_nrow, ans_ncol, i, j, *ans_elt, bitmask; const int *x_elt, *bitpos_elt; ans_nrow = LENGTH(x); ans_ncol = LENGTH(bitpos); PROTECT(ans = allocMatrix(INTSXP, ans_nrow, ans_ncol)); ans_elt = INTEGER(ans); for (j = 0, bitpos_elt = INTEGER(bitpos); j < ans_ncol; j++, bitpos_elt++) { if (*bitpos_elt == NA_INTEGER || *bitpos_elt < 1) error("'bitpos' must contain values >= 1"); bitmask = 1 << (*bitpos_elt - 1); for (i = 0, x_elt = INTEGER(x); i < ans_nrow; i++, x_elt++) *(ans_elt++) = (*x_elt & bitmask) != 0; } UNPROTECT(1); return ans; } /**************************************************************************** * --- .Call ENTRY POINT --- * Creates the (sorted) union of two sorted integer vectors */ SEXP Integer_sorted_merge(SEXP x, SEXP y) { int x_i, y_i, x_len, y_len, ans_len; const int *x_ptr, *y_ptr; int *ans_ptr; SEXP ans; x_len = LENGTH(x); y_len = LENGTH(y); x_i = 0; y_i = 0; x_ptr = INTEGER(x); y_ptr = INTEGER(y); ans_len = 0; while (x_i < x_len && y_i < y_len) { if (*x_ptr == *y_ptr) { x_ptr++; x_i++; y_ptr++; y_i++; } else if (*x_ptr < *y_ptr) { x_ptr++; x_i++; } else { y_ptr++; y_i++; } ans_len++; } if (x_i < x_len) { ans_len += x_len - x_i; } else if (y_i < y_len) { ans_len += y_len - y_i; } PROTECT(ans = NEW_INTEGER(ans_len)); x_i = 0; y_i = 0; x_ptr = INTEGER(x); y_ptr = INTEGER(y); ans_ptr = INTEGER(ans); while (x_i < x_len && y_i < y_len) { if (*x_ptr == *y_ptr) { *ans_ptr = *x_ptr; x_ptr++; x_i++; y_ptr++; y_i++; } else if (*x_ptr < *y_ptr) { *ans_ptr = *x_ptr; x_ptr++; x_i++; } else { *ans_ptr = *y_ptr; y_ptr++; y_i++; } ans_ptr++; } if (x_i < x_len) { memcpy(ans_ptr, x_ptr, (x_len - x_i) * sizeof(int)); } else if (y_i < y_len) { memcpy(ans_ptr, y_ptr, (y_len - y_i) * sizeof(int)); } UNPROTECT(1); return ans; } /**************************************************************************** * --- .Call ENTRY POINT --- */ SEXP Integer_mseq(SEXP from, SEXP to) { int i, j, n, ans_length, *from_elt, *to_elt, *ans_elt; SEXP ans; if (!IS_INTEGER(from) || !IS_INTEGER(to)) error("'from' and 'to' must be integer vectors"); n = LENGTH(from); if (n != LENGTH(to)) error("lengths of 'from' and 'to' must be equal"); ans_length = 0; for (i = 0, from_elt = INTEGER(from), to_elt = INTEGER(to); i < n; i++, from_elt++, to_elt++) { ans_length += (*from_elt <= *to_elt ? *to_elt - *from_elt : *from_elt - *to_elt) + 1; } PROTECT(ans = NEW_INTEGER(ans_length)); ans_elt = INTEGER(ans); for (i = 0, from_elt = INTEGER(from), to_elt = INTEGER(to); i < n; i++, from_elt++, to_elt++) { if (*from_elt == NA_INTEGER || *to_elt == NA_INTEGER) error("'from' and 'to' contain NAs"); if (*from_elt <= *to_elt) { for (j = *from_elt; j <= *to_elt; j++) { *ans_elt = j; ans_elt++; } } else { for (j = *from_elt; j >= *to_elt; j--) { *ans_elt = j; ans_elt++; } } } UNPROTECT(1); return ans; } SEXP Integer_fancy_mseq(SEXP lengths, SEXP offset, SEXP rev) { int lengths_length, offset_length, rev_length, ans_length, i, length, *ans_elt, i2, i3, offset_elt, rev_elt, j; const int *lengths_elt; SEXP ans; lengths_length = LENGTH(lengths); offset_length = LENGTH(offset); rev_length = LENGTH(rev); if (lengths_length != 0) { if (offset_length == 0) error("'offset' has length 0 but not 'lengths'"); if (rev_length == 0) error("'rev' has length 0 but not 'lengths'"); } ans_length = 0; for (i = 0, lengths_elt = INTEGER(lengths); i < lengths_length; i++, lengths_elt++) { length = *lengths_elt; if (length == NA_INTEGER) error("'lengths' contains NAs"); if (length < 0) length = -length; ans_length += length; } PROTECT(ans = NEW_INTEGER(ans_length)); ans_elt = INTEGER(ans); for (i = i2 = i3 = 0, lengths_elt = INTEGER(lengths); i < lengths_length; i++, i2++, i3++, lengths_elt++) { if (i2 >= offset_length) i2 = 0; /* recycle */ if (i3 >= rev_length) i3 = 0; /* recycle */ length = *lengths_elt; offset_elt = INTEGER(offset)[i2]; if (length != 0 && offset_elt == NA_INTEGER) { UNPROTECT(1); error("'offset' contains NAs"); } rev_elt = INTEGER(rev)[i3]; if (length >= 0) { if (length >= 2 && rev_elt == NA_LOGICAL) { UNPROTECT(1); error("'rev' contains NAs"); } if (rev_elt) { for (j = length; j >= 1; j--) *(ans_elt++) = j + offset_elt; } else { for (j = 1; j <= length; j++) *(ans_elt++) = j + offset_elt; } } else { if (length <= -2 && rev_elt == NA_LOGICAL) { UNPROTECT(1); error("'rev' contains NAs"); } if (rev_elt) { for (j = length; j <= -1; j++) *(ans_elt++) = j - offset_elt; } else { for (j = -1; j >= length; j--) *(ans_elt++) = j - offset_elt; } } } UNPROTECT(1); return ans; } /**************************************************************************** * findIntervalAndStartFromWidth() * * 'x' and 'width' are integer vectors */ SEXP _find_interv_and_start_from_width(const int *x, int x_len, const int *width, int width_len) { int i, interval, start; const int *x_elt, *width_elt; int *interval_elt, *start_elt, *x_order_elt; SEXP ans, ans_class, ans_names, ans_rownames, ans_interval, ans_start; SEXP x_order; for (i = 0, width_elt = width; i < width_len; i++, width_elt++) { if (*width_elt == NA_INTEGER) error("'width' cannot contain missing values"); else if (*width_elt < 0) error("'width' must contain non-negative values"); } width_elt = width; ans_rownames = R_NilValue; PROTECT(ans_interval = NEW_INTEGER(x_len)); PROTECT(ans_start = NEW_INTEGER(x_len)); if (x_len > 0 && width_len > 0) { start = 1; interval = 1; PROTECT(x_order = NEW_INTEGER(x_len)); _get_order_of_int_array(x, x_len, 0, INTEGER(x_order), 0); for (i = 0, x_order_elt = INTEGER(x_order); i < x_len; i++, x_order_elt++) { x_elt = x + *x_order_elt; interval_elt = INTEGER(ans_interval) + *x_order_elt; start_elt = INTEGER(ans_start) + *x_order_elt; if (*x_elt == NA_INTEGER) error("'x' cannot contain missing values"); else if (*x_elt < 0) error("'x' must contain non-negative values"); if (*x_elt == 0) { *interval_elt = 0; *start_elt = NA_INTEGER; } else { while (interval < width_len && *x_elt >= (start + *width_elt)) { interval++; start += *width_elt; width_elt++; } if (*x_elt > start + *width_elt) error("'x' values larger than vector length 'sum(width)'"); *interval_elt = interval; *start_elt = start; } } UNPROTECT(1); PROTECT(ans_rownames = NEW_INTEGER(2)); INTEGER(ans_rownames)[0] = NA_INTEGER; INTEGER(ans_rownames)[1] = -x_len; } else { PROTECT(ans_rownames = NEW_INTEGER(0)); } PROTECT(ans = NEW_LIST(2)); PROTECT(ans_class = NEW_CHARACTER(1)); PROTECT(ans_names = NEW_CHARACTER(2)); SET_STRING_ELT(ans_class, 0, mkChar("data.frame")); SET_STRING_ELT(ans_names, 0, mkChar("interval")); SET_STRING_ELT(ans_names, 1, mkChar("start")); SET_NAMES(ans, ans_names); SET_VECTOR_ELT(ans, 0, ans_interval); SET_VECTOR_ELT(ans, 1, ans_start); setAttrib(ans, install("row.names"), ans_rownames); SET_CLASS(ans, ans_class); UNPROTECT(6); return ans; } /* --- .Call ENTRY POINT --- */ SEXP findIntervalAndStartFromWidth(SEXP x, SEXP width) { if (!IS_INTEGER(x)) error("'x' must be an integer vector"); if (!IS_INTEGER(width)) error("'width' must be an integer vector"); return _find_interv_and_start_from_width(INTEGER(x), LENGTH(x), INTEGER(width), LENGTH(width)); } IRanges/src/inter_range_methods.c0000644000126300012640000003426412234075662020460 0ustar00biocbuildphs_compbio/**************************************************************************** * Fast inter-range methods * * Author: Herve Pages * ****************************************************************************/ #include "IRanges.h" #include #define R_INT_MIN (1+INT_MIN) static int debug = 0; SEXP debug_inter_range_methods() { #ifdef DEBUG_IRANGES debug = !debug; Rprintf("Debug mode turned %s in file %s\n", debug ? "on" : "off", __FILE__); #else Rprintf("Debug mode not available in file %s\n", __FILE__); #endif return R_NilValue; } /**************************************************************************** * Low-level helper functions. */ static int get_cachedCompressedIRangesList_eltlens_max( const cachedCompressedIRangesList *cached_x) { int x_len, ir_len_max, i, ir_len; x_len = _get_cachedCompressedIRangesList_length(cached_x); ir_len_max = 0; for (i = 0; i < x_len; i++) { ir_len = _get_cachedCompressedIRangesList_eltLength( cached_x, i); if (ir_len > ir_len_max) ir_len_max = ir_len; } return ir_len_max; } static int append_cachedIRanges_to_RangeAE(RangeAE *range_ae, const cachedIRanges *cached_ir) { int ir_len, j, start, width; ir_len = _get_cachedIRanges_length(cached_ir); for (j = 0; j < ir_len; j++) { start = _get_cachedIRanges_elt_start(cached_ir, j); width = _get_cachedIRanges_elt_width(cached_ir, j); _RangeAE_insert_at(range_ae, _RangeAE_get_nelt(range_ae), start, width); } return ir_len; } /**************************************************************************** * "range" method. */ /* --- .Call ENTRY POINT --- */ SEXP IRanges_range(SEXP x) { int x_len, min, max, i, end; const int *start_p, *width_p; SEXP ans, ans_start, ans_width; x_len = _get_IRanges_length(x); if (x_len == 0) { PROTECT(ans_start = NEW_INTEGER(0)); PROTECT(ans_width = NEW_INTEGER(0)); PROTECT(ans = _new_IRanges("IRanges", ans_start, ans_width, R_NilValue)); UNPROTECT(3); return ans; } start_p = INTEGER(_get_IRanges_start(x)); width_p = INTEGER(_get_IRanges_width(x)); min = *(start_p++); max = min + *(width_p++) - 1; for (i = 1; i < x_len; i++, start_p++, width_p++) { if (*start_p < min) min = *start_p; end = *start_p + *width_p - 1; if (end > max) max = end; } PROTECT(ans_start = ScalarInteger(min)); PROTECT(ans_width = ScalarInteger(max - min + 1)); PROTECT(ans = _new_IRanges("IRanges", ans_start, ans_width, R_NilValue)); UNPROTECT(3); return ans; } /**************************************************************************** * "ranges" methods. */ /* WARNING: The reduced ranges are *appended* to 'out_ranges'! Returns the number of ranges that were appended. */ static int reduce_ranges(const int *x_start, const int *x_width, int x_len, int drop_empty_ranges, int min_gapwidth, int *order_buf, RangeAE *out_ranges, IntAEAE *mapping, int *out_inframe_start) { int out_len, out_len0, i, j, start_j, width_j, end_j, append_or_drop, max_end, gapwidth, delta, width_inc; IntAE tmp, *mapping_elt; if (min_gapwidth < 0) error("IRanges internal error in reduce_ranges(): " "negative min_gapwidth not supported"); _get_order_of_int_pairs(x_start, x_width, x_len, 0, order_buf, 0); out_len = out_len0 = _RangeAE_get_nelt(out_ranges); for (i = 0; i < x_len; i++) { j = order_buf[i]; start_j = x_start[j]; width_j = x_width[j]; end_j = start_j + width_j - 1; if (i == 0) { /* 'append_or_drop' is a toggle that indicates how the current input range should be added to 'out_ranges': 1 for appended (or dropped), 0 for merged. */ append_or_drop = 1; max_end = end_j; delta = start_j - 1; } else { /* If 'i' != 0 and 'append_or_drop' is 1 then the previous range was empty so 'gapwidth' will be >= 0. */ gapwidth = start_j - max_end - 1; if (gapwidth >= min_gapwidth) append_or_drop = 1; } if (append_or_drop) { if (width_j != 0 || (!drop_empty_ranges && (out_len == out_len0 || start_j != out_ranges->start.elts[ out_len - 1]))) { /* Append to 'out_ranges'. */ _RangeAE_insert_at(out_ranges, out_len, start_j, width_j); if (mapping != NULL) { /* Append to 'mapping'. */ tmp = _new_IntAE(1, 1, j + 1); _IntAEAE_insert_at(mapping, out_len, &tmp); mapping_elt = mapping->elts + out_len; } out_len++; append_or_drop = 0; } max_end = end_j; if (i != 0) delta += gapwidth; } else { width_inc = end_j - max_end; if (width_inc > 0) { /* Merge with last range in 'out_ranges'. */ out_ranges->width.elts[out_len - 1] += width_inc; max_end = end_j; } if (!(width_j == 0 && drop_empty_ranges) && mapping != NULL) { /* Append to 'mapping'. */ _IntAE_insert_at(mapping_elt, _IntAE_get_nelt(mapping_elt), j + 1); } } if (out_inframe_start != NULL) out_inframe_start[j] = start_j - delta; } return out_len - out_len0; } /* --- .Call ENTRY POINT --- */ SEXP Ranges_reduce(SEXP x_start, SEXP x_width, SEXP drop_empty_ranges, SEXP min_gapwidth, SEXP with_mapping, SEXP with_inframe_start) { int x_len, *inframe_start; const int *x_start_p, *x_width_p; SEXP ans, ans_names, ans_mapping, ans_inframe_start; RangeAE out_ranges; IntAE order_buf; IntAEAE tmp, *mapping; x_len = _check_integer_pairs(x_start, x_width, &x_start_p, &x_width_p, "start(x)", "width(x)"); if (LOGICAL(with_mapping)[0]) { tmp = _new_IntAEAE(0, 0); mapping = &tmp; } else { mapping = NULL; } if (LOGICAL(with_inframe_start)[0]) { PROTECT(ans_inframe_start = NEW_INTEGER(x_len)); inframe_start = INTEGER(ans_inframe_start); } else { inframe_start = NULL; } out_ranges = _new_RangeAE(0, 0); order_buf = _new_IntAE(x_len, 0, 0); reduce_ranges(x_start_p, x_width_p, x_len, LOGICAL(drop_empty_ranges)[0], INTEGER(min_gapwidth)[0], order_buf.elts, &out_ranges, mapping, inframe_start); /* Make 'ans' */ PROTECT(ans = NEW_LIST(4)); PROTECT(ans_names = NEW_CHARACTER(4)); SET_STRING_ELT(ans_names, 0, mkChar("start")); SET_STRING_ELT(ans_names, 1, mkChar("width")); SET_STRING_ELT(ans_names, 2, mkChar("mapping")); SET_STRING_ELT(ans_names, 3, mkChar("inframe.start")); SET_NAMES(ans, ans_names); UNPROTECT(1); SET_VECTOR_ELT(ans, 0, _new_INTEGER_from_IntAE(&(out_ranges.start))); SET_VECTOR_ELT(ans, 1, _new_INTEGER_from_IntAE(&(out_ranges.width))); if (mapping != NULL) { PROTECT(ans_mapping = _new_LIST_from_IntAEAE(mapping, 0)); SET_VECTOR_ELT(ans, 2, ans_mapping); UNPROTECT(1); } if (inframe_start != NULL) { SET_VECTOR_ELT(ans, 3, ans_inframe_start); UNPROTECT(1); } UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP CompressedIRangesList_reduce(SEXP x, SEXP drop_empty_ranges, SEXP min_gapwidth, SEXP with_mapping) { SEXP ans, ans_names, ans_mapping, ans_partitioning_end; //ans_unlistData, ans_partitioning; cachedCompressedIRangesList cached_x; cachedIRanges cached_ir; int x_len, in_len_max, i; IntAE order_buf; RangeAE in_ranges, out_ranges; IntAEAE tmp, *mapping; cached_x = _cache_CompressedIRangesList(x); x_len = _get_cachedCompressedIRangesList_length(&cached_x); if (LOGICAL(with_mapping)[0]) { tmp = _new_IntAEAE(0, 0); mapping = &tmp; } else { mapping = NULL; } in_len_max = get_cachedCompressedIRangesList_eltlens_max(&cached_x); order_buf = _new_IntAE(in_len_max, 0, 0); in_ranges = _new_RangeAE(0, 0); out_ranges = _new_RangeAE(0, 0); PROTECT(ans_partitioning_end = NEW_INTEGER(x_len)); for (i = 0; i < x_len; i++) { cached_ir = _get_cachedCompressedIRangesList_elt(&cached_x, i); _RangeAE_set_nelt(&in_ranges, 0); append_cachedIRanges_to_RangeAE(&in_ranges, &cached_ir); reduce_ranges(in_ranges.start.elts, in_ranges.width.elts, _RangeAE_get_nelt(&in_ranges), LOGICAL(drop_empty_ranges)[0], INTEGER(min_gapwidth)[0], order_buf.elts, &out_ranges, mapping, NULL); INTEGER(ans_partitioning_end)[i] = _RangeAE_get_nelt(&out_ranges); } /* Make 'ans' */ PROTECT(ans = NEW_LIST(4)); PROTECT(ans_names = NEW_CHARACTER(4)); SET_STRING_ELT(ans_names, 0, mkChar("start")); SET_STRING_ELT(ans_names, 1, mkChar("width")); SET_STRING_ELT(ans_names, 2, mkChar("mapping")); SET_STRING_ELT(ans_names, 3, mkChar("partitioning_by_end")); SET_NAMES(ans, ans_names); UNPROTECT(1); SET_VECTOR_ELT(ans, 0, _new_INTEGER_from_IntAE(&(out_ranges.start))); SET_VECTOR_ELT(ans, 1, _new_INTEGER_from_IntAE(&(out_ranges.width))); if (mapping != NULL) { PROTECT(ans_mapping = _new_LIST_from_IntAEAE(mapping, 0)); SET_VECTOR_ELT(ans, 2, ans_mapping); UNPROTECT(1); } SET_VECTOR_ELT(ans, 3, ans_partitioning_end); UNPROTECT(2); /* PROTECT(ans_unlistData = _new_IRanges_from_RangeAE("IRanges", &out_ranges)); PROTECT(ans_names = duplicate(_get_CompressedList_names(x))); PROTECT(ans_partitioning = _new_PartitioningByEnd( "PartitioningByEnd", ans_partitioning_end, ans_names)); PROTECT(ans = _new_CompressedList(_get_classname(x), ans_unlistData, ans_partitioning)); UNPROTECT(5); */ return ans; } /**************************************************************************** * "gaps" methods. */ /* WARNING: The ranges representing the gaps are *appended* to 'out_ranges'! Returns the number of ranges that were appended. */ static int gaps_ranges(const int *x_start, const int *x_width, int x_len, int restrict_start, int restrict_end, int *order_buf, RangeAE *out_ranges) { int out_len, out_len0, i, j, start_j, width_j, end_j, max_end, gapstart, gapwidth; if (restrict_start != NA_INTEGER) max_end = restrict_start - 1; else max_end = NA_INTEGER; _get_order_of_int_pairs(x_start, x_width, x_len, 0, order_buf, 0); out_len = out_len0 = _RangeAE_get_nelt(out_ranges); for (i = 0; i < x_len; i++) { j = order_buf[i]; width_j = x_width[j]; if (width_j == 0) continue; start_j = x_start[j]; end_j = start_j + width_j - 1; if (max_end == NA_INTEGER) { max_end = end_j; } else { gapstart = max_end + 1; if (restrict_end != NA_INTEGER && start_j > restrict_end + 1) start_j = restrict_end + 1; gapwidth = start_j - gapstart; if (gapwidth >= 1) { /* Append to 'out_ranges'. */ _RangeAE_insert_at(out_ranges, out_len, gapstart, gapwidth); out_len++; max_end = end_j; } else if (end_j > max_end) { max_end = end_j; } } if (restrict_end != NA_INTEGER && max_end >= restrict_end) break; } if (restrict_end != NA_INTEGER && max_end != NA_INTEGER && max_end < restrict_end) { gapstart = max_end + 1; gapwidth = restrict_end - max_end; /* Append to 'out_ranges'. */ _RangeAE_insert_at(out_ranges, out_len, gapstart, gapwidth); out_len++; } return out_len - out_len0; } /* --- .Call ENTRY POINT --- */ SEXP IRanges_gaps(SEXP x_start, SEXP x_width, SEXP start, SEXP end) { int x_len; const int *x_start_p, *x_width_p; SEXP ans, ans_names; RangeAE out_ranges; IntAE order_buf; x_len = _check_integer_pairs(x_start, x_width, &x_start_p, &x_width_p, "start(x)", "width(x)"); out_ranges = _new_RangeAE(0, 0); order_buf = _new_IntAE(x_len, 0, 0); gaps_ranges(x_start_p, x_width_p, x_len, INTEGER(start)[0], INTEGER(end)[0], order_buf.elts, &out_ranges); PROTECT(ans = NEW_LIST(2)); PROTECT(ans_names = NEW_CHARACTER(2)); SET_STRING_ELT(ans_names, 0, mkChar("start")); SET_STRING_ELT(ans_names, 1, mkChar("width")); SET_NAMES(ans, ans_names); UNPROTECT(1); SET_VECTOR_ELT(ans, 0, _new_INTEGER_from_IntAE(&(out_ranges.start))); SET_VECTOR_ELT(ans, 1, _new_INTEGER_from_IntAE(&(out_ranges.width))); UNPROTECT(1); return ans; } /* --- .Call ENTRY POINT --- */ SEXP CompressedIRangesList_gaps(SEXP x, SEXP start, SEXP end) { SEXP ans, ans_names, ans_unlistData, ans_partitioning, ans_partitioning_end; cachedCompressedIRangesList cached_x; cachedIRanges cached_ir; int x_len, in_len_max, start_len, *start_elt, *end_elt, i; IntAE order_buf; RangeAE in_ranges, out_ranges; cached_x = _cache_CompressedIRangesList(x); x_len = _get_cachedCompressedIRangesList_length(&cached_x); in_len_max = get_cachedCompressedIRangesList_eltlens_max(&cached_x); order_buf = _new_IntAE(in_len_max, 0, 0); in_ranges = _new_RangeAE(0, 0); out_ranges = _new_RangeAE(0, 0); start_len = LENGTH(start); if ((start_len != 1 && start_len != x_len) || start_len != LENGTH(end)) error("'start' and 'end' should both be integer vectors " "of length 1 or length(x)"); PROTECT(ans_partitioning_end = NEW_INTEGER(x_len)); start_elt = INTEGER(start); end_elt = INTEGER(end); for (i = 0; i < x_len; i++) { cached_ir = _get_cachedCompressedIRangesList_elt(&cached_x, i); _RangeAE_set_nelt(&in_ranges, 0); append_cachedIRanges_to_RangeAE(&in_ranges, &cached_ir); gaps_ranges(in_ranges.start.elts, in_ranges.width.elts, _RangeAE_get_nelt(&in_ranges), *start_elt, *end_elt, order_buf.elts, &out_ranges); INTEGER(ans_partitioning_end)[i] = _RangeAE_get_nelt(&out_ranges); if (start_len != 1) { start_elt++; end_elt++; } } PROTECT(ans_unlistData = _new_IRanges_from_RangeAE("IRanges", &out_ranges)); PROTECT(ans_names = duplicate(_get_CompressedList_names(x))); PROTECT(ans_partitioning = _new_PartitioningByEnd( "PartitioningByEnd", ans_partitioning_end, ans_names)); PROTECT(ans = _new_CompressedList(_get_classname(x), ans_unlistData, ans_partitioning)); UNPROTECT(5); return ans; } /**************************************************************************** * "disjointBins" method. */ /* --- .Call ENTRY POINT --- * Worst case complexity of O(n^2) :(, but in practice very fast. */ SEXP Ranges_disjointBins(SEXP x_start, SEXP x_width) { SEXP ans; IntAE bin_ends = _new_IntAE(128, 0, 0); PROTECT(ans = NEW_INTEGER(length(x_start))); for (int i = 0; i < length(x_start); i++) { // find a bin, starting at first int j = 0, end = INTEGER(x_start)[i] + INTEGER(x_width)[i] - 1; for (; j < _IntAE_get_nelt(&bin_ends) && bin_ends.elts[j] >= INTEGER(x_start)[i]; j++); // remember when this bin will be open if (j == _IntAE_get_nelt(&bin_ends)) _IntAE_append(&bin_ends, &end, 1); else bin_ends.elts[j] = end; // store the bin for this range INTEGER(ans)[i] = j + 1; } UNPROTECT(1); return ans; } IRanges/src/localmem.c0000644000126300012640000000536312234075662016227 0ustar00biocbuildphs_compbio/* LocalMem.c - local memory routines. * * These routines are meant for the sort of scenario where * a lot of little to medium size pieces of memory are * allocated, and then disposed of all at once. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #include "common.h" #include "localmem.h" static char const rcsid[] = "$Id: localmem.c,v 1.10 2005/04/11 07:20:03 markd Exp $"; struct lm { struct lmBlock *blocks; size_t blockSize; size_t allignMask; size_t allignAdd; }; struct lmBlock { struct lmBlock *next; char *free; char *end; char *extra; }; static struct lmBlock *newBlock(struct lm *lm, size_t reqSize) /* Allocate a new block of at least reqSize */ { size_t size = (reqSize > lm->blockSize ? reqSize : lm->blockSize); size_t fullSize = size + sizeof(struct lmBlock); struct lmBlock *mb = needLargeZeroedMem(fullSize); if (mb == NULL) errAbort("Couldn't allocate %lld bytes", (long long)fullSize); mb->free = (char *)(mb+1); mb->end = ((char *)mb) + fullSize; mb->next = lm->blocks; lm->blocks = mb; return mb; } struct lm *lmInit(int blockSize) /* Create a local memory pool. */ { struct lm *lm; int aliSize = sizeof(long); if (aliSize < sizeof(double)) aliSize = sizeof(double); if (aliSize < sizeof(void *)) aliSize = sizeof(void *); lm = needMem(sizeof(*lm)); lm->blocks = NULL; if (blockSize <= 0) blockSize = (1<<14); /* 16k default. */ lm->blockSize = blockSize; lm->allignAdd = (aliSize-1); lm->allignMask = ~lm->allignAdd; newBlock(lm, blockSize); return lm; } void lmCleanup(struct lm **pLm) /* Clean up a local memory pool. */ { struct lm *lm = *pLm; if (lm == NULL) return; slFreeList(&lm->blocks); freeMem(lm); *pLm = NULL; } void *lmAlloc(struct lm *lm, size_t size) /* Allocate memory from local pool. */ { struct lmBlock *mb = lm->blocks; void *ret; size_t memLeft = mb->end - mb->free; if (memLeft < size) mb = newBlock(lm, size); ret = mb->free; mb->free += ((size+lm->allignAdd)&lm->allignMask); if (mb->free > mb->end) mb->free = mb->end; return ret; } void *lmCloneMem(struct lm *lm, void *pt, size_t size) /* Return a local mem copy of memory block. */ { void *d = lmAlloc(lm, size); memcpy(d, pt, size); return d; } char *lmCloneString(struct lm *lm, char *string) /* Return local mem copy of string. */ { if (string == NULL) return NULL; else { int size = strlen(string)+1; char *s = lmAlloc(lm, size); memcpy(s, string, size); return s; } } struct slName *lmSlName(struct lm *lm, char *name) /* Return slName in memory. */ { struct slName *n; int size = sizeof(*n) + strlen(name) + 1; n = lmAlloc(lm, size); strcpy(n->name, name); return n; } IRanges/src/localmem.h0000644000126300012640000000243012234075662016224 0ustar00biocbuildphs_compbio/* LocalMem.h - local memory routines. * * These routines are meant for the sort of scenario where * a lot of little to medium size pieces of memory are * allocated, and then disposed of all at once. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ struct lm *lmInit(int blockSize); /* Create a local memory pool. Parameters are: * blockSize - how much system memory to allocate at a time. Can * pass in zero and a reasonable default will be used. */ void lmCleanup(struct lm **pLm); /* Clean up a local memory pool. */ void *lmAlloc(struct lm *lm, size_t size); /* Allocate memory from local pool. */ char *lmCloneString(struct lm *lm, char *string); /* Return local mem copy of string. */ struct slName *lmSlName(struct lm *lm, char *name); /* Return slName in memory. */ void *lmCloneMem(struct lm *lm, void *pt, size_t size); /* Return a local mem copy of memory block. */ #define lmAllocVar(lm, pt) (pt = lmAlloc(lm, sizeof(*pt))); /* Shortcut to allocating a single variable in local mem and * assigning pointer to it. */ #define lmAllocArray(lm, pt, size) (pt = lmAlloc(lm, sizeof(*pt) * (size))) /* Shortcut to allocating an array in local mem and * assigning pointer to it. */ IRanges/src/memalloc.c0000644000126300012640000003214212234075662016222 0ustar00biocbuildphs_compbio/* memalloc.c - Routines to allocate and deallocate dynamic memory. * This lets you have a stack of memory handlers. The default * memory handler is a thin shell around malloc/free. You can * substitute routines that do more integrety checking with * pushCarefulMem(), or routines of your own devising with * pushMemHandler(). * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #include "common.h" /*#include "obscure.h"*/ #include "memalloc.h" #include "dlist.h" static char const rcsid[] = "$Id: memalloc.c,v 1.31 2007/04/24 18:35:43 hiram Exp $"; static void *defaultAlloc(size_t size) /* Default allocator. */ { return malloc(size); } static void defaultFree(void *vpt) /* Default deallocator. */ { free(vpt); } static void *defaultRealloc(void *vpt, size_t size) /* Default deallocator. */ { return realloc(vpt, size); } static struct memHandler defaultMemHandler = /* Default memory handler. */ { NULL, defaultAlloc, defaultFree, defaultRealloc, }; static struct memHandler *mhStack = &defaultMemHandler; struct memHandler *pushMemHandler(struct memHandler *newHandler) /* Use newHandler for memory requests until matching popMemHandler. * Returns previous top of memory handler stack. */ { struct memHandler *oldHandler = mhStack; slAddHead(&mhStack, newHandler); return oldHandler; } struct memHandler *popMemHandler() /* Removes top element from memHandler stack and returns it. */ { struct memHandler *oldHandler = mhStack; if (mhStack == &defaultMemHandler) errAbort("Too many popMemHandlers()"); mhStack = mhStack->next; return oldHandler; } void setDefaultMemHandler() /* Sets memHandler to the default. */ { mhStack = &defaultMemHandler; } /* 128*8*1024*1024 == 1073741824 == 2^30 on 32 bit machines,size_t == 4 bytes*/ /* on 64 bit machines, size_t = 8 bytes, 2^30 * 2 * 2 = 2^32 == 4 Gb */ static size_t maxAlloc = 128*8*1024*1024*(sizeof(size_t)/4)*(sizeof(size_t)/4); void setMaxAlloc(size_t s) /* Set large allocation limit. */ { maxAlloc = s; } void *needLargeMem(size_t size) /* This calls abort if the memory allocation fails. The memory is * not initialized to zero. */ { void *pt; if (size == 0 || size >= maxAlloc) errAbort("needLargeMem: trying to allocate %llu bytes (limit: %llu)", (unsigned long long)size, (unsigned long long)maxAlloc); if ((pt = mhStack->alloc(size)) == NULL) errAbort("needLargeMem: Out of memory - request size %llu bytes, errno: %d\n", (unsigned long long)size, errno); return pt; } void *needLargeZeroedMem(size_t size) /* Request a large block of memory and zero it. */ { void *v; v = needLargeMem(size); memset(v, 0, size); return v; } void *needLargeMemResize(void* vp, size_t size) /* Adjust memory size on a block, possibly relocating it. If vp is NULL, * a new memory block is allocated. Memory not initted. */ { void *pt; if (size == 0 || size >= maxAlloc) errAbort("needLargeMemResize: trying to allocate %llu bytes (limit: %llu)", (unsigned long long)size, (unsigned long long)maxAlloc); if ((pt = mhStack->realloc(vp, size)) == NULL) errAbort("needLargeMemResize: Out of memory - request size %llu bytes, errno: %d\n", (unsigned long long)size, errno); return pt; } void *needLargeZeroedMemResize(void* vp, size_t oldSize, size_t newSize) /* Adjust memory size on a block, possibly relocating it. If vp is NULL, a * new memory block is allocated. If block is grown, new memory is zeroed. */ { void *v = needLargeMemResize(vp, newSize); if (newSize > oldSize) memset(((char*)v)+oldSize, 0, newSize-oldSize); return v; } void *needHugeMem(size_t size) /* No checking on size. Memory not initted. */ { void *pt; if (size == 0) errAbort("needHugeMem: trying to allocate 0 bytes"); if ((pt = mhStack->alloc(size)) == NULL) errAbort("needHugeMem: Out of huge memory - request size %llu bytes, errno: %d\n", (unsigned long long)size, errno); return pt; } void *needHugeZeroedMem(size_t size) /* Request a large block of memory and zero it. */ { void *v; v = needHugeMem(size); memset(v, 0, size); return v; } void *needHugeMemResize(void* vp, size_t size) /* Adjust memory size on a block, possibly relocating it. If vp is NULL, * a new memory block is allocated. No checking on size. Memory not * initted. */ { void *pt; if ((pt = mhStack->realloc(vp, size)) == NULL) errAbort("needHugeMemResize: Out of memory - request resize %llu bytes, errno: %d\n", (unsigned long long)size, errno); return pt; } void *needHugeZeroedMemResize(void* vp, size_t oldSize, size_t newSize) /* Adjust memory size on a block, possibly relocating it. If vp is NULL, a * new memory block is allocated. No checking on size. If block is grown, * new memory is zeroed. */ { void *v; v = needHugeMemResize(vp, newSize); if (newSize > oldSize) memset(((char*)v)+oldSize, 0, newSize-oldSize); return v; } #define NEEDMEM_LIMIT 500000000 void *needMem(size_t size) /* Need mem calls abort if the memory allocation fails. The memory * is initialized to zero. */ { void *pt; if (size == 0 || size > NEEDMEM_LIMIT) errAbort("needMem: trying to allocate %llu bytes (limit: %llu)", (unsigned long long)size, (unsigned long long)NEEDMEM_LIMIT); if ((pt = mhStack->alloc(size)) == NULL) errAbort("needMem: Out of memory - request size %llu bytes, errno: %d\n", (unsigned long long)size, errno); memset(pt, 0, size); return pt; } void *needMoreMem(void *old, size_t oldSize, size_t newSize) /* Adjust memory size on a block, possibly relocating it. If vp is NULL, a * new memory block is allocated. No checking on size. If block is grown, * new memory is zeroed. */ { return needLargeZeroedMemResize(old, oldSize, newSize); } void *wantMem(size_t size) /* Want mem just calls malloc - no zeroing of memory, no * aborting if request fails. */ { return mhStack->alloc(size); } void freeMem(void *pt) /* Free memory will check for null before freeing. */ { if (pt != NULL) mhStack->free(pt); } void freez(void *vpt) /* Pass address of pointer. Will free pointer and set it * to NULL. */ { void **ppt = (void **)vpt; void *pt = *ppt; *ppt = NULL; freeMem(pt); } static int carefulAlignSize; /* Alignment size for machine - 8 bytes for DEC alpha, 4 for Sparc. */ static int carefulAlignAdd; /* Do aliSize = *(unaliSize+carefulAlignAdd)&carefulAlignMask); */ #if __WORDSIZE == 64 static bits64 carefulAlignMask; /* to make sure requests are aligned. */ #elif __WORDSIZE == 32 static bits32 carefulAlignMask; /* to make sure requests are aligned. */ #else static bits32 carefulAlignMask; /* to make sure requests are aligned. */ #endif static struct memHandler *carefulParent; static size_t carefulMaxToAlloc; static size_t carefulAlloced; struct carefulMemBlock /* Keep one of these for each outstanding memory block. It's a doubly linked list. */ { struct carefulMemBlock *next; struct carefulMemBlock *prev; int size; int startCookie; }; int cmbStartCookie = 0x78753421; char cmbEndCookie[4] = {0x44, 0x33, 0x7F, 0x42}; struct dlList *cmbAllocedList; static void carefulMemInit(size_t maxToAlloc) /* Initialize careful memory system */ { carefulMaxToAlloc = maxToAlloc; cmbAllocedList = newDlList(); carefulAlignSize = sizeof(double); if (sizeof(void *) > carefulAlignSize) carefulAlignSize = sizeof(void *); if (sizeof(long) > carefulAlignSize) carefulAlignSize = sizeof(long); if (sizeof(off_t) > carefulAlignSize) carefulAlignSize = sizeof(off_t); if (sizeof(long long) > carefulAlignSize) carefulAlignSize = sizeof(long long); carefulAlignAdd = carefulAlignSize-1; carefulAlignMask = ~carefulAlignAdd; } static void *carefulAlloc(size_t size) /* Allocate extra memory for cookies and list node, and then * return memory block. */ { struct carefulMemBlock *cmb; char *pEndCookie; size_t newAlloced = size + carefulAlloced; size_t aliSize; if (newAlloced > carefulMaxToAlloc) { /* sprintLongWithCommas(maxAlloc, (long long)carefulMaxToAlloc); sprintLongWithCommas(allocRequest, (long long)newAlloced);*/ errAbort("Allocated too much memory - more than %ld bytes (%ld)", carefulMaxToAlloc, newAlloced); } carefulAlloced = newAlloced; aliSize = ((size + sizeof(*cmb) + 4 + carefulAlignAdd)&carefulAlignMask); cmb = carefulParent->alloc(aliSize); cmb->size = size; cmb->startCookie = cmbStartCookie; pEndCookie = (char *)(cmb+1); pEndCookie += size; memcpy(pEndCookie, cmbEndCookie, sizeof(cmbEndCookie)); dlAddHead(cmbAllocedList, (struct dlNode *)cmb); return (void *)(cmb+1); } static void carefulFree(void *vpt) /* Check cookies and free. */ { struct carefulMemBlock *cmb = ((struct carefulMemBlock *)vpt)-1; size_t size = cmb->size; char *pEndCookie; carefulAlloced -= size; pEndCookie = (((char *)(cmb+1)) + size); if (cmb->startCookie != cmbStartCookie) errAbort("Bad start cookie %x freeing %llx\n", cmb->startCookie, ptrToLL(vpt)); if (memcmp(pEndCookie, cmbEndCookie, sizeof(cmbEndCookie)) != 0) errAbort("Bad end cookie %x%x%x%x freeing %llx\n", pEndCookie[0], pEndCookie[1], pEndCookie[2], pEndCookie[3], ptrToLL(vpt)); dlRemove((struct dlNode *)cmb); carefulParent->free(cmb); } static void *carefulRealloc(void *vpt, size_t size) /* realloc a careful memblock block. */ { unsigned char* newBlk = carefulAlloc(size); if (vpt != NULL) { struct carefulMemBlock *cmb = ((struct carefulMemBlock *)vpt)-1; memcpy(newBlk, vpt, cmb->size); carefulFree(vpt); } return newBlk; } void carefulCheckHeap() /* Walk through allocated memory and make sure that all cookies are * in place. */ { int maxPieces = 10000000; /* Assume no more than this many pieces allocated. */ struct carefulMemBlock *cmb; char *pEndCookie; size_t size; if (carefulParent == NULL) return; for (cmb = (struct carefulMemBlock *)(cmbAllocedList->head); cmb->next != NULL; cmb = cmb->next) { size = cmb->size; pEndCookie = (((char *)(cmb+1)) + size); if (cmb->startCookie != cmbStartCookie) errAbort("Bad start cookie %x checking %llx\n", cmb->startCookie, ptrToLL(cmb+1)); if (memcmp(pEndCookie, cmbEndCookie, sizeof(cmbEndCookie)) != 0) errAbort("Bad end cookie %x%x%x%x checking %llx\n", pEndCookie[0], pEndCookie[1], pEndCookie[2], pEndCookie[3], ptrToLL(cmb+1)); if (--maxPieces == 0) errAbort("Loop or more than 10000000 pieces in memory list"); } } int carefulCountBlocksAllocated() /* How many memory items are allocated? */ { return dlCount(cmbAllocedList); } long carefulTotalAllocated() /* Return total bases allocated */ { return carefulAlloced; } static struct memHandler carefulMemHandler = /* Default memory handler. */ { NULL, carefulAlloc, carefulFree, carefulRealloc, }; void pushCarefulMemHandler(size_t maxAlloc) /* Push the careful (paranoid, conservative, checks everything) * memory handler top of the memHandler stack and use it. */ { carefulMemInit(maxAlloc); carefulParent = pushMemHandler(&carefulMemHandler); } struct memTracker /* A structure to keep track of memory. */ { struct memTracker *next; /* Next in list. */ struct dlList *list; /* List of allocated blocks. */ struct memHandler *parent; /* Underlying memory handler. */ struct memHandler *handler; /* Memory handler. */ }; static struct memTracker *memTracker = NULL; /* Head in memTracker list. */ static void *memTrackerAlloc(size_t size) /* Allocate extra memory for cookies and list node, and then * return memory block. */ { struct dlNode *node; size += sizeof (*node); node = memTracker->parent->alloc(size); if (node == NULL) return node; dlAddTail(memTracker->list, node); return (void*)(node+1); } static void memTrackerFree(void *vpt) /* Check cookies and free. */ { struct dlNode *node = vpt; node -= 1; dlRemove(node); memTracker->parent->free(node); } static void *memTrackerRealloc(void *vpt, size_t size) /* Resize a memory block from memTrackerAlloc. */ { if (vpt == NULL) return memTrackerAlloc(size); else { struct dlNode *node = ((struct dlNode *)vpt)-1; size += sizeof(*node); dlRemove(node); node = memTracker->parent->realloc(node, size); if (node == NULL) return node; dlAddTail(memTracker->list, node); return (void*)(node+1); } } void memTrackerStart() /* Push memory handler that will track blocks allocated so that * they can be automatically released with memTrackerEnd(). You * can have memTrackerStart one after the other, but memTrackerStart/End * need to nest. */ { struct memTracker *mt; if (memTracker != NULL) errAbort("multiple memTrackerStart calls"); AllocVar(mt); AllocVar(mt->handler); mt->handler->alloc = memTrackerAlloc; mt->handler->free = memTrackerFree; mt->handler->realloc = memTrackerRealloc; mt->list = dlListNew(); mt->parent = pushMemHandler(mt->handler); memTracker = mt; } void memTrackerEnd() /* Free any remaining blocks and pop tracker memory handler. */ { struct memTracker *mt = memTracker; if (mt == NULL) errAbort("memTrackerEnd without memTrackerStart"); memTracker = NULL; popMemHandler(); dlListFree(&mt->list); freeMem(mt->handler); freeMem(mt); } IRanges/src/memalloc.h0000644000126300012640000000322312234075662016225 0ustar00biocbuildphs_compbio/* Let the user redirect where memory allocation/deallocation * happens. 'careful' routines help debug scrambled heaps. * * This file is copyright 2002 Jim Kent, but license is hereby * granted for all use - public, private or commercial. */ #ifndef MEMALLOC_H #define MEMALLOC_H struct memHandler { struct memHandler *next; void * (*alloc)(size_t size); void (*free)(void *vpt); void * (*realloc)(void* vpt, size_t size); }; struct memHandler *pushMemHandler(struct memHandler *newHandler); /* Use newHandler for memory requests until matching popMemHandler. * Returns previous top of memory handler stack. */ struct memHandler *popMemHandler(); /* Removes top element from memHandler stack and returns it. */ void setDefaultMemHandler(); /* Sets memHandler to the default. */ void pushCarefulMemHandler(size_t maxAlloc); /* Push the careful (paranoid, conservative, checks everything) * memory handler top of the memHandler stack and use it. */ void carefulCheckHeap(); /* Walk through allocated memory and make sure that all cookies are * in place. Only walks through what's been done since * pushCarefulMemHandler(). */ int carefulCountBlocksAllocated(); /* How many memory items are allocated? (Since called * pushCarefulMemHandler(). */ long carefulTotalAllocated(); /* Return total bases allocated */ void setMaxAlloc(size_t s); /* Set large allocation limit. */ void memTrackerStart(); /* Push memory handler that will track blocks allocated so that * they can be automatically released with memTrackerEnd(). */ void memTrackerEnd(); /* Free any remaining blocks and pop tracker memory handler. */ #endif /* MEMALLOC_H */ IRanges/src/rbTree.c0000644000126300012640000004001012234075662015645 0ustar00biocbuildphs_compbio/* rbTree - Red-Black Tree - a type of binary tree which * automatically keeps relatively balanced during * inserts and deletions. * original author: Shane Saunders * adapted into local conventions: Jim Kent */ #include "common.h" #include "localmem.h" #include "rbTree.h" static char const rcsid[] = "$Id: rbTree.c,v 1.11 2007/11/26 02:09:52 kent Exp $"; static struct rbTreeNode *restructure(struct rbTree *t, int tos, struct rbTreeNode *x, struct rbTreeNode *y, struct rbTreeNode *z) /* General restructuring function - checks for all * restructuring cases. Call when insert has messed up tree. * Sadly delete has to do even more work. */ { struct rbTreeNode *parent, *midNode; if(y == x->left) { if(z == y->left) { /* in-order: z, y, x */ midNode = y; y->left = z; x->left = y->right; y->right = x; } else { /* in-order: y, z, x */ midNode = z; y->right = z->left; z->left = y; x->left = z->right; z->right = x; } } else { if(z == y->left) { /* in-order: x, z, y */ midNode = z; x->right = z->left; z->left = x; y->left = z->right; z->right = y; } else { /* in-order: x, y, z */ midNode = y; x->right = y->left; y->left = x; y->right = z; } } if(tos != 0) { parent = t->stack[tos-1]; if(x == parent->left) parent->left = midNode; else parent->right = midNode; } else t->root = midNode; return midNode; } struct rbTree *rbTreeNewDetailed(int (*compare)(void *, void *), struct lm *lm, struct rbTreeNode *stack[128]) /* Allocate rbTree on an existing local memory & stack. This is for cases * where you want a lot of trees, and don't want the overhead for each one. * Note, to clean these up, just do freez(&rbTree) rather than rbFreeTree(&rbTree). */ { struct rbTree *t; AllocVar(t); t->root = NULL; t->compare = compare; t->lm = lm; t->stack = stack; t->n = 0; return t; } struct rbTree *rbTreeNew(int (*compare)(void *, void *)) /* rbTreeNew() - Allocates space for a red-black tree and returns a pointer * to it. The function compare compares they keys of two items, and returns a * negative, zero, or positive integer depending on whether the first item is * less than, equal to, or greater than the second. */ { /* The stack keeps us from having to keep explicit * parent, grandparent, greatgrandparent variables. * It needs to be big enough for the maximum depth * of tree. Since the whole point of rb trees is * that they are self-balancing, this is not all * that deep, just 2*log2(N). Therefore a stack of * 128 is good for up to 2^64 items in stack, which * should keep us for the next couple of decades... */ struct lm *lm = lmInit(0); struct rbTreeNode **stack = lmAlloc(lm, 128 * sizeof(stack[0])); return rbTreeNewDetailed(compare, lm, stack); } void rbTreeFree(struct rbTree **pTree) /* rbTreeFree() - Frees space used by the red-black tree pointed to by t. */ { struct rbTree *tree = *pTree; if (tree != NULL) { lmCleanup(&tree->lm); freez(pTree); } } void rbTreeFreeList(struct rbTree **pList) /* Free up a list of rbTrees. */ { struct rbTree *tree, *next; for (tree = *pList; tree != NULL; tree = next) { next = tree->next; rbTreeFree(&tree); } } void *rbTreeAdd(struct rbTree *t, void *item) /* rbTreeAdd() - Inserts an item into the red-black tree pointed to by t, * according the the value its key. The key of an item in the red-black * tree must be unique among items in the tree. If an item with the same key * already exists in the tree, a pointer to that item is returned. Otherwise, * NULL is returned, indicating insertion was successful. */ { struct rbTreeNode *x, *p, *q, *m, **attachX; int (* compare)(void *, void *); int cmpResult; rbTreeColor col; struct rbTreeNode **stack = NULL; int tos; tos = 0; if((p = t->root) != NULL) { compare = t->compare; stack = t->stack; /* Repeatedly explore either the left branch or the right branch * depending on the value of the key, until an empty branch is chosen. */ for(;;) { stack[tos++] = p; cmpResult = compare(item, p->item); if(cmpResult < 0) { p = p->left; if(!p) { p = stack[--tos]; attachX = &p->left; break; } } else if(cmpResult > 0) { p = p->right; if(!p) { p = stack[--tos]; attachX = &p->right; break; } } else { return p->item; } } col = rbTreeRed; } else { attachX = &t->root; col = rbTreeBlack; } /* Allocate new node and place it in tree. */ if ((x = t->freeList) != NULL) t->freeList = x->right; else lmAllocVar(t->lm, x); x->left = x->right = NULL; x->item = item; x->color = col; *attachX = x; t->n++; /* Restructuring or recolouring will be needed if node x and its parent, p, * are both red. */ if(tos > 0) { while(p->color == rbTreeRed) { /* Double red problem. */ /* Obtain a pointer to p's parent, m, and sibling, q. */ m = stack[--tos]; q = p == m->left ? m->right : m->left; /* Determine whether restructuring or recolouring is needed. */ if(!q || q->color == rbTreeBlack) { /* Sibling is black. ==> Perform restructuring. */ /* Restructure according to the left to right order, of nodes * m, p, and x. */ m = restructure(t, tos, m, p, x); m->color = rbTreeBlack; m->left->color = m->right->color = rbTreeRed; /* Restructuring eliminates the double red problem. */ break; } /* else just need to flip color */ /* Sibling is also red. ==> Perform recolouring. */ p->color = rbTreeBlack; q->color = rbTreeBlack; if(tos == 0) break; /* The root node always remains black. */ m->color = rbTreeRed; /* Continue, checking colouring higher up. */ x = m; p = stack[--tos]; } } return NULL; } void *rbTreeFind(struct rbTree *t, void *item) /* rbTreeFind() - Find an item in the red-black tree with the same key as the * item pointed to by `item'. Returns a pointer to the item found, or NULL * if no item was found. */ { struct rbTreeNode *p, *nextP; int (*compare)(void *, void *) = t->compare; int cmpResult; /* Repeatedly explore either the left or right branch, depending on the * value of the key, until the correct item is found. */ for (p = t->root; p != NULL; p = nextP) { cmpResult = compare(item, p->item); if(cmpResult < 0) nextP = p->left; else if(cmpResult > 0) nextP = p->right; else return p->item; } return NULL; } void *rbTreeRemove(struct rbTree *t, void *item) /* rbTreeRemove() - Delete an item in the red-black tree with the same key as * the item pointed to by `item'. Returns a pointer to the deleted item, * and NULL if no item was found. */ { struct rbTreeNode *p, *r, *x, *y, *z, *b, *newY; struct rbTreeNode *m; rbTreeColor removeCol; void *returnItem; int (* compare)(void *, void *); int cmpResult; struct rbTreeNode **stack; int i, tos; /* Attempt to locate the item to be deleted. */ if((p = t->root)) { compare = t->compare; stack = t->stack; tos = 0; for(;;) { stack[tos++] = p; cmpResult = compare(item, p->item); if(cmpResult < 0) p = p->left; else if(cmpResult > 0) p = p->right; else /* Item found. */ break; if(!p) return NULL; } } else return NULL; /* p points to the node to be deleted, and is currently on the top of the * stack. */ if(!p->left) { tos--; /* Adjust tos to remove p. */ /* Right child replaces p. */ if(tos == 0) { r = t->root = p->right; x = y = NULL; } else { x = stack[--tos]; if(p == x->left) { r = x->left = p->right; y = x->right; } else { r = x->right = p->right; y = x->left; } } removeCol = p->color; } else if(!p->right) { tos--; /* Adjust tos to remove p. */ /* Left child replaces p. */ if(tos == 0) { r = t->root = p->left; x = y = NULL; } else { x = stack[--tos]; if(p == x->left) { r = x->left = p->left; y = x->right; } else { r = x->right = p->left; y = x->left; } } removeCol = p->color; } else { /* Save p's stack position. */ i = tos-1; /* Minimum child, m, in the right subtree replaces p. */ m = p->right; do { stack[tos++] = m; m = m->left; } while(m); m = stack[--tos]; /* Update either the left or right child pointers of p's parent. */ if(i == 0) { t->root = m; } else { x = stack[i-1]; /* p's parent. */ if(p == x->left) { x->left = m; } else { x->right = m; } } /* Update the tree part m is removed from, and assign m the child * pointers of p (only if m is not the right child of p). */ stack[i] = m; /* Node m replaces node p on the stack. */ x = stack[--tos]; r = m->right; if(tos != i) { /* x is equal to the parent of m. */ y = x->right; x->left = r; m->right = p->right; } else { /* m was the right child of p, and x is equal to m. */ y = p->left; } m->left = p->left; /* We treat node m as the node which has been removed. */ removeCol = m->color; m->color = p->color; } /* Get return value and reuse the space used by node p. */ returnItem = p->item; p->right = t->freeList; t->freeList = p; t->n--; /* The pointers x, y, and r point to nodes which may be involved in * restructuring and recolouring. * x - the parent of the removed node. * y - the sibling of the removed node. * r - the node which replaced the removed node. * From the above code, the next entry off the stack will be the parent of * node x. */ /* The number of black nodes on paths to all external nodes (NULL child * pointers) must remain the same for all paths. Restructuring or * recolouring of nodes may be necessary to enforce this. */ if(removeCol == rbTreeBlack) { /* Removal of a black node requires some adjustment. */ if(!r || r->color == rbTreeBlack) { /* A black node replaced the deleted black node. Note that * external nodes (NULL child pointers) are always black, so * if r is NULL it is treated as a black node. */ /* This causes a double-black problem, since node r would need to * be coloured double-black in order for the black color on * paths through r to remain the same as for other paths. */ /* If r is the root node, the double-black color is not necessary * to maintain the color balance. Otherwise, some adjustment of * nearby nodes is needed in order to eliminate the double-black * problem. NOTE: x points to the parent of r. */ if(x) for(;;) { /* There are three adjustment cases: * 1. r's sibling, y, is black and has a red child, z. * 2. r's sibling, y, is black and has two black children. * 3. r's sibling, y, is red. */ if(y->color == rbTreeBlack) { /* Note the conditional evaluation for assigning z. */ if(((z = y->left) && z->color == rbTreeRed) || ((z = y->right) && z->color == rbTreeRed)) { /* Case 1: perform a restructuring of nodes x, y, and * z. */ b = restructure(t, tos, x, y, z); b->color = x->color; b->left->color = b->right->color = rbTreeBlack; break; } else { /* Case 2: recolour node y red. */ y->color = rbTreeRed; if(x->color == rbTreeRed) { x->color = rbTreeBlack; break; } /* else */ if(tos == 0) break; /* Root level reached. */ /* else */ r = x; x = stack[--tos]; /* x <- parent of x. */ y = x->left == r ? x->right : x->left; } } else { /* Case 3: Restructure nodes x, y, and z, where: * - If node y is the left child of x, then z is the left * child of y. Otherwise z is the right child of y. */ if(x->left == y) { newY = y->right; z = y->left; } else { newY = y->left; z = y->right; } restructure(t, tos, x, y, z); y->color = rbTreeBlack; x->color = rbTreeRed; /* Since x has moved down a place in the tree, and y is the * new the parent of x, the stack must be adjusted so that * the parent of x is correctly identified in the next call * to restructure(). */ stack[tos++] = y; /* After restructuring, node r has a black sibling, newY, * so either case 1 or case 2 applies. If case 2 applies * the double-black problem does not reappear. */ y = newY; /* Note the conditional evaluation for assigning z. */ if(((z = y->left) && z->color == rbTreeRed) || ((z = y->right) && z->color == rbTreeRed)) { /* Case 1: perform a restructuring of nodes x, y, and * z. */ b = restructure(t, tos, x, y, z); b->color = rbTreeRed; /* Since node x was red. */ b->left->color = b->right->color = rbTreeBlack; } else { /* Case 2: recolour node y red. */ /* Note that node y is black and node x is red. */ y->color = rbTreeRed; x->color = rbTreeBlack; } break; } } } else { /* A red node replaced the deleted black node. */ /* In this case we can simply color the red node black. */ r->color = rbTreeBlack; } } return returnItem; } /* Some variables to help recursively dump tree. */ static int dumpLevel; /* Indentation level. */ static FILE *dumpFile; /* Output file */ static void (*dumpIt)(void *item, FILE *f); /* Item dumper. */ static void rTreeDump(struct rbTreeNode *n) /* Recursively dump. */ { if (n == NULL) return; spaceOut(dumpFile, ++dumpLevel * 3); fprintf(dumpFile, "%c ", (n->color == rbTreeRed ? 'r' : 'b')); dumpIt(n->item, dumpFile); fprintf(dumpFile, "\n"); rTreeDump(n->left); rTreeDump(n->right); --dumpLevel; } void rbTreeDump(struct rbTree *tree, FILE *f, void (*dumpItem)(void *item, FILE *f)) /* Dump out rb tree to file, mostly for debugging. */ { dumpFile = f; dumpLevel = 0; dumpIt = dumpItem; fprintf(f, "rbTreeDump\n"); rTreeDump(tree->root); } /* Variables to help recursively traverse tree. */ static void (*doIt)(void *item); static void *minIt, *maxIt; static int (*compareIt)(void *, void *); static void rTreeTraverseRange(struct rbTreeNode *n) /* Recursively traverse tree in range applying doIt. */ { if (n != NULL) { int minCmp = compareIt(n->item, minIt); int maxCmp = compareIt(n->item, maxIt); if (minCmp >= 0) rTreeTraverseRange(n->left); if (minCmp >= 0 && maxCmp <= 0) doIt(n->item); if (maxCmp <= 0) rTreeTraverseRange(n->right); } } static void rTreeTraverse(struct rbTreeNode *n) /* Recursively traverse full tree applying doIt. */ { if (n != NULL) { rTreeTraverse(n->left); doIt(n->item); rTreeTraverse(n->right); } } void rbTreeTraverseRange(struct rbTree *tree, void *minItem, void *maxItem, void (*doItem)(void *item)) /* Apply doItem function to all items in tree such that * minItem <= item <= maxItem */ { doIt = doItem; minIt = minItem; maxIt = maxItem; compareIt = tree->compare; rTreeTraverseRange(tree->root); } void rbTreeTraverse(struct rbTree *tree, void (*doItem)(void *item)) /* Apply doItem function to all items in tree */ { doIt = doItem; compareIt = tree->compare; rTreeTraverse(tree->root); } struct slRef *itList; /* List of items that rbTreeItemsInRange returns. */ static void addRef(void *item) /* Add item it itList. */ { refAdd(&itList, item); } struct slRef *rbTreeItemsInRange(struct rbTree *tree, void *minItem, void *maxItem) /* Return a sorted list of references to items in tree between range. * slFreeList this list when done. */ { itList = NULL; rbTreeTraverseRange(tree, minItem, maxItem, addRef); slReverse(&itList); return itList; } struct slRef *rbTreeItems(struct rbTree *tree) /* Return sorted list of items. slFreeList this when done.*/ { itList = NULL; rbTreeTraverse(tree, addRef); slReverse(&itList); return itList; } int rbTreeCmpString(void *a, void *b) /* Set up rbTree so as to work on strings. */ { return strcmp(a, b); } int rbTreeCmpWord(void *a, void *b) /* Set up rbTree so as to work on case-insensitive strings. */ { return differentWord(a,b); } IRanges/src/rbTree.h0000644000126300012640000000722212234075662015662 0ustar00biocbuildphs_compbio/* rbTree - rbTreeRed-rbTreeBlack Tree - a type of binary tree which * automatically keeps relatively balanced during * inserts and deletions. * original author: Shane Saunders * adapted into local conventions: Jim Kent */ #ifndef RBTREE_H #define RBTREE_H typedef enum {rbTreeRed,rbTreeBlack} rbTreeColor; /* Structure type for nodes in the red-black tree. */ struct rbTreeNode { struct rbTreeNode *left, *right; /* Children. */ rbTreeColor color; /* Heart of algorithm. */ void *item; /* Item stored in tree */ }; /* Structure type for the red-black tree. */ struct rbTree { struct rbTree *next; /* Next tree in list. */ struct rbTreeNode *root; /* Root of tree */ int n; /* Number of items in tree. */ int (* compare)(void *, void *);/* Comparison function */ struct rbTreeNode **stack; /* Ancestor stack. */ struct lm *lm; /* Local memory pool. */ struct rbTreeNode *freeList; /* List of nodes to reuse. */ }; struct rbTree *rbTreeNew(int (*compare)(void *, void *)); /* Allocates space for a red-black tree and returns a pointer * to it. The function compare compares they keys of two items, and returns a * negative, zero, or positive integer depending on whether the first item is * less than, equal to, or greater than the second. */ void rbTreeFree(struct rbTree **pTree); /* Frees space used by the red-black tree pointed to by t. */ void rbTreeFreeList(struct rbTree **pList); /* Free up a list of rbTrees. */ struct rbTree *rbTreeNewDetailed(int (*compare)(void *, void *), struct lm *lm, struct rbTreeNode *stack[128]); /* Allocate rbTree on an existing local memory & stack. This is for cases * where you want a lot of trees, and don't want the overhead for each one. * Note, to clean these up, just do freez(&rbTree) rather than rbFreeTree(&rbTree). */ void *rbTreeAdd(struct rbTree *t, void *item); /* Inserts an item into the red-black tree pointed to by t, * according the the value its key. The key of an item in the red-black * tree must be unique among items in the tree. If an item with the same key * already exists in the tree, a pointer to that item is returned. Otherwise, * NULL is returned, indicating insertion was successful. */ void *rbTreeFind(struct rbTree *t, void *item); /* Find an item in the red-black tree with the same key as the * item pointed to by `item'. Returns a pointer to the item found, or NULL * if no item was found. */ void *rbTreeRemove(struct rbTree *t, void *item); /* rbTreeRemove() - Delete an item in the red-black tree with the same key as * the item pointed to by `item'. Returns a pointer to the deleted item, * and NULL if no item was found. */ void rbTreeTraverseRange(struct rbTree *tree, void *minItem, void *maxItem, void (*doItem)(void *item)); /* Apply doItem function to all items in tree such that * minItem <= item <= maxItem */ struct slRef *rbTreeItemsInRange(struct rbTree *tree, void *minItem, void *maxItem); /* Return a sorted list of references to items in tree between range. * slFreeList this list when done. */ void rbTreeTraverse(struct rbTree *tree, void (*doItem)(void *item)); /* Apply doItem function to all items in tree */ struct slRef *rbTreeItems(struct rbTree *tree); /* Return sorted list of items. slFreeList this when done.*/ void rbTreeDump(struct rbTree *tree, FILE *f, void (*dumpItem)(void *item, FILE *f)); /* Dump to a file */ int rbTreeCmpString(void *a, void *b); /* Set up rbTree so as to work on strings. */ int rbTreeCmpWord(void *a, void *b); /* Set up rbTree so as to work on case-insensitive strings. */ #endif /* RBTREE_H */ IRanges/src/safe_arithm.c0000644000126300012640000000323412234075662016713 0ustar00biocbuildphs_compbio/**************************************************************************** * Safe signed integer arithmetic * * ------------------------------ * * TODO: Extend to support safe double arithmetic when the need arises. * ****************************************************************************/ #include "IRanges.h" #include /* for INT_MAX and INT_MIN */ static int ovflow_flag; void _reset_ovflow_flag() { ovflow_flag = 0; return; } int _get_ovflow_flag() { return ovflow_flag; } /* Reference: * The CERT C Secure Coding Standard * Rule INT32-C. Ensure that operations on signed integers do not result * in overflow */ int _safe_int_add(int x, int y) { if (x == NA_INTEGER || y == NA_INTEGER) return NA_INTEGER; if (((y > 0) && (x > (INT_MAX - y))) || ((y < 0) && (x < (INT_MIN - y)))) { ovflow_flag = 1; return NA_INTEGER; } return x + y; } int _safe_int_mult(int x, int y) { if (x == NA_INTEGER || y == NA_INTEGER) return NA_INTEGER; if (x > 0) { /* x is positive */ if (y > 0) { /* x and y are positive */ if (x > (INT_MAX / y)) { ovflow_flag = 1; return NA_INTEGER; } } else { /* x is positive, y is non-positive */ if (y < (INT_MIN / x)) { ovflow_flag = 1; return NA_INTEGER; } } } else { /* x is non-positive */ if (y > 0) { /* x is non-positive, y is positive */ if (x < (INT_MIN / y)) { ovflow_flag = 1; return NA_INTEGER; } } else { /* x and y are non-positive */ if ((x != 0) && (y < (INT_MAX / x))) { ovflow_flag = 1; return NA_INTEGER; } } } return x * y; } IRanges/src/sort_utils.c0000644000126300012640000001611112234075662016636 0ustar00biocbuildphs_compbio/**************************************************************************** * Low-level sorting utilities * * --------------------------- * * * * All sortings/orderings are based on the qsort() function from the * * standard C lib. * * Note that C qsort() is NOT "stable" so the ordering functions below * * (_get_order_of_*() functions) need to ultimately break ties by position * * (this is done by adding a little extra code at the end of the comparison * * function used in the call to qsort()). * ****************************************************************************/ #include "IRanges.h" #include /* for qsort() */ static const int *aa, *bb, *cc, *dd; /**************************************************************************** * Sorting or getting the order of an int array. */ static int compar_ints_for_asc_sort(const void *p1, const void *p2) { return *((const int *) p1) - *((const int *) p2); } static int compar_ints_for_desc_sort(const void *p1, const void *p2) { return compar_ints_for_asc_sort(p2, p1); } void _sort_int_array(int *x, int nelt, int desc) { int (*compar)(const void *, const void *); compar = desc ? compar_ints_for_desc_sort : compar_ints_for_asc_sort; qsort(x, nelt, sizeof(int), compar); return; } static int compar_aa_for_stable_asc_order(const void *p1, const void *p2) { int i1, i2, ret; i1 = *((const int *) p1); i2 = *((const int *) p2); ret = aa[i1] - aa[i2]; if (ret != 0) return ret; /* Break tie by position so the ordering is "stable". */ return i1 - i2; } /* We cannot just define compar_aa_for_stable_desc_order(p1, p2) to be * compar_aa_for_stable_asc_order(p2, p1) because of the tie-break * by position. */ static int compar_aa_for_stable_desc_order(const void *p1, const void *p2) { int i1, i2, ret; i1 = *((const int *) p1); i2 = *((const int *) p2); ret = aa[i2] - aa[i1]; if (ret != 0) return ret; /* Break tie by position so the ordering is "stable". */ return i1 - i2; } void _get_order_of_int_array(const int *x, int nelt, int desc, int *out, int out_shift) { int i, (*compar)(const void *, const void *); aa = x - out_shift; for (i = 0; i < nelt; i++) out[i] = i + out_shift; compar = desc ? compar_aa_for_stable_desc_order : compar_aa_for_stable_asc_order; qsort(out, nelt, sizeof(int), compar); return; } /**************************************************************************** * Getting the order of 2 int arrays of the same length. * The second array ('b') is used to break ties in the first array ('a'). */ static int compar_int_pairs(int a1, int b1, int a2, int b2) { int ret; ret = a1 - a2; if (ret != 0) return ret; ret = b1 - b2; return ret; } static int compar_aabb(int i1, int i2) { int ret; ret = aa[i1] - aa[i2]; if (ret != 0) return ret; ret = bb[i1] - bb[i2]; return ret; } static int compar_aabb_for_stable_asc_order(const void *p1, const void *p2) { int i1, i2, ret; i1 = *((const int *) p1); i2 = *((const int *) p2); ret = compar_aabb(i1, i2); if (ret != 0) return ret; /* Break tie by position so the ordering is "stable". */ return i1 - i2; } /* We cannot just define compar_aabb_for_stable_desc_order(p1, p2) to be * compar_aabb_for_stable_asc_order(p2, p1) because of the tie-break * by position. */ static int compar_aabb_for_stable_desc_order(const void *p1, const void *p2) { int i1, i2, ret; i1 = *((const int *) p1); i2 = *((const int *) p2); ret = compar_aabb(i2, i1); if (ret != 0) return ret; /* Break tie by position so the ordering is "stable". */ return i1 - i2; } void _get_order_of_int_pairs(const int *a, const int *b, int nelt, int desc, int *out, int out_shift) { int i, (*compar)(const void *, const void *); aa = a - out_shift; bb = b - out_shift; for (i = 0; i < nelt; i++, out_shift++) out[i] = out_shift; compar = desc ? compar_aabb_for_stable_desc_order : compar_aabb_for_stable_asc_order; qsort(out, nelt, sizeof(int), compar); return; } void _get_matches_of_ordered_int_pairs( const int *a1, const int *b1, const int *o1, int nelt1, const int *a2, const int *b2, const int *o2, int nelt2, int nomatch, int *out, int out_shift) { int i1, i2, ret; i2 = 0; ret = 0; for (i1 = 0; i1 < nelt1; i1++, o1++) { while (i2 < nelt2) { ret = compar_int_pairs( a1[*o1], b1[*o1], a2[*o2], b2[*o2]); if (ret <= 0) break; i2++, o2++; } out[*o1] = ret == 0 ? *o2 + out_shift : nomatch; } return; } /**************************************************************************** * Getting the order of 4 int arrays of the same length. * 2nd, 3rd and 4th arrays are used to successively break ties. */ static int compar_int_quads(int a1, int b1, int c1, int d1, int a2, int b2, int c2, int d2) { int ret; ret = compar_int_pairs(a1, b1, a2, b2); if (ret != 0) return ret; ret = c1 - c2; if (ret != 0) return ret; ret = d1 - d2; return ret; } static int compar_aabbccdd(int i1, int i2) { int ret; ret = compar_aabb(i1, i2); if (ret != 0) return ret; ret = cc[i1] - cc[i2]; if (ret != 0) return ret; ret = dd[i1] - dd[i2]; return ret; } static int compar_aabbccdd_for_stable_asc_order(const void *p1, const void *p2) { int i1, i2, ret; i1 = *((const int *) p1); i2 = *((const int *) p2); ret = compar_aabbccdd(i1, i2); if (ret != 0) return ret; /* Break tie by position so the ordering is "stable". */ return i1 - i2; } /* We cannot just define compar_aabbccdd_for_stable_desc_order(p1, p2) to be * compar_aabbccdd_for_stable_asc_order(p2, p1) because of the tie-break * by position. */ static int compar_aabbccdd_for_stable_desc_order(const void *p1, const void *p2) { int i1, i2, ret; i1 = *((const int *) p1); i2 = *((const int *) p2); ret = compar_aabbccdd(i2, i1); if (ret != 0) return ret; /* Break tie by position so the ordering is "stable". */ return i1 - i2; } void _get_order_of_int_quads(const int *a, const int *b, const int *c, const int *d, int nelt, int desc, int *out, int out_shift) { int i, (*compar)(const void *, const void *); aa = a - out_shift; bb = b - out_shift; cc = c - out_shift; dd = d - out_shift; for (i = 0; i < nelt; i++, out_shift++) out[i] = out_shift; compar = desc ? compar_aabbccdd_for_stable_desc_order : compar_aabbccdd_for_stable_asc_order; qsort(out, nelt, sizeof(int), compar); return; } void _get_matches_of_ordered_int_quads( const int *a1, const int *b1, const int *c1, const int *d1, const int *o1, int nelt1, const int *a2, const int *b2, const int *c2, const int *d2, const int *o2, int nelt2, int nomatch, int *out, int out_shift) { int i1, i2, ret; i2 = 0; ret = 0; for (i1 = 0; i1 < nelt1; i1++, o1++) { while (i2 < nelt2) { ret = compar_int_quads( a1[*o1], b1[*o1], c1[*o1], d1[*o1], a2[*o2], b2[*o2], c2[*o2], d2[*o2]); if (ret <= 0) break; i2++, o2++; } out[*o1] = ret == 0 ? *o2 + out_shift : nomatch; } return; } IRanges/src/str_utils.c0000644000126300012640000001164012234075662016461 0ustar00biocbuildphs_compbio#include "IRanges.h" #include /* for UINT_MAX and UINT_MIN */ #include /* for isblank() and isdigit() */ #include /* * --- .Call ENTRY POINT --- * We cannot rely on the strsplit() R function to split a string into single * characters when the string contains junk. For example: * > r <- as.raw(c(10, 255)) * > s <- rawToChar(r) * > s * [1] "\n\xff" * > strsplit(s, NULL, fixed=TRUE)[[1]] * [1] NA * doesn't work! * The function below should be safe, whatever the content of 's' is! * The length of the returned string is the number of chars in single * string 's'. Not vectorized. */ SEXP safe_strexplode(SEXP s) { SEXP s0, ans; int s0_length, i; char buf[2] = "X"; /* we only care about having buf[1] == 0 */ s0 = STRING_ELT(s, 0); s0_length = LENGTH(s0); PROTECT(ans = NEW_CHARACTER(s0_length)); for (i = 0; i < s0_length; i++) { buf[0] = CHAR(s0)[i]; SET_STRING_ELT(ans, i, mkChar(buf)); } UNPROTECT(1); return ans; } /**************************************************************************** * strsplit_as_list_of_ints() */ static IntAE int_ae_buf; static char errmsg_buf[200]; static SEXP explode_string_as_integer_vector(SEXP s, char sep0) { const char *str; int offset, n, ret; long int val; str = CHAR(s); _IntAE_set_nelt(&int_ae_buf, offset = 0); while (str[offset]) { ret = sscanf(str + offset, "%ld%n", &val, &n); if (ret != 1) { snprintf(errmsg_buf, sizeof(errmsg_buf), "decimal integer expected at char %d", offset + 1); return R_NilValue; } offset += n; while (isblank(str[offset])) offset++; if (val < INT_MIN || val > INT_MAX) { UNPROTECT(1); snprintf(errmsg_buf, sizeof(errmsg_buf), "out of range integer at char %d", offset + 1); return R_NilValue; } _IntAE_insert_at(&int_ae_buf, _IntAE_get_nelt(&int_ae_buf), (int) val); if (str[offset] == '\0') break; if (str[offset] != sep0) { snprintf(errmsg_buf, sizeof(errmsg_buf), "separator expected at char %d", offset + 1); return R_NilValue; } offset++; } return _new_INTEGER_from_IntAE(&int_ae_buf); } /* --- .Call ENTRY POINT --- */ SEXP strsplit_as_list_of_ints(SEXP x, SEXP sep) { SEXP ans, x_elt, ans_elt; int ans_length, i; char sep0; ans_length = LENGTH(x); sep0 = CHAR(STRING_ELT(sep, 0))[0]; if (isdigit(sep0) || sep0 == '+' || sep0 == '-') error("'sep' cannot be a digit, \"+\" or \"-\""); int_ae_buf = _new_IntAE(0, 0, 0); PROTECT(ans = NEW_LIST(ans_length)); for (i = 0; i < ans_length; i++) { x_elt = STRING_ELT(x, i); if (x_elt == NA_STRING) { UNPROTECT(1); error("'x' contains NAs"); } ans_elt = explode_string_as_integer_vector(x_elt, sep0); if (ans_elt == R_NilValue) { UNPROTECT(1); error("in list element %d: %s", i + 1, errmsg_buf); } PROTECT(ans_elt); SET_VECTOR_ELT(ans, i, ans_elt); UNPROTECT(1); } UNPROTECT(1); return ans; } /**************************************************************************** * svn_time() returns the time in Subversion format, e.g.: * "2007-12-07 10:03:15 -0800 (Fri, 07 Dec 2007)" * The -0800 part will be adjusted if daylight saving time is in effect. * * TODO: Find a better home for this function. */ /* * 'out_size' should be at least 45 (for year < 10000, 44 chars will be * printed to it + '\0'). */ static int get_svn_time(time_t t, char *out, size_t out_size) { #if defined(__INTEL_COMPILER) return -1; #else /* defined(__INTEL_COMPILER) */ struct tm result; int utc_offset, n; static const char *wday2str[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}, *mon2str[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}, *svn_format = "%d-%02d-%02d %02d:%02d:%02d %+03d00 (%s, %02d %s %d)"; //localtime_r() not available on Windows+MinGW //localtime_r(&t, &result); result = *localtime(&t); #if defined(__APPLE__) || defined(__FreeBSD__) //'struct tm' has no member named 'tm_gmtoff' on Windows+MinGW utc_offset = result.tm_gmtoff / 3600; #else /* defined(__APPLE__) || defined(__FreeBSD__) */ tzset(); //timezone is not portable (is a function, not a long, on OS X Tiger) utc_offset = - (timezone / 3600); if (result.tm_isdst > 0) utc_offset++; #endif /* defined(__APPLE__) || defined(__FreeBSD__) */ n = snprintf(out, out_size, svn_format, result.tm_year + 1900, result.tm_mon + 1, result.tm_mday, result.tm_hour, result.tm_min, result.tm_sec, utc_offset, wday2str[result.tm_wday], result.tm_mday, mon2str[result.tm_mon], result.tm_year + 1900); return n >= out_size ? -1 : 0; #endif /* defined(__INTEL_COMPILER) */ } /* --- .Call ENTRY POINT --- */ SEXP svn_time() { time_t t; char buf[45]; t = time(NULL); if (t == (time_t) -1) error("IRanges internal error in svn_time(): " "time(NULL) failed"); if (get_svn_time(t, buf, sizeof(buf)) != 0) error("IRanges internal error in svn_time(): " "get_svn_time() failed"); return mkString(buf); } IRanges/src/ucsc_handlers.c0000644000126300012640000000101212234075662017236 0ustar00biocbuildphs_compbio#include "IRanges.h" #include "common.h" #include "errabort.h" #include "ucsc_handlers.h" #define WARN_BUF_SIZE 512 static void R_warnHandler(char *format, va_list args) { char warn_buf[WARN_BUF_SIZE]; vsnprintf(warn_buf, WARN_BUF_SIZE, format, args); warning(warn_buf); } static void R_abortHandler() { error("UCSC library operation failed"); } void pushRHandlers() { pushAbortHandler(R_abortHandler); pushWarnHandler(R_warnHandler); } void popRHandlers() { popAbortHandler(); popWarnHandler(); } IRanges/src/ucsc_handlers.h0000644000126300012640000000013212234075662017245 0ustar00biocbuildphs_compbio#ifndef HANDLERS_H #define HANDLERS_H void pushRHandlers(); void popRHandlers(); #endif IRanges/tests/0000755000126300012640000000000012227064470014633 5ustar00biocbuildphs_compbioIRanges/tests/IRanges_unit_tests.R0000644000126300012640000000011712227064470020566 0ustar00biocbuildphs_compbiorequire("IRanges") || stop("unable to load IRanges package") IRanges:::.test()