totofugaのブログ

ネットワークとかc言語、perlの話。

gauss-jordan法

perl アルゴリズム 
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my $a = [
    [1, -1, 1],
    [2, 1, -3],
    [3, 2, -1],
];

my $b = [
    [-5],
    [19],
    [16],
];

gauss_jordan($a, $b);

print Dumper($a);
print Dumper($b);

sub gauss_jordan {
    my ($a, $b) = @_;

    my $n = scalar @$a;
    my $m = scalar @{$b->[0]};

    my @check;
    my @switch;
    for my $i ( 0.. $n - 1 ) {

        # まだ使用していない行の最大値を取得する
        my $max_row;
        my $max_col;

        for my $j ( 0.. $n - 1 ) { # 行

            if ( $check[$j] ) { next };
            for my $k ( 0.. $n - 1 ) { # 列

                if ( $check[$k] ) { next };

                if ( !defined $max_row  || abs($a->[$max_row][$max_col]) < abs($a->[$j][$k]) ) {
                    $max_row = $j;
                    $max_col = $k;
                }
            }
        }

        $check[$max_col] = 1;

        if ( $max_row != $max_col ) {
            # 行入れ替え
            ($a->[$max_col], $a->[$max_row]) = ($a->[$max_row], $a->[$max_col]);
            ($b->[$max_col], $b->[$max_row]) = ($b->[$max_row], $b->[$max_col]);
            push @switch, [$max_col, $max_row];
        }

        # 対象行の処理
        my $pivnv = 1 / $a->[$max_col][$max_col];

        $a->[$max_col][$max_col] = 1;

        foreach ( @{$a->[$max_col]} ) {
            $_ *= $pivnv;
        }

        foreach ( @{$b->[$max_col]} ) {
            $_ *= $pivnv;
        }

        # 対象以外の行
        foreach my $l ( 0.. $n - 1 ) {
            next if ( $l == $max_col );

            my $dum = $a->[$l][$max_col]; # $a->[$l][$max_col] / 1

            $a->[$l][$max_col] = 0;

            foreach my $p ( 0.. $n - 1 ) {
                $a->[$l][$p] -= $a->[$max_col][$p] * $dum;
            }

            foreach my $p ( 0.. $m - 1 ) {
                $b->[$l][$p] -= $b->[$max_col][$p] * $dum;
            }
        }
    }
    for my $c (@switch) {
        foreach my $i (0.. $n - 1) {
            my $tmp = $a->[$i][$c->[0]];
            $a->[$i][$c->[0]] = $a->[$i][$c->[1]];
            $a->[$i][$c->[1]] = $tmp;
        }
    }
}

NUMERICAL RECIPED in Cのをperlで書き直してみた。 中学とかで習う連立方程式を解くやり方をそのままプログラムにした方法

bには結果が返り、 計算に必要なくなった列を単位行列として変換していくためaには逆行列が返る。

内部探索(interpolation search)

perl アルゴリズム

データが均等なランダムの場合loglogNの速度になるため、 binary searchより効率がよくなるが、 一つの計算時間は増えるため、データがかなり大きい場合にのみ有効。

やってることは、binary searchのメディアンの選び方を現在のデータから 有効そうな位置を取得してるだけ。

http://en.wikipedia.org/wiki/Interpolation_search

perlの実装

my @a = map { int (rand() * 100) } 0..99;
@a = sort { $a <=> $b } @a;
my $i = find(\@a, 50);

if ( $i ) {
    print "============find===============\n";
    print "index: $i\n";
    print "value: $a[$i]\n";
    print "===============================\n";
} else {
    print "============not find===============\n";
}



# interpolation search
# 内挿探索

sub find {
    my ($a, $v) = @_;

    my $l = 0;
    my $r = $#$a;

    while ( $a[$l] <= $v && $a[$r] >= $v ) {
        my $mid = int($l + ($v - $a[$l]) *  ($r - $l) / ( $a->[$r] - $a->[$l] ));

        if ( $a[$mid] > $v ) {
            $r = $mid - 1;
        }elsif ( $a[$mid] < $v ) {
            $l = $mid + 1;
        }else{
            return $mid;
        }
        print $l. ":". $r. "\n";
    }

    return undef;
}

グラフ

アルゴリズム perl

グラフの内部表現で通常c言語だと エッジの数によって隣接行列か隣接リストのどっちかで表すが、

メモリと速度をあまり気にしない場合perlだと ハッシュを使った下記のような形で作るのが簡単。

my $adj;

sub add_connect {
    my ($a, $b) = @_;

    $adj->{$a}->{$b} = 1;
}

sub del_connect {
    my ($a, $b) = @_;

    $adj->{$a}->{$b} = 0;
}

sub to_connects {
    my ($node) = @_;
    return grep { $adj->{$node}->{$_} } keys %{$adj->{$node}};
}

sub from_connects {
     my ($node) = @_;
     return grep { $adj->{$_}->{$node} } keys %$adj;
}

dfsとbfsだとこんな感じ。

# dfs(深さ優先探索)
my %mark;
sub dfs_search {
    my ($node) = @_;
    return 0 if $mark{$node}++;

    print $node. "|";

    foreach my $next_node ( to_connects($node) ) {
        dfs_search($next_node);
    }
    return 1;
}

# bfs(幅優先探索)
my %mark;
while (@a) {
    my $node = shift @a;

    next if ( $mark{$node}++ );
    print $node. "|";

    foreach my $next_node ( to_connects($node) ) {
        push @a, $next_node;
    }
}

ヒープ木

アルゴリズム perl

順位キューで挿入と探索をlogNで行いたいときに使う

