Haskell checkers - how to write a function that returns a list of possible jumps

Question

I would like to ask for help because I do not know how to write a function that analyzes possible jumps for a checkers' pawn. I am stuck and I will be very thankful for help.

I created a chessboard and a list of tuples that represent chessboard as a list.

This is the form to be able to show the chessboard on the screen: ""p.p.p.p. .p.p.p.p p.p.p.p. ........ ........ ........ P.P.P.P. .P.P.P.P P.P.P.P. ""

And this is the form which I use to analyze possible moves of pieces: [((1,1),'p'),((1,2),'.'),((1,3),'p'),((1,4),'.'),((1,5),'p'),((1,6),'.'),((1,7),'p'),((1,8),'.'),((2,1),'.'),((2,2),'p'),((2,3),'.'),((2,4),'p'),((2,5),'.'),((2,6),'p'),((2,7),'.'),((2,8),'p'),((3,1),'p'),((3,2),'.'),((3,3),'p'),((3,4),'.'),((3,5),'p'),((3,6),'.'),((3,7),'p'),((3,8),'.'),((4,1),'.'),((4,2),'.'),((4,3),'.'),((4,4),'.'),((4,5),'.'),((4,6),'.'),((4,7),'.'),((4,8),'.'),((5,1),'.'),((5,2),'.'),((5,3),'.'),((5,4),'.'),((5,5),'.'),((5,6),'.'),((5,7),'.'),((5,8),'.'),((6,1),'.'),((6,2),'.'),((6,3),'.'),((6,4),'.'),((6,5),'.'),((6,6),'.'),((6,7),'.'),((6,8),'.'),((7,1),'P'),((7,2),'.'),((7,3),'P'),((7,4),'.'),((7,5),'P'),((7,6),'.'),((7,7),'P'),((7,8),'.'),((8,1),'.'),((8,2),'P'),((8,3),'.'),((8,4),'P'),((8,5),'.'),((8,6),'P'),((8,7),'.'),((8,8),'P')]

This is the code I wrote so far:

module Checkers where

import Test.HUnit
import Test.QuickCheck
import Data.Char
import Data.Maybe (fromJust)
import Control.Error.Util (note)
import Data.Maybe (listToMaybe)
import Data.Char(isDigit)
import Data.String
import Data.List
import Prelude


type Board = [[Square]]
type Square = Maybe Piece

data Piece = Piece PColor PType deriving (Show)
data PColor = White | Black deriving (Show)
data PType = Pawn | Queen deriving (Show)

typeList:: [(Char, PType)]
typeList = [('p', Pawn), ('q', Queen)]


initialBoard = unlines ["p.p.p.p."
                        ,".p.p.p.p"
                        ,"p.p.p.p."
                        ,"........"
                        ,"........"
                        ,"........"
                        ,"P.P.P.P."
                        ,".P.P.P.P"
                        ,"P.P.P.P." ]

board2 = unlines        ["p.p.p.p."
                        ,".p.p.p.p"
                        ,"p.p.p.p."
                        ,".P.P.P.."
                        ,"........"
                        ,"........"
                        ,"P...P.P."
                        ,".P.P.P.P"
                        ,"P.P.P.P."]



showBoard :: Board -> String
showBoard = unlines. map showRow
    where showRow = map showSquare


readBoard :: String -> Either String Board
readBoard = (mapM . mapM) readSquare . lines

showSquare:: Square -> Char
-- showSquare Nothing = ' '
-- showSquare (Just p)  = showPiece p
showSquare = maybe ' ' showPiece

readSquare:: Char -> Either String Square
readSquare '.' = return Nothing
readSquare c = note errorMsg $ fmap return (readPiece c)  
        where errorMsg = "Error reading square '" ++ show c ++ "' is not a valid square"

--readSquare:: Char -> Square
--readSquare c = readPiece c

showPiece:: Piece ->  Char
showPiece (Piece White Pawn) = 'P'
showPiece (Piece Black Pawn) = 'p'
showPiece (Piece White Queen) = 'Q'
showPiece (Piece Black Queen) = 'q'

readPiece:: Char -> Maybe Piece
readPiece c = fmap makePiece lookupType
    where   color = if isUpper c then White else Black
        lookupType = lookup (toLower c) typeList
        makePiece = Piece color

--readPiece 'P' = Just (Piece White Pawn)
--readPiece 'p' = Just (Piece Black Pawn)
--readPiece 'Q' = Just (Piece White Queen)
--readPiece 'q' = Just (Piece Black Queen)
--readPiece _ = Nothing

--transform chessboard into a list of tuples to analyze possible kills


--String or Int?
testString = "hello world 13 i am a new 37 developer 82"

