File:Abweichung der Tageslänge vom SI-Tag.svg

#! /usr/bin/perl -w
use strict;
use utf8;
use POSIX;

my $y0= 1962;
my $y= $y0;
my $m= 1;
my $d= 1;
my $dut1= 0;
my $scale= 1.5e6;
my $cscale= 300;
my $min= -2400;
my $max= 8400;
my $vr= $max - $min;
my $dv= 300;
my $ddv= 5;
my $fs= 224;

my @ml= (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

my (@data, %data, @py, @pv, @y, @ls);

while ( <> )
{
  /^ (\d+)\s+(\d+)\s+(\d+) \s+ \d+(?:\s+-?\d+\.\d+){2} (\s+-?\d+\.\d+)
    (\s+-?\d+\.\d+) (?:\s+-?\d+\.\d+){2}(?:\s+\d+\.\d+){6}\s*$
    /x or next;

  $1 == $y && $2 == $m && $3 == $d or die;

  $4 - $dut1 > 0.5 and push @ls, $y + ($m - 1)/12;
  $dut1= $4;

  push @data, $5 + 0;
  $data{$y} += $5;

  ++$d <= ($m != 2 | $y % 4 ? $ml[$m] : 29)
    or $d= 1, ++$m <= 12
    or $m= 1, ++$y;
}

{ my $s= 0;

  for my $y ( $y0 .. $y + 1 ) {
    push @y, $s;
    $s += $y % 4 ? 365 : 366;
  }
}

my $hr= $y[$y+1-$y0];

binmode STDOUT, ":utf8";
print qq|<?xml version="1.0" encoding="UTF-8"?>\n|;
print qq|<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"|;
print qq| "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">\n|;
print qq|<svg version="1.1" xml:lang="de" xmlns="http://www.w3.org/2000/svg"|;
printf qq| viewBox="-%.1f -%.1f %.1f %.1f"|,
  $fs * 4 + .5, $fs * 1.5 + .5, $fs * 8 + $hr + 1, $fs * 4 + $vr + 1;
print qq| fill="none" stroke-width="16" stroke-linecap="round"|;
print qq| stroke-linejoin="round" font-family="Arial,sans-serif">\n|;
print qq|<title>Abweichung der Tageslänge vom SI-Tag</title>\n|;
printf qq|<rect x="-%.1f" y="-%.1f" width="100%%" height="100%%"|,
  $fs * 4 + .5, $fs * 1.5 + .5;
print qq| fill="#fff" stroke="none"/>\n|;
print qq|<g transform="translate(0,$max) scale(1,-1)">\n|;

{ my $d1= 0;
  my $d2= 0;
  my $d3= 0;
  my (@v1, @v2, @h1, @h2, @h3);

  for my $y ( $y0 .. $y + 1 ) {
    my $d= $y % 4 ? 365 : 366;
    $y % 10 ? ((push @v1, $d1), $d1= 0) : ((push @v2, $d2), $d2= 0);
    $y % 5 or push @py, [ $d3 + $d / 2, $y ];
    $d1 += $d, $d2 += $d, $d3 += $d;
  }

  $d1= $d2= $d3= $min;

  for ( my $y= ceil $min / $dv; $y <= $max / $dv; ++$y ) {
    $y % $ddv ? ((push @h1, $d1), $d1= 0) :
      (($y ? ((push @h2, $d2), $d2= 0) : ((push @h3, $d3), $d3= 0)),
        push @pv, [ -$y * $dv + (floor .3 * $fs + .5), $y * $dv ]);
    $d1 += $dv, $d2 += $dv, $d3 += $dv;
  }

  printf qq|<path stroke="#e0e0e0" d="M0,%dh$hr|, shift @h1;
  printf "m-$hr,%dh$hr", $_ for @h1;
  print qq|"/>\n|;

  printf qq|<path stroke="#e0e0e0" d="M%d,${min}v$vr|, shift @v1;
  printf "m%d,-${vr}v$vr", $_ for @v1;
  print qq|"/>\n|;

  printf qq|<path stroke="#c0c0c0" d="M0,%dh$hr|, shift @h2;
  printf "m-$hr,%dh$hr", $_ for @h2;
  print qq|"/>\n|;

  printf qq|<path stroke="#c0c0c0" d="M%d,${min}v$vr|, shift @v2;
  printf "m%d,-${vr}v$vr", $_ for @v2;
  print qq|"/>\n|;

  printf qq|<path stroke="#808080" d="M0,%dh$hr|, shift @h3;
  printf "m-$hr,%dh$hr", $_ for @h3;
  print qq|"/>\n|;
}

{ my @data= map { floor $_ * $scale + .5 } @data;

  printf qq|<path stroke="#a0a0a0" stroke-width="8" d="M.5,%d|, $data[0];
  printf "l1,%d", $data[$_] - $data[$_-1] for 1 .. $#data;
  print qq|"/>\n|;
}

{ my (@rm);

  for my $i ( 182 .. $#data - 182 ) {
    my $rm= 0; $rm += $data[$_] for $i - 182 .. $i + 182;
    push @rm, floor $rm / 365 * $scale + .5;
  }

  printf qq|<path stroke="#008000" d="M182.5,%d|, $rm[0];
  printf "l1,%d", $rm[$_] - $rm[$_-1] for 1 .. $#rm;
  print qq|"/>\n|;
}

{ my $i0= $y[1972-$y0];
  my $s= 0;
  my (@cum);

  for my $i ( reverse 1 .. $i0 - 1 ) {
    $s -= $data[$i];
    push @cum, floor $s * $cscale + .5;
  }

  @cum= reverse @cum;
  push @cum, $s= 0;

  for my $i ( $i0 .. $#data ) {
    $s += $data[$i];
    push @cum, floor $s * $cscale + .5;
  }

  print qq|<g fill="#e06060">|;

  for my $i ( 0 .. $#ls ) {
    my $t= $ls[$i];
    my $y= int $t;
    my $p= $y[$y-$y0]; $y == $t or $p += $y % 4 ? 181 : 182;
    my $v= ($i + .5) * $cscale;
    print qq|<circle cx="$p" cy="$v" r="32"/>|;
  }

  print qq|</g>\n|;
  printf qq|<path stroke="#a00000" d="M0,%d|, $cum[0];
  printf "l1,%d", $cum[$_] - $cum[$_-1] for 1 .. $#cum;
  print qq|"/>\n|;
}

print qq|</g>\n|;
print qq|<g transform="translate(0,$max)" font-size="$fs">\n|;
printf qq|<g transform="translate(0,%.0f)" text-anchor="middle" fill="#000">|,
  -$min + $fs * 1.5;
printf qq|<text x="%d">%d</text>|, @$_ for @py;
print qq|</g>\n|;
printf qq|<g transform="translate(%.0f)" text-anchor="end" fill="#008000">|,
  -$fs * .8;
printf qq|<text y="%d">%s\x{2009}ms</text>|, $_->[0],
  $_->[1] > 0 ? sprintf "+%.0f", $_->[1] / $scale * 1000 :
  $_->[1] < 0 ? sprintf "\x{2212}%.0f", -$_->[1] / $scale * 1000 :
  "±0" for @pv;
print qq|</g>\n|;
printf qq|<g transform="translate(%.0f)" text-anchor="start" fill="#a00000">|,
  $hr + $fs * .8;
printf qq|<text y="%d">%s\x{2009}s</text>|, $_->[0],
  $_->[1] > 0 ? sprintf "+%.0f", $_->[1] / $cscale :
  $_->[1] < 0 ? sprintf "\x{2212}%.0f", -$_->[1] / $cscale :
  "±0" for @pv;
print qq|</g>\n|;
print qq|<g transform="translate(4648,500)">\n|;
print qq|<rect width="7870" height="1400" stroke="#808080" fill="#fff"|;
print qq| fill-opacity=".5"/>\n|;
print qq|<path stroke="#a0a0a0" d="M282.5,250h731"/><text fill="#808080"|;
print qq| x="1193" y="317">Tägliche Abweichung der|;
print qq| Tageslänge vom SI-Tag (86'400\x{2009}s)</text>\n|;
print qq|<path stroke="#008000" d="M282.5,550h731"/><text fill="#008000"|;
print qq| x="1193" y="617">Gleitendes 365-Tage-Mittel der Abweichung</text>\n|;
print qq|<path stroke="#a00000" d="M282.5,850h731"/><text fill="#a00000"|;
print qq| x="1193" y="917">|;
print qq|Kumulative Abweichung seit Einführung der Schaltsekunden</text>\n|;
print qq|<circle fill="#e06060" cx="648" cy="1150" r="32"/>|;
print qq|<text fill="#e06060" x="1193" y="1217">UTC-Schaltsekunde</text>\n|;
print qq|</g>\n|;
print qq|</g>\n|;
print qq|</svg>\n|;