Lisp Programming Examples

hola

lisp

;;; Funciones para tratar los árboles minimax, tal como los necesita
;;; el algoritmo de poda alpha-beta de los materiales.
;;; Supondremos que un árbol
;;; o bien es una hoja: número
;;; o bien no lo es: ('max/min (hijo_1 hijo_2 . . . hijo_n))
;;;    y hijo_j es un árbol
;;;
;;; He intentado maximizar la simplicidad, y NADA esté protegido contra
;;; errores
;;;

(defun hoja (arbol)
  (numberp arbol))

(defun evalua (arbol)
  (if (hoja arbol) arbol)) ; si no es hoja no se considera; ya se protegerá en el código

(defun nodo-min (arbol)
  (eql 'min (car arbol)))

(defun nodo-max (arbol)
  (eql 'max (car arbol)))

(defun hijos (arbol)
  (if (not (hoja arbol)) (cadr arbol)))

;;; Poda alpha-beta tal como está implementada en el
;;; Módulo 2, página 85, implementado en Common Lisp
;;;
;;; Fijémonos que un árbol es un nodo con hijos, o una hoja
;;; El código necesitará las siguientes funciones:
;;;
;;; (hoja nodo)  -------> booleano
;;; (evalua nodo) ------> el valor de los nodos, típicamente un coste, por tanto un número 
;;;                       (tan solo tiene sentido si (hoja nodo) es true)
;;; (nodo-min nodo) ----> booleano
;;; (nodo-max nodo) ----> booleano
;;; (hijos nodo) -------> lista de nodos
;;;

(defun minimax (arbol)
  (cond 
   ((hoja arbol) (evalua arbol))
   ((nodo-min arbol) (apply #'min (mapcar #'minimax (hijos arbol))))
   ((nodo-max arbol) (apply #'max (mapcar #'minimax (hijos arbol))))))

(defun minimax-alpha-beta (nodo alpha beta)
  (cond
    ((hoja nodo)
     (let ((val (evalua nodo)))
	   (format t "~A " val)
	   val))
    ((nodo-min nodo)
     (let ((beta-tmp beta))
       (do ((ch (hijos nodo) (cdr ch)))
	   ((or (null ch) (<= beta-tmp alpha)) beta-tmp)
	 (let ((r (minimax-alpha-beta (car ch) alpha beta-tmp)))
	   (if (< r beta-tmp) (setf beta-tmp r))))))
    ((nodo-max nodo)
     (let ((alpha-tmp alpha))
       (do ((ch (hijos nodo) (cdr ch)))
	   ((or (null ch) (<= beta alpha-tmp)) alpha-tmp)
	 (let ((r (minimax-alpha-beta (car ch) alpha-tmp beta)))
	   (if (< alpha-tmp r) (setf alpha-tmp r))))))))

;;; La función de la pregunta 3
;;;
(defun mystery (p x1 x2)
  (if (hoja p)
     (let ((val (evalua p)))
       (format t "~A " val)
       val)
     (let ((w (hijos p))
	   (m x1))
       (dolist (q w m) (let ((k (- (mystery q (- x2) (- m)))))
			 (if (> k m) (setf m k))
			 (if (>= m x2) (return m)))))))

;;; Tests
;;; Unos cuantos árboles para hacer pruebas:

(defparameter *tree-001*
  '(max ((min ((max ((min (15 14))
		     (min (13 12))))
	       (max ((min (11 10))
		     (min (9 8))))))
	 (min ((max ((min (7 6))
		     (min (5 4))))
	       (max ((min (3 2))
		     (min (1 0)))))))))

(defparameter *tree-002*
  '(max ((min ((max ((min (0 -1))
		     (min (-2 -3))))
	       (max ((min (-4 -5))
		     (min (-6 -7))))))
	 (min ((max ((min (-8 -9))
		     (min (-10 -11))))
	       (max ((min (-12 -13))
		     (min (-14 -15)))))))))