data StringOrInt = S String | I Int
    deriving (Eq,Ord,Show)

readInt :: String -> Int
readInt = read

--convert String into tuples
--1. convert chessBoard into a list
myShow :: String -> String
myShow s = concat ["[", intersperse ',' s, "]"]
isSlash x = x=='\'
deleteAllInstances :: Eq a => a -> [a] -> [a]
deleteAllInstances a xs = filter (/= a) xs
clearBoardList_ s = deleteAllInstances '
' $ myShow $ s
clearBoardList__ s = deleteAllInstances '[' $ clearBoardList_ s
clearBoardList s = deleteAllInstances ',' $ clearBoardList__ s

--2 zip with coordinates (1,1), (1,2).... (8,8)
makeL = [(x,y)| x<-[1..8], y<-[1..8]]
makeTuplesBoard s = zip makeL s
testList = makeList initialBoard
testList2 = makeList board2
--3 all together
makeList s = makeTuplesBoard $ clearBoardList s --xy coordinates of pawns


--is there my Pawn?
isMyPawn ((x,y),z) = (z=='p' || z=='q')
matchFirst (a,b) ((c,d),_) = (a,b) == (c,d)
whatIsThere (a,b) list =  eliminate $ find (matchFirst (a,b)) list          --test: whatIsThere (1,1) $ makeList initialBoard
eliminate (Just a) = a
whichPiece (a,b) list = snd $ snd ( whatIsThere (a,b) $ makeTuplesBoard list ) --shows what is on a specific field

isThereSth (a,b) list = whichPiece (a,b) list == 'p' || whichPiece (a,b) list == 'P' || whichPiece (a,b) list == 'q' ||whichPiece (a,b) list == 'Q'     --isThereSth (1,1) $ makeList initialBoard

isThereMyPawn (a,b) list = ((whichPiece (a,b) list == 'p'), list)     --whichPiece (a,b) list == ((a,b),'p')
isThereMyQueen (a,b) list = ((whichPiece (a,b) list == 'q'), list)
isThereOtherPawn (a,b) list = ((whichPiece (a,b) list == 'P'), list)
isThereOtherQueen (a,b) list = ((whichPiece (a,b) list == 'Q'), list)

--remove a figure from its place and put somewhere else
removePiece (a,b) list = map (\ x -> if matchFirst (a,b) x then ((a,b),'.') else x) list
removeMyPawn (a,b) list = removePiece (a,b) list
removeMyQueen (a,b) list = removePiece (a,b) list 
removeOtherPawn (a,b) list = removePiece (a,b) list 
removeOtherQueen (a,b) list = removePiece (a,b) list
isWithinLimit (a,b) 
    | not ((a>0) && (a<9) && (b>0) && (b<9)) = False
    | otherwise = True

isWithinLimit1 (a,b) list
    | not ((a>0) && (a<9) && (b>0) && (b<9)) = (False, list)
    | otherwise = (True, list)

putPiece (a,b) piece list = map (\ x -> if matchFirst (a,b) x then ((a,b),piece) else x) list --map (\ x -> if matchFirst (a,b) x then ((a,b),'.') else x) list
--test: movePiece (1,1) (1,2) $  makeTuplesBoard initialBoard
movePiece (a,b) (c,d) list =  removePiece (a,b) $ putPiece (c,d) (whichPiece (a,b) $  makeTuplesBoard initialBoard ) (makeTuplesBoard initialBoard)

--putADot (a,b) list = replace ( matchFirst (a,b)) list 
--swapTuples (a,b) (c,d) list = 
--move (a,b) (c,d) list = 
--  | (isThereSth (a,b) == False) = list
--        | otherwise = 

isThereOtherPawn2 (a,b) list x
    | (x==True) = fst $ isThereOtherPawn (a,b) list
    | otherwise = False

isWithinLimit2 (a,b) list x
    | (x==True) = fst $ isWithinLimit1 (a,b) list 
    | otherwise = False

isFree2 (a,b) list x
    | (x==True) = isFree (a,b) list
    | otherwise = False

isThereMyPawn2 (a,b) list x 
    | (x==True) = fst $ isThereMyPawn (a,b) list
    | otherwise = False

isFree (a,b) list = not (isThereSth (a,b) list)
isJumpLFPossible (a,b) list = isThereMyPawn2 (a,b) list $ (isFree2 (a+2,b-2) list $ isWithinLimit2 (a+2,b-2) testList $ isThereOtherPawn2 (a+1,b-1) list $ fst $ isWithinLimit1 (a+1,b-1) list) --test: isFree2 (3,4) testList $ isWithinLimit2 (3,4) testList $ isThereOtherPawn2 (3,4) testList $ fst $ isWithinLimit1 (2,3) testList

