#!/usr/bin/perl -w
# file KLEIDER/web/src/pinw/diagramme.pl
# Punktwolken und ausgleichende Kurven
# 2020-07-16 Herbert Schiemann <h.schiemann@herbaer.de>

use utf8;                     # Dieser Quelltext ist utf-8-kodiert
use Cwd qw(realpath);
use Herbaer::Ausgleichskurve; 
use Herbaer::Punktediagramm; 
use Herbaer::Readargs;
use Herbaer::Replace;
use POSIX qw(floor);
   
binmode (STDIN,  ":encoding(utf-8)");
binmode (STDOUT, ":encoding(utf-8)");
binmode (STDERR, ":encoding(utf-8)");

my $args = {
   "[cnt]verbose" => 1,
   "intlen"       => 64,             # Intervalllänge der Zerlegung
   "qntprz"       => 15,             # Prozentsatz der "großen" und "kleinen" Datenreihen
   "viewport"     => "3000x2000",
   "margin"       => "20:40:60:115", # Ränder (oben, rechts, unten, links)
   "in"           => undef,
   "out"          => undef,
};

# gibt die Version nach STDOUT aus
sub version {
   print << 'VERSION';
diagramme.pl
Punktwolken und ausgleichende Kurven
2020-07-16 Herbert Schiemann <h.schiemann@herbaer.de>
GPL 2 oder neuer
VERSION
};
$args -> {"[sr]version"} = sub { version (); exit 0; };

$args -> {"[sr]help"} = sub {
   set_defaults ($args);
   version ();
   print_message_with_values (<<"HELP", $args);
$0 --help     zeigt diese Hilfe an
$0 --version  zeigt die Programm-Version an

$0 [option]...
--[no_]verbose                erhöht den Umfang der STDERR-Ausgabe \${[cnt]verbose}
--intlen    INTLEN            Intervalllänge für Ausgleichskurve \${intlen};
--qntprz    QNTPRZ            Prozentsatz großer/kleiner Datenreihen \${qntprz}
--viewport  BREITExHOEHE      Viewport \${viewport}
--margin    T:R:B:L           Ränder
--in        IN                Pfad der Eingabedatei
                              \${in}
--out       OUT               Pfad der Ausgabedateien mit Platzhalter
                              \${out}
HELP
   exit 0;
}; # help

sub set_defaults {
   my $args = shift;
   my $b = realpath ($0);
   
   my $verb = $args -> {"[cnt}verbose"};
   if ($args -> {"viewport"} !~ /^[1-9][0-9]*x[1-9][0-9]*$/) {
      if ($verb) {
         print "Ungültiger Wert --viewport " . $args -> {"viewport"} . "\n";
         print "Benutze --viewport 3000x2000\n";
      }
      $args -> {"viewport"} = "3000x2000";
   }
   $args -> {"in"}  ||= "$b/info/detailed_counts";   
   $args -> {"out"} ||= $args -> {"in"} . '_${key}.xml';
}; # set_defaults

=for comment
berechnet
   view
   xport
   yport
=cut
sub prep_args {
   my $args = shift;
   my $verb = $args -> {"[cnt}verbose"};
   my ($a, $b, $p, $v);
   if ($args -> {"margin"} =~ /^([0-9]+):([0-9]+):([0-9]+):([0-9]+)$/) {
      $args -> {"mtop"}    = $1 + 0;
      $args -> {"mright"}  = $2 + 0;
      $args -> {"mbottom"} = $3 + 0;
      $args -> {"mleft"}   = $4 + 0;
   }
   else {
      print STDERR "ungültiges Argument --margin ", $args -> {"margin"}, "\n" if $verb;
      exit 1;
   }
   
   if ($args -> {"viewport"} =~ /^(.*)x(.*)$/) {
      $a = $1 + 0;
      $b = $2 + 0;
      $v = [$a, $b];
      $args -> {"view"} = $v;
   }
   else {
      print STDERR "ungültiges Argument --viewport ", $args -> {"vieport"}, "\n" if $verb;
      exit 1;
   }
   $args -> {"xport"} = [$args -> {"mleft"}, $a - $args -> {"mright"}];
   $args -> {"yport"} = [$args -> {"mtop"},  $b - $args -> {"mbottom"}];
}; # prep_args

=for comment
$data -> KEY -> "numrows" -> COUNT        -- Anzahl der Datenreihen
             -> "data"    -> [{"points" -> [[x0, y0], ...],
                               "xrange" -> [xmin, xmax],
                               "yrange" -> [ymin, ymax]
                               }, ...
                             ]
             -> "xrange"  -> [XMIN, XMAX]
             -> "yrange"  -> [YMIN, YMAX]
             -> "amin"    -> AUSGLEICH
             -> "amax"    -> AUSGLEICH
             -> "atot"    -> AUSGLEICH
=cut

my $data = {};

