双方向リスト(？)

質問

単方向じゃなくて双方向でなおかつ切り替え可能なリファレンスがほしいです。

AAA = bbb とするとき、
AAAからbbbを返し、bbbからAAAを返す物がほしい。
さらに、AAA = ccc と書き換えた場合、
bbbとの関係は解除される。

具体的には、座標 x y に物体 a とb があるとき、
xyからaとbが得られます。
a b 自体はそれぞれリファレンスであり、物体の詳細データが書き込まれてます。
同様、xyもリファレンスであり、位置についての情報が書き込まれています。

ここまでは単純な相互参照で解決できるのですが、
困ったことに物体は移動をおこないます。車が走って隣町に行くように。

その時、座標から物体にアクセスする場合と、
物体から座標にアクセスする場合がおかしくならないように一発で解決する手段を教えてください。

なお、現在は全く無関係な単方向なリファレンス(ようは普通のリファレンス)を二つもちいています。
位置を書き換えるときは、物体から座標にアクセスし、
その座標から自分自身へのリンクを検索し、
そして削除し、
自分自身の座標へのリンクを削除し、
自分自身の新しい座標へのリンクを埋め込み、
そしてその座標にアクセスし、
自分自身へのリンクを埋め込むという、かなりカオスなことになっています。

普通、位置と物体って同時に平等に存在するものじゃなかったっけ？うーむ。

記述がカオスにならない良い方法を教えてください。
あと、何万回もループするプログラムなので出来れば速いやつがいいです。

回答No.2

_--_1l1_1_ · ベストアンサー

位置が決まれば、そこに物体があると。。。？これもうわかんねぇな。

なお、以下の例は
一つの位置に二つの物体があるか、
二つの位置の同じ物体が存在する
とたぶん破綻します。
例えば、
x => 1, y=> 2, a => 100, b => 200
x => 1, y=> 2, a => 300, b => 400

x => 1, y=> 2, a => 100, b => 200
x => 3, y=> 4, a => 100, b => 200

表示がくずれるので空白2文字を全角空白にしていることに注意
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use Data::Dumper;

{
　　package DualHash;

　　sub new {
　　　　my ( $class, %args ) = @_;
　　　　bless \%args, $class;
　　}

　　sub set {
　　　　my $obj　= shift;
　　　　my %hash = (@_);
　　　　my $x　　= $hash{x} // die 'need x';
　　　　my $y　　= $hash{y} // die 'need y';
　　　　my $a　　= $hash{a} // die 'need a';
　　　　my $b　　= $hash{b} // die 'need b';

　　　　$obj->{pos}->{$x}->{$y}　= { a => $a, b => $b };
　　　　$obj->{data}->{$a}->{$b} = { x => $x, y => $y };
　　}

　　sub get_pos {
　　　　my $obj　= shift;
　　　　my %hash = (@_);
　　　　my $a　　= $hash{a} // die 'need a';
　　　　my $b　　= $hash{b} // die 'need b';

　　　　return ( $obj->{data}->{$a}->{$b}->{x},
　　　　　　$obj->{data}->{$a}->{$b}->{y} );
　　}

　　sub get_data {
　　　　my $obj　= shift;
　　　　my %hash = (@_);
　　　　my $x　　= $hash{x} // die 'need x';
　　　　my $y　　= $hash{y} // die 'need y';

　　　　return ( $obj->{pos}->{$x}->{$y}->{a}, $obj->{pos}->{$x}->{$y}->{b} );
　　}

　　sub change_pos {
　　　　my $obj　 = shift;
　　　　my %hash　= (@_);
　　　　my $old_x = $hash{old_x} // die 'need old_x';
　　　　my $old_y = $hash{old_y} // die 'need old_y';
　　　　my $new_x = $hash{new_x} // die 'need new_x';
　　　　my $new_y = $hash{new_y} // die 'need new_y';

　　　　my ( $a, $b ) = $obj->get_data( x => $old_x, y => $old_y );

　　　　$obj->{pos}->{$new_x}->{$new_y} = { a => $a,　　 b => $b };
　　　　$obj->{data}->{$a}->{$b}　　　　= { x => $new_x, y => $new_y };
　　　　delete $obj->{pos}->{$old_x}->{$old_y};
　　　　if ( 0 == scalar keys %{ $obj->{pos}->{$old_x} } ) {
　　　　　　delete $obj->{pos}->{$old_x};
　　　　}
　　}

　　sub change_data {
　　　　my $obj　 = shift;
　　　　my %hash　= (@_);
　　　　my $old_a = $hash{old_a} // die 'need old_a';
　　　　my $old_b = $hash{old_b} // die 'need old_b';
　　　　my $new_a = $hash{new_a} // die 'need new_a';
　　　　my $new_b = $hash{new_b} // die 'need new_b';

　　　　my ( $x, $y ) = $obj->get_pos( a => $old_a, b => $old_b );

　　　　$obj->{data}->{$new_a}->{$new_b} = { x => $x,　　 y => $y };
　　　　$obj->{pos}->{$x}->{$y}　　　　　= { a => $new_a, b => $new_b };
　　　　delete $obj->{data}->{$old_a}->{$old_b};
　　　　if ( 0 == scalar keys %{ $obj->{data}->{$old_a} } ) {
　　　　　　delete $obj->{data}->{$old_a};
　　　　}
　　}

　　1;
}

