diff --git a/bin/add-track-json.pl b/bin/add-track-json.pl index c561ce2eef..d48155a127 100755 --- a/bin/add-track-json.pl +++ b/bin/add-track-json.pl @@ -2,6 +2,10 @@ use strict; use warnings; +use FindBin qw($RealBin); +use lib "$RealBin/../src/perl5"; +use JBlibs; + use Pod::Usage; use JSON 2; diff --git a/main.css b/main.css index d66a9a639f..0f035a5158 100644 --- a/main.css +++ b/main.css @@ -11,6 +11,10 @@ html, body { color: #aaa; } +.dijitDialogPaneActionBar { + text-align: right; +} + .nav { vertical-align: middle; z-index: 10; @@ -268,6 +272,11 @@ div.track-label, div.tracklist-label { /* NOTE: browsers that don't support rgba colors will fall back to all track labels being #bcbcbc */ +.notfound-dialog .message { + margin: 1em; + text-align: center; +} + div.track-label { color: black; margin: 5px 0 0 3px; diff --git a/release-notes.txt b/release-notes.txt index 9b53a55bbd..bc1afde9db 100644 --- a/release-notes.txt +++ b/release-notes.txt @@ -1,5 +1,24 @@ {{$NEXT}} + * Fixed "Can't locate JSON.pm" errors with add-track-json.pl. + + * Added a reference-sequence-selection dropdown box, similar to the + old one, that is on by default if fewer than 30 reference + sequences, otherwise it's off unless `refSeqDropdown: true` is set + in the configuration (issue #138). + + * Fixed bug in which popup dialog boxes showing other websites showed + the website in only the top portion of the dialog box. Only + present in some browsers (issue #149). + + * Fix coordinate display bug in feature detail popups. The feature's + position was being displayed in interbase coordinates, but should + be displayed in 1-based coordinates. Thanks to Steffi Geisen for + pointing this out. + + * Added a `style.height` option to Wiggle tracks to control the + track's height in pixels (issue #131). (Erik Derohanian) + * Added support for a `style.trackLabelCss` configuration variable to allow customizing the appearance of the label for a particular track (issue #4). diff --git a/src/JBrowse/Browser.js b/src/JBrowse/Browser.js index 45392f9c06..6bce36ddad 100644 --- a/src/JBrowse/Browser.js +++ b/src/JBrowse/Browser.js @@ -3,11 +3,14 @@ var _gaq = _gaq || []; // global task queue for Google Analytics define( [ 'dojo/_base/lang', 'dojo/topic', + 'dojo/aspect', + 'dojo/_base/array', 'dijit/layout/ContentPane', 'dijit/layout/BorderContainer', 'dijit/Dialog', 'dijit/form/ComboBox', 'dijit/form/Button', + 'dijit/form/Select', 'JBrowse/Util', 'JBrowse/Store/LazyTrie', 'JBrowse/Store/Autocomplete', @@ -18,11 +21,14 @@ define( [ function( lang, topic, + aspect, + array, dijitContentPane, dijitBorderContainer, dijitDialog, dijitComboBox, dijitButton, + dijitSelectBox, Util, LazyTrie, AutocompleteStore, @@ -729,9 +735,11 @@ Browser.prototype.navigateTo = function(loc) { } catch (x) {} if( oldLoc ) { this.navigateToLocation( oldLoc ); + return; } else { // if we don't just go to the middle 80% of that refseq this.navigateToLocation({ref: ref.name, start: ref.end*0.1, end: ref.end*0.9 }); + return; } } @@ -816,7 +824,27 @@ Browser.prototype.searchNames = function( /**String*/ loc ) { + ":" + (startbp - flank) + ".." + (endbp + flank)); brwsr.showTracks(brwsr.names.extra[nameMatches[0][ post1_4 ? 1 : 0 ]]); - }); + }, + // if no match for the name is found, show a popup dialog saying this. + function() { + var d = dijitDialog({ title: 'Not found', className: 'notfound-dialog' }); + + var content = dojo.create('div', { + className: 'message', + innerHTML: 'Not found: '+loc+'' + }); + + var actionBar = dojo.create( 'div', { className: 'dijitDialogPaneActionBar' }); + new dijitButton({label: 'OK', onClick: dojo.hitch(d,'hide')}).placeAt(actionBar); + + d.set('content',[content,actionBar]); + + // clean up this dialog completely when it's hidden + aspect.after(d, 'hide', function() { d.destroyRecursive(); }); + + d.show(); + } + ); }; @@ -1299,6 +1327,22 @@ Browser.prototype.createNavBox = function( parent, locLength ) { navbox.appendChild(document.createTextNode( four_nbsp )); + // if we have fewer than 30 ref seqs, or `refSeqDropdown: true` is + // set in the config, then put in a dropdown box for selecting + // reference sequences + if( this.refSeqOrder.length && this.refSeqOrder.length < 30 || this.config.refSeqDropdown ) { + this.refSeqSelectBox = new dijitSelectBox({ + name: 'refseq', + options: array.map( this.refSeqOrder || [], + function( refseqName ) { + return { label: refseqName, value: refseqName }; + }), + onChange: dojo.hitch(this, function( newRefName ) { + this.navigateToLocation({ ref: newRefName }); + }) + }).placeAt( navbox ); + } + // make the location box this.locationBox = new dijitComboBox( { diff --git a/src/JBrowse/Store/LazyTrie.js b/src/JBrowse/Store/LazyTrie.js index 896b98313a..4e77558582 100644 --- a/src/JBrowse/Store/LazyTrie.js +++ b/src/JBrowse/Store/LazyTrie.js @@ -138,26 +138,36 @@ return declare('JBrowse.Store.LazyTrie', null, return results; }, - exactMatch: function(key, callback) { + exactMatch: function(key, callback, notfoundCallback ) { + notfoundCallback = notfoundCallback || function() {}; + var trie = this; - this.findNode(key, function(prefix, node) { + this.findNode(key, + function(prefix, node) { if ((prefix.toLowerCase() == key.toLowerCase()) && node[1]) callback(node[1]); - }); + }, + notfoundCallback + ); }, - findNode: function(query, callback) { + findNode: function(query, foundCallback, notfoundCallback ) { + notfoundCallback = notfoundCallback || function() {}; + var trie = this; this.findPath(query, function(path) { var node = trie.root; - for (i = 0; i < path.length; i++) + for (var i = 0; i < path.length; i++) node = node[path[i]]; var foundPrefix = trie.pathToPrefix(path); - callback(foundPrefix, node); - }); + foundCallback(foundPrefix, node); + }, notfoundCallback); }, - findPath: function(query, callback) { + findPath: function(query, foundCallback, notfoundCallback) { + + notfoundCallback = notfoundCallback || function() {}; + if (!this.root) { this.deferred = arguments; return; @@ -171,7 +181,10 @@ return declare('JBrowse.Store.LazyTrie', null, while(true) { childIndex = this.binarySearch(node, query.charAt(qStart)); - if (childIndex < 0) return; + if (childIndex < 0) { + notfoundCallback(); + return; + } path.push(childIndex); if ("number" == typeof node[childIndex][0]) { @@ -181,7 +194,7 @@ return declare('JBrowse.Store.LazyTrie', null, handleAs: "json", load: function(o) { node[childIndex] = o; - trie.findPath(query, callback); + trie.findPath(query, foundCallback); } }); return; @@ -194,14 +207,16 @@ return declare('JBrowse.Store.LazyTrie', null, // match if (query.substr(qStart, node[0].length) != node[0].substr(0, Math.min(node[0].length, - query.length - qStart))) + query.length - qStart))) { + notfoundCallback(); return; + } qStart += node[0].length; if (qStart >= query.length) { // we've reached the end of the query string, and we // have some matches - callback(path); + foundCallback(path); return; } } diff --git a/src/JBrowse/View/Track/HTMLFeatures.js b/src/JBrowse/View/Track/HTMLFeatures.js index aade92dba4..d3ff48440d 100644 --- a/src/JBrowse/View/Track/HTMLFeatures.js +++ b/src/JBrowse/View/Track/HTMLFeatures.js @@ -144,7 +144,7 @@ var HTMLFeatures = declare( BlockBased, container.innerHTML += fmt( 'Name', f.get('name') ); container.innerHTML += fmt( 'Type', f.get('type') ); container.innerHTML += fmt( 'Description', f.get('note') ); - container.innerHTML += fmt( 'Position', this.refSeq.name+':'+f.get('start')+'..'+f.get('end') ); + container.innerHTML += fmt( 'Position', Util.assembleLocString({ start: f.get('start'), end: f.get('end'), ref: this.refSeq.name })); container.innerHTML += fmt( 'Strand', {'1':'+', '-1': '-', 0: undefined }[f.get('strand')] || f.get('strand') ); var additionalTags = array.filter( f.tags(), function(t) { return ! {name:1,start:1,end:1,strand:1,note:1,subfeatures:1,type:1}[t.toLowerCase()]; }); @@ -972,16 +972,18 @@ var HTMLFeatures = declare( BlockBased, onclick: dojo.hitch(dialog,'hide'), innerHTML: spec.url }, dialog.titleBar ); - aspect.after( dialog, 'layout', function() { - // hitch a ride on the dialog box's - // layout function, which is called on - // initial display, and when the window - // is resized, to keep the iframe - // sized to fit exactly in it. - var cDims = domGeom.getMarginBox( dialog.domNode ); - iframe.width = cDims.w; - iframe.height = iframe.height = cDims.h - domGeom.getMarginBox(dialog.titleBar).h - 2; - }); + var updateIframeSize = function() { + // hitch a ride on the dialog box's + // layout function, which is called on + // initial display, and when the window + // is resized, to keep the iframe + // sized to fit exactly in it. + var cDims = domGeom.getMarginBox( dialog.domNode ); + iframe.width = cDims.w; + iframe.height = cDims.h - domGeom.getMarginBox(dialog.titleBar).h - 2; + }; + aspect.after( dialog, 'layout', updateIframeSize ); + aspect.after( dialog, 'show', updateIframeSize ); } aspect.after( dialog, 'hide', function() { dialog.destroyRecursive(); }); diff --git a/src/perl5/Bio/JBrowse/Cmd/FormatSequences.pm b/src/perl5/Bio/JBrowse/Cmd/FormatSequences.pm index df256e547e..c81728f1c4 100644 --- a/src/perl5/Bio/JBrowse/Cmd/FormatSequences.pm +++ b/src/perl5/Bio/JBrowse/Cmd/FormatSequences.pm @@ -18,7 +18,8 @@ use File::Path 'mkpath'; use POSIX; -use JsonGenerator; +use JSON 2; +use JsonFileStorage; use FastaDatabase; sub option_defaults {( @@ -46,6 +47,8 @@ sub run { my $refs = $self->opt('refs'); my $compress = $self->opt('compress'); + $self->{storage} = JsonFileStorage->new( $self->opt('out'), $self->opt('compress'), { pretty => 0 } ); + pod2usage( 'must provide either a --fasta, --gff, or --conf option' ) unless defined $self->opt('gff') || $self->opt('conf') || $self->opt('fasta'); @@ -102,7 +105,11 @@ sub run { $refs = join (",", $db->seq_ids); } } elsif ( $self->opt('conf') ) { - my $config = JsonGenerator::readJSON( $self->opt('conf') ); + my $config = decode_json( do { + local $/; + open my $f, '<', $self->opt('conf') or die "$! reading ".$self->opt('conf'); + scalar <$f> + }); eval "require $config->{db_adaptor}; 1" or die $@; @@ -189,7 +196,7 @@ sub run { exit; } - JsonGenerator::modifyJsonFile( catfile( $self->opt('out'), 'seq', 'refSeqs.json' ), + $self->{storage}->modify( 'seq/refSeqs.json', sub { #add new ref seqs while keeping the order #of the existing ref seqs @@ -219,7 +226,7 @@ sub run { } unless( $self->opt('noseq') ) { - JsonGenerator::modifyJsonFile( catfile( $self->opt('out'), "trackList.json" ), + $self->{storage}->modify( 'trackList.json', sub { my $trackList = shift; unless (defined($trackList)) { diff --git a/src/perl5/JsonFileStorage.pm b/src/perl5/JsonFileStorage.pm index 37f7327095..59eacdc3a7 100644 --- a/src/perl5/JsonFileStorage.pm +++ b/src/perl5/JsonFileStorage.pm @@ -30,6 +30,8 @@ use IO::File; use Fcntl ":flock"; use PerlIO::gzip; +use constant DEFAULT_MAX_JSON_DEPTH => 2048; + =head2 new( $outDir, $compress, \%opts ) Constructor. Takes the directory to work with, boolean flag of @@ -44,7 +46,7 @@ sub new { my ($class, $outDir, $compress, $opts) = @_; # create JSON object - my $json = JSON->new->relaxed; + my $json = JSON->new->relaxed->max_depth( DEFAULT_MAX_JSON_DEPTH ); # set opts if (defined($opts) and ref($opts) eq 'HASH') { for my $method (keys %$opts) { diff --git a/src/perl5/JsonGenerator.pm b/src/perl5/JsonGenerator.pm deleted file mode 100644 index 87ed986086..0000000000 --- a/src/perl5/JsonGenerator.pm +++ /dev/null @@ -1,472 +0,0 @@ -package JsonGenerator; - -use base 'Exporter'; -our @EXPORT_OK = qw/ readJSON writeJSON modifyJsonFile /; - -use strict; -use warnings; - -use NCList; -use LazyNCList; -use JSON 2; -use IO::File; -use Fcntl ":flock"; -use POSIX qw(ceil floor); -use List::Util qw(min max sum reduce); -use PerlIO::gzip; -use constant MAX_JSON_DEPTH => 2048; - -#this series of numbers is used in JBrowse for zoom level relationships -my @multiples = (1, 2, 5, 10, 20, 50, 100, 200, 500, 1000, 2000, 5000, - 10_000, 20_000, 50_000, 100_000, 200_000, 500_000, 1_000_000); - -my $startIndex = 0; -my $endIndex = 1; -#position of the lazy subfeature file name in the fake feature. -my $lazyIndex = 2; - -my $histChunkSize = 10_000; - -my %builtinDefaults = - ( - "class" => "feature" - ); - -sub readJSON { - my ($file, $default, $compress) = @_; - if (-s $file) { - my $OLDSEP = $/; - my $fh = new IO::File $file, O_RDONLY - or die "couldn't open $file: $!"; - binmode($fh, ":gzip") if $compress; - flock $fh, LOCK_SH; - undef $/; - $default = JSON::from_json(<$fh>); - $fh->close() - or die "couldn't close $file: $!"; - $/ = $OLDSEP; - } - return $default; -} - -sub writeJSON { - my ($file, $toWrite, $opts, $compress) = @_; - - # create JSON object - my $json = new JSON; - # set opts - if (defined($opts) and ref($opts) eq 'HASH') { - for my $method (keys %$opts) { - $json->$method( $opts->{$method} ); - } - } - - # check depth - #my $depth = findDepth($toWrite); - #my $maxDepth = $json->get_max_depth; - # if ($depth >= $maxDepth) { - # my @deepPath = @{deepestPath($toWrite)}; - # my $warning = "WARNING: found deep path (depth = " . $depth . ", max depth allowed = " . $maxDepth . ")\n"; - # warn $warning; - # for my $n (0..$#deepPath) { - # my $elem = $deepPath[$n]; - # my $type = ref($elem); - # if ($type eq 'HASH') { - # warn $n, ": { ", join(", ", map("$_ => $$elem{$_}", keys %$elem)), " }\n"; - # } elsif ($type eq 'ARRAY') { - # warn $n, ": [ ", join(", ", map(defined($_) ? $_ : "undef", @$elem)), " ]\n"; - # } else { - # warn $n, ": ", $elem, "\n"; - # } - # } - # warn $warning; # repeat the warning after printing the trace - # } - - # write - my $fh = new IO::File $file, O_WRONLY | O_CREAT - or die "couldn't open $file: $!"; - flock $fh, LOCK_EX; - $fh->seek(0, SEEK_SET); - $fh->truncate(0); - if ($compress) { - binmode($fh, ":gzip") - or die "couldn't set binmode: $!"; - } - $fh->print($json->encode($toWrite)); - $fh->close() - or die "couldn't close $file: $!"; -} - -sub modifyJsonFile { - my ($file, $callback) = @_; - my ($data, $assign); - my $fh = new IO::File $file, O_RDWR | O_CREAT - or die "couldn't open $file: $!"; - flock $fh, LOCK_EX; - # if the file is non-empty, - if (($fh->stat())[7] > 0) { - # get data - my $jsonString = join("", $fh->getlines()); - $data = JSON::from_json($jsonString) if (length($jsonString) > 0); - # prepare file for re-writing - $fh->seek(0, SEEK_SET); - $fh->truncate(0); - } - # modify data, write back - $fh->print(JSON::to_json($callback->($data), {pretty => 1})); - $fh->close() - or die "couldn't close $file: $!"; -} - -sub writeTrackEntry { - my ($file, $entry) = @_; - modifyJsonFile($file, - sub { - my $origTrackList = shift; - my @trackList = grep { exists($_->{'label'}) } @$origTrackList; - my $i; - for ($i = 0; $i <= $#trackList; $i++) { - last if ($trackList[$i]->{'label'} eq $entry->{'label'}); - } - $trackList[$i] = $entry; - return \@trackList; - }); -} - -# turn perl subs from the config file into callable functions -sub evalSubStrings { - my $hashref = shift; - foreach my $key (keys %{$hashref}) { - next if ("CODE" eq (ref $hashref->{$key})); - - if ("HASH" eq (ref $hashref->{$key})) { - evalSubStrings($hashref->{$key}); - } else { - $hashref->{$key} = eval($hashref->{$key}) - if (defined($hashref->{$key}) && $hashref->{$key} =~ /^\s*sub\s*{.*}\s*$/); - } - } -} - -sub new { - my ($class, $outDir, $chunkBytes, $compress, $label, $segName, - $refStart, $refEnd, $setStyle, $headers, $subfeatHeaders, - $featureCount) = @_; - - my %style = ("key" => $label, - %builtinDefaults, - %$setStyle); - - evalSubStrings(\%style); - - my $self = { - style => \%style, - label => $label, - outDir => $outDir, - chunkBytes => $chunkBytes, - compress => $compress, - sublistIndex => $#{$headers} + 1, - curMapHeaders => $headers, - subfeatHeaders => $subfeatHeaders, - ext => ($compress ? "jsonz" : "json"), - refStart => $refStart, - refEnd => $refEnd, - count => 0 - }; - - # $featureCount is an optional parameter; if we don't know it, - # then arbitrarily estimate that there's 0.25 features per base - # (0.25 features/base is pretty dense, which gives us - # a relatively high-resolution histogram; we can always throw - # away the higher-resolution histogram data later, so a dense - # estimate is conservative. A dense estimate does cost more RAM, though) - $featureCount = $refEnd * 0.25 unless defined($featureCount); - - # $histBinThresh is the approximate the number of bases per - # histogram bin at the zoom level where FeatureTrack.js switches - # to the histogram view by default - my $histBinThresh = ($refEnd * 2.5) / $featureCount; - $self->{histBinBases} = $multiples[0]; - foreach my $multiple (@multiples) { - $self->{histBinBases} = $multiple; - last if $multiple > $histBinThresh; - } - - # initialize histogram arrays to all zeroes - $self->{hists} = []; - for (my $i = 0; $i <= $#multiples; $i++) { - my $binBases = $self->{histBinBases} * $multiples[$i]; - $self->{hists}->[$i] = [(0) x ceil($refEnd / $binBases)]; - # somewhat arbitrarily cut off the histograms at 100 bins - last if $binBases * 100 > $refEnd; - } - - mkdir($outDir) unless (-d $outDir); - unlink (glob $outDir . "/hist*"); - unlink (glob $outDir . "/lazyfeatures*"); - unlink $outDir . "/trackData.json"; - - my $lazyPathTemplate = "$outDir/lazyfeatures-{chunk}." . $self->{ext}; - - # $output writes out the feature JSON chunk file - my $output = sub { - my ($toWrite, $chunkId) = @_; - #print STDERR "writing chunk $chunkId\n"; - (my $path = $lazyPathTemplate) =~ s/\{chunk\}/$chunkId/g; - writeJSON($path, - $toWrite, - {pretty => 0, max_depth => MAX_JSON_DEPTH}, - $compress); - }; - - # $measure measures the size of the feature in the final JSON - my $measure = sub { - # add 1 for the comma between features - # (ignoring, for now, the extra characters for sublist brackets) - return length(JSON::to_json($_[0])) + 1; - }; - - $self->{sublistIndex} += 1 if ($self->{sublistIndex} == $lazyIndex); - $self->{features} = LazyNCList->new($startIndex, $endIndex, - $self->{sublistIndex}, - $lazyIndex, - $measure, - $output, - $chunkBytes); - - bless $self, $class; - return $self; -} - -sub addFeature { - my ($self, $feature) = @_; - - $self->{features}->addSorted($feature); - $self->{count}++; - - my $histograms = $self->{hists}; - my $curHist; - my $start = max(0, min($feature->[$startIndex], $self->{refEnd})); - my $end = min($feature->[$endIndex], $self->{refEnd}); - return if ($end < 0); - - for (my $i = 0; $i <= $#multiples; $i++) { - my $binBases = $self->{histBinBases} * $multiples[$i]; - $curHist = $histograms->[$i]; - last unless defined($curHist); - - my $firstBin = int($start / $binBases); - my $lastBin = int($end / $binBases); - for (my $bin = $firstBin; $bin <= $lastBin; $bin++) { - $curHist->[$bin] += 1; - } - } -} - -sub featureCount { - my ($self) = @_; - return $self->{count}; -} - -sub hasFeatures { - my ($self) = @_; - return $self->{count} >= 0; -} - -sub generateTrack { - my ($self) = @_; - - my $ext = $self->{ext}; - my $features = $self->{features}; - $features->finish(); - - # approximate the number of bases per histogram bin at the zoom level where - # FeatureTrack.js switches to histogram view, by default - my $histBinThresh = ($self->{refEnd} * 2.5) / $self->{count}; - - # find multiple of base hist bin size that's just over $histBinThresh - my $i; - for ($i = 1; $i <= $#multiples; $i++) { - last if ($self->{histBinBases} * $multiples[$i]) > $histBinThresh; - } - - my @histogramMeta; - # Generate more zoomed-out histograms so that the client doesn't - # have to load all of the histogram data when there's a lot of it. - for (my $j = $i - 1; $j <= $#multiples; $j += 1) { - my $curHist = $self->{hists}->[$j]; - last unless defined($curHist); - my $histBases = $self->{histBinBases} * $multiples[$j]; - - my $chunks = chunkArray($curHist, $histChunkSize); - for (my $i = 0; $i <= $#{$chunks}; $i++) { - writeJSON($self->{outDir} . "/hist-$histBases-$i.$ext", - $chunks->[$i], - {pretty => 0}, - $self->{compress}); - } - push @histogramMeta, - { - basesPerBin => $histBases, - arrayParams => { - length => $#{$curHist} + 1, - urlTemplate => "hist-$histBases-{chunk}.$ext", - chunkSize => $histChunkSize - } - }; - } - - my @histStats; - for (my $j = $i - 1; $j <= $#multiples; $j++) { - last unless defined($self->{hists}->[$j]); - my $binBases = $self->{histBinBases} * $multiples[$j]; - push @histStats, {'bases' => $binBases, - arrayStats($self->{hists}->[$j])}; - } - - my $trackData = { - 'label' => - $self->{label}, - 'key' => - $self->{style}->{key}, - 'sublistIndex' => - $self->{sublistIndex}, - 'lazyIndex' => - $lazyIndex, - 'headers' => - $self->{curMapHeaders}, - 'featureCount' => - $self->{count}, - 'type' => - "FeatureTrack", - 'className' => - $self->{style}->{class}, - 'subfeatureClasses' => - $self->{style}->{subfeature_classes}, - 'subfeatureHeaders' => - $self->{subfeatHeaders}, - 'arrowheadClass' => - $self->{style}->{arrowheadClass}, - 'clientConfig' => - $self->{style}->{clientConfig}, - 'featureNCList' => - $self->{features}->topLevelList, - 'lazyfeatureUrlTemplate' => - "lazyfeatures-{chunk}.$ext", - 'histogramMeta' => - \@histogramMeta, - 'histStats' => - \@histStats - }; - $trackData->{urlTemplate} = $self->{style}->{urlTemplate} - if defined($self->{style}->{urlTemplate}); - writeJSON($self->{outDir} ."/trackData.$ext", - $trackData, - {pretty => 0, max_depth => MAX_JSON_DEPTH}, - $self->{compress}); -} - -sub arrayStats { - my $arr = shift; - my $max = max(@$arr); - my $sum = sum(@$arr); - my $mean = $sum / ($#{$arr} + 1); -# my $var = sum(map {($_ - $mean) ** 2} @$arr) / ($#{$arr} + 1); -# return ('max' => $max, 'sum' => $sum, -# 'mean' => $mean, 'var' => $var, -# 'stddev' => sqrt($var)); - return ('max' => $max, 'mean' => $mean); -} - -sub chunkArray { - my ($bigArray, $chunkSize) = @_; - - my @result; - for (my $start = 0; $start <= $#{$bigArray}; $start += $chunkSize) { - my $lastIndex = $start + $chunkSize; - $lastIndex = $#{$bigArray} if $lastIndex > $#{$bigArray}; - - push @result, [@{$bigArray}[$start..$lastIndex]]; - } - return \@result; -} - -# findDepth returns the depth of the deepest element(s) in the structure -# the code is the iterative form of findDepth($obj) = 1 + max(map(findDepth($_), childArray($obj))) -# where childArray($obj) = values(%$obj) [for a hash], @$obj [for an array] or the empty list [for a scalar] -sub findDepth { - my ($obj) = @_; - my ($depth, $childArray, $childIndex); - my @stack; - - FD_NEW_OBJ: - my $type = ref($obj); - $childArray = $type eq 'HASH' ? [values %$obj] : ($type eq 'ARRAY' ? $obj : []); - $depth = 0; - $childIndex = 0; - FD_CHILD_LOOP: - if ($childIndex < @$childArray) { - push @stack, [$depth, $childArray, $childIndex]; - $obj = $childArray->[$childIndex]; - goto FD_NEW_OBJ; - } elsif (@stack) { - my $childDepth = $depth + 1; - my $vars = pop @stack; - ($depth, $childArray, $childIndex) = @$vars; - if ($childDepth > $depth) { - $depth = $childDepth; - } - ++$childIndex; - goto FD_CHILD_LOOP; - } - - return $depth + 1; -} - -# deepestPath returns the path to (the first of) the deepest element(s) in the structure -# the code is the iterative form of deepestPath($obj) = ($obj, longest(map(deepestPath($_), childArray($obj)))) -# where childArray($obj) = values(%$obj) [for a hash], @$obj [for an array] or the empty list [for a scalar] -# and longest(@x1, @x2, ... @xn) returns the longest of the given arrays (or the first such, in the event of a tie) -sub deepestPath { - my ($obj) = @_; - my ($trace, $childArray, $childIndex); - my @stack; - - DP_NEW_OBJ: - my $type = ref($obj); - $childArray = $type eq 'HASH' ? [values %$obj] : ($type eq 'ARRAY' ? $obj : []); - $trace = []; - $childIndex = 0; - DP_CHILD_LOOP: - if ($childIndex < @$childArray) { - push @stack, [$obj, $trace, $childArray, $childIndex]; - $obj = $childArray->[$childIndex]; - goto DP_NEW_OBJ; - } elsif (@stack) { - my $childTrace = [$obj, @$trace]; - my $vars = pop @stack; - ($obj, $trace, $childArray, $childIndex) = @$vars; - if (@$childTrace > @$trace) { - $trace = $childTrace; - } - ++$childIndex; - goto DP_CHILD_LOOP; - } - - return [$obj, @$trace]; -} - -1; - -=head1 AUTHOR - -Mitchell Skinner Emitch_skinner@berkeley.eduE - -Copyright (c) 2007-2009 The Evolutionary Software Foundation - -This package and its accompanying libraries are free software; you can -redistribute it and/or modify it under the terms of the LGPL (either -version 2.1, or at your option, any later version) or the Artistic -License 2.0. Refer to LICENSE for the full license text. - -=cut