(defparameter *tree-003*
  '(max ((min ((max ((min (0 1))
		     (min (2 3))))
	       (max ((min (4 5))
		     (min (6 7))))))
	 (min ((max ((min (8 9))
		     (min (10 11))))
	       (max ((min (12 13))
		     (min (14 15)))))))))

(defparameter *tree-004*
  '(max ((min (4 5))
         (min (6
               (max (3 4)) 
               (max (7 9))))
         (min (3 8)))))

(defparameter *tree-005*
  '(max ((min (21 -85 7 -8)) 
         (min (-11 -65 7 -42))
         (min (-14 -15 73 99))
         (min (-37 -71 -97 -90)))))

(defparameter *tree-006*
  '(max ((min ((max ((min (-76 -28))
		     (min (3 -60))))
	       (max ((min (-66 -36))
		     (min (-88 56))))))
	 (min ((max ((min (13 -7))
		     (min (50 19))))
	       (max ((min (16 -15))
		     (min (-67 46)))))))))

(defparameter *tree-007*
  '(max ((min ((max (-9 18 -5))
	       (max (16 7 -5))
	       (max (-3 16 11))))
	 (min ((max (-17 9 -8))
	       (max (-13 -2 2))
	       (max (5 16 1))))
	 (min ((max (13 18 4))
	       (max (-12 12 10))
	       (max (-10 -5 6)))))))

(defparameter *tree-008*
  '(max ((min ((max (2 2 0))
	       (max (-5 4 -6))
	       (max (-11 5 10))))
	 (min ((max (-18 -1 1))
	       (max (-10 -6 -4))
	       (max (-9 16 19))))
	 (min ((max (-8 -9 8))
	       (max (-7 12 -9))
	       (max (16 -7 19)))))))

(defparameter *tree-009*
  '(max ((min ((max (8 7 3))
	       (max (9 1 6))
	       (max (2 4 1))))
	 (min ((max (1 3 5))
	       (max (3 9 2))
	       (max (6 5 2))))
	 (min ((max (1 2 3))
	       (max (9 7 2))
	       (max (16 6 4)))))))

(defparameter *tree-010*
  '(max ((min (4 5))
         (min (6
               (max (13 14)) 
               (max (17 19))))
         (min (3 8)))))

(defparameter *tree-011*
  '(min ((max ((min (8 7 3))
	       (min (9 1 6))
	       (min (2 4 1))))
	 (max ((min (1 3 5))
	       (min (3 9 2))
	       (min (6 5 2))))
	 (max ((min (1 2 3))
	       (min (9 7 2))
	       (min (16 6 4)))))))

4

lisp

(
    defun my-middle (lst)
    (
        cond
        ((null lst) nil)
        ((null (cdr lst)) nil)
        ((null (cdr (cdr lst))) nil)
        (
            (null (cdr (cdr (cdr lst))))
            (list (car (cdr lst)))
        )
        (
            t
            (
                append
                (list (car (cdr lst)))
                (my-middle (cdr lst))
            )
        )
    )
)

(
    defun my-last (lst)
    (
        cond
        ((null lst) nil)
        (
            (null (cdr lst))
            (car lst)
        )
        (
            t
            (my-last (cdr lst))
        )
    )
)

(
    defun f-l-swap (lst)
    (
        append
        (list (my-last lst))
        (my-middle lst)
        (list (car lst))
    )
)