my $dual_hash_1 = DualHash->new;
$dual_hash_1->set( x => 1,　y => 2,　a => 3,　b => 4 );
$dual_hash_1->set( x => 10, y => 20, a => 30, b => 40 );

my ( $x, $y, $a, $b );

( $a, $b ) = $dual_hash_1->get_data( x => 1, y => 2 );
say $a, ', ', $b;　　# 3, 4

( $x, $y ) = $dual_hash_1->get_pos( a => 3, b => 4 );
say $x, ', ', $y;　　# 1, 2

### old_a => 3, old_b => 4, new_a => 300, new_b => 400
### x => 1, y => 2
$dual_hash_1->change_data(
　　old_a => 3,
　　old_b => 4,
　　new_a => 300,
　　new_b => 400
);
( $x, $y ) = $dual_hash_1->get_pos( a => 300, b => 400 );
say $x, ', ', $y;　　# 1, 2

( $a, $b ) = $dual_hash_1->get_data( x => 1, y => 2 );
say $a, ', ', $b;　　# 300, 400

### old_x => 10, old_y => 20, new_x => 100, new_y => 200
### a => 30, b => 40
$dual_hash_1->change_pos(
　　old_x => 10,
　　old_y => 20,
　　new_x => 100,
　　new_y => 200
);
( $a, $b ) = $dual_hash_1->get_data( x => 100, y => 200 );
say $a, ', ', $b;　　# 30, 40

( $x, $y ) = $dual_hash_1->get_pos( a => 30, b => 40 );
say $x, ', ', $y;　　# 100, 200

お礼

お返事遅くなりました。
無事解決することができました。
動作が遅いのでPerlの中にcを埋めてみることにしました。
ありがとうございます。

回答No.4

kumoz

Perl には、クロージャと呼ばれる面白い仕組みがあります。a, b それぞれに情報を初期化でき、無名サブルーチンを通して更新することもできます。今回の質問に役立つかどうかは不明ですが、次のサンプルコードを参考にしてみてください。

use strict;
my %hash;
my $aa = init(name => 'a', x => 10, y => 100);
my $bb = init(name => 'b', x => 10, y => 100);
print "@{$hash{10}->{100}}\n"; # a b
$aa->(x => 20, y => 50);
print "@{$hash{10}->{100}}\n"; # b
print "@{$hash{20}->{50}}\n"; # a
$bb->(x => 30, y => 70);
print join(', ', keys %hash), "\n"; # 20, 30 (10 は削除済み)

sub init {
my %attr = @_;
push @{$hash{$attr{x}}->{$attr{y}}}, $attr{name};
sub {
return \%attr unless @_;
my %update = @_; my %pos;
foreach my $key (keys %update) {
if ($key eq 'x' or $key eq 'y') { $pos{$key} = $update{$key}; }
else { $attr{$key} = $update{$key}; }
}
if (%pos) {
@{$hash{$attr{x}}->{$attr{y}}} = grep { $_ ne $attr{name} } @{$hash{$attr{x}}->{$attr{y}}};
delete $hash{$attr{x}}->{$attr{y}} unless @{$hash{$attr{x}}->{$attr{y}}};
delete $hash{$attr{x}} unless keys %{$hash{$attr{x}}};
$attr{x} = $pos{x} if exists $pos{x};
$attr{y} = $pos{y} if exists $pos{y};
push @{$hash{$attr{x}}->{$attr{y}}}, $attr{name};
}
}
}

お礼

いえ、関係ないということはないです。ありがとうございます。
開発当初はクロージャで実装していました。(その後何度か変更しましたけども…)

ちなみに最初に万のループと書きましたが、
一回の動作で万なのでプロセスが始まって終わるまでには兆を突破するんですよね。
そんなわけで採用基準も複雑で大変な目に遭ってます。

回答No.3

Tacosan

正直なところインターフェイスがわからんので「具体的な方法」など出しようもないんだが, bless とか tieがらみとかを駆使すればできるかもしれん.

それにしても「ハッシュのキー自体がさらに他へのリファレンスとして機能しています」ってどういうことだろう. 確かにリファレンスをハッシュのキーとして使うことは可能だけど, 推奨されてないはずだし....

お礼

特に回答ではないと見受けましたので割愛させて頂きます。
ありがとうございました。

回答No.1

Tacosan

少なくとも, 「両方とも単なるスカラーへのリファレンス」ではだめです... というか, そうしちゃうと意味のあるプログラムにはできないような気がしますです. 個人的にはハッシュへのリファレンスを使うかな.

あと, 「普通、位置と物体って同時に平等に存在するものじゃなかったっけ」はたぶん勘違いだと思います. あらゆる物体が位置を持つけど, あらゆる位置に物体があるわけじゃない... よね?

お礼

8次元構造のハッシュですよ。相互参照を含めると無限になりますけど…
ついでにハッシュのキー自体がさらに他へのリファレンスとして機能していますので、3次元の中の8次元です。(質問には関係ないので省略されてもらいました)。
ただPerlのリファレンスは常にスカラーなのでスカラーとしか処理ができません。

>あらゆる物体が位置を持つけど, あらゆる位置に物体があるわけじゃない
いや、これは専門学的にいうと違います。
でも今回はどうでもいいですし、それについて書いたわけじゃないですので回答がずれてると思うです。

回答は具体的な方法をお待ちします。