[HaBo]

| ?- Lagalopexloesung=[[1,0,0,1,0,0],[1,0,1,1,0,0],[0,0,1,1,0,0],[0,1,1,1,0,0],[1,1,1,1,0,0],[1,1,1,1,0,1],[0,1,1,1,0,1],[0,0,1,1,0,1],[1,0,1,1,0,1],[1,0,0,1,0,1],[0,0,0,1,0,1],[0,1,0,1,0,1],[1,1,0,1,0,1],[1,1,0,0,0,1],[0,1,0,0,0,1],[0,0,0,0,0,1],[1,0,0,0,0,1],[1,0,1,0,0,1],[0,0,1,0,0,1],[0,1,1,0,0,1],[1,1,1,0,0,1],[1,1,1,0,1,1],[0,1,1,0,1,1],[0,0,1,0,1,1],[1,0,1,0,1,1],[1,0,0,0,1,1],[0,0,0,0,1,1],[0,1,0,0,1,1],[1,1,0,0,1,1],[1,1,0,1,1,1],[0,1,0,1,1,1],[0,0,0,1,1,1],[1,0,0,1,1,1],[1,0,1,1,1,1],[0,0,1,1,1,1],[0,1,1,1,1,1],[1,1,1,1,1,1]],
     valid(Lagalopexloesung).
yes
| ?-

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
local $Data::Dumper::Indent = 0;

my $HaBoUID  = shift || 18149;    # My (MontyPerl's) UID is the default.
my $bits     = $HaBoUID & 63;     # 2**6 - 1
my @solution = fillBits($bits);

my $outArray = [];
for (@solution) {
    push @$outArray, [map { $_ ? 1 : 0 } split(//, sprintf("%06b", $_))];
}
my $dumped = Dumper $outArray;
$dumped =~ s/^\$VAR\d+ = //;
$dumped =~ s/;$//;
print $dumped, "\n";

sub fillBits {
    my ($bits, @way) = @_;
    if ($bits == 63) {
        # warm... warmer.. disco.
        return @way, $bits;
    }
    elsif (grep { $bits == $_ } @way) {
        # we had this number already.
        return;
    }
    for my $n (0 .. 5) {
        if (canSwitch($bits, $n)) {
            my @sol = fillBits($bits ^ (2**$n), @way, $bits);
            return @sol if @sol;
        }
    }
    return;
}

sub canSwitch {
    my ($bits, $bit) = @_;
    if (!((2**($bit + 1)) & $bits)) {
        for my $n (($bit + 2) .. 5) {
            if (!((2**$n) & $bits)) {
                return 0;
            }
        }
        return 1;
    }
    else {
        return 0;
    }
}

valid([[1,0,0,1,0,1],[0,0,0,1,0,1],[0,1,0,1,0,1],[1,1,0,1,0,1],[1,1,0,0,0,1],[0,1,0,0,0,1],[0,0,0,0,0,1],[1,0,0,0,0,1],[1,0,1,0,0,1],[0,0,1,0,0,1],[0,1,1,0,0,1],[1,1,1,0,0,1],[1,1,1,0,1,1],[0,1,1,0,1,1],[0,0,1,0,1,1],[1,0,1,0,1,1],[1,0,0,0,1,1],[0,0,0,0,1,1],[0,1,0,0,1,1],[1,1,0,0,1,1],[1,1,0,1,1,1],[0,1,0,1,1,1],[0,0,0,1,1,1],[1,0,0,1,1,1],[1,0,1,1,1,1],[0,0,1,1,1,1],[0,1,1,1,1,1],[1,1,1,1,1,1]]).
true.

trans(X,X).                         
trans([0|T],[1|T]).                 
trans([1|T],[0|T]).                 
step([0|T1],[0|T2]) :- trans(T1,T2).  
step([1|T1],[1|T2]) :- step(T1,T2).  
                                    
valid([_]).                         
valid([X,Y|Z]) :- (trans(X,Y);step(X,Y)),        
        valid([Y|Z]),!; write(('Uebergang:',X->Y)).

import Control.Monad.State
import Control.Monad.Writer

canBeChanged :: [Int] -> Int -> Bool
canBeChanged _ 0 = True
canBeChanged xs n = all (==1) (take (n-1) xs) && (xs !! (n-1)) == 0

flipBit lst n = (take n lst) ++ [if (lst !! n) == 0 then 1 else 0] ++ (drop (n+1) lst)

getTransTo' :: Int -> Int -> [Int] -> StateT [Int] (Writer [[Int]]) ()
getTransTo' i n lst
    | lst !! i == n = return ()
    | canBeChanged lst i = put (flipBit lst i) >> get >>= tell . (:[])
    -- if we can't set it directly, set all bits left of it to their required values:
    | otherwise = sequence_ $ [getTransTo (i-1) 0] ++ [getTransTo x 1 | x <- reverse [0..i-2]] ++ [getTransTo i n]

getTransTo :: Int -> Int -> StateT [Int] (Writer [[Int]]) ()
getTransTo i n = get >>= getTransTo' i n

findPathExt :: [Int] -> [Int] -> [[Int]]
findPathExt lst pattern = [lst] ++ (execWriter $ execStateT solve lst)
    where solve = mapM_ (uncurry getTransTo) . reverse $ zip [0..length lst-1] pattern

findPath :: [Int] -> [[Int]]
findPath lst = findPathExt lst [1,1..]

[[0,0,1,1,0,1],[1,0,1,1,0,1],[1,0,0,1,0,1],[0,0,0,1,0,1],[0,1,0,1,0,1],[1,1,0,1,0,1],[1,1,0,0,0,1],[0,1,0,0,0,1],[0,0,0,0,0,1],[1,0,0,0,0,1],[1,0,1,0,0,1],[0,0,1,0,0,1],[0,1,1,0,0,1],[1,1,1,0,0,1],[1,1,1,0,1,1],[0,1,1,0,1,1],[0,0,1,0,1,1],[1,0,1,0,1,1],[1,0,0,0,1,1],[0,0,0,0,1,1],[0,1,0,0,1,1],[1,1,0,0,1,1],[1,1,0,1,1,1],[0,1,0,1,1,1],[0,0,0,1,1,1],[1,0,0,1,1,1],[1,0,1,1,1,1],[0,0,1,1,1,1],[0,1,1,1,1,1],[1,1,1,1,1,1]]

#include <iostream>

using namespace std;

void bin(int i, bool sep = true)
{
	cout << ((sep)? "," : "") << "[";
	for (int n = 5; n >= 0; --n)
		cout << ((i>>n)&1) << ((n > 0)? "," : "");
	cout << "]";
}

void setbit(int &v, int p, int val = 1)
{
	if (((v >> p) & 1) == !!val)
		return;
	if (p < 5) {
		setbit(v, p + 1, 0);
		for (int pos = p + 2; pos < 6; ++pos)
			setbit(v, pos);
	}
	v ^= (1 << p);
	bin(v);
}

int main()
{
	int id;
	cout << "HaBo-UserId: " << flush;
	cin >> id;
	id &= 0x2f;
	cout << "Die Sechs-Bit-Zahl: " << id << endl;

	cout << "[";
	bin(id, false);

	int pos;
	for (pos = 0; pos < 6; ++pos)
		setbit(id, pos);
	cout << "]" << endl;
}