| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package App::RecordStream::Aggregator::PercentileMap; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | our $VERSION = "4.0.24"; | 
| 4 |  |  |  |  |  |  |  | 
| 5 | 5 |  |  | 5 |  | 2353 | use strict; | 
|  | 5 |  |  |  |  | 14 |  | 
|  | 5 |  |  |  |  | 133 |  | 
| 6 | 5 |  |  | 5 |  | 64 | use warnings; | 
|  | 5 |  |  |  |  | 13 |  | 
|  | 5 |  |  |  |  | 142 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 | 5 |  |  | 5 |  | 29 | use App::RecordStream::Aggregator::InjectInto::Field; | 
|  | 5 |  |  |  |  | 10 |  | 
|  | 5 |  |  |  |  | 93 |  | 
| 9 | 5 |  |  | 5 |  | 21 | use App::RecordStream::DomainLanguage::Registry; | 
|  | 5 |  |  |  |  | 12 |  | 
|  | 5 |  |  |  |  | 98 |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 5 |  |  | 5 |  | 20 | use base qw(App::RecordStream::Aggregator::InjectInto::Field); | 
|  | 5 |  |  |  |  | 8 |  | 
|  | 5 |  |  |  |  | 2223 |  | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | sub _make_percentiles | 
| 14 |  |  |  |  |  |  | { | 
| 15 | 0 |  |  | 0 |  |  | my $percentiles = shift; | 
| 16 |  |  |  |  |  |  |  | 
| 17 | 0 | 0 |  |  |  |  | if(ref($percentiles) eq "ARRAY") | 
| 18 |  |  |  |  |  |  | { | 
| 19 | 0 |  |  |  |  |  | return $percentiles; | 
| 20 |  |  |  |  |  |  | } | 
| 21 |  |  |  |  |  |  |  | 
| 22 |  |  |  |  |  |  | # be careful, split(' ', ...) is extreme magic split, not split on one space | 
| 23 | 0 |  |  |  |  |  | return [split(' ', $percentiles)]; | 
| 24 |  |  |  |  |  |  | } | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | sub new | 
| 27 |  |  |  |  |  |  | { | 
| 28 | 0 |  |  | 0 | 0 |  | my $class       = shift; | 
| 29 | 0 |  |  |  |  |  | my $percentiles = shift; | 
| 30 | 0 |  |  |  |  |  | my $field       = shift; | 
| 31 |  |  |  |  |  |  |  | 
| 32 | 0 |  |  |  |  |  | my $this = $class->SUPER::new($field); | 
| 33 | 0 |  |  |  |  |  | $this->{'percentiles'} = _make_percentiles($percentiles); | 
| 34 |  |  |  |  |  |  |  | 
| 35 | 0 |  |  |  |  |  | return $this; | 
| 36 |  |  |  |  |  |  | } | 
| 37 |  |  |  |  |  |  |  | 
| 38 |  |  |  |  |  |  | sub new_from_valuation | 
| 39 |  |  |  |  |  |  | { | 
| 40 | 0 |  |  | 0 | 0 |  | my $class       = shift; | 
| 41 | 0 |  |  |  |  |  | my $percentiles = shift; | 
| 42 | 0 |  |  |  |  |  | my $valuation   = shift; | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 0 |  |  |  |  |  | my $this = $class->SUPER::new_from_valuation($valuation); | 
| 45 | 0 |  |  |  |  |  | $this->{'percentiles'} = _make_percentiles($percentiles); | 
| 46 |  |  |  |  |  |  |  | 
| 47 | 0 |  |  |  |  |  | return $this; | 
| 48 |  |  |  |  |  |  | } | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | sub initial { | 
| 51 | 0 |  |  | 0 | 0 |  | return []; | 
| 52 |  |  |  |  |  |  | } | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | sub combine_field | 
| 55 |  |  |  |  |  |  | { | 
| 56 | 0 |  |  | 0 | 0 |  | my $this   = shift; | 
| 57 | 0 |  |  |  |  |  | my $cookie = shift; | 
| 58 | 0 |  |  |  |  |  | my $value  = shift; | 
| 59 |  |  |  |  |  |  |  | 
| 60 | 0 |  |  |  |  |  | push @$cookie, $value; | 
| 61 | 0 |  |  |  |  |  | return $cookie; | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | sub squish | 
| 65 |  |  |  |  |  |  | { | 
| 66 | 0 |  |  | 0 | 0 |  | my $this   = shift; | 
| 67 | 0 |  |  |  |  |  | my $cookie = shift; | 
| 68 |  |  |  |  |  |  |  | 
| 69 | 0 |  |  |  |  |  | my @sorted = sort { $a <=> $b } @$cookie; | 
|  | 0 |  |  |  |  |  |  | 
| 70 |  |  |  |  |  |  |  | 
| 71 | 0 |  |  |  |  |  | my %ret; | 
| 72 |  |  |  |  |  |  |  | 
| 73 | 0 |  |  |  |  |  | for my $percentile (@{$this->{'percentiles'}}) | 
|  | 0 |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | { | 
| 75 | 0 |  |  |  |  |  | my $index = int((scalar @sorted) * ($percentile / 100)); | 
| 76 |  |  |  |  |  |  |  | 
| 77 | 0 | 0 |  |  |  |  | if($index == scalar(@sorted)) | 
| 78 |  |  |  |  |  |  | { | 
| 79 | 0 |  |  |  |  |  | $index--; | 
| 80 |  |  |  |  |  |  | } | 
| 81 |  |  |  |  |  |  |  | 
| 82 | 0 |  |  |  |  |  | $ret{$percentile} = $sorted[$index]; | 
| 83 |  |  |  |  |  |  | } | 
| 84 |  |  |  |  |  |  |  | 
| 85 | 0 |  |  |  |  |  | return \%ret; | 
| 86 |  |  |  |  |  |  | } | 
| 87 |  |  |  |  |  |  |  | 
| 88 |  |  |  |  |  |  | sub short_usage | 
| 89 |  |  |  |  |  |  | { | 
| 90 | 0 |  |  | 0 | 0 |  | return "map of percentile values for field"; | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | sub long_usage | 
| 94 |  |  |  |  |  |  | { | 
| 95 | 0 |  |  | 0 | 0 |  | print < | 
| 96 |  |  |  |  |  |  | Usage: percmap,, | 
| 97 |  |  |  |  |  |  | Finds the field values which  percent of values are less than. | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | This is computed by creating an array of all values, sorting, and indexing | 
| 100 |  |  |  |  |  |  | into it at the floor((percentile / 100) * length) point | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | will be perl split to determine percentiles to compute. | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | Output is a hash whose keys are percentiles and whose values are | 
| 105 |  |  |  |  |  |  | corresponding field values. | 
| 106 |  |  |  |  |  |  | EOF | 
| 107 |  |  |  |  |  |  | } | 
| 108 |  |  |  |  |  |  |  | 
| 109 |  |  |  |  |  |  | sub argct | 
| 110 |  |  |  |  |  |  | { | 
| 111 | 0 |  |  | 0 | 0 |  | return 2; | 
| 112 |  |  |  |  |  |  | } | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | App::RecordStream::Aggregator->register_implementation('percentilemap', __PACKAGE__); | 
| 115 |  |  |  |  |  |  | App::RecordStream::Aggregator->register_implementation('percmap', __PACKAGE__); | 
| 116 |  |  |  |  |  |  |  | 
| 117 |  |  |  |  |  |  | App::RecordStream::DomainLanguage::Registry::register_vfn(__PACKAGE__, 'new_from_valuation', 'percentilemap', 'SCALAR', 'VALUATION'); | 
| 118 |  |  |  |  |  |  | App::RecordStream::DomainLanguage::Registry::register_vfn(__PACKAGE__, 'new_from_valuation', 'percmap', 'SCALAR', 'VALUATION'); | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | 1; |