TSPL学习笔记(4):数组相关练习

最近研究函数式编程,都是haskell和scheme交互着看的,因此笔记中两种语言的内容都有,练习通常也都用两种语言分别实现.
本篇练习一些数组有关的问题,之因此与数组相关是由于在命令式编程中如下问题的核心数据结构主要是数组,而在scheme和haskell中主要是用list来实现.

scheme中没有数组这个数据结构,因此须要用list来实现相似数组的操做,下面首先定义了一些辅组函数用于操做和显示数组,

(define (gen-matrix width hight f)
    (define (gen-row x y row matrix)
        (if (>= x width) (cons (reverse row) matrix)
            (gen-row (+ x 1) y (cons (f x y) row) matrix)))
    (define (gen y matrix)
        (if (>= y hight) matrix
            (gen (+ y 1) (gen-row 0 y '() matrix))))
    (reverse (gen 0 '())))

(define (show-matrix matrix)
    (define (show-row row)
        (if (not (null? row)) (begin (display (car row))(display "\n")(show-row (cdr row)))))
    (show-row matrix))

(define (get-matrix-size matrix)
    (if (null? matrix) '()
        (if (null? (car matrix)) '()
            (list (length (car matrix)) (length matrix)))))

gen-matrix用于生成一个width X hight的矩阵,f是一个形如(lambda (x y))的函数,用于输出x y位置的内容,例如:

(gen-matrix 4 4 (lambda (x y) (if (and (= x 2) (= y 2)) 1 0)

将生成一个(2 2)位置为1,其他位置为0的4X4矩阵.

show-matrix用于将列表形式的矩阵以矩形的方式输出到屏幕,例如:

(show-matrix (gen-matrix 4 4 (lambda (x y) (if (and (= x 2) (= y 2)) 1 0))))

将输出

(0 0 0 0)
(0 0 0 0)
(0 0 1 0)
(0 0 0 0)

get-matrix-size用于得到一个矩阵的width和hight其返回值是一个list,(car list) = width (cadr list) = hight

(define (member? xs x)
    (cond
        [(null? xs) #f]
        [else (if (equal? x (car xs)) #t (member? (cdr xs) x))]))

member?函数用于判断一个x在xs中是否存在,此函数在下面的几个示例中用到.

迷宫

给定一个迷宫地图,输入起始点和目标点，输出一条从起始点到目标点的路径,首先来看下scheme的代码

(define maze1  '((1 1 1 1 1 1 1 1 1)
                (1 0 1 0 0 0 1 0 1)
                (1 0 1 0 1 0 1 0 1)
                (1 0 1 0 1 0 1 0 1)
                (1 0 0 0 0 0 0 0 1)
                (1 1 1 1 1 1 1 1 1)))

;返回一条路径             
(define (findpath-one maze from to)(define (findpath-one maze from to)
(letrec* ( [direction '((0 -1) (0 1) (-1 0) (1 0))]         
           [arrive? (lambda (cur) (and (= (car cur) (car to)) (= (cadr cur) (cadr to))))]
           [moveable?  (lambda (x y)
                         (cond
                            [(> y (length maze)) #f]
                            [else (let ([line (list-ref maze y)]) 
                                   (if (> x (length line)) #f (= (list-ref line x) 0)))]))]
           [foreach-dir (lambda (dirs pos path close)
                           (cond
                             [(null? dirs) '()]
                             [else (let* ([dir (car dirs)]
                                          [dirx (car dir)]
                                          [diry (cadr dir)]     
                                          [nextpos (list (+ (car pos) dirx) (+ (cadr pos) diry))]
                                          [ret (move nextpos path close)])                           
                                    (if (not (null? ret)) ret (foreach-dir (cdr dirs) pos path close)))]))]
           [move (lambda (pos path close) 
                    (if (arrive? pos) (reverse (cons pos path))
                        (if (or (not (moveable? (car pos) (cadr pos))) (member? close pos)) '()
                            (foreach-dir direction pos (cons pos path) (cons pos close)))))])
       (cond
            [(arrive? from) (list from)]
            [(or (not (moveable? (car from) (cadr from))) (not (moveable? (car to) (cadr to)))) '()]
            [else (foreach-dir direction from (list from) (list from))])))

使用经典的回溯算法,从当前点出发,遍历direction中的四个方向,若是往一个方向前进的时候遇到阻挡,则回溯到上一层去尝试下一个方向。若是方向用完了则代表从当前点没法到达目标,继续回溯到上一层.若是回溯到第一层且方向用完代表从起始点没有到达目标点的路径.这里用了一个辅助的数据结构close表,用于保存已经走过的路径,用于避免路径探测的时候走回头路致使死循环.

要想将结果显示在屏幕上能够定义以下函数:

(define (showmaze maze path)
    (let ([matrix-size (get-matrix-size maze)])
    (define matrix (gen-matrix (car matrix-size) (cadr matrix-size) (lambda (x y)
        (if (member? path (list x y)) '*
            (list-ref (list-ref maze y) x)))))
    (show-matrix matrix))
)

经过输入一个地图和路径就能够把寻路结果显示到屏幕中，例如:

(showmaze maze1 (findpath-one maze1 '(1 1) '(3 3)))

输出

(1 1 1 1 1 1 1 1 1)
(1 * 1 0 0 0 0 0 1)
(1 * 1 0 1 0 1 0 1)
(1 * 1 * 1 0 1 0 1)
(1 * * * 0 0 1 0 1)
(1 1 1 1 1 1 1 1 1)

接着来看下haskell的版本

import qualified Data.Set as Set
-- 走迷宫
--module Maze   
--( 
--  FindOne   
--) where

--返回指定下标的元素
elemat :: [maybe] -> Int -> maybe           
elemat xs idx = 
        if idx >= length xs then error "index out of range"
        else fetch xs 0
    where fetch (x:xs) acc = 
        if acc == idx then x
        else fetch xs (acc+1)   

-- 检查输入点是否可移动
movable ::[[Int]] -> (Int,Int) -> Bool
movable maze (x,y) =  
        if y < length maze then 
            let line = elemat maze y
            in if x < length line then
                elemat line x == 0
            else False   
        else False

-- 输出一条路径
findonepath :: [[Int]] -> (Int,Int) -> (Int,Int) -> [(Int,Int)]
findonepath maze from to
    | not (movable maze from) || not (movable maze to) = []
    | otherwise = foreachdir direction from [from] $ Set.fromList [] 
    where 
          direction = [(0,-1),(0,1),(-1,0),(1,0)] -- 4个移动方向
          foreachdir dirs (x,y) path close
            | null dirs = []
            | otherwise = 
              let 
                    (dirx,diry) = head dirs  
                    nextpos = (x+dirx,y+diry)   
                    ret = move path close nextpos
              in 
                    if null ret then
                        foreachdir (tail dirs) (x,y) path close
                    else ret                    
          move path close (x,y)
            | (x,y) == to = reverse ((x,y):path) --到达目的地 
            | otherwise = 
                if Set.member (x,y) close || not (movable maze (x,y)) then []
                else foreachdir direction (x,y) ((x,y):path) $ Set.insert (x,y) close

与scheme版本区别的地方有两点:

• 没有list-ref方法,因此定义了一个辅组函数elemat用于取给定下标的list元素
• 使用Data.Set做为close列表的数据结构

八皇后

八皇后问题也是一个经典的回溯算法问题,解题方法与迷宫问题相似:

• 在当前行的0-N-1的位置中寻找一个合法位置放置皇后,若是找到跳到下面一步,不然说明在当前行的任何位置放置皇后都不能有合法的解,回溯到上一行,
  若是已经回溯到了第一行,切尝试过第一行的全部位置,说明问题没有任何的合法解
• 进入下一行,若是当前行号大于等于N,输出一个结果,不然执行步骤1

下面是找出一个八皇后解的完整代码:

(define (puzzle size)   
    (define (vaild? queen pos);判断当前位置是否能够放置皇后
        (define (check xs)
            (if (null? xs) #t
                (let ([x (car (car xs))]
                      [y (cadr (car xs))])
                 (cond [(= x (car pos)) #f]
                       [(= (abs (- x (car pos))) (abs (- y (cadr pos)))) #f]
                       [else (check (cdr xs))]))))
        (check queen))
    (define (foreach-row x y queen result)
        (cond 
              [(>= x size) result]
              [(>= y size) (cons queen result)]
              [else (let ([newresult (if (vaild? queen (list x y))
                                         (foreach-row 0 (+ y 1) (cons (list x y) queen) result)          
                                         result)])
                          (foreach-row (+ x 1) y queen newresult))]))
    (let ([result (foreach-row 0 0 '() '())])
         (define (show xs)
            (if (not (null? xs))
                (begin (display "------result-------\n")
                (show-matrix (gen-matrix size size (lambda (x y) (if (member? (car xs) (list x y)) '* " "))))
                (show (cdr xs)))))                  
         (show result)
         (display "total solution:")(display (length result))(display "\n")))

haskell的实现

--判断皇后是否能够合法放置
vaild :: [(Int,Int)] -> (Int,Int) -> Bool
vaild [] _ = True
vaild xs (x,y) = foldr (\q acc -> if (x == (fst q)) || (abs (x - fst q)) == (abs (y - snd q)) then False  else acc) True xs  

foreachrow :: (Int,Int) -> Int -> [(Int,Int)] -> [[(Int,Int)]] -> [[(Int,Int)]]
foreachrow (x,y) size queen result 
    | x >= size = result
    | y >= size = (queen:result)
    | otherwise = let newresult = if vaild queen (x,y) then foreachrow (0,y+1) size ((x,y):queen) result
                                  else result
                  in  foreachrow (x+1,y) size queen newresult

puzzle :: Int -> Int
puzzle 0 = 0
puzzle size = length $ foreachrow (0,0) size [] []

蛇形矩阵

输入2,输出:

1 2 
4 3

输入3,输出:

1 2 3
8 9 4
7 6 5

依此类推.

先简单描述下算法,初始时矩阵全为0,向左移动并将计数值1写到起始位置(0 0),一直向当前方向移动,直到遇到碰撞,切换移动方向.碰撞的条件是x y坐标超出矩阵范围或x y位置的值不为0.

为了处理二维数组添加如下的辅助函数:

;1维,2维数组            
;数组起始下标为0            
(define (make-array n init) (rep init n))
(define (array-at array n) (element-at array (+ n 1)))
(define (array-replace-at array n new) (replace array new (+ n 1)))

(define (make-array2d width hight init) (make-array hight (make-array width init))) 

(define (array2d-at array2d c r)
    (let ([row (if (> (length array2d) r) (array-at array2d r) '())])
         (if (null? row) "idx out of range"
             (if (> c (length row)) "idx out of range"
                (array-at row c)))))

(define (array2d-replace-at array2d c r new)
    (let ([row (if (> (length array2d) r) (array-at array2d r) '())])
         (if (null? row) "idx out of range"
             (if (> c (length row)) "idx out of range"
                (array-replace-at array2d r (array-replace-at row c new))))))

下面是主函数

(define (snake size)
    (define maxc (* size size))
    (define (snake-imp c matrix cur direction)
        (if (> c maxc) matrix
            (let* ([curx (car cur)]
                   [cury (cadr cur)]
                   [tmpx (+ curx (caar direction))]
                   [tmpy (+ cury (cadar direction))]
                   [newmatrix (array2d-replace-at matrix curx cury c)]
                   [newdirection (if (or ;检测是否须要调整方向
                                     (> 0 tmpx)
                                     (>= tmpx size)
                                     (> 0 tmpy)
                                     (>= tmpy size)
                                     (not (= 0 (array2d-at newmatrix tmpx tmpy)))) (lshift direction 1)
                                     direction)]
                   [newx (+ curx (caar newdirection))]
                   [newy (+ cury (cadar newdirection))])                                                       
            (snake-imp (+ c 1) newmatrix (list newx newy) newdirection))))       
     (snake-imp 1 (make-array2d size size 0)  '(0 0) '((1 0) (0 1) (-1 0) (0 -1))))