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=;
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());
}
}
enum Triomino{
NorthEast,NorthWest,SouthWest,SouthEast,Vertical,Horizon;
public int[] area(int w){
switch(this){
case NorthEast: return new int[] {,w,w+1};
case NorthWest: return new int[] {,w,w-1};
case SouthWest: return new int[] {,w+1,1};
case SouthEast: return new int[] {,w,1};
case Vertical: return new int[] {,w,2*w};
case Horizon: return new int[] {,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>;
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 (,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  M.empty
where board = listArray (,h*w-1).repeat$ False
area x t = let ys = case t of
N -> [,w,w+1]
W -> [,w,w-1]
S -> [,w+1,1]
E -> [,w,1]
V -> [,w,2*w]
H -> [,1,2]
in zipWith (+) ys $ repeat x
inBoard x t = case t of
W -> div x w < h-1 && mod x w > 
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 (,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 (,h*w-1) False
solve b  M.empty >>= print.fst
area x t =  let ys = case t of
N -> [,w,w+1]
W -> [,w,w-1]
S -> [,w+1,1]
E -> [,w,1]
V -> [,w,2*w]
H -> [,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 > 
V -> div x w < h-2
H -> mod x w < w-2
_ -> div x w < h-1 && mod x w < w-1

どちらも遅いが、IOUArrayはUArrayよりも若干速い。

それにしても、汚いコードだ。