Haskell检查器 - 如何编写一个返回可能跳转列表的函数

时间:2016-05-29 14:45:16

标签: haskell

我想请求帮助,因为我不知道如何编写一个分析跳棋棋子可能跳跃的功能。 我被困住了,我将非常感谢你的帮助。

我创建了一个棋盘和一个代表棋盘作为列表的元组列表。

这是能够在屏幕上显示棋盘的表格: “\” PPPP \ npppp \ np.ppp \ n ........ \ n ........ \ n ........ \ nP.PPP \ nPPPP \ nP.PPP \ n \ “”

这是我用来分析片段可能移动的形式: [((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')]

这是我到目前为止编写的代码:

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 '\n' $ 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

我的问题如下。我需要一个函数来返回所有可能的跳转序列的列表。我认为它需要是一个递归函数。这应该: (1)检查是否可以向右跳,向左跳 (2)如果可能的话,那么从(1)之后的一个棋子的位置递归地运行自己 (3)它应该返回一个元组列表列表,表示可能的跳跃序列:[(a,b),(c,d),(e,f),(g,h)],[(a,b) ,(p,r)],[(a,b),(q,s),(t,u)]] (4)如果棋子到达棋盘的另一端,如果有任何可能的跳跃,它可以向后跳 (5)如果棋子到达棋盘的末端并且没有跳跃可能会变成女王(它被加冠 - 我无法判断这种可能性是否应该被包含在这个功能中 - 也许不是)

换句话说,从位置(a,b)我想分析所有可能的跳转并编写一个返回所有可能跳转序列列表的函数。 ... 修改后我的问题仍然存在,但我可以更简单地解释一下:

函数canOneJump(a,b)板返回一个可能的位置列表,其中棋子在跳转后可以是这些位置。换句话说,该函数返回[(1,2),(2,3),(4,5)]每个元组表示一个行和一个列,其中pawn可以在跳转之后。 我有一个函数应该从pawn的初始位置(a,b)创建跳转列表(基于作为列表给出的棋盘情况),但它不起作用。也许有人可以帮我修复这个功能,这样才有效。 我想获得一个跳跃序列列表[[(3,3),(5,5),(7,3)],[(3,3),(5,1)]],它们代表不同的跳跃序列可用。

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

2 个答案:

答案 0 :(得分:3)

首先我建议将您的代码发布到Code Review Stackexchange,以获得有关代码风格,组织和其他提示的一些指示。他们有一条关于只审查工作代码的规则,所以请让他们查看你的代码。

以下是我将如何进行的概述。

使用这些类型定义,解决方案将更容易理解:

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

步骤1.使用您已有的功能,编写一个函数来返回特定方块的所有可能的单跳:

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

请注意,您将返回更新的CoordBoard - 即移除跳跃的棋盘并移动跳线。如果没有可能的跳转,则返回空列表。

步骤2.然后编写一个函数,从起始方块中找到所有可能的跳路径

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

这也会返回执行跳转动作的CoordBoardmultiJumps背后的想法是:

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'

这是递归发生的地方。 (提示:multijumps可以写为列表理解。)

答案 1 :(得分:0)

最后,我解决了我的问题,但我不得不改变几个函数/编写新函数。

canJumpLB (a,b) list
        | (isJumpLBPossible (a,b) list) = [(a,b),(a-2, b-2)]
        | otherwise = [] 

canJumpRB (a,b) list
        | (isJumpRBPossible (a,b) list) =  [(a,b),(a-2, b+2)] 
        | otherwise = [] 

 canOneJump (a,b) list =filter (/=[]) $filter (/=[]) $filter (/=[]) [canJumpLF (a,b) list] ++ [canJumpRF (a,b) list]


canImakeAnotherJump list listOfLists = concat $ [canOneJump (x!!((length x)-1)) list | x <- listOfLists]
anotherJump list listOfLists = combine (canImakeAnotherJump list listOfLists) listOfLists []

jumpSequences v list []  
        | (canOneJump v list == []) = []
        | otherwise = jumpSequences v list (canOneJump v list)

jumpSequences v list results  
        | ((canImakeAnotherJump list results) == []) = results
        | otherwise = jumpSequences v list (anotherJump list results)

函数jumpSequences显示来自某个位置的所有跳跃序列。我的棋子不会向后跳,所以我不会更新棋盘。