二分ヒープ - Wikipedia

挿入のときは最下層の一番左に挿入して補正 取り出すときは一番上から取得 => 最下層の一番左にあったものを上に付けて補正

を行うので常に完全バランスが取れて、左からノードが埋まっていく。

perlでのheap実装

# heap木

my @a = (7,  2, 3);
foreach ( @a ) {
    heap_insert($_);
}

my $ret;

while ( $ret = heap_remove() ) {
    print $ret. "\n";
}

my @heap;

sub heap_remove {

    return unless ( @heap );

    if ( @heap == 1 ) {
        return pop @heap;
    }

    my $top = $heap[0];
    $heap[0] = pop @heap;
    top_down(0);

    return $top;
}

sub heap_insert {
    my ($data) = @_;
    my $n = scalar @heap;
    $heap[$n] = $data;

    bottom_up($n);
}

sub bottom_up {
    my ($index) = @_;

    return if ( $index == 0 );

    my $parent_index = int ( ( $index + 1 ) / 2 ) - 1;
     if ( $heap[$index] > $heap[$parent_index] ) {

         @heap[$index, $parent_index] = @heap[$parent_index, $index]; # swap
         bottom_up($parent_index);
     }
 }

 sub top_down {
     my ($index) = @_;

     my $n = scalar @heap;

     my $l = ($index + 1) * 2 - 1;
     my $r = $l + 1;

     if ( $l < $n && $heap[$l] > $heap[$index] ) {
         @heap[$l, $index] = @heap[$index, $l];
         top_down($l);
     } elsif ( $r < $n && $heap[$r] > $heap[$index] ) {
         @heap[$r, $index] = @heap[$index, $r];
         top_down($r);
     }
 }

データは配列として格納する。 一つ上のノードにアクセスする場合は /2 一つ下のノードにアクセスする場合は *2 をする。

アセンブラからELF

アセンブラ

64bitに以降したら

nasm -f elf test.asm
ld test.o

としていたアセンブラから実行ファイルへの変換が動かなくなっていた

could not read symbols: File in wrong format

の様なエラーが出る。 どうやら-m elf_i386を指定しないといけないらしい。

#!/bin/sh

if [ ! $# -eq 1 ]; then
        echo "please set asmfile"
        exit 1
fi

if [ ! -f $1 ]; then
        echo "file not fount" 1>&2
        exit 1
fi

BASE_NAME=${1%.*}

nasm -f elf ${1} -o ${BASE_NAME}.o
ld -e main -m elf_i386 -o ${BASE_NAME} ${BASE_NAME}.o

rm -rf ${BASE_NAME}.o

こんな感じに修正した。

サーバーで複数ポートを待ち受ける

perl

socketは普通にacceptすると処理をblockしてしまうので複数のポートの待ちうけが出来ません。 acceptする前にIO->Selectのcan_readを使用することにより複数ポートの待ちうけが可能になります。

#!/usr/bin/perl                                      
use strict;                                          
use warnings;                                        
use IO::Socket;                                      
use IO::Select;                                      
                                                     
my @ports = (6000, 7000);                            
                                                     
my $select = IO::Select->new;                        
                                                     
foreach my $port ( @ports ) {                        
    my $listen = IO::Socket::INET->new(              
        Listen => SOMAXCONN,                         
        LocalPort => $port,                          
        Proto => 'tcp',                              
    ) or die $@;                                     
                                                     
    $select->add($listen);                           
}                                                    
                                                     
my @handles;                                         
while(@handles = $select->can_read) {                
    foreach my $handle (@handles) {                  
        my $new = $handle->accept();                 
        if ( my $pid = fork ) {                      
            $new->close();                           
        } else {                                     
                                                     
            select($new);                            
            print "connect to @{[$new->sockport]}\n";
            exit(0);                                 
        }                                            
    }                                                
}

telnetでアクセスすると6000と7000どちらのポートでもアクセスできることを確認できます。

$telnet localhost 6000
Trying ::1...
telnet: connect to address ::1: Connection refused
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
connect to 6000
Connection closed by foreign host.
$ telnet localhost 7000
Trying ::1...
telnet: connect to address ::1: Connection refused
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
connect to 7000
Connection closed by foreign host.

perl: warning: Please check that your locale settings:　ワーニングの対処法

perl

CentOSにて /etc/sysconfig/i18nで LANG="ja_JP.UTF-8" 言語設定を行った時に

# perl -v 

perl: warning: Setting locale failed.
perl: warning: Please check that your locale settings:
    LANGUAGE = (unset),
    LC_ALL = (unset),
    LANG = "ja_JP.UTF-8"
    are supported and installed on your system.
perl: warning: Falling back to the standard locale ("C").

This is perl, v5.10.1 (*) built for x86_64-linux-thread-multi

Copyright 1987-2009, Larry Wall

Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.

Complete documentation for Perl, including FAQ lists, should be found on
this system using "man perl" or "perldoc perl".  If you have access to the
Internet, point your browser at http://www.perl.org/, the Perl Home Page.

と出て来た場合の対処法です。

まずlocaleでja_JP.utf8があるか確認します。(多分無い)

locale -a

でja_JP.utf8無い場合は 以下に進んでください

glibc-commonパッケージになっていたので 多分あるのでここ飛ばしてもよいですが念のため /usr/share/i18n/charmaps にUTF-8.gzがあることを確認 /usr/share/i18n/locales にja_JPがあることを確認

localeを作成します。

sudo localedef -i ja_JP -f UTF-8 ja_JP.utf8

再びlocaleコマンドを実行するとja_JP.utf8が出来たことを確認してください。

locale -a

これでwarningが無くなります