source: subversion/applications/rendering/tah-heatmap/generate-heatmap.pl @ 34483

Last change on this file since 34483 was 15820, checked in by avar, 10 years ago

Pod documentation, and implement --warp-size so the image can be changed with a code snippet on the command line

File size: 4.5 KB
Line 
1#!/usr/bin/env perl
2use feature ':5.10';
3use strict;
4use warnings;
5use GD;
6
7use Getopt::Long ();
8use Pod::Usage ();
9
10=head1 NAME
11
12generate-heatmap.pl - Make a 2^12 x 2^12 pixel heatmap of the world by looking at the size of z12 tiles
13
14=head1 SYNOPSIS
15
16    To generate the map, do:
17
18     wget http://tah.openstreetmap.org/media/filesizes.bz2
19     bzip2 -d filesizes.bz2
20     perl parse-filesize.pl filesizes > tile-sizes.dat
21     perl generate-heatmap.pl tile-sizes.dat > osm-heatmap.png
22
23=head1 DESCRIPTION
24
25This program generates a 4096x4096 PNG heatmap of the globe based on
26t@h tile sizes, see
27L<http://lists.openstreetmap.org/pipermail/tilesathome/2009-May/005858.html>
28
29=head1 OPTIONS
30
31=over
32
33=item --help
34
35This help message.
36
37=item --warp-size
38
39A bit of Perl code that will be evaluated to warp the size of the
40current tileset (given with the C<$size> variable) on a scale of 0-1.
41
42It has access to almost all the variables in the program, including:
43
44    $max     The maximum tileset size we've found
45    $min     The minimum tileset size we've found
46    $median  The median size of the tilesets
47
48=back
49
50=head1 LICENSE
51
52GNU general public licence (since that's what ViewCVS's heatmap subroutine was under)
53
54The output is CC-BY-SA 2.0 presumably if you source OSM data
55
56=cut
57
58Getopt::Long::Parser->new(
59        config => [ qw< bundling no_ignore_case no_require_order > ],
60)->getoptions(
61    'h|help' => \my $help,
62    'warp-size=s' => \my $warp_size,
63) or help();
64
65# --help
66help( verbose => 1, exitval => 0 )
67    if $help;
68
69my $from = 0;
70my $to   = 2**12-1;
71
72# Create a new image with each pixel = one z12 tile
73my $im = GD::Image->new(2**12, 2**12);
74
75my $file = shift;
76say STDERR "Parsing tile size file `$file'...";
77my ($hash, $min, $max) = parse_tile_size($file);
78say STDERR "Done parsing tile size";
79
80my $hash_num = scalar keys %$hash;
81my $median = ((sort { $a <=> $b } values %$hash)[int($hash_num/2)]);
82
83# say STDERR "Min = $min";
84# say STDERR "Max = $max";
85# say STDERR "Average = " . (int sum(values %$hash)/$hash_num);
86# say STDERR "Median = " . ((sort { $a <=> $b } values %$hash)[int($hash_num/2)]);
87# say STDERR "Num keys = $hash_num";
88
89my $color;
90for my $x ($from .. $to)
91{
92    say STDERR "Processing $x/" . 2**12 if $x % 100 == 0;
93
94    my $x_key = sprintf "%04d", $x;
95
96    for my $y ($from .. $to)
97    {
98        my $y_key = sprintf "%04d", $y;
99        my $key = $x_key . ',' . $y_key;
100        if (exists $hash->{$key}) {
101            my $size = $hash->{$key};
102            my @rgb = heatmap(warp_size_for_heatmap($size));
103            $color = $im->colorResolve(@rgb);
104            $im->setPixel($x, $y, $color);
105        } else {
106            # Black background
107            $im->setPixel($x, $y, $im->colorResolve(0,0,0));
108        }
109    }
110}
111
112# make sure we are writing to a binary stream
113binmode STDOUT;
114
115# Convert the image to PNG and print it on standard output
116print $im->png;
117
118exit 0;
119
120sub parse_tile_size
121{
122    my ($file) = @_;
123
124    my (%hash, $smallest, $biggest);
125
126    my $do_size = sub {
127        my $size = shift;
128
129        if (not defined $biggest or $size > $biggest) {
130            $biggest = $size;
131        }
132        if (not defined $smallest or $size < $smallest) {
133            $smallest = $size;
134        }
135    };
136
137    open my $fh, "<", $file or die "Can't open file $file: $!";
138    while (my $line = <$fh>)
139    {
140        chomp $line;
141        my ($tile, $size) = split /\s+/, $line;
142        $do_size->($size);
143        $hash{$tile} = $size;
144    }
145    close $fh;
146
147    return (\%hash, $smallest, $biggest);
148}
149
150sub warp_size_for_heatmap
151{
152    my $size = shift;
153    my $n;
154
155    unless ($warp_size) {
156        $n = $size / ($median * 32);
157        $n = 0.95 if $n >= 1;
158    } else {
159        $n = eval $warp_size;
160    }
161
162    return $n;
163}
164
165# From http://google.com/codesearch/p?hl=en#v85D9_xn8lk/viewcvs.py/gmod/graphbrowse/cgi/graphbrowse%3Frev%3D1.10&q=heat map rgb lang:perl
166sub heatmap {
167    my($v)=@_;
168
169    die "Heatmap input out of range: $v" if $v < 0 || $v > 1;
170
171    my @rgb;
172
173    for my $offset (-0.25,0,0.25) {
174        my $x = $v + $offset;
175        my $y;
176        if ($x <= .125) {
177            $y = 0;
178        } elsif ($x <= .375) {
179            $y = ($x-.125)/.25;
180        } elsif ($x <= .625) {
181            $y = 1;
182        } elsif ($x <= .875) {
183            $y = (.875 - $x )/.25;
184        } else {
185            $y = 0;
186        }
187        push @rgb => $y * 255;
188    }
189    map { int } @rgb;
190}
191
192sub help
193{
194    my %arg = @_;
195
196    Pod::Usage::pod2usage(
197        -verbose => $arg{ verbose },
198        -exitval => $arg{ exitval } || 0,
199    );
200}
Note: See TracBrowser for help on using the repository browser.