最近研究函数式编程,都是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 "
")(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-------
")
(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 "
")))
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))))