双方向リスト(？)

Question

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

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

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

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

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

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

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

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

_--_1l1_1_ · Accepted Answer

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

なお、以下の例は
一つの位置に二つの物体があるか、
二つの位置の同じ物体が存在する
とたぶん破綻します。
例えば、
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

kumoz · Answer

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}}
"; # a b
$aa->(x => 20, y => 50);
print "@{$hash{10}->{100}}
"; # b
print "@{$hash{20}->{50}}
"; # a
$bb->(x => 30, y => 70);
print join(', ', keys %hash), "
"; # 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};
    }
  }
}

Tacosan · Answer

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

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

Tacosan · Answer

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

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

双方向リスト(？)

位置が決まれば、そこに物体があると。

Perl には、クロージャと呼ばれる面白い仕組みがあります。

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

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

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング