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))))