/
ch-2.pl
executable file
·124 lines (98 loc) · 2.9 KB
/
ch-2.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
#!/usr/bin/perl
# A tailor-made class for this task.
package Rectangle;
use strict;
use warnings;
use List::Util qw(min);
use overload
'<=>' => \&cmp_rect, # compare by size
'.=' => \&position, # set position
'""' => \&show; # stringify
# Create a new rectangle over the full length of
# the given (partial) histogram and with maximum height.
sub new {
my $class = shift;
bless {height => min(@_) // 0,
length => scalar @_,
position => -1}, $class;
}
# Compare two rectangles by size.
sub cmp_rect {
my ($self, $other) = @_;
$self->{length} * $self->{height} <=> $other->{length} * $other->{height};
}
# Set (end) position.
sub position {
my ($self, $pos) = @_;
$self->{position} = $pos;
$self;
}
# String representation.
sub show {
my $self = shift;
sprintf "size=%d, length=%d, position=%d, height=%d",
$self->{length} * $self->{height}, $self->{length},
$self->{position}, $self->{height};
}
# Check if point is contained in rectangle.
sub contains {
my ($self, $ix, $height) = @_;
$ix >= $self->{position} - $self->{length} + 1 &&
$ix <= $self->{position} && $height <= $self->{height};
}
package main;
use strict;
use warnings;
use List::Util qw(max reduce);
# Find the largest rectangle inside a histogram.
# The Rectangle constructor, comparator and assignment operator
# are specifically designed to offer a terse implementation here.
sub max_rect {
# Slide over all elements seeking for the maximum rectangle
reduce {
my $pos = $b;
# Slide over all windows ending at the selected position.
reduce {
# Get the maximum rectangle over the full window length.
my $rect = Rectangle->new(@_[$b .. $pos]);
# If the new rectangle is larger than the current maximum,
# set the position and use it as the new maximum.
$rect > $a ? $rect .= $pos : $a;
} $a, 0 .. $b;
} Rectangle->new, 0 .. $#_;
}
# Create the histogram row data at the given height:
# - empty, if height is above the value
# - asterisk, if the point is inside the maximum rectangle
# - hash otherwise.
sub hist_chars {
my ($max, $height) = (shift, shift);
map $_[$_] >= $height ?
$max->contains($_, $height) ?
'*' : '#' : '', 0 .. $#_;
}
# Generate a format string. Produces $size + 1 items of equal
# length $len that are separated by one blank. The first item has
# conversion $first, the rest have conversion $rest.
sub gen_fmt ($$$$) {
my ($len, $first, $rest, $size) = @_;
"%${len}${first}" . " %${len}${rest}" x $size . "\n";
}
# Print the histogram.
sub print_hist {
my $max = shift;
my $height = max @_;
my $len = length $height;
my $fmt = gen_fmt $len, 'd', 's', @_;
do {
printf $fmt, $height, hist_chars $max, $height, @_
} while --$height;
printf gen_fmt($len, 's', 's', @_), ('-') x (@_ + 1);
printf gen_fmt($len, 's', 'd', @_), '', @_;
}
# main
for my $hist ([2, 1, 4, 5, 3, 7], [3, 2, 3, 5, 7, 5, 2]) {
my $max = max_rect @$hist;
print_hist $max, @$hist;
print "max rectangle: $max\n\n";
}