Problem 161

http://projecteuler.net/index.php?section=problems&id=161
やっと解けた。

import java.util.*;
public class P161{
    static Map<Board,Long> memo;
    static Board board;
    static int h=12,w=9;
    static long solve(int x){
	if(memo.containsKey(board))return memo.get(board);
	if(x==h*w)return 1;//finish 
	if(board.shape[x])return solve(x+1);//filled
	long count=0;
	for(Triomino t:EnumSet.range(Triomino.NorthEast,Triomino.Horizon))//next step
	    if(canPut(x,t)){
		for(int y:t.area(w))board.shape[x+y]=true;//put Triomino
		count+=solve(x+1);
		for(int y:t.area(w))board.shape[x+y]=false;//remove Triomino
	    }
	if(count>1)memo.put(new Board(board.shape),count);
	return count;
    }
    static boolean canPut(int x,Triomino t){
	if(!t.canPut(h,w,x))return false;
	for(int y:t.area(w))if(board.shape[x+y])return false;
	return true;
    }
    public static void main(String[] args){
	memo=new HashMap<Board,Long>();
	board=new Board(new boolean[h*w]);
	System.out.println(solve(0));
    }
}
enum Triomino{
    NorthEast,NorthWest,SouthWest,SouthEast,Vertical,Horizon;
    public int[] area(int w){
	switch(this){
	case NorthEast: return new int[] {0,w,w+1};
	case NorthWest: return new int[] {0,w,w-1};
	case SouthWest: return new int[] {0,w+1,1};
	case SouthEast: return new int[] {0,w,1};
	case Vertical: return new int[] {0,w,2*w};
	case Horizon: return new int[] {0,1,2};
	default: return null;
	}
    }
    public boolean canPut(int h,int w,int x){
	switch(this){
	case NorthWest: return x/w<h-1 && x%w>0;
	case Vertical: return x/w<h-2;
	case Horizon: return x%w<w-2;
	default: return x/w<h-1 && x%w<w-1;
	}
    }
}
class Board{
    boolean[] shape;
    Board (boolean[] s){
	shape=Arrays.copyOf(s,s.length);
    }
    public boolean equals(Object obj){
    	if(this==obj)return true;
	if(obj==null||(obj.getClass()!=this.getClass()))return false;
	return Arrays.equals(this.shape,((Board)obj).shape);
    }
    public int hashCode(){
	return Arrays.hashCode(shape);
    }
}

javaのHashMapは使えなさ過ぎる。なんで、配列をキーにするのにわざわざ新しいclassを作らないといけないんだ。
まったく。

[追記]

同じアルゴリズムをhaskellでUArrayを使って

import Data.Array.Unboxed
import qualified Data.Map as M
data Triomino = N | W | S | E | V | H 
type Board = UArray Int Bool
type Memo = M.Map Board Integer

h =12
w =9
memoise f x y memo = case M.lookup x memo of
                       Just fx -> (fx,memo)
                       Nothing -> let (fx,memo') = f x y memo
                                  in (fx,if fx > 1 then M.insert x fx memo' else memo')

solve :: Board -> Int -> Memo -> (Integer,Memo)
solve b x memo | x == h*w = (1,memo) 
               | b!x = memoise solve b (x+1) memo 
               | otherwise = foldl next (0,memo) $ filter (canPut b x) [N,W,S,E,V,H]
               where next (c,m) t = let (c',m') = memoise solve (b//[(y,True)| y<-area x t]) x m
                                    in (c+c',m')

canPut :: Board -> Int -> Triomino -> Bool
canPut b x t | not $ inBoard x t = False
             | otherwise = all (not.(b!)) $ area x t

main = print.fst$solve board 0 M.empty
    where board = listArray (0,h*w-1).repeat$ False 

area x t = let ys = case t of
                      N -> [0,w,w+1]
                      W -> [0,w,w-1]
                      S -> [0,w+1,1]
                      E -> [0,w,1]
                      V -> [0,w,2*w]
                      H -> [0,1,2]
           in zipWith (+) ys $ repeat x

inBoard x t = case t of
                W -> div x w < h-1 && mod x w > 0
                V -> div x w < h-2
                H -> mod x w < w-2
                _ -> div x w < h-1 && mod x w < w-1

IOArrayを使って

import Data.Array.IO
import Data.Array.Unboxed
import qualified Data.Map as M
import Control.Monad
data Triomino = N | W | S | E | V | H 
type Board = IOUArray Int Bool
type Memo = M.Map (UArray Int Bool) Integer

h =12
w =9

memoise f x y memo = do ix <- freeze x
                        case M.lookup ix memo of
                          Just fx -> return (fx,memo)
                          Nothing -> do (fx,memo') <- f x y memo
                                        let memo'' = if fx > 1 then M.insert ix fx memo' else memo'
                                        return (fx,memo'')

solve :: Board -> Int -> Memo -> IO (Integer,Memo)
solve b x memo | x == h*w = return (1,memo)
               | otherwise = readArray b x >>= solve'
    where solve' filled | filled = memoise solve b (x+1) memo
                        | otherwise = foldM next (0,memo) [N,W,S,E,V,H]
          next i t = canPut b x t >>= next' i t
          next' (c,m) t f | not f = return (c,m)
                          | otherwise = do mapM_ (\i -> writeArray b i True) $ area x t
                                           (c',m') <- memoise solve b (x+1) m
                                           mapM_ (\i -> writeArray b i False) $ area x t
                                           return (c+c',m')

canPut b x t | not $ inBoard x t = return False
             | otherwise = mapM (readArray b) (area x t) >>= return.not.or

main = do b <- newArray (0,h*w-1) False
          solve b 0 M.empty >>= print.fst

area x t =  let ys = case t of
                       N -> [0,w,w+1]
                       W -> [0,w,w-1]
                       S -> [0,w+1,1]
                       E -> [0,w,1]
                       V -> [0,w,2*w]
                       H -> [0,1,2]
            in zipWith (+) ys $ repeat x

inBoard :: Int -> Triomino -> Bool
inBoard x t = case t of
                W -> div x w < h-1 && mod x w > 0
                V -> div x w < h-2
                H -> mod x w < w-2
                _ -> div x w < h-1 && mod x w < w-1

どちらも遅いが、IOUArrayはUArrayよりも若干速い。
それにしても、汚いコードだ。