(write (f-l-swap '((a d) f 10 w h)))

Distance - Function

lisp

(defun calculatedistance (x1 y1 x2 y2)
    (write (sqrt (+ (* (- x1 x2) (- x1 x2)) (* (- y1 y2)(- y1 y2)))))
)

(calculatedistance 1 2 10 3)

zabawy z lispem

lisp

(cl:defpackage jjhop.random
    (:export random-int-as-string))
(in-package jjhop.random)

(write-line "w pakiecie 'jjhop.radom'")
        
(defun random-int-as-string ()
    (let ((rs (make-random-state t)))
         (write-to-string (random 999999999999 rs))))
        
;; ---------------------------------
        
(cl:defpackage main)
(in-package main)
(cl:import '(jjhop.random:random-int-as-string))
        

(write-line "w pakiecie 'main'")
        
(write-line (random-int-as-string))
(write-line (random-int-as-string))
(write-line (random-int-as-string))
(write-line (random-int-as-string))
(write-line (random-int-as-string))

Execute LISP Online

lisp

(defun triangle (n)

  (cond 
    ( (floatp n) (print "Decimals number are not valid input, please enter an integer")
    )
    ( (stringp n) (print "Strings are not valid input, please enter an integer")
    )
    (
  
        (loop for i from 1 to n 
  
            do (loop for j from 1 to i
                 do (write j)
                )

            (princ #\NewLine)
        )
    )
  )
)


(triangle 4)

Execute LISP Online

lisp

(defun triangle (n)
  (cond 
    ( (floatp n) (print "Decimals number are not valid input, please enter an integer"))
    ( (stringp n) (print "Strings are not valid input, please enter an integer"))
  ) 
  
  (loop for i from 1 to n 
  
     do (loop for j from 1 to i
            do (write j)
        )
        
    (princ #\NewLine)
  
    )
)

(triangle 10)

raptor

lisp

(write-line "Hello World")
(setf Diseases '(
              (disease1 ((name choroba1) (smiertelnosc 90) (objawy (ob1 ob2 ob3))) ) ;cos tam jeszcze daj
              (disease2 ((name choroba2) (smiertelnosc 50)) )
              ) 
      )
;(print (second(assoc 'disease1 Diseases)))
;(print (second(assoc 'objawy (second(assoc 'disease1 Diseases)) )) ) 

(defun disease-name (disease)
     (second (assoc 'name (second disease)))
    )

(defun get-names (diseases)
    (if (null diseases)   nil
        (cons (disease-name (first diseases))
              (get-names (cdr diseases))
        )
    )
)

(print (get-names Diseases))

Execute LISP Online

lisp

(write-line "Hello World")
(defun R (x1 y1 x2 y2)
    (sqrt + * ((- x1 x2)(- x1 x2))* ((- y1 y2)(- y1 y2))
)
(print (R 1 1 2 2))

Execute LISP Online

lisp

;Plaindrom number check
(defun IsPalindrom (N)
(setq m 0)
(setq k 1)
(loop while (/= m N) do
(setq k1 k)
(setq q 1)
(setq invertk 0)
(loop while (/= k1 0) do
(setq modk (mod k1 10))
(setq invertk (+ (*
invertk 10) modk))
(setq k1 (floor (/ k1
10)))
)
(if (eq k invertk)
(progn
(print k)
(setq m (1+ m))
)
)
(setq k (1+ k))
)
)

(IsPalindrom 20)

Execute LISP Online

lisp

(SETQ L '(A B C D))

;problem 1
(format t "My-first CAR")
(defun my-first (lst)
    ( car lst)
)
(print (my-first L))

(format t "~%My-rest CDR")
(defun my-rest (lst)
    (cdr lst)    
)
(print(my-rest L))

(format t "~%Construct")
(defun construct (lst)
    (cons (car lst) (cdr lst))    
)
(print (construct L))

;problem 2
(format t "~%Rotate-left")
(defun rotate-left (lst)
    (append (CDR lst) (list(car lst)))
)
(print (rotate-left L))

(format t "~%Double rotate-left")
(print (rotate-left (rotate-left L)))

;problem 3
(format t "~%Rotate-right")
(defun rotate-right (lst)
    ( append (LAST lst) (reverse (cdr(reverse lst))) )
)
(print (rotate-right L))

(format t "~%Double rotate-right")
(print (rotate-right (rotate-right L)))

;problem 4
(format t "~%Palindrom")
(defun palindrom (lst) 
    (append lst (reverse lst) )
)
(print (palindrom L))

;problem 5
(format t "~%Quadratic")
(defun ec2 (a b c)
    (list (/(+(- b) (SQRT(-(* b b) (* 4 a c)))) (* 2 a)) (/(-(- b) (SQRT(-(* b b) (* 4 a c )))) (* 2 a)))
)
(print (ec2 2 7 6))

Follow

Newsletter