From 709bd766d3a9734a9db22a5a501ce0404dbded10 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sun, 7 Apr 2013 15:57:30 +0100 Subject: 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 --- calc-price | 289 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 289 insertions(+) create mode 100644 calc-price 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"; -- cgit v1.2.3