トップ > Perl > 優先度付きキュー

優先度付きキュー

Perl

数学的基礎とデータ構造 (アルゴリズムイントロダクション)のp131付近。エラー処理をさぼっている。。。

  • ヒープソートは優れたアルゴリズムだけど、ソートのアルゴリズムとしてはクイックソートのほうが実際上より優れている
    • なんだって!!
  • でも、ヒープのデータ構造自体には色々応用があるらしい
    • その中でも、優先度付きキューと呼ばれるものは人気があるようだ
  • 優先度付きキューがどういう場面で使われているかというと、共用計算機上でのジョブのスケジュールらしい
    • これは実行待ちのジョブとそれらの相対的な優先度を持っている
use strict;
use warnings;

sub parent {
    my $i = shift;
    return int($i/2);
}

sub left {
    my $i = shift;
    return 2 * $i;
}

sub right {
    my $i = shift;
    return 2 * $i + 1;
}

sub heap_size {
    my $a = shift;
    my $length = @$a; # 配列をスカラーに代入すると長さが得られる
    return $length;
}

sub heap_print {
    sub heap_print_internal {
	my ($a, $i, $indent) = @_;
	if ($i <= @$a) {
	    print " " x $indent, @$a[$i-1], "\n";
	    &heap_print_internal($a, &left($i), $indent + 1);
	    &heap_print_internal($a, &right($i), $indent + 1);
	}
    }
    my $a = shift;
    &heap_print_internal($a, 1, 0);
}

sub max_heapify {
    my ($a, $i) = @_;
    my $l = &left($i);
    my $r = &right($i);
    my $largest = undef;
    if ($l <= heap_size($a) && @$a[$l -1] > @$a[$i -1]) {
	$largest = $l;
    } else {
	$largest = $i;
    }

    if ($r <= heap_size($a) && @$a[$r -1] > @$a[$largest -1]) {
	$largest = $r;
    }

    if ($largest != $i) {
        my $tmp = undef;
	# swap
	$tmp =  @$a[$i-1];
	@$a[$i-1] = @$a[$largest -1];
	@$a[$largest -1] = $tmp;
	
	max_heapify($a, $largest);
    }
}

sub heap_extract_max {
    my $a = shift;
    # ToDo : implement error
    my $max = @$a[0];
    @$a[0] = @$a[@$a - 1];
    pop(@$a); # 一番低い順位のものが上にくるようにして、buildしなおす
    &max_heapify($a,1);
    return $max;
}

sub heap_sort {
    my $a = shift;
    &build_max_heap($a);
    my @result =();
    foreach (reverse(1..@$a)) { # 本には2まででよいと書いてあるけど、プログラムの戻り値としては1のほうがやりやすい
	print "[", join(",", @$a), "] -> ";
	# swap
	my $tmp =  @$a[0];
	@$a[0] = @$a[$_ - 1];
	@$a[$_ - 1] = $tmp;

	unshift(@result, pop(@$a));
	&max_heapify($a,1);

	print "[", join(",", @$a), "].\n";
	print "result : [", join(",", @result), "].\n";
    }
    return @result;
}

# priority queue starts from here
sub heap_maximum {
    my $a = shift;
    return @$a[0];
}

sub heap_extract_max {
    my $a = shift;
    # ToDo : implement error
    my $max = @$a[0];
    shift(@$a);
    &max_heapify($a,1);
    return $max;
}

sub heap_increase_key {
    my ($a, $i, $key) = @_;
    # ToDo : implement error
    @$a[$i-1] = $key;

    while ($i > 1 && @$a[&parent($i)-1] < @$a[$i-1]) {
	# swap
	my $tmp =  @$a[$i -1];
	@$a[$i -1] = @$a[&parent($i)-1];
	@$a[&parent($i)-1] = $tmp;

	$i = &parent($i);
    }
}

my @a = (16, 14, 10, 8, 7, 9, 3, 2, 4, 1);
print "=" x 35, "\n";
print "initial heap is as follows.\n";
&heap_print(\@a);
print "=" x 35, "\n";
print "maximum value in this heap is ", &heap_extract_max(\@a), ".\n";
print "=" x 35, "\n";
print "before inserting key into heap...\n";
print "=" x 35, "\n";
&heap_print(\@a);
&heap_increase_key(\@a, 9, 15);
print "after inserting key into heap...\n";
print "=" x 30, "\n";
&heap_print(\@a);

実行結果。

/tmp% perl priority_queue.pl
===================================
initial heap is as follows.
16
 14
  8
   2
   4
  7
   1
 10
  9
  3
===================================
maximum value in this heap is 16.
===================================
before inserting key into heap...
===================================
14
 10
  7
   4
   1
  9
 8
  3
  2
after inserting key into heap...
==============================
15
 14
  10
   4
   7
  9
 8
  3
  2

で、これだけだと面白くないので、jobもどきっぽいものを作ってみることにした。最初にいくつかjobを追加して、いくつかこなす。優先度の変更があった上で、残り全部のjobを消化するという流れになっている。

my @a = (1, 2, 3, 1, 2, 1, 1, 3, 1, 3, 2);
&build_max_heap(\@a);
print "=" x 40, "\n";
print "initial priority heap is as follows.\n";
&heap_print(\@a);

print "=" x 40, "\n";
foreach (1..5){
    print "done the job which priority is ", &heap_extract_max(\@a), "\n";
}
print "=" x 40, "\n";

print "increase the some priority of some jobs...\n";
&heap_increase_key(\@a, 4, 3);
&heap_increase_key(\@a, 6, 3);

print "=" x 40, "\n";
print "priority heap's state is now as follows.\n";
&heap_print(\@a);

while (@a > 0) {
    print "done the job which priority is ", &heap_extract_max(\@a), "\n";
}

print "all jobs have done!!\n";

実行結果。

/tmp% perl priority_queue.pl       
========================================
initial priority heap is as follows.
3
 3
  2
   1
   1
  2
   1
   2
 3
  1
  1
========================================
done the job which priority is 3
done the job which priority is 3
done the job which priority is 3
done the job which priority is 2
done the job which priority is 2
========================================
increase the some priority of some jobs...
========================================
priority heap's state is now as follows.
3
 2
  1
  1
 3
  1
done the job which priority is 3
done the job which priority is 3
done the job which priority is 2
done the job which priority is 1
done the job which priority is 1
done the job which priority is 1
all jobs have done!!

優先度の高いjobから消化され、優先度の変更があってもちゃんと優先度が高い順からこなされていることが確認できた!!