sub read_data {
   my ($args, $data) = @_;
   my $verb = $args -> {"[cnt]verbose"};
   print STDERR "read_data\n" if $verb;
   my $h;
   my $line;
   my $key;
   my ($xmin, $xmax, $ymin, $ymax);
   my $r;
   my $points;
   my $n;
   my $v;
   my $f = $args -> {"in"};
   if (!open ($h, "<", $f)){
      print "Kann Datei \"$f\" nicht lesen: $!\n" if $verb;
      return;
   };
   while (defined ($line = <$h>)) {
      next if $line =~ /^\s*#/;
      $line =~ s/\s*$//;
      $line =~ s/^\s*//;
      $line =~ s/^([^ ,]+)[ ,]*//;
      $key  = $1;
      $points = [];
      $n = 0;
      while ($line =~ s/^([^ ,]+)[ ,]*//) {
         $v = $1 + 0;
         push (@$points, [$n, $v]);
         if (!$n) {
            $xmin = $n;
            $xmax = $n;
            $ymin = $v;
            $ymax = $v;
         }
         else {
            $ymin = $v if $v < $ymin;
            $ymax = $v if $ymax < $v;
         }
         ++$n;
      }
      next unless $n;
      $xmax = --$n;
      $dr = {
         "points" => $points,
         "xrange" => [$xmin, $xmax],
         "yrange" => [$ymin, $ymax],
      };
      $d = $data -> {$key};
      if (! defined ($d)) {
         $d = {
            "numrows" => 1,
            "data"    => [ $dr ],
            "xrange"  => [$xmin, $xmax],
            "yrange"  => [$ymin, $ymax],
         };
         $data -> {$key} = $d;
      }
      else {
         ++$d -> {"numrows"};
         push (@{$d -> {"data"}}, $dr);
         $r = $d -> {"xrange"};
         $r -> [0] = $xmin if $xmin < $r -> [0];
         $r -> [1] = $xmax if $xmax > $r -> [1];
         $r = $d -> {"yrange"};
         $r -> [0] = $ymin if $ymin < $r -> [0];
         $r -> [1] = $ymax if $ymax > $r -> [1];
      }
   };
   close $h;
} # read_data

sub order {
   my ($a, $b) = @_;
   my $x = $a -> {"points"};
   my $y = $b -> {"points"};
   my $m  = @$x;
   my $m2 = @$y;
   my ($v, $w);
   $m = $m2 if $m2 < $m;
   while ($m-- >= 0) {
      $v = $x -> [$m] -> [1];
      $w = $y -> [$m] -> [1];
      return 1  if $v < $w;
      return -1 if $v > $w;
   }
   return 0;
} # order

sub ausgleich {
   my ($args, $data) = @_;
   my $verb = $args -> {"[cnt]verbose"};
   print STDERR "ausgleich\n" if $verb;
   my ($k, $d);
   my $sect;                  # Zerlegung
   my $n;                     # Anzahl der Intervalle, ...
   my $i;
   my $x;                     # aktueller Zerlegungspunkt
   my ($amin, $atot, $amax);  # Ausgleichskurven
   my $q;                     # Quantil
   my $r;                     # Datenreihe
   my $p;                     # Reihe von Punkten
   while ( ($k, $d) = each %$data ) {
      print STDERR "key $k\n" if $verb;
      $sect = $d -> {"xrange"};
      $xmin = $sect -> [0];
      $xmax = $sect -> [1];
      $n = floor (($xmax - $xmin + $args -> {"intlen"} - 1) / $args -> {"intlen"});
      $x = $xmin;
      $sect = [ $x ];
      while ($n) {
         $x += floor (0.5 + ($xmax - $x) / $n--);
         push (@$sect, $x);
      }
      print STDERR "xmin, xmax [$xmin, $xmax]\n" if $verb;
      print STDERR "sect [", join (", ", @$sect), "]\n" if $verb;
      $amin = new Herbaer::Ausgleichskurve ($sect);
      $amax = new Herbaer::Ausgleichskurve ($sect);
      $atot = new Herbaer::Ausgleichskurve ($sect);
      $amin -> verbose ($verb);
      $amax -> verbose ($verb);
      $atot -> verbose ($verb);
      $d -> {"amin"} = $amin;
      $d -> {"atot"} = $atot;
      $d -> {"amax"} = $amax;
      $r = $d -> {"data"};
      $d -> {"data"} = [ sort { order ($a, $b) } @$r ];
      $r = $d -> {"data"};
      $n = $d -> {"numrows"};
      $q = $n - floor ($n * (100 - $args -> {"qntprz"}) / 100.0);
      for ($i = 0; $i < $n; ++$i) {
         $p = $r -> [$i] -> {"points"};
         $amin -> add_points ($p) if ($i < $q);
         $atot -> add_points ($p);
         $amax -> add_points ($p) if ($i + $q >= $n);
      }
      $amin -> fix_value_at_point ($xmin, 1) -> solve ();
      $atot -> fix_value_at_point ($xmin, 1) -> solve ();
      $amax -> fix_value_at_point ($xmin, 1) -> solve ();
   }
} # ausgleich

sub write_diagramm {
   my ($args, $data) = @_;
   my ($key, $d);
   my $pd;
   my $p;
   my @scale =
      (@{$args -> {"xport"}}, $args -> {"yport"} -> [1], $args -> {"yport"} -> [0]);
   my $repl = {"key" => "KEY",};
   my $out = $args -> {"out"};
   my $of;
   while (($key, $d) = each %$data) {
      $repl -> {"key"} = $key;
      $of = replace ($out, $repl);
      $pd = new Herbaer::Punktediagramm (@{$args -> {"view"}}, $key);
      for $p (@{$d -> {"data"}}) {
         $pd -> add_pointset ("point", $p -> {"points"});
      }
      $pd -> add_cbezier ("min", $d -> {"amin"} -> get_cbezier());
      $pd -> add_cbezier ("max", $d -> {"amax"} -> get_cbezier());
      $pd -> add_cbezier ("tot", $d -> {"atot"} -> get_cbezier());
      $pd -> y_autorange ();
      $pd -> x_autoticks ();
      $pd -> scale (@scale);
      $pd -> write_xml ($of);
   }
} # write_diagramm

read_args      ($args);
set_default    ($args);
prep_args      ($args);
read_data      ($args, $data);
ausgleich      ($args, $data);
write_diagramm ($args, $data);

# end of file KLEIDER/web/src/pinw/diagramme.pl