文档章节

我是来看common lisp效果的

yyliu
 yyliu
发布于 2012/05/06 16:01
字数 583
阅读 173
收藏 0
;;;The extent of the world
(defparameter *width* 100)
(defparameter *height* 30)
(defparameter *jungle* '(45 10 10 10))
(defparameter *plant-energy* 80)
;;;Growing plants in our world
;;cons cells should be compared with equal
(defparameter *plants* (make-hash-table :test #'equal))
;;Grow new plants
(defun random-plant (left top width height)
  (let ((pos (cons (+ left (random width)) (+ top (random height)))))
    (setf (gethash pos *plants*) t)))
(defun add-plants ()
  (apply #'random-plant *jungle*)
  (random-plant 0 0 *width* *height*))
;;;Creating animals
(defstruct animal x y energy dir genes)
;;x,y stand for the position
;;energy represent its energy,when the energy exhausted,it will die
;;dir is the direction it faced
;;genes decide the direction it will choose
;;Creating an animal in the center of the map
(defparameter *animals*
  (list (make-animal :x;we only use list to traverse animal,
                     ;its efficient enough.
                     (ash *width* -1)
                     :y
                     (ash *height* -1)
                     :energy
                     1000
                     :dir
                     0
                     :genes;genes represent the possiblity 
                     ;that an animal will choose
                     (loop repeat 8
                           ;collect is OK??
                           collect (1+ (random 10))))))
;;;Handling animal motion
;;;想想九宫格
(defun move (animal)
  (let ((dir (animal-dir animal))
        (x (animal-x animal))
        (y (animal-y animal)))
    ;如果达到*width*,置0
    (setf (animal-x animal) (mod (+ x
                                    (cond ((and (>= dir 2) (< dir 5)) 1)
                                          ((or (= dir 1) (= dir 5)) 0)
                                          (t -1))
                                    *width*)
                                 *width*))
    (setf (animal-y animal) (mod (+ y
                                    (cond ((and (>= dir 0) (< dir 3)) -1)
                                          ((and (>= dir 4) (< dir 7)) 1)
                                          (t 0))
                                    *height*)
                                 *height*))
    (decf (animal-energy animal))))
;;;Handling animal turning
(defun turn (animal)
  (let ((x (random (apply #'+ (animal-genes animal)))))
    ;;this was not easy to understand it,
    ;;当随机数落在哪个区间就哪个方向的递归描述
    (labels ((angle (genes x)
               (let ((xnu (- x (car genes))))
                 (if (< xnu 0)
                   0
                   (1+ (angle (cdr genes) xnu))))))
      (setf (animal-dir animal)
            (mod (+ (animal-dir animal) (angle (animal-genes animal) x))
              8)))))
;;;Handling animal eating
(defun eat (animal)
  (let ((pos (cons (animal-x animal) (animal-y animal))))
    (when (gethash pos *plants*)
      (incf (animal-energy animal) *plant-energy*)
      (remhash pos *plants*))))
;;;Handling animal reproduction
;;定义繁殖时需要能量
(defparameter *reproduction-energy* 200)
(defun reproduce (animal)
  (let ((e (animal-energy animal)))
    (when (>= e *reproduction-energy*)
      (setf (animal-energy animal) (ash e -1))
      (let ((animal-nu (copy-structure animal));浅复制命令
            (genes (copy-list (animal-genes animal)))
            (mutation (random 8)))
        (setf (nth mutation genes) 
              (max 1 (+ (nth mutation genes) (random 3) -1)))
;This means the gene value will change plus or minus one, or
;stay the same.
        (setf (animal-genes animal-nu) genes)
        (push animal-nu *animals*)))))
;;;Simulating a day in our world
(defun update-world ()
  (setf *animals* (remove-if (lambda (animal)
                               (<= (animal-energy animal) 0))
                             *animals*))
  (mapc (lambda (animal)
          (turn animal)
          (move animal)
          (eat animal)
          (reproduce animal))
        *animals*)
  (add-plants))
;;;Drawing our world
;;;This has low performance but will not matters
(defun draw-world ()
  (loop for y
        below *height*
        do (progn 
             (fresh-line);outputs a newline only if the output-stream
             ;is not already at the start of a line
             (princ "|")
             (loop for x
                   below *width*
                   do (princ (cond ((some (lambda (animal)
                                     ;可能不止一个动物
                                            (and (= (animal-x animal) x)
                                                 (= (animal-y animal) y)))
                                          *animals*)
                                    #\M)
                                   ((gethash (cons x y) *plants*) #\*)
                                   (t #\space))))
             (princ "|"))))
;;;Creating a user interface
(defun evolution ()
  (draw-world)
  (fresh-line)
  (let ((str (read-line)))
    (cond ((equal str "quit") ())
;Recall Conrad’s Rule of Thumb for Comparing Stuff
;use eq for symbols
;use equal for everything else
          (t (let ((x (parse-integer str :junk-allowed t)))
               (if x
                 (loop for i
                       below x
                       do (update-world)
                       if (zerop (mod i 1000))
                       do (princ #\.))
                 (update-world))
               (evolution))))))

© 著作权归作者所有

共有 人打赏支持
yyliu
粉丝 31
博文 14
码字总数 20045
作品 0
无锡
私信 提问
用ECL编译字符游戏的跨平台(Linux/OSX/WINDOWS)可执行文件

用ECL编译字符游戏的跨平台(Linux/OSX/WINDOWS)可执行文件 说明 前面我们用 写了一个代码超简短的字符游戏, 不过每次运行时都需要通过 来加载, 本文介绍一种可以把 代码编译为可执行文件的方...

FreeBlues
2016/01/20
122
15
LispBox 集成开发环境分析 (一)Windows版本分析

LispBox 集成开发环境分析 (一)Windows版本分析 LispBox 是一个开源的LISP 集成开发环境,由 SLIME (The Superior Lisp Interaction Mode for Emacs) 交互接口、 Quicklisp 库管理器、Clo...

FreeBlues
2012/11/14
0
0
Common Lisp学习资源整理

Lisp Hackers: Interviews with 100x More Productive Programmers Posted on June 26th, 2013 Lisp Hackers: Interviews with 100x More Productive Programmers, by Vsevolod Dyomkin, is ......

戎码半生
2017/01/24
0
0
一个很有趣的用于调试函数代码的函数 dtrace.lisp

一个很有趣的用于调试函数代码的函数 dtrace.lisp,来自这本书《COMMON LISP:A Gentle Introduction to Symbolic Computation》。 Common Lisp 中原来就有一个跟踪函数 trace,使用时把你要跟...

FreeBlues
2014/02/17
0
1
一篇比较深刻的讲FP特性的文章

【IT168 技术文档】甫于日前落幕的Software Development 2.0研讨会,来宾之一的Andrei Alexandrescu被问到未来编程语言的趋势时,他认为函数编程(Functional Pogramming)可能会再度兴起。我认...

刘小兵2014
2010/12/14
0
0

没有更多内容

加载失败,请刷新页面

加载更多

mybatis缓存的装饰器模式

一般在开发生产中,对于新需求的实现,我们一般会有两种方式来处理,一种是直接修改已有组件的代码,另一种是使用继承方式。第一种显然会破坏已有组件的稳定性。第二种,会导致大量子类的出现...

算法之名
昨天
12
0
单元测试

右键方法 Go To --> Test,简便快速生成测试方法。 相关注解 @RunWith(SpringRunner.class) 表示要在测试环境中跑,底层实现是 jUnit测试工具。 @SpringBootTest 表示启动整个 Spring工程 @A...

imbiao
昨天
3
0
欧拉公式

欧拉公式表达式 欧拉公式的几何意 cosθ + j sinθ 是个复数,实数部分也就是实部为 cosθ ,虚数部分也就是虚部为 j sinθ ,对应复平面单位圆上的一个点。 根据欧拉公式和这个点可以用 复指...

sharelocked
昨天
5
0
burpsuite无法抓取https数据包

1.将浏览器和burpsuite的代理都设置好 2.在浏览器地址栏输入: http://burp 3.下载下面的证书,并将证书导入浏览器 cacert.der

Frost729
昨天
3
0
JeeSite4.x 消息管理、消息推送、消息提醒

实现统一的消息推送接口,包含PC消息、短信消息、邮件消息、微信消息等,无需让所有开发者了解消息是怎么发送出去的,只需了解消息发送接口即可。 所有推送消息均通过 MsgPushUtils 工具类发...

ThinkGem
昨天
9
0

没有更多内容

加载失败,请刷新页面

加载更多

返回顶部
顶部