Perl / 技術情報 / アルゴリズムルーレット選択

  • ある集合の要素はそれぞれ重みを持っている。
  • 例えばそれぞれの重みが @rate = (60,30,10) だとして、それぞれに対して累計 @total = (60,90,100) を求める。
  • それぞれの累計の値は、それぞれの要素の数直線上の値を表すと考えると良い。
  • 次に累計の範囲内でランダムな値を決め、それぞれの累計の値と比較すれば、対応する要素が求まる。
  • 以下のroulette1()/roulette2()はその実装。

#!/usr/local/bin/perl

use strict;
use warnings;
use Data::Dumper;

my @rate = (60,30,10);

my @result1;
foreach ( 1 .. 100000 ) {
 my $idx = roulette1(@rate);
 $result1[$idx]++;
}
print Dumper \@result1;

my @result2;
foreach ( 1 .. 100000 ) {
 my $idx = roulette2(@rate);
 $result2[$idx]++;
}
print Dumper \@result2;

sub roulette1 {
 my @rate = @_;
 my @total;
 $total[0] = $rate[0];
 for ( my $i = 1 ; $i < @rate ; $i++ ) {
     $total[$i] = $total[ $i - 1 ] + $rate[$i];
 }
 my $rand = int( rand( $total[ @total - 1 ] ) ) + 1;
 my $idx  = 0;
 while ( $rand > $total[$idx] ) {
     $idx++;
 }
 return $idx;
}

sub roulette2 {
 my @rate = @_;
 my $total;
 foreach my $n (@rate) {
     $total += $n;
 }
 my $rand = int( rand($total) ) + 1;
 my $idx = 0;
 for ( ; $idx < @rate ; $idx++ ) {
     $rand -= $rate[$idx];
     if ( $rand <= 0 ) {
         last;
     }
 }
 return $idx;
}

Perl / 技術情報 / アルゴリズムビット演算による権限制御

#!/usr/bin/env perl

use strict;
use warnings;
use 5.012;

# 権限を設定
my $none    = 0x0;
my $read    = 0x1 << 0;
my $write   = 0x1 << 1;
my $execute = 0x1 << 2;
my $extra   = 0x1 << 3;

# 権限を付与
my $all = $none | $read | $write | $execute;

# 権限をはく奪
my $not_all = $all & ~$read;

my %actions = (
 +read    => $read,
 +write   => $write,
 +execute => $execute,
 +extra   => $extra,
);

# 権限を2進数で確認
printf( "%- 10s%04bn", "none",    $none );     # none      0000
printf( "%- 10s%04bn", "read",    $read );     # read      0001
printf( "%- 10s%04bn", "write",   $write );    # write     0010
printf( "%- 10s%04bn", "execute", $execute );  # execute   0100
printf( "%- 10s%04bn", "extra",   $extra );    # extra     1000
printf( "%- 10s%04bn", "all",     $all );      # all       0111
printf( "%- 10s%04bn", "not_all", $not_all );  # not_all   0110

say '';

# 各権限の内容を確認
if (($all & $read) != 0) {           
 say "all can read ? => OK";                 # all can read ? => OK
} else {                             
 say "all can read ? => NG";      
}                                    

if (($write & $read) != 0) {         
 say "write can read ? => OK";               # write can read ? => NG
} else {                             
 say "write can read ? => NG";    
}                                    

if (($not_all & $read) != 0) {       
 say "not_all can read ? => OK";             # not_all can read ? => NG
} else {                             
 say "not_all can read ? => NG";  
}

if (($not_all & $write) != 0) {       
 say "not_all can write ? => OK";             # not_all can write ? => OK
} else {                             
 say "not_all can write ? => NG";  
}

say '';

while ( my ( $k, $v ) = each %actions ) {       # all can execute ? => OK
 if ( ( $all & $v ) != 0 ) {                 # all can read ? => OK
     say "all can $k ? => OK";               # all can extra ? => NG
 }                                           # all can write ? => OK
 else {                                
     say "all can $k ? => NG";         
 }                                     
}                                         

say '';

while ( my ( $k, $v ) = each %actions ) {       # extra can execute ? => NG
 if ( ( $extra & $v ) != 0 ) {               # extra can read ? => NG
     say "extra can $k ? => OK";             # extra can extra ? => OK
 }                                           # extra can write ? => NG
 else {
     say "extra can $k ? => NG";
 }
}

Perl / 技術情報 / アルゴリズムビット演算

左にシフト

say 3<<1; # 6
say 3<<2; # 12
say 3<<3; # 24

1ビット、左にシフトすると、数は2倍になる。

右にシフト

say 24>>1; # 12
say 24>>2; # 6
say 24>>3; # 3
say 24>>4; # 1
say 3 / 2; # 1.5

1ビット、右にシフトすると、数は半分になる。

あるビット列について、特定のビットだけ取り出す

my $num = 25;
my $pos = 3;
my $bit_mask = 1<<$pos;

printf "%b\n", $num;       # 11001
printf "%b\n", $bit_mask;  #  1000

say $num & $bit_mask;      # 8
say 25 & (1<<3);           # 8
  • 特定のビットは1<<nで表せる。これをビットマスクと呼ぶ。
  • あるビット列について、ビットマスクと論理積(&)を取ると、特定のビットを取り出せる。
  • 上の例では、あるビット列(11001/25)の3番目(一番下の桁を0番目とする)のビットを取り出してる。

あるビット列について、特定のビットをセットする

my $num = 25;
my $pos = 2;
my $bit_mask = 1<<$pos;

printf "%b\n", $num;           # 11001
printf "%b\n", $bit_mask;      #   100

say $num | $bit_mask;          # 29
say 25 | (1<<2);               # 29
printf "%b\n", (25 | (1<<2));  # 11101

* あるビット列について、ビットマスクと論理和(|)を取ると、特定のビットをセットできる。
* 上の例では、あるビット列(11001/25)の2番目のビットをセットしてる。

あるビット列について、特定のビットをクリアする

my $num = 25;
my $pos = 3;
my $bit_mask = 1<<$pos;

printf "%b\n", $num;           # 11001
printf "%b\n", ~$bit_mask;     # 11111111111111111111111111110111

say $num & ~$bit_mask;         # 17
say 25 & ~(1<<3);              # 17
printf "%b\n", (25 & ~(1<<3)); # 10001
  • あるビット列について、論理否定(~)したビットマスクと論理積(&)を取ると、特定のビットをクリアできる。
  • 上の例では、あるビット列(11001/25)の3番目のビットをクリアしてる。

n進数を10進数に変換

say oct("011");    # 8進数→10進数 「9」
say oct("0xA1");   # 16進数→10進数 「161」
say oct("0b101");  # 2進数→10進数 「5」
say oct("11");     # 8進数→10進数 「9」