foo-1.0: FooField.hs
-- ==================================
-- Module name: FooField
-- Project: Foo
-- Copyright (C) 2007 Bartosz Wójcik
-- Created on: 01.10.2007
-- Last update: 07.04.2008
-- Version: %
{- This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
-}
-- ==================================
module FooField
where
-- This module provides bunch of functions creating filed for the game, manipulating on this field and giving different
-- information about current field status or part of it.
-- Field is a graph that consists of list of unique vertices, each of 2 coortinates, where the vetex has following informaion:
-- one flag whether vertex is "active"
-- list of vertices it has edge to.
import Data.List
-- One of 2 precompiler options have to be active:
-- either ArrayGraph or MapGraph (MapGraph brings 10-30% acceleration of playing machine)
#define MapGraph
-- #define ArrayGraph
-- Next option is meaningfull only in ArrayGraph case.
-- It accelerates playing machine a bit, but less in comparison to MapGraph option.
#define DiffArrayGraph
-- --------------------------------
-- Field definition based on Arrays
-- --------------------------------
#ifdef ArrayGraph
#ifdef DiffArrayGraph
import Data.Array.Diff
#else
import Array
#endif
type Vertex = (Int,Int)
type Value = (Bool,[Vertex])
#ifdef DiffArrayGraph
type Graph = DiffArray Vertex Value
#else
type Graph = Array Vertex Value
#endif
-- Initial filed
field :: Int -> Int -> Graph
field fL fW = array ((0,0),(fW,fL+2)) [((x,y),(x == hW && y == hL || x == 0 || x == fW || (y == 1 || y == fL+1) && x /= hW, -- whether vertex is already 'active'
[(a,b) | a<-[(x-1)..(x+1)] , b<-[(y-1)..(y+1)], -- edges to all neighbour fields
b > 1 || y > 1 || x == hW || a == hW, -- line on the goal has some limitations
b < fL+1 || y < fL+1 || x == hW || a == hW, -- line on 2nd goal as well
b >= 0, b < fL + 3, -- field length limitations
x > 0 || a > 0, -- side line
x < fW || a < fW, -- 2nd side line
(a,b) /= (x,y)])) -- no edge to the same vertex
| x<-[0..fW], y<-[0..fL+2]] -- field's coordinates
where hL = round (fromIntegral fL / 2) + 1 -- half of Length - position of the middle of the filed
hW = round (fromIntegral fW / 2) -- half of Width - position of the middle of the filed
-- Removes edge from the graph. Edge is entered as 2 vertices.
rmEdge :: Vertex -> Vertex -> Graph -> Graph
rmEdge v1 v2 g = g // [(v1,(True,[v | v <- vertices v1 g, v /= v2])),(v2,(True,[v | v <- vertices v2 g, v /= v1]))]
-- Removes connections between successors of v2 and v2.
-- Use it: rmEdges (vertices v g) v g
rmEdges :: [Vertex] -> Vertex -> Graph -> Graph
rmEdges vl v2 g = g // ([(v2,(True,[]))] ++ [(v1,(active v1 g,[v | v <- vertices v1 g, v /= v2])) | v1 <- vl])
-- List of vertices that constuct edges with given vertex.
vertices :: Vertex -> Graph -> [Vertex]
vertices v g = snd(g!v)
-- Whether vertex is active
active :: Vertex -> Graph -> Bool
active v g = fst(g!v)
-- Checks if there is edge between 2 vertices.
chckEdge :: Vertex -> Vertex -> Graph -> Bool
chckEdge v1 v2 g = (== [v2]) $ filter (== v2) (vertices v1 g)
#endif
-- --------------------------------
-- Field definition based on Maps
-- --------------------------------
#ifdef MapGraph
import qualified Data.Map as Map
import Array
type Vertex = (Int,Int)
type Value = (Bool,[Vertex])
type Graph = Map.Map Vertex Value
-- Initial filed
field :: Int -> Int -> Graph
field fL fW = Map.fromList [((x,y),(x == hW && y == hL || x == 0 || x == fW || (y == 1 || y == fL+1) && x /= hW, -- whether vertex is already 'active'
[(a,b) | a<-[(x-1)..(x+1)] , b<-[(y-1)..(y+1)], -- edges to all neighbour fields
b > 1 || y > 1 || x == hW || a == hW, -- line on the goal has some limitations
b < fL+1 || y < fL+1 || x == hW || a == hW, -- line on 2nd goal as well
b >= 0, b < fL + 3, -- field length limitations
x > 0 || a > 0, -- side line
x < fW || a < fW, -- 2nd side line
(a,b) /= (x,y)])) -- no edge to the same vertex
| x<-[0..fW], y<-[0..fL+2]] -- field's coordinates
where hL = round (fromIntegral fL / 2) + 1 -- half of Length - position of the middle of the filed
hW = round (fromIntegral fW / 2) -- half of Width - position of the middle of the filed
-- Removes edge from the graph. Edge is entered as 2 vertices.
rmEdge :: Vertex -> Vertex -> Graph -> Graph
rmEdge v1 v2 g = Map.adjust (rmSuccesor v2) v1 $ Map.adjust (rmSuccesor v1) v2 g
rmSuccesor :: Vertex -> Value -> Value
rmSuccesor succesor (val,ls) = (True,[v | v <- ls, v /= succesor])
-- Removes all edges of vertex v.
-- First removes connections between successors of v and v then vice versa (as connections are directed).
rmSuccesors :: Vertex -> Graph -> Graph
rmSuccesors v g = (Map.adjust (\(val,vs) -> (val,[])) v . rmEdges (vertices v g) v) g
-- Removes connections between successors of v2 and v2.
-- Use it: rmEdges (vertices v g) v g
rmEdges :: [Vertex] -> Vertex -> Graph -> Graph
rmEdges [] v2 g = g
rmEdges (v1:vl) v2 g = rmEdges vl v2 (Map.adjust (rmSuccesor v1) v2 g)
-- List of vertices that constuct edges with given vertex.
vertices :: Vertex -> Graph -> [Vertex]
vertices v g = snd(g Map.! v)
-- Whether vertex is active
active :: Vertex -> Graph -> Bool
active v g = fst(g Map.! v)
-- Checks if there is edge between 2 vertices.
chckEdge :: Vertex -> Vertex -> Graph -> Bool
chckEdge v1 v2 g = (== [v2]) $ filter (== v2) (vertices v1 g)
#endif
-- Returns a mark of given edge. The mark is unique within defined graph.
-- Used for recognition same moves that are separatelly unfolded.
markEdge :: (Num b, Ord b) => b -> (b, b) -> (b, b) -> b
markEdge fW v1 v2 = 4 * (maxX * fW + maxY) + edgeNum
where (maxX,maxY) = max v1 v2
(minX,minY) = min v1 v2
edgeNum | minY > maxY = 0
| minY == maxY = 1
| minX == maxX = 2
| otherwise = 3