Perlゼミ

  1. Perl
    2. ›
  2. サブルーチン
    3. ›
  3. here

サブルーチンの演習問題

サブルーチンの具体的な例を使って学ぶために、いくつかの例を挙げて、解説します。

csv形式の文字列を配列の配列に変換する

csv形式の文字列を配列の配列に変換するサンプルです。 

use strict;
use warnings;

# 名前,年齢,出身
my $text = << 'EOS';
tora,24,Japan
rika,12,USA
kenta,25,Chinese
EOS

print "1: csv形式の文字列を、配列の配列に変換する。\n";
my $persons = parse($text);

require Data::Dumper;
print Data::Dumper->Dump([$persons], ['$perlsons']);

sub parse{
  my $text = shift;
  my @lines = split("\n", $text);
  
  my $items_list = [];
  for my $line ( @lines ){
    my @items = split(',', $line);
    push @$items_list, [@items];
  }
  
  wantarray ? return @$items_list : $items_list; 
}

変換のイメージ

|------------------|
| tora,24,Japan    |
| rika,12,USA      |
| kenta,25,Chinese |
|------------------|
        ↓
[
  [ tora, 24, Japan ],
  [ rika, 12, USA ],
  [ kenta, 25, Chinese ],
]
  • テキストを、配列の配列に変換します。

(1)ヒアドキュメントのわからない人は。

my $text = << 'EOS';
tora,24,Japan
rika,12,USA
kenta,25,Chinese
EOS

ヒアドキュメントを参照。

(2)サブルーチンの呼び出し

my $persons = parse($text);

parse というサブルーチンに、 $text という引数を渡してあげます。こうすると、parse が、実行されて、その戻り値が、$person に代入されます。

(3)配列の配列の作成の方法

push @$items_list, [@items];

push関数は、第一引数に、配列を要求します。@$items_list と、デリファレンスして、配列を渡します。

push関数は、第二引数以降は、リストを要求しますが、@items として、配列を渡してはいけません。そうすると最終的に、 

[tora, 24, Japan,rika, 12, USA, kenta, 25, Chinese]

という配列ができてしまいます。[@items]として、配列へのリファレンスを作成してあげて、これをpushします。

(4)戻り値を選択的に返却する

wantarray ? return @$items_list : $items_list;

wantarray関数を使って戻り値をコンテキストに応じて返却することができます。(現在の僕はwantarrayは非推奨)

csv形式の文字列をハッシュの配列に変換する

csv形式の文字列をハッシュの配列に変換するサンプルです。 

use strict;
use warnings;

# 名前,年齢,出身
my $text = << 'EOS';
tora,24,Japan
rika,12,USA
kenta,25,Chinese
EOS

print "1: csv形式の文字列を、ハッシュの配列に変換する。\n";
my $headers = ['name', 'age', 'country'];

my $persons = parse($text, $headers);

require Data::Dumper;
print Data::Dumper->Dump([ $persons], ['$perlsons']);

sub parse{
  my ($text, $headers) = @_;
  
  my @lines = split("\n", $text);
  
  my $items_hash_list = [];
  foreach my $line (@lines) {
    my @items = split(',', $line);
    
    my %items_hash = ();
    @items_hash{@$headers} = @items;
    
    push @$items_hash_list, {%items_hash}; 
  }
  
  wantarray ? return @$items_hash_list : $items_hash_list;
}

変換のイメージ

|------------------|
| tora,24,Japan    |
| rika,12,USA      |
| kenta,25,Chinese |
|------------------|
        ↓
[
    {
      'country' => 'Japan',
      'name' => 'tora',
      'age' => '24'
    },
    {
      'country' => 'USA',
      'name' => 'rika',
      'age' => '12'
    },
    {
      'country' => 'Chinese',
      'name' => 'kenta',
      'age' => '25'
    }
]

テキストを、配列の配列に変換します。

(1)サブルーチンの呼び出し

my $persons = parse($text, $headers);

parse というサブルーチンに、 $text と $header という引数を渡してあげます。ヘッダも一緒に渡すことで、サブルーチンの中で、ヘッダ名を書く必要がなくなります。

サブルーチンの中で、ヘッダ名を書いてしまうと、サブルーチンとヘッダ名が、密に結合してしまいサブルーチンの汎用性が失われます。ヘッダ名を引数として与えることで、どのようなcsv形式の文字列に対しても、このサブルーチンを活用することができます。

(2)ハッシュの配列の作成の方法

for my $line (@lines){
  my @items = split(',', $line);
    
  my %items_hash = ();
  @items_hash{@$headers} = @items;
    
  push @$items_hash_list, {%items_hash}; 
}

ハッシュスライスを用いて、ヘッダに対応するハッシュを作成します。 

@items_hash{@$headers} = @items;

