#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

my @cards = (
  [qw(RH GH BT YT)],
  [qw(BT RH YH GT)],
  [qw(GT RH BH YT)],
  [qw(BT GH RH YT)],
  [qw(GH BH RT YT)],
  [qw(RH YH RT BT)],
  [qw(RT BT GH YH)],
  [qw(GT BT RH YH)],
  [qw(GT YT GH BH)],
);


my %bits_from_name = (
    GH => 0b1000,
    GT => 0b0111,
    YH => 0b1001,
    YT => 0b0110,
    BH => 0b1010,
    BT => 0b0101,
    RH => 0b1011,
    RT => 0b0100,
);

my @positions = (
    [ 0,  1,  3,  0],
    [ 0,  2,  4,  1],
    [ 0,  0,  5,  2],
    [ 3,  6,  8,  0],
    [ 4,  7,  9,  6],
    [ 5,  0, 10,  7],
    [ 8, 11,  0,  0],
    [ 9, 12,  0, 11],
    [10,  0,  0, 12],
);

my @placements = ();

my %vec_desc;
foreach my $c (0..$#cards) {
    my @card = @{ $cards[$c] };
    foreach my $rotation (1..4) {
        my $description = join ' ', @card;
        foreach my $p (0..8) {
            my $pos = $positions[$p];
            my $row = '';
            vec($row, 48 + $#cards, 1) = 0;
            vec($row, 48 + $c,      1) = 1;
            foreach my $j (0..3) {
                my $junction = $pos->[$j] or next;
                vec($row, $junction - 1, 4) = $bits_from_name{$card[$j]};
            }
            push @placements, $row;
            $vec_desc{$row} = $description;
        }
        unshift @card, pop @card;
    }
}

my $zero = '';
vec($zero, 48 + $#cards, 1) = 0;

solve($zero);
print "\nNo solution found\n";
exit;

sub solve {
    my($state, @placed) = @_;
    
    my $this_place = @placed;
    if($this_place == 9) {
        print "Solution:\n";
        print "$vec_desc{$_}\n" foreach @placed;
        print "\n";
        exit;
    }

    my @candidates;
    if($this_place == 0) {
        @candidates = @placements;
    }
    else {
        my $mask = $zero;
        if(my $top = $positions[$this_place]->[0]) {
            vec($mask, $top - 1, 4) = 15;
        }
        if(my $left = $positions[$this_place]->[3]) {
            vec($mask, $left - 1, 4) = 15;
        }
        my $wanted = ($state & $mask) ^ $mask;
        @candidates = grep {
            ($_ & $mask) eq $wanted and
            ($state & $_) eq $zero
        } @placements;
    }
    foreach (@candidates) {
        solve($state | $_, @placed, $_);
    }
}