当番表作りを自動化してみた

PTA活動などでいろんな当番表を作ったりしますが、これが地味に時間がかかるんですよね。この曜日はNG、この日は予定があるなど、それぞれに都合がありますからね。

そんなのをお助けするプログラムをちょこっと作ってみました。

当番表とは

どんな条件なのかなと整理してみます。

• 名簿がある
• 日程が決まっている
• 人数が決まっている
• 公平性が求められる
• 人によって都合がある

ということでプログラムを作ってみます

make_shift.pl

#!/bin/perl

use strict;

# 名簿
my @baselist = (
  '山田',
  '鈴木',
  '佐藤',
  '高橋',
  '伊藤',
  '小林',
  '渡辺',
  '中村',
  '山口'
);

# NG条件（正規表現）
my %ng = (
  '山田' => '\(月\)',
  '渡辺'=> '\(月\)',
  '小林'=> '2月14日',
  '中村'=> '2月4日',
);

# 回数上限
my %limit = (
  '伊藤' => 4,
  '小林' => 4,
);

# 日付リスト
my @dt = (
  '1月31日(木)',
  '2月4日(月)',
  '2月7日(木)',
  '2月12日(火)',
  '2月14日(木)',
  '2月18日(月)',
  '2月21日(木)',
  '2月25日(月)',
  '2月28日(木)',
  '3月4日(月)'
);

# 同じ日に必要な人数
my $num_per_day = 4;

# 順番割り当てリストの初期化（開始位置はランダム）
my $i = int(rand($#baselist + 1));
my @list = ();
while ($#list < ($#dt + 1) * ($num_per_day + 1)){
  push(@list, $baselist[$i]);
  $i++;
  if ($i > $#baselist){
    $i = 0;
  }
}

# 結果データの初期化
my %check = ();
my %result = ();
my %ct = ();
foreach my $d (@dt){
  $check{$d} = {};
  $result{$d} = [];
}

# 初期値のセット
push (@{$result{'1月31日(木)'}},'小林','高橋','山田','山口');
push (@{$result{'2月4日(月)'}},'伊藤','鈴木','佐藤','小林');

# 事前にセットした名前を削除
foreach my $name (@baselist){
  $ct{$name} = 0;
}

# 初期値分をカウント＆リストからその分除去
foreach my $d (@dt){
  foreach my $name (@{$result{$d}}){
    $ct{$name}++;
    $i = 0;
    while ($list[$i] ne $name){
      $i++;
      last if ($i >= $#list);
    }
    splice(@list, $i, 1);
  }
}

# 当番表のセット
foreach my $j (1..$num_per_day){
  foreach my $d (@dt){
    my $ct = $#{$result{$d}};
    next if ($ct >= $num_per_day - 1);
    my $i = 0;
    my $name = $list[$i];
    while (check_ng($d, $name)){
      $i++;
      $name = $list[$i];
    }
    splice(@list, $i, 1);
    $check{$d}{$name} = 1;
    push (@{$result{$d}}, $name);
    $ct{$name}++;
  }
}

# 結果の出力
print "結果リスト\n";
foreach my $d(@dt){
  print join("\t",$d,@{$result{$d}}) . "\n";
}

print "回数チェック\n";
foreach my $name(@baselist){
  print "$name\t$ct{$name}\n";
}

print "結果リスト（日付抜き）\n";
foreach my $d(@dt){
  print join("\t",@{$result{$d}}) . "\n";
}

sub check_ng($$){
  my $d = shift;
  my $name = shift;
  return 1 if (exists $check{$d}{$name});
  if (exists $ng{$name}){
    my $ng = $ng{$name};
    if ($d =~ /$ng/){
      return 1;
    }
  }
  if (exists $limit{$name}){
    my $limit = $limit{$name};
    if ($ct{$name} >= $limit){
      return 1;
    }
  }
  
  return 0;
}

出力結果は以下の通りです。

結果.txt

結果リスト
1月31日(木)	小林	高橋	山田	山口
2月4日(月)	伊藤	鈴木	佐藤	小林
2月7日(木)	渡辺	山田	山口	鈴木
2月12日(火)	中村	鈴木	渡辺	山口
2月14日(木)	佐藤	高橋	山田	渡辺
2月18日(月)	高橋	佐藤	伊藤	中村
2月21日(木)	伊藤	小林	佐藤	山田
2月25日(月)	中村	伊藤	高橋	佐藤
2月28日(木)	渡辺	中村	小林	高橋
3月4日(月)	山口	鈴木	中村	佐藤
回数チェック
山田	4
鈴木	4
佐藤	6
高橋	5
伊藤	4
小林	4
渡辺	4
中村	5
山口	4
結果リスト（日付抜き）
小林	高橋	山田	山口
伊藤	鈴木	佐藤	小林
渡辺	山田	山口	鈴木
中村	鈴木	渡辺	山口
佐藤	高橋	山田	渡辺
高橋	佐藤	伊藤	中村
伊藤	小林	佐藤	山田
中村	伊藤	高橋	佐藤
渡辺	中村	小林	高橋
山口	鈴木	中村	佐藤

最後に

今回は、とある役の仕事で必要になって作りましたけど、きっと困ってる方は結構いらっしゃるんだろうなと思ってます。
気が向いたら、Webで簡単に当番表を作れるツールを作りますね。