# 以下と同じ意味
@items_hash{('name', 'age', 'country') = ('tora', 24, 'Japan');

# 分解すると
$items_hash{name} = 'tora';
$items_hash{age} = 24;
$items_hash{contry} = 'Japan';

このようにハッシュスライスを用いると、繰り返しを記述する必要がなくなります。 

push @$items_hash_list, {%items_hash};

push関数は、第二引数以降は、リストを要求しますが、%items_hash として、ハッシュを渡してはいけません。そうすると最終的に{%items_hash} として、ハッシュへのリファレンスを作成して、これをpushします。

最大値と最小値を求める

最大値と最小値を求めるサンプルです。 

use strict;
use warnings;

my @nums = (1, 2, 3);

print "1:最大値,最小値を求めるサブルーチン\n";
print "(" . join(',', @nums) . " )\n";
print "最大値 :" . max(@nums) . "\n"; 
print "最小値 :" . min(@nums) . "\n"; 

sub max{
  my @nums = @_;
  
  my $max_num;
  for my $num (@nums) {
    if (!defined $max_num) {
      $max_num = $num;
    }
    else{
      if ($num > $max_num) {
        $max_num = $num;
      }
    }
  }
  return $max_num;
}

sub min{
  my $min_num;
  for my $num (@nums) {
    if (!defined $min_num){
      $min_num = $num;
    }
    else {
      if ($num < $min_num){
        $min_num = $num;
      }
    }
  }
  return $min_num;
}

(1) 最大値を求めるアルゴリズム

sub max{
  my @nums = @_;
  
  my $max_num;
  for my $num (@nums) {
    if (!defined $max_num) {
      $max_num = $num;
    }
    else{
      if ($num > $max_num) {
        $max_num = $num;
      }
    }
  }
  return $max_num;
}

配列を入力として、最大値が出力になるサブルーチンです。最大値だと仮定したものを、変数に代入して残していきます。最後に残った $max_num が、最大値であるとわかります。数学とは異なるプログラミングの独特の考え方です。

最初は $max_num、未定義値なので、未定義値だった場合は比較を行わずに、$max_num に $num を代入しています。

バブルソートする

バブルソートするサンプルです。while文やfor文を使って、並べ替えを行っています。 

use strict;
use warnings;

my @nums = (5, 2, 7, 3, 4);

print "1: バブルソ\ートで昇順に並べ替えるサブルーチン\n";
print join(',', @nums) . " (最初の状態)\n";
my @sorted_nums_ascend = bubble_sort_ascend(@nums);
print join(',', @sorted_nums_ascend) . " (最後の状態)\n\n";

print "2: バブルソ\ートで降順に並べ替えるサブルーチン\n";
print join(',', @nums) . " (最初の状態)\n";
my @sorted_nums_descend = bubble_sort_descend(@nums);
print join(',', @sorted_nums_descend) . " (最後の状態)\n";

# バブルソートするサブルーチン。( 昇順 )
sub bubble_sort_ascend{
  my @nums = @_;
  if (@nums < 2) {
    return @nums;
  }
  
  my $change_cnt = @nums - 1;

  # 要素数nの配列 a があるとすると、 
  # 最初は、n - 1 回の交換をする。
  # a[0] と a[1], a[1] と a[2], .... ,a[n-2] と a[n-1]

  # ２回目は、n - 2 回の交換をする
  # a[0] と a[1], a[1] と a[2], .... ,a[n-3] と a[n-2]

  # 最後は、
  # a[0] と a[1] を交換する。

  # バブルソートでは、交換が一周するたびに、最大値が
  # 確定していきますので、交換が一周するたびに、
  # 交換回数を、１減らします。
                       
  while( $change_cnt > 0 ){
    for my $i (0 .. $change_cnt - 1) { 
       
     # 次の数と比べて自分のほうが大きければ交換、
     # 自分のほうが小さければ何もしない。
     # こうすることで、一番最後の要素が、最大になる。
     if ($nums[$i] > $nums[$i + 1]) {
       ($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
       print join(',', @nums) . " (スナップ)\n";
     }
    }
    $change_cnt--;
  }
  
  return @nums;
}

# バブルソートするサブルーチン。( 降順 )
sub bubble_sort_descend{
  my @nums = @_;
  if( @nums < 2 ){
    return @nums;
  }
  
  my $change_cnt = @nums - 1;
                       
  while ($change_cnt > 0) {
    for my $i (0 .. $change_cnt - 1){ 
     if ($nums[$i] < $nums[$i + 1]) {
       ($nums[ $i ], $nums[ $i + 1]) = ($nums[$i + 1], $nums[$i]);
       print join(',', @nums) . " (スナップ)\n"; 
     }
    }
    $change_cnt--;
  }
  
  return @nums;
}

バブルソートとは

バブルソートとは、隣合う数を比較し、自分のほうが次の数よりも大きければ交換して、最終的に並べ替えを行うアルゴリズムのことです。( 昇順の場合 )

バブルソートの過程( 5,4,3,2,1 の場合 )

# 1週目

5,4,3,2,1 ( 5 と 4 が交換される。 )

4,5,3,2,1 ( 5 と 3 が交換される )

4,3,5,2,1 ( 5 と 2 が交換される )

4,3,2,5,1 ( 5 と 1 が交換される )

4,3,2,1,5 ( 5が最大値に確定して、次は、前４つで同様の交換をおこなう。 )

# 2週目

4,3,2,1,5

3,4,2,1,5

3,2,4,1,5

3,2,1,4 5 ( 4が最大値に確定して、次は、前3つで同様の交換をおこなう。 )

#3週目 以下同様

降順と昇順を選択してバブルソートする

前回のバブルソートを工夫して、降順と昇順の選択をできるようにしたものです。エラー処理も加えました。 

use strict;
use warnings;

my @nums = (5,2,7,3,4);
print "1: 降順と昇順を選択してバブルソ\ ートするサブルーチン\n";
print join(',', @nums) . " (最初の状態)\n";

my @sorted_nums_ascend = bubble_sort(\@nums, {order => 'ascend'});
my @sorted_nums_descend = bubble_sort(\@nums, {order => 'descend'});

if (@sorted_nums_ascend) {
  print join(',', @sorted_nums_ascend) . " (昇順)\n";
}
else {
  print "\@sorted_nums_ascend は空リストです。\n";
}

if (@sorted_nums_descend) {
  print join(',', @sorted_nums_descend) . " (降順)\n\n";
}
else {
  print "\@sorted_nums_descend は空リストです。\n\n";
}

# 降順と昇順を選択してバブルソートするサブルーチン
sub bubble_sort{
  my ($nums, $opt) = @_; 
  
  # エラー処理
  my @nums;
  # $nums が、配列のリファレンスかどうかのチェック。
  if (defined $nums){
   if (ref $nums eq 'ARRAY') {
     @nums = @$nums
   }
   else { return }
  }
  else{ return }
  
  my $order = 'ascend';
  # $opt が、ハッシュのリファレンスであるかどうかのチェック
  if (defined $opt) {
    if (ref $opt eq 'HASH') {
      # $opt->{order} が真値ならば代入。
      $order = $opt->{order} if $opt->{order}; 
      
      unless ($order eq 'ascend' || $order eq 'descend') {
        return;
      }
    }
    else { return }
  }

  # 本処理
  if (@nums < 2) {
    return @nums;
  }
  
  my $change_cnt = @nums - 1;
                       
  while ($change_cnt > 0) {
    for my $i (0 .. $change_cnt - 1) {
      # 昇順と降順を選択するには、前回からこの部分だけを書き直せばよい。
      my $is_change;
      if ($order eq 'ascend') {
        # 昇順の場合は、$nums[$i] > $nums[$i+ 1 ] ならば交換する
        $is_change = $nums[$i] > $nums[$i + 1];
      }
      elsif ($order eq 'descend') {
        # 降順の場合は、$nums[$i] < $nums[$i+ 1 ] ならば交換する
        $is_change = $nums[$i] < $nums[$i + 1];
      }

      if ($is_change) {
        ($nums[$i], $nums[$i+ 1]) = ($nums[$i+ 1 ], $nums[$i]);
      }
    }
    $change_cnt--;
  }
  
  return @nums;
}

(1) 引数の解説( オプションは、ハッシュへのリファレンスで渡してあげる )

my @sorted_nums_ascend = bubble_sort(\@nums, {order => 'ascend'});

配列とハッシュを渡して上げたいので、リファレンスを使います。実際のプログラミングでは、オプションをハッシュのリファレンスで渡してあげることが多いです。

(2) エラー処理

my @nums;
if (defined $nums) {
  if (ref $nums eq 'ARRAY') {
    @nums = @$nums;
  }
  else { return }
}
else { return }

第一引数が定義されていないときはreturnで、処理を終わります。第一引数が定義されていても、第一引数が、配列へのリファレンスでない場合は、return で処理を終わります。

変数に不正な状態がある場合は、処理を続けてはいけません。致命的なエラーならば、die関数を使って例外を投げるのもよいでしょう。

(3)デフォルト値を設定しておく

my $order = 'ascend';
$order = $opt->{order} if $opt->{order};

$opt->{order}の指定がなければ、エラーで返すのではなく、デフォルト値を指定しておｋ親切なやり方です。$opt->{order} がある場合だけ上書きします。

(4)昇順と降順のアルゴリズムを選択する

# 前回のバブルソート
if ($nums[$i] < $nums[$i + 1]) {
  ($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
  print join(',', @nums) . " (スナップ)\n"; 
}

# 今回のバブルソート
my $is_change;
if ($order eq 'ascend') {
  $is_change = $nums[$i] > $nums[$i + 1];
}
elsif ($order eq 'descend') {
  $is_change = $nums[$i] < $nums[$i + 1];
}

if ($is_change) {
  ($nums[$i], $nums[$i + 1]) = ($nums[$i + 1], $nums[$i]);
}

ascend の場合は、$nums[$i] > $nums[$i + 1] という判定を行い、descend の場合は、$nums[$i] < $nums[$i + 1] という判定を行えばよいです。

このようなアルゴリズムは、最初からいっぺんに考えるよりも、今回のように別々に作って違いのある部分だけに着目して改造したほうが見通しがたちやすいです。

業務に役立つPerl

Perlテキスト処理のエッセンス

PerlでポータブルなLinuxファイル管理入門

ITエンジニアの求人情報など

　ITエンジニアの求人情報・Webサービス・ソフトウェア・スクールなどの情報。

システム開発のお問い合わせ

Perlクラブ