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
125
126
127
128
129
130
131
132
133
134
135
136
137
|
constant $bs = 8;
constant $debug = False;
#| Gets the remaining number of items left to pack
sub num-remain (%h) {
[+] %h.values.».elems;
}
sub exists-and-elems ( %h, $key ) {
%h{$key}:exists and %h{$key}.elems;
}
sub compute-packing ( @list where { .all ~~ Pair and $_.».value.all ~~ Int } ) is export {
say "Received list: ", @list.perl if $debug;
my @result;
my $i = 0;
my $visual;
my %h{Int} = first-run(@list, @result);
say %h.perl if $debug;
say "before second run Packing:", @result.perl if $debug;
second-run(%h, @result);
say "before loopy Packing:", @result.perl if $debug;
loopy(%h, @result);
say "after loopy" if $debug;
try say "packing:", @result.».value if $debug;
push-remaining(%h, @result);
die unless num-remain(%h) == 0;
say "Final packing:", @result.».value if $debug;
@result;
}
sub test-it {
my @list = init();
say compute-packing(@list);
}
sub push-remaining (%h, @result) {
for %h.keys.sort(-*) -> $key {
while exists-and-elems(%h, $key) {
@result.push(%h{$key}.pop => $key);
}
}
}
sub loopy (%h, @result) {
my $left;
my $i;
repeat while $left != [+] %h.values.».elems {
$left = [+] %h.values.».elems;
say "left: ", $left if $debug;
say "First final-run" if $debug;
final-run(%h, @result);
say "Remaining: ", %h.perl if $debug;
say "Packing:", @result.perl if $debug;
$i++;
say "thing", "$left {[+] %h.values.».elems}" if $debug;
last if $left == 0;
}
}
sub init {
my $i = 0;
my @list;
for ^10 {
@list.push($i++ => (1..8).pick) for ^5;
}
@list.push($i++ => 1) for ^10;
@list.push($i++ => 15);
@list;
}
sub first-run (@list, @result) {
# First categorize everything divisible by the bs
sub mapper(Pair $i) returns List {
$i.value %% $bs ?? 'div' !! 'not-div',
}
my $a = categorize &mapper, @list;
say "first run \$a: ", $a.perl if $debug;
unless $a<div>:!exists {
for $a<div>.flat {
@result.push($_);
}
}
my %h{Int};
unless $a<not-div>:!exists {
my $b = $a<not-div>;
# Make a hash whose keys are the bitwidth and hold an array of which items they
# represent
for $b.flat -> $pair {
my $value = $pair.value;
my $item = $pair.key;
push %h{$value}, $item ;
}
}
%h;
}
sub get-remain ($piece) {
abs(abs($bs - $piece) - ($piece.Int div $bs) * $bs);
}
sub second-run (%h, @result) {
# Start with the largest items
for %h.keys.sort(-*) -> $key {
# Find ones which are complement 6 and 2 for example, 3 and 3
my $a2 = get-remain($key);
say "1 key $key a2 $a2" if $debug;
while (%h{$key}:exists and %h{$key}.elems) and (%h{$a2}:exists and %h{$a2}.elems) {
# For the case of 4 and 4, make sure we have at least 2 elems
last if $key == $a2 and %h{$key}.elems < 2;
my $p1 = %h{$key}.pop => $key;
my $p2 = %h{$a2}.pop => $a2;
@result.push($p1);
@result.push($p2);
}
}
}
sub final-run (%h, @result) {
my $tot = 0;
for %h.keys.sort(-*) -> $key {
next unless %h{$key}:exists and %h{$key}.elems;
my $temp_tot = $tot + $key;
my $pushed-yet = False;
for %h.keys.sort(-*) -> $key2 {
next unless %h{$key2}:exists and %h{$key2}.elems;
while $temp_tot + $key2 <= 8 {
last if $key == $key2 and %h{$key}.elems < 2;
last if %h{$key2}.elems < 1;
say "key[$key] key2 [$key2] temp_tot[$temp_tot] tot[$tot] tot + key2[{$tot + $key2}]" if $debug;
unless $pushed-yet {
@result.push((%h{$key}.pop orelse die $_) => $key);
say "Pushing key $key" if $debug;
$pushed-yet = True
}
@result.push((%h{$key2}.pop orelse die $_) => $key2);
say "Pushing key2 $key2" if $debug;
$temp_tot += $key2;
$tot = $temp_tot;
}
}
}
}
|
