Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Re: Challenge: Setting Sun Puzzle

by itub (Priest)
on Oct 04, 2004 at 20:11 UTC ( [id://396374]=note: print w/replies, xml ) Need Help??


in reply to Challenge: Setting Sun Puzzle

Here's my solution. It's not as short as some of the others because it is object-oriented/array based instead of using strings and regexes, but it agrees that the solution needs 112 "simple moves".

The code:

#!/home/ivan/bin/perl use strict; use warnings; package Piece; use vars qw(@pieces %shapes); %shapes = ( big => [2,2], vert => [1,2], horiz => [2,1], small => [1,1], ); @pieces = ( { shape => 'big', orig => [1,0], }, { shape => 'vert', orig => [0,0], }, { shape => 'vert', orig => [3,0], }, { shape => 'vert', orig => [0,3], }, { shape => 'vert', orig => [3,3], }, { shape => 'horiz', orig => [1,2], }, { shape => 'small', orig => [1,3], }, { shape => 'small', orig => [2,3], }, { shape => 'small', orig => [1,4], }, { shape => 'small', orig => [2,4], }, ); { my $i = 0; for (@pieces) { $_->{id} = $i++; bless $_; } } sub shape { shift->{shape} }; sub orig { shift->{orig} }; sub id { shift->{id} }; sub size { my ($self) = @_; $shapes{$self->shape}; } sub pieces { @pieces; } package Board; use overload '""' => 'draw'; use base 'Storable'; use vars qw($MAX_X $MAX_Y) $MAX_X = 4; $MAX_Y = 5; sub new { my $self = bless { board => [[]], pieces => [Piece->pieces], n => 0, }, shift; for my $piece (@{$self->{pieces}}) { $self->put($piece) or die; } $self->{holes} = [$self->find_holes]; $self; } sub put { my ($self, $piece) = @_; my ($x0,$y0) = @{$piece->orig}; my ($xsize, $ysize) = @{$piece->size}; my $board = $self->{board}; for (my $x = $x0; $x < $x0+$xsize; $x++) { for (my $y = $y0; $y < $y0+$ysize; $y++) { return 0 if defined $board->[$x][$y]; $board->[$x][$y] = $piece->id; } } 1; } sub draw { my ($self) = @_; my $board = $self->{board}; my $ret; for (my $y = 0; $y < $MAX_Y; $y++) { for (my $x = 0; $x < $MAX_X; $x++) { my $p = $board->[$x][$y]; $ret .= (defined $p ? substr($self->piece($p)->shape,0,1) + : ' '); } $ret .= "\n"; } $ret; } sub find_holes { my ($self) = @_; my $board = $self->{board}; my @ret; for (my $y = 0; $y < $MAX_Y; $y++) { for (my $x = 0; $x < $MAX_X; $x++) { push @ret, [$x, $y] unless defined $board->[$x][$y]; } } @ret; } sub holes { @{shift->{holes}} } sub n { shift->{n} } sub piece_at { my ($self, $x, $y) = @_; $self->{board}[$x][$y]; } sub piece_north { my ($self, $pos) = @_; my ($x, $y) = @$pos; my $piece; while ($y-- > 0) { $piece = $self->piece_at($x, $y); last if defined $piece; } $piece; } sub piece_south { my ($self, $pos) = @_; my ($x, $y) = @$pos; my $piece; while ($y++ < $MAX_Y-1) { $piece = $self->piece_at($x, $y); last if defined $piece; } $piece; } sub piece_east { my ($self, $pos) = @_; my ($x, $y) = @$pos; my $piece; while ($x++ < $MAX_X-1) { $piece = $self->piece_at($x, $y); last if defined $piece; } $piece; } sub piece_west { my ($self, $pos) = @_; my ($x, $y) = @$pos; my $piece; while ($x-- > 0) { $piece = $self->piece_at($x, $y); last if defined $piece; } $piece; } sub delete { my ($self, $piece) = @_; my ($x0,$y0) = @{$piece->{orig}};; my ($xsize, $ysize) = @{$piece->size}; my $board = $self->{board}; for (my $x = $x0; $x < $x0+$xsize; $x++) { for (my $y = $y0; $y < $y0+$ysize; $y++) { $board->[$x][$y] = undef; } } 1; } sub piece { my ($self, $n) = @_; $self->{pieces}[$n]; } sub move { my ($self, $n, $dir) = @_; my $new = $self->dclone; my $pn = $new->piece($n); $new->delete($pn); if ($dir eq 'east') { $pn->{orig}[0]++; } elsif ($dir eq 'west') { $pn->{orig}[0]--; } elsif ($dir eq 'south') { $pn->{orig}[1]++; } else { $pn->{orig}[1]--; } $new->put($pn) or return undef; $new->{holes} = [$new->find_holes]; $new->{n}++; $new; } package main; my @dirs = qw(north south east west); my %opp_dirs = qw( north south south north east west west east ); my $board0 = Board->new; my %seen = ("$board0" => 0); my $count = 0; my @confs = (); my @q = ($board0); my $solution; my $distance; while (1 and @q) { $count++; my $board = shift @q; push @confs, "$board"; my ($x, $y) = @{$board->piece(0)->orig}; if ($x == 1 and $y == 3) { $solution = "$board"; $distance = $board->n; print "FOUND($x,$y) at distance $distance\n"; last; } for my $hole ($board->holes) { my $p; for my $dir (@dirs) { my $method = "piece_$dir"; $p = $board->$method($hole); next unless defined $p; my $new_board = $board->move($p, $opp_dirs{$dir}); if ($new_board) { my $s = "$new_board"; unless (exists $seen{$s}) { $seen{$s} = $count; my $r = join "\n", map { scalar reverse } split "\ +n", $s; $seen{"$r\n"} = $count; push @q, $new_board; } } } } } # print the solution while ($distance >= 0) { print "$distance\n$solution\n"; $solution = $confs[$seen{$solution}-1]; $distance--; }

and the solution:

FOUND(1,3) at distance 112
112
vvvv
vvvv
sshh
 bbs
 bbs

111
vvvv
vvvv
sshh
bb s
bb s

110
vvvv
vvvv
sshh
bbs 
bb s

109
vvvv
vvvv
sshh
bb  
bbss

108
vvvv
vvvv
ss  
bbhh
bbss

107
vvvv
vvvv
s s 
bbhh
bbss

106
vvvv
vvvv
s  s
bbhh
bbss

105
vvvv
vvvv
 s s
bbhh
bbss

104
vvvv
vvvv
  ss
bbhh
bbss

103
vvvv
vvvv
bbss
bbhh
  ss

102
vvvv
vvvv
bbss
bbhh
 s s

101
vvvv
vvvv
bbss
bbhh
 ss 

100
vvvv
vvvv
bbss
bbhh
s s 

99
vvvv
vvvv
bbss
bbhh
ss  

98
vvvv
vvvv
bbss
bb  
sshh

97
vvvv
vvvv
bbs 
bb s
sshh

96
vvvv
vvvv
bb s
bb s
sshh

95
vvvv
vvvv
 bbs
 bbs
sshh

94
 vvv
vvvv
vbbs
 bbs
sshh

93
 vvv
 vvv
vbbs
vbbs
sshh

92
v vv
v vv
vbbs
vbbs
sshh

91
vv v
vv v
vbbs
vbbs
sshh

90
vvv 
vvv 
vbbs
vbbs
sshh

89
vvv 
vvvs
vbb 
vbbs
sshh

88
vvv 
vvvs
vbbs
vbb 
sshh

87
vvvs
vvv 
vbbs
vbb 
sshh

86
vvvs
vvvs
vbb 
vbb 
sshh

85
vvvs
vvvs
v bb
v bb
sshh

84
v vs
vvvs
vvbb
v bb
sshh

83
v vs
v vs
vvbb
vvbb
sshh

82
vv s
vv s
vvbb
vvbb
sshh

81
vv s
vvs 
vvbb
vvbb
sshh

80
vvss
vv  
vvbb
vvbb
sshh

79
vvss
vvbb
vvbb
vv  
sshh

78
vvss
vvbb
vvbb
vvhh
ss  

77
vvss
vvbb
vvbb
vvhh
s s 

76
vvss
vvbb
vvbb
vvhh
s  s

75
vvss
vvbb
vvbb
vvhh
 s s

74
vvss
vvbb
vvbb
vvhh
  ss

73
vvss
vvbb
v bb
vvhh
 vss

72
vvss
vvbb
  bb
vvhh
vvss

71
v ss
vvbb
 vbb
vvhh
vvss

70
vs s
vvbb
 vbb
vvhh
vvss

69
vss 
vvbb
 vbb
vvhh
vvss

68
 ss 
vvbb
vvbb
vvhh
vvss

67
s s 
vvbb
vvbb
vvhh
vvss

66
ss  
vvbb
vvbb
vvhh
vvss

65
ssbb
vvbb
vv  
vvhh
vvss

64
ssbb
vvbb
vvhh
vv  
vvss

63
ssbb
vvbb
vvhh
vvs 
vv s

62
ssbb
vvbb
vvhh
vv s
vv s

61
ssbb
vvbb
vvhh
v vs
v vs

60
ssbb
v bb
vvhh
vvvs
v vs

59
ssbb
v bb
v hh
vvvs
vvvs

58
ssbb
v bb
vhh 
vvvs
vvvs

57
s bb
vsbb
vhh 
vvvs
vvvs

56
 sbb
vsbb
vhh 
vvvs
vvvs

55
vsbb
vsbb
 hh 
vvvs
vvvs

54
vsbb
vsbb
hh  
vvvs
vvvs

53
vsbb
vsbb
hhv 
vvvs
vv s

52
vsbb
vsbb
hhv 
vvvs
vvs 

51
vsbb
vsbb
hhv 
vvv 
vvss

50
vsbb
vsbb
hh v
vv v
vvss

49
vsbb
vsbb
hh v
vvsv
vv s

48
vsbb
vsbb
hh v
vvsv
vvs 

47
vsbb
vsbb
hh  
vvsv
vvsv

46
vsbb
vsbb
 hh 
vvsv
vvsv

45
vsbb
vsbb
  hh
vvsv
vvsv

44
vsbb
v bb
 shh
vvsv
vvsv

43
vsbb
v bb
s hh
vvsv
vvsv

42
vsbb
v bb
svhh
vvsv
v sv

41
vsbb
vvbb
svhh
v sv
v sv

40
vsbb
vvbb
svhh
 vsv
 vsv

39
vsbb
vvbb
 vhh
svsv
 vsv

38
 sbb
vvbb
vvhh
svsv
 vsv

37
s bb
vvbb
vvhh
svsv
 vsv

36
svbb
vvbb
v hh
svsv
 vsv

35
svbb
vvbb
vvhh
svsv
  sv

34
svbb
vvbb
vvhh
svsv
 s v

33
svbb
vvbb
vvhh
svsv
s  v

32
svbb
vvbb
v hh
svsv
sv v

31
svbb
vvbb
vhh 
svsv
sv v

30
svbb
vvbb
vhhv
svsv
sv  

29
svbb
vvbb
vhhv
sv v
svs 

28
svbb
vvbb
vhhv
sv v
sv s

27
svbb
vvbb
vhhv
s vv
s vs

26
svbb
vvbb
vhhv
s vv
 svs

25
svbb
vvbb
vhhv
 svv
 svs

24
svbb
 vbb
vhhv
vsvv
 svs

23
svbb
 vbb
 hhv
vsvv
vsvs

22
 vbb
svbb
 hhv
vsvv
vsvs

21
 vbb
 vbb
shhv
vsvv
vsvs

20
v bb
v bb
shhv
vsvv
vsvs

19
vbb 
vbb 
shhv
vsvv
vsvs

18
vbb 
vbbv
shhv
vsv 
vsvs

17
vbb 
vbbv
shhv
vsvs
vsv 

16
vbbv
vbbv
shh 
vsvs
vsv 

15
vbbv
vbbv
s hh
vsvs
vsv 

14
vbbv
vbbv
 shh
vsvs
vsv 

13
vbbv
vbbv
vshh
vsvs
 sv 

12
vbbv
vbbv
vshh
vsvs
s v 

11
vbbv
vbbv
vshh
v vs
ssv 

10
vbbv
vbbv
v hh
vsvs
ssv 

9
vbbv
vbbv
vhh 
vsvs
ssv 

8
vbbv
vbbv
vhhs
vsv 
ssv 

7
vbbv
vbbv
vhhs
vs v
ss v

6
vbbv
vbbv
vhhs
vs v
s sv

5
vbbv
vbbv
vhhs
vs v
 ssv

4
vbbv
vbbv
 hhs
vs v
vssv

3
vbbv
vbbv
hh s
vs v
vssv

2
vbbv
vbbv
hhs 
vs v
vssv

1
vbbv
vbbv
hh  
vssv
vssv

0
vbbv
vbbv
 hh 
vssv
vssv

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://396374]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2024-03-29 13:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found