ある数を出来るだけ最大数に対して、均等にグループ分けする

注意

• 下記はまだ計算が間違っています(よいうことに気付いた)
• 修正しますた！

経緯

• 何かそれっぽいコード見てたら結構ベタ書きだったので、もうちょい汎用的に書けたんじゃないの？ってなった。

やりたいこと

• 先頭詰めで出来るだけ均等にならしてグループ分けした数の配列にして取得したい

欲しい結果(ここでは最大数を4として考える)

• SOME_NUMが13の場合
• (4, 3, 3, 3)
• SUM_NUMが20の場合
• (4, 4, 4, 4, 4)
• SUM_NUMが5の場合
• (3, 2)

まず、MAX_NUM と MAX_NUM - 1だけで構成できるケースだけ考える(4 と 3だけのケース)

• MAX_NUM ではない要素はどういう条件か？
• 末尾から (MAX_NUM - 余り - 1) 数分の要素(剰余に対して、補填を出した要素数)
• (SOME_NUM % MAX_NUM) がゼロの場合は発生しない
• Perlで書いてみる

my @result_list = ();
my $division = ceil($some_num / $max_num);
my $surplus  = $some_num % $max_num;

for my $i (1 .. $division) {
    if (!$surplus || $division - ($max_num - $surplus) >= $i) {
        push @result_list, $max_num;
    }
    else {
        push @result_list, $max_num - 1;
    }
}

MAX_NUM と MAX_NUM - 1で構成されないケースがどういう条件で発生するか？

• MAX_NUMな要素から1ずつ補填して、全要素が (MAX_NUM - 1) 以上を満たせるケース
• 補填する側の要素最大数は MAX_NUM - 1(補填される数は最低でも1)
• つまり、商がMAX_NUM - 1より小さいケースであればMAX_NUMを満たさない
• この場合の要素のベースは floor(SOME_NUM / 商)
• Perlで書いてみる

my $base_num = floor($some_num / $division);
my $surplus  = $some_num % $base_num;

for my $i (1 .. $division) {
    if ($surplus && $surplus >= $i) {
        push @result_list, $base_num + 1;
    }
    else {
        push @result_list, $base_num;
    }
}

ちょっと雑だけど全体像

# !/usr/env perl

use strict;
use warnings;
use POSIX qw/ceil floor/;

my $max_num = $ARGV[0];

for my $some_num (1 .. $ARGV[1]) {
    my @result_list  = ();

    my $division =  ceil($some_num / $max_num);
    my $surplus  =  $some_num % $max_num;

    if ($division > $max_num - 1) {
        for my $i (1 .. $division) {
            if (!$surplus || $division - ($max_num - $surplus) >= $i) {
                push @result_list, $max_num;
            }
            else {
                push @result_list, $max_num - 1;
            }
        }
    }
    else {
        my $base_num = floor($some_num / $division);
        my $surplus  = $some_num % $base_num;
        for my $i (1 .. $division) {
            if ($surplus && $surplus >= $i) {
                push @result_list, $base_num + 1;
            }
            else {
                push @result_list, $base_num;
            }
        }
    }

    printf "$some_num: (%s)\n", join q{, }, @result_list;

    my $total = 0;
    $total += $_ for @result_list;
    print "ERROR!! $total: $some_num\n" if $total != $some_num;
}

__END__

実行結果

$ perl ~/test.pl 4 27
1: (1)
2: (2)
3: (3)
4: (4)
5: (3, 2)
6: (3, 3)
7: (4, 3)
8: (4, 4)
9: (3, 3, 3)
10: (4, 3, 3)
11: (4, 4, 3)
12: (4, 4, 4)
13: (4, 3, 3, 3)
14: (4, 4, 3, 3)
15: (4, 4, 4, 3)
16: (4, 4, 4, 4)
17: (4, 4, 3, 3, 3)
18: (4, 4, 4, 3, 3)
19: (4, 4, 4, 4, 3)
20: (4, 4, 4, 4, 4)
21: (4, 4, 4, 3, 3, 3)
22: (4, 4, 4, 4, 3, 3)
23: (4, 4, 4, 4, 4, 3)
24: (4, 4, 4, 4, 4, 4)
25: (4, 4, 4, 4, 3, 3, 3)
26: (4, 4, 4, 4, 4, 3, 3)
27: (4, 4, 4, 4, 4, 4, 3)

$ perl ~/test.pl 5 36
1: (1)
2: (2)
3: (3)
4: (4)
5: (5)
6: (3, 3)
7: (4, 3)
8: (4, 4)
9: (5, 4)
10: (5, 5)
11: (4, 4, 3)
12: (4, 4, 4)
13: (5, 4, 4)
14: (5, 5, 4)
15: (5, 5, 5)
16: (4, 4, 4, 4)
17: (5, 4, 4, 4)
18: (5, 5, 4, 4)
19: (5, 5, 5, 4)
20: (5, 5, 5, 5)
21: (5, 4, 4, 4, 4)
22: (5, 5, 4, 4, 4)
23: (5, 5, 5, 4, 4)
24: (5, 5, 5, 5, 4)
25: (5, 5, 5, 5, 5)
26: (5, 5, 4, 4, 4, 4)
27: (5, 5, 5, 4, 4, 4)
28: (5, 5, 5, 5, 4, 4)
29: (5, 5, 5, 5, 5, 4)
30: (5, 5, 5, 5, 5, 5)
31: (5, 5, 5, 4, 4, 4, 4)
32: (5, 5, 5, 5, 4, 4, 4)
33: (5, 5, 5, 5, 5, 4, 4)
34: (5, 5, 5, 5, 5, 5, 4)
35: (5, 5, 5, 5, 5, 5, 5)
36: (5, 5, 5, 5, 4, 4, 4, 4)

$ perl ~/test.pl 6 48
1: (1)
2: (2)
3: (3)
4: (4)
5: (5)
6: (6)
7: (4, 3)
8: (4, 4)
9: (5, 4)
10: (5, 5)
11: (6, 5)
12: (6, 6)
13: (5, 4, 4)
14: (5, 5, 4)
15: (5, 5, 5)
16: (6, 5, 5)
17: (6, 6, 5)
18: (6, 6, 6)
19: (5, 5, 5, 4)
20: (5, 5, 5, 5)
21: (6, 5, 5, 5)
22: (6, 6, 5, 5)
23: (6, 6, 6, 5)
24: (6, 6, 6, 6)
25: (5, 5, 5, 5, 5)
26: (6, 5, 5, 5, 5)
27: (6, 6, 5, 5, 5)
28: (6, 6, 6, 5, 5)
29: (6, 6, 6, 6, 5)
30: (6, 6, 6, 6, 6)
31: (6, 5, 5, 5, 5, 5)
32: (6, 6, 5, 5, 5, 5)
33: (6, 6, 6, 5, 5, 5)
34: (6, 6, 6, 6, 5, 5)
35: (6, 6, 6, 6, 6, 5)
36: (6, 6, 6, 6, 6, 6)
37: (6, 6, 5, 5, 5, 5, 5)
38: (6, 6, 6, 5, 5, 5, 5)
39: (6, 6, 6, 6, 5, 5, 5)
40: (6, 6, 6, 6, 6, 5, 5)
41: (6, 6, 6, 6, 6, 6, 5)
42: (6, 6, 6, 6, 6, 6, 6)
43: (6, 6, 6, 5, 5, 5, 5, 5)
44: (6, 6, 6, 6, 5, 5, 5, 5)
45: (6, 6, 6, 6, 6, 5, 5, 5)
46: (6, 6, 6, 6, 6, 6, 5, 5)
47: (6, 6, 6, 6, 6, 6, 6, 5)
48: (6, 6, 6, 6, 6, 6, 6, 6)

• 最近、Textile書く方が多いからMarkdown戸惑った。タグは何にするかワカランかったのでとりあえずPerl