-- ================================== -- 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 . -} -- ================================== 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