isJumpRFPossible (a,b) list = isThereMyPawn2 (a,b) list $ (isFree2 (a+2,b+2) list $ isWithinLimit2 (a+2,b+2) testList $ isThereOtherPawn2 (a+1,b+1) list $ fst $ isWithinLimit1 (a+1,b+1) list) --test: isFree2 (3,4) testList $ isWithinLimit2 (3,4) testList $ isThereOtherPawn2 (3,4) testList $ fst $ isWithinLimit1 (2,3) testList


-- checking whether my Pawn has any jump possiblitiy - one move
canJumpLF (a,b) list
        | (isJumpLFPossible (a,b) list) = [(a,b),(a+2, b-2)] 
        | otherwise = [] --test: canJump (1,1) testBoard

canJumpRF (a,b) list
        | (isJumpRFPossible (a,b) list) = [(a,b),(a+2, b+2)] 
        | otherwise = [] --test: canJump (1,1) testBoard

    isFree (a,b) list = not (isThereSth (a,b) list)


-- recursive check whether and which kills are possible for my Pawn
--canJump (a,b) list 
--      | (fst (canJumpLF (a,b) list)) = snd (canJump (a+2, b-2) list)
--      | (fst (canJumpRF (a,b) list)) = snd (canJump (a+2, b+2) list)
--      | otherwise = []

replaceTuple tups old new = map check tups where
    check tup | tup == old = new
              | otherwise  = tup


--movePawn (x,y) (a,b) = if (isMyPawn(x,y)

--replacePawn list = replaceTuple $ ((x,y),_) ((x,y),'.') list

--analyze possible moves of pawn


--Tests
tests:: Test
tests = TestList $ map TestCase
    [assertEqual "odd tests here" 1(1 :: Int)]

prop_empty :: Int -> Bool
prop_empty c1 = (c1::Int) == c1

runTest = do
    return()

main:: IO()
main = runTest

My problem is as follows. I need a function that returns a list of all possible jump sequences. I think it needs to be a recursive function. It should: (1) check whether a jump to the right, left is possible (2) if it is possible, then recursively run itself from the position a pawn would take after (1) (3) it should return a list of tuples' lists representing possible sequences of jumps: [(a,b), (c,d), (e,f), (g,h)], [(a,b), (p,r)], [(a,b), (q,s), (t,u)]] (4) if the pawn reached the opposite end of the chessboard it can jump backwards if there are any possible jumps (5) if the pawn reached the end of the board and there are no jumps possible it turns into a queen (it gets crowned - I cannot tell whether this possibility should be included in this function or not - perhaps not)

In other words, from the position (a,b) I want to analyze all possible jumps and write a function that returns a list of all possible jump sequences. ... After modifications my problem remains but I can explain it simpler:

The function canOneJump (a,b) board returns a list of possible places where pawns can be after they made 1 jump. In other words, the function returns [(1,2), (2,3), (4,5)] each tuple representing a row and a column where a pawn can be after a jump. I have a function that is supposed to create now lists of jumps from the initial location of a pawn (a,b) (based on the chessboard situation which is given as a list) but it does not work. Perhaps someone could help me to fix this function so it works. I want to get a list of jump sequences [[(3,3), (5,5), (7,3)], [(3,3), (5,1)]] that represent different jump sequences that are available.

canJump v board = 
        map (v:) w
        where
            list = listPlacesAfterMyPawnJump v board
            w = concat $ map (flip canJump board) list

ErikR · Accepted Answer

First I'd suggest posting your code to the Code Review Stackexchange to get some pointers on code style, organization, and other tips. They have a rule about only reviewing working code, so just ask them to review the code that you have.

Here's an outline of how I would proceed.

The solution will be a lot easier to understand with these type definitions:

type Coord = (Int,Int)
type CoordBoard = [ (Coord, Char) ]

Step 1. Using the functions you already have, write a function to return all possible single jumps from a specific square:

singleJumps :: (Coord, CoordBoard) -> [ (Coord, CoordBoard) ]

Note that you return the updated CoordBoard - i.e. the board with the jumped piece removed and the jumper moved. Return the empty list if there are no possible jumps.

Step 2. Then write a function to find all possible jump paths from a starting square:

multiJumps :: (Coord, CoordBoard) -> [ ([Coord], CoordBoard) ]

This also returns the CoordBoard with the jump moves executed. The idea behind multiJumps is:

for each possible single jump (rc, b):
  for each possible multi jump (path, b') starting from (rc,b):
    return the path (rc:path) and ending board configuration b'

This is where the recursion happens. (Hint: multijumps can be written as a list comprehension.)

Haskell checkers - how to write a function that returns a list of possible jumps

Answers (2)

Related Questions