用scheme实现KMP算法
2016-05-10 00:29
351 查看
scheme真丧心病狂
形式语义学作业,自选函数式语言实现任意程序。于是选了scheme。不得不说这个语言真蛋疼,括号匹配导致我检查的时间趋近于正无穷。
#lang racket
(define f (make-vector 101))
(define m 7)
(define n 7)
(define loop2
(lambda(P i j)
(begin
(if(and (> j 0) (not (eqv? (string-ref P i) (string-ref P j))))
(loop2 P i (vector-ref f j))
j)
)))
(define (getfail P)
(set! m (string-length P))
(vector-set! f 0 0)
(vector-set! f 1 0)
(define loop
(lambda(i)
(if(< i m)
(begin
(set! i (+ i 1))
(let ((j (loop2 P (- i 1) (vector-ref f (- i 1)))))
(if(eqv? (string-ref P (- i 1)) (string-ref P j))
(vector-set! f i (+ j 1))
(vector-set! f i 0)))
(loop i))
0)))
(loop 1))
(define loop3
(lambda(P T i j)
(begin
(if(and (> j 0) (not (eqv? (string-ref T i) (string-ref P j))))
(loop3 P T i (vector-ref f j))
j)
)))
(define (KMP T P)
(getfail P)
(set! n (string-length T))
(define loop
(lambda(i j)
(if(and (< i n) (< j m))
(begin
(set! i (+ i 1))
(set! j (loop3 P T (- i 1) j))
(when(eqv? (string-ref T (- i 1)) (string-ref P j))
(set! j (+ j 1)))
(loop i j))
(cons i j)) ))
(loop 0 0))
(define ans (cons -1 -1))
(define (main)
(let ((P (read)))
(when(not(eof-object? P))
(getfail P)
(define loop
(lambda(i)
(if(< i m)
(begin
(display (vector-ref f i))
(display " ")
(loop (+ i 1)))
(newline))))
(loop 0)
(main))))
(define loopp
(lambda(T i)
(if(< i n)
(begin
(if(and (>= i (- (car ans) m)) (< i (car ans)))
(display (char-upcase (string-ref T i)))
(display (string-ref T i)))
(loopp T (+ i 1)))
(newline))))
(define (main2)
(display "请依次输入模式串和匹配串:")
(let ((P (read)) (T (read)))
(when(not(eof-object? P))
(set! ans (KMP T P))
(define loop
(lambda(i)
(if(< i m)
(begin
(display (vector-ref f i))
(display " ")
(loop (+ i 1)))
(newline))))
(loop 0)
(display ans)
(newline)
(if(= (cdr ans) m)
(begin
(display "匹配成功,显示如下:")
(loopp T 0))
(begin
(display "匹配失败,匹配串中不包含模式串。")
(newline)))
(main2))))
形式语义学作业,自选函数式语言实现任意程序。于是选了scheme。不得不说这个语言真蛋疼,括号匹配导致我检查的时间趋近于正无穷。
#lang racket
(define f (make-vector 101))
(define m 7)
(define n 7)
(define loop2
(lambda(P i j)
(begin
(if(and (> j 0) (not (eqv? (string-ref P i) (string-ref P j))))
(loop2 P i (vector-ref f j))
j)
)))
(define (getfail P)
(set! m (string-length P))
(vector-set! f 0 0)
(vector-set! f 1 0)
(define loop
(lambda(i)
(if(< i m)
(begin
(set! i (+ i 1))
(let ((j (loop2 P (- i 1) (vector-ref f (- i 1)))))
(if(eqv? (string-ref P (- i 1)) (string-ref P j))
(vector-set! f i (+ j 1))
(vector-set! f i 0)))
(loop i))
0)))
(loop 1))
(define loop3
(lambda(P T i j)
(begin
(if(and (> j 0) (not (eqv? (string-ref T i) (string-ref P j))))
(loop3 P T i (vector-ref f j))
j)
)))
(define (KMP T P)
(getfail P)
(set! n (string-length T))
(define loop
(lambda(i j)
(if(and (< i n) (< j m))
(begin
(set! i (+ i 1))
(set! j (loop3 P T (- i 1) j))
(when(eqv? (string-ref T (- i 1)) (string-ref P j))
(set! j (+ j 1)))
(loop i j))
(cons i j)) ))
(loop 0 0))
(define ans (cons -1 -1))
(define (main)
(let ((P (read)))
(when(not(eof-object? P))
(getfail P)
(define loop
(lambda(i)
(if(< i m)
(begin
(display (vector-ref f i))
(display " ")
(loop (+ i 1)))
(newline))))
(loop 0)
(main))))
(define loopp
(lambda(T i)
(if(< i n)
(begin
(if(and (>= i (- (car ans) m)) (< i (car ans)))
(display (char-upcase (string-ref T i)))
(display (string-ref T i)))
(loopp T (+ i 1)))
(newline))))
(define (main2)
(display "请依次输入模式串和匹配串:")
(let ((P (read)) (T (read)))
(when(not(eof-object? P))
(set! ans (KMP T P))
(define loop
(lambda(i)
(if(< i m)
(begin
(display (vector-ref f i))
(display " ")
(loop (+ i 1)))
(newline))))
(loop 0)
(display ans)
(newline)
(if(= (cdr ans) m)
(begin
(display "匹配成功,显示如下:")
(loopp T 0))
(begin
(display "匹配失败,匹配串中不包含模式串。")
(newline)))
(main2))))
相关文章推荐
- authentication password与scheme区别
- emacs学习
- MIT-scheme写的一个数据处理程序
- authentic Arizona Cardinals jerseys b2bjersey.com 8n
- 编程起步
- 元编程(metaprogrammming)的艺术:元编程介绍
- URI vs URL vs URN
- Tomcat6配置SSL的方法
- 作者文章阅读次数:3742
- 修改Eclipse为黑色主题
- XML
- 代码大全学习-33-布局和风格(Layout and Style)
- Android学习笔记之AndroidManifest.xml文件解析
- Android如何解析Intent
- HTTPS(Secure Hypertext Transfer Protocol)安全超文本传输协议
- Rfc2111
- RFC2392
- RFC2384
- RFC2192
- linux常用软件