script to calculate cost of journeys

data taken from oyster website and wikipedia

known problems:

- multi-zone stations (those at the border between two zones) are
  assigned only one zone
- night bus rides may get assigned to the wrong day
- price caps have not been verified, I'm trusting the TfL website

1 files changed, 289 insertions, 0 deletions

diff --git a/calc-price b/calc-price
new file mode 100644
index 0000000..680a16d
--- /dev/null
+++ b/calc-price
@@ -0,0 +1,289 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.016;
+use DBI;
+use Path::Class;
+use Getopt::Long::Descriptive;
+use Try::Tiny;
+use DateTime;
+use open ':std',':locale';
+use Data::Printer;
+
+# this is from http://www.tfl.gov.uk/tickets/14837.aspx
+
+sub day_of_journey {
+    my ($ts) = @_;
+
+    my $day = $ts->clone->truncate(to=>'day');
+    my $day_end = $ts->clone->set(hour=>4,minute=>30,second=>0);
+    if ($ts < $day_end) {
+        $day->subtract(days=>1);
+    }
+    return $day;
+}
+
+sub is_peak {
+    my ($ts) = @_;
+
+    return 0 if $ts->day_of_week ~~ [6,7]; # sat&sun no peak
+    my $peak_start = $ts->clone->set(hour=>4,minute=>30,second=>0);
+    return 0 if $ts < $peak_start;
+    my $peak_stop =  $ts->clone->set(hour=>9,minute=>29,second=>59);
+    return 0 if $ts > $peak_stop;
+    return 1;
+}
+
+# data from Wikipedia
+{my %zone_for_station = (
+    q{Aldgate East}                                       => 1,
+    q{Alexandra Palace [National Rail]}                   => 3,
+    q{Angel}                                              => 1,
+    q{Bank}                                               => 1,
+    q{Barons Court}                                       => 2,
+    q{Blackfriars}                                        => 1,
+    q{Blackfriars [London Underground]}                   => 1,
+    q{Brentford [National Rail]}                          => 4,
+    q{Camden Town}                                        => 2,
+    q{Chalk Farm}                                         => 2,
+    q{Chancery Lane}                                      => 1,
+    q{Charing Cross}                                      => 1,
+    q{Charing Cross [London Underground]}                 => 1,
+    q{Covent Garden}                                      => 1,
+    q{Custom House DLR}                                   => 3,
+    q{Cutty Sark DLR}                                     => 2,
+    q{Dalston Junction [London Overground]}               => 2,
+    q{Dalston Kingsland}                                  => 2,
+    q{Ealing Broadway}                                    => 3,
+    q{Ealing Common}                                      => 3,
+    q{East Croydon [National Rail]}                       => 5,
+    q{Embankment}                                         => 1,
+    q{Euston [London Underground]}                        => 1,
+    q{Euston Square}                                      => 1,
+    q{Finsbury Park [London Underground / National Rail]} => 2,
+    q{Golders Green}                                      => 3,
+    q{Goodge Street}                                      => 1,
+    q{Greenford}                                          => 4,
+    q{Green Park}                                         => 1,
+    q{Hanger Lane}                                        => 3,
+    q{Hayes & Harlington [National Rail]}                 => 5,
+    q{Heathrow Terminal 5 [London Underground]}           => 6,
+    q{Highbury & Islington}                               => 2,
+    q{High Street Kensington}                             => 1,
+    q{Holborn}                                            => 1,
+    q{Hounslow Central}                                   => 4,
+    q{Hoxton [London Overground]}                         => 1,
+    q{Hyde Park Corner}                                   => 1,
+    q{Kensal Green}                                       => 2,
+    q{Kings Cross [National Rail]}                        => 1,
+    q{Ladbroke Grove}                                     => 2,
+    q{Lancaster Gate}                                     => 1,
+    q{Leicester Square}                                   => 1,
+    q{Leytonstone}                                        => 3,
+    q{Limehouse DLR}                                      => 2,
+    q{Liverpool Street [London Underground]}              => 1,
+    q{London Bridge [London Underground]}                 => 1,
+    q{Mansion House}                                      => 1,
+    q{Marble Arch}                                        => 1,
+    q{Mornington Crescent}                                => 2,
+    q{North Acton}                                        => 2,
+    q{Northfields}                                        => 3,
+    q{Northolt}                                           => 5,
+    q{Notting Hill Gate}                                  => 1,
+    q{Oxford Circus}                                      => 1,
+    q{Paddington [National Rail]}                         => 1,
+    q{Park Royal}                                         => 3,
+    q{Piccadilly Circus}                                  => 1,
+    q{Pimlico}                                            => 1,
+    q{Pinner}                                             => 5,
+    q{Queensway}                                          => 1,
+    q{Rayners Lane}                                       => 5,
+    q{Rotherhithe [London Overground]}                    => 2,
+    q{Shepherd's Bush (Central line)}                     => 2,
+    q{Shepherd's Bush Market}                             => 2,
+    q{Sloane Square}                                      => 1,
+    q{South Kensington}                                   => 1,
+    q{Southwark}                                          => 1,
+    q{St Paul's}                                          => 1,
+    q{Tottenham Court Road}                               => 1,
+    q{Tower Hill}                                         => 1,
+    q{Turnham Green}                                      => 2,
+    q{Vauxhall [London Underground]}                      => 1,
+    q{Victoria [London Underground]}                      => 1,
+    q{Waterloo (Jubilee line entrance)}                   => 1,
+    q{Waterloo [London Underground / National Rail]}      => 1,
+    q{West Ealing [National Rail]}                        => 3,
+    q{White City}                                         => 2,
+    q{Wood Green}                                         => 3
+);
+
+sub zone_for_station {
+    my ($station) = @_;
+
+    if (not exists $zone_for_station{$station}) {
+        warn "unknown station: <$station>\n";
+    }
+    return $zone_for_station{$station};
+}
+}
+
+my $default_db_path = file(__FILE__)->parent->file('oyster.db')->stringify;;
+
+my ($opt,$usage) = describe_options(
+    '%c %o',
+    [ 'database|d=s', 'path to the database to use',
+      { default => $default_db_path } ],
+    [],
+    [ 'help|h', 'print help and exit' ],
+);
+if ($opt->help) {
+    print $usage->text;
+    exit;
+}
+
+my $dbh = DBI->connect(
+    'dbi:SQLite:dbname='.$opt->database,
+    '','',
+    { RaiseError => 1, PrintError => 0, AutoCommit => 1 },
+);
+
+my $sth = $dbh->prepare(q{SELECT start_ts,stop_ts,description FROM journeys});
+$sth->execute;
+
+my %journeys_on_day;
+my %range_for_day;
+
+sub update_range {
+    my ($day_key,$peak,$tube,$start_zone,$stop_zone) = @_;
+
+    my ($min_zone,$max_zone) = sort {$a<=>$b} $start_zone,$stop_zone;
+    my $cur_range=$range_for_day{$day_key}//={};
+
+    $cur_range->{peak}||=$peak;
+    $cur_range->{tube}||=$tube;
+    if ($tube && ($cur_range->{min_zone}||9 > $min_zone)) {
+        $cur_range->{min_zone} = $min_zone;
+    }
+    if ($tube && ($cur_range->{max_zone}||-1 < $max_zone)) {
+        $cur_range->{max_zone} = $max_zone;
+    }
+
+    return;
+}
+
+while (my $row=$sth->fetchrow_hashref) {
+    my $start_ts = DateTime->from_epoch(
+        epoch=> $row->{start_ts},
+        time_zone=>'Europe/London',
+    );
+
+    my $day_key= day_of_journey($start_ts)->ymd;
+
+    my @journey;my ($peak,$tube,$start_zone,$stop_zone)=(0,0,0,0);
+    $peak = is_peak($start_ts);
+
+    if ($row->{description} =~ m{\ABus journey, route (\S+)}) {
+        @journey=('bus','bus');$tube=0;
+    }
+    elsif ($row->{description} =~ m{\A(.*?) to (.*)}) {
+        ($start_zone,$stop_zone) = sort {$a<=>$b}
+            map { zone_for_station($_) } $1,$2;
+        @journey=($start_zone,$stop_zone);$tube=1;
+    }
+    else {
+        warn "unparseable journey: <$row->{description}>, ignoring\n";
+        next;
+    }
+
+    push @{$journeys_on_day{$day_key}},[$peak,@journey];
+    update_range($day_key,$peak,$tube,$start_zone,$stop_zone);
+}
+
+# data from http://www.tfl.gov.uk/tickets/14416.aspx and
+# http://www.tfl.gov.uk/tickets/14415.aspx
+my %prices = (
+    bus => [1.40,4.40], # value: journey, daily cap
+
+    '0-1-1' => [2.10,7.00], # key: no peak, zone 1 to 1
+    '1-1-1' => [2.10,8.40],
+    '0-1-2' => [2.10,7.00],
+    '1-1-2' => [2.80,8.40],
+    '0-1-3' => [2.70,7.70],
+    '1-1-3' => [3.20,10.60],
+    '0-1-4' => [2.70,7.70],
+    '1-1-4' => [3.80,10.60],
+    '0-1-5' => [3.00,8.50],
+    '1-1-5' => [4.60,15.80],
+    '0-1-6' => [3.00,8.50],
+    '1-1-6' => [5.00,15.80],
+
+    '0-2-2' => [1.50,7.00],
+    '1-2-2' => [1.60,8.40],
+    '0-2-3' => [1.50,7.70],
+    '1-2-3' => [1.60,10.60],
+    '0-2-4' => [1.50,7.70],
+    '1-2-4' => [2.30,10.60],
+    '0-2-5' => [1.50,8.50],
+    '1-2-5' => [2.70,15.80],
+    '0-2-6' => [1.50,8.50],
+    '1-2-6' => [2.70,15.80],
+
+    '0-3-3' => [1.50,7.70],
+    '1-3-3' => [1.60,10.60],
+    '0-3-4' => [1.50,7.70],
+    '1-3-4' => [1.60,10.60],
+    '0-3-5' => [1.50,8.50],
+    '1-3-5' => [2.30,15.80],
+    '0-3-6' => [1.50,8.50],
+    '1-3-6' => [2.70,15.80],
+
+    '0-4-4' => [1.50,7.70],
+    '1-4-4' => [1.60,10.60],
+    '0-4-5' => [1.50,8.50],
+    '1-4-5' => [1.60,15.80],
+    '0-4-6' => [1.50,8.50],
+    '1-4-6' => [2.30,15.80],
+
+    '0-5-5' => [1.50,8.50],
+    '1-5-5' => [1.60,15.80],
+    '0-5-6' => [1.50,8.50],
+    '1-5-6' => [1.60,15.80],
+
+    '0-6-6' => [1.50,8.50],
+    '1-6-6' => [1.60,15.80],
+);
+
+my $total=0;
+for my $day (sort keys %journeys_on_day) {
+    my $cost=0;
+
+
+    for my $journey (@{$journeys_on_day{$day}}) {
+        if ($journey->[1] eq 'bus') {
+            $cost += $prices{bus}->[0];
+        }
+        else {
+            my $key = join '-',@$journey;
+            $cost += $prices{$key}->[0] or die "Can't get price for $key";
+        }
+    }
+
+    my $range= $range_for_day{$day};
+    my $cap;
+    if (not $range->{tube}) {
+        $cap= $prices{bus}->[1];
+    }
+    else {
+        my $cap_key = join '-',@{$range}{qw(peak min_zone max_zone)};
+        $cap = $prices{$cap_key}->[1] or die "Can't get cap for $cap_key";
+    }
+
+    if ($cost > $cap) {
+        $cost = $cap;
+    }
+
+    say "Cost for $day: $cost";
+    $total+=$cost;
+}
+
+say "Total: $total";