Lisp Programming Examples

test2

lisp

(print (setq l1 '(1 2 (3) 4 5)))

(print (car l1))
(print (cdr l1))
(print (nthcdr 3 l1))
(print (nth 4 l1))

(print "L2")

(print (setq l2 '((1 (2) 3) 4 5 (6(7(8) ana (are (mere)))))))
(print (caar(cdar(cdar(cddr(cdr l2))))))
(print (caadar(nthcdr 2 (cdar(cdar(cddr(cdr l2)))))))
(print (caar(cddr(cdr l2))))

lisp

(print "Enter a number")
(terpri)
(setf x (read))
(format t "Enter ~S numbers " x)
(terpri)
(setf flag 0)
(setf my-array (make-array x))
(dotimes (y x)
(setf (aref my-array y) (read))
)
(write-line "Enter a number to be searched")
(setf q (read))
(dotimes (y x)
(if (= (aref my-array y) q)
(progn (write-line "Number found")
(setf flag 1))
)
)
 
(if ( = flag 0)
(format t "The number ~S doesnot exist" q)
)

Execute LISP Online

lisp

(defvar x (list 1 2 3 4 5))
(defvar y (list 6 7 8 9 10))
(defvar z (list 11 12))
(defun list_reference (items n)
    (if (= n 0)
        (car items)
        (list_reference (cdr items) (- n 1))
        )
    )
(defun list_length (items)
    (if (null items)
        0
        (+ 1 (list_length (cdr items))))
    )

(defvar w (list (list 1 2) (list 3 4)))
(defun count_leaves (tree)
    (if (null tree)
    0
    (if (not (listp tree))
        1
        (+ (count_leaves(car tree)) (count_leaves(cdr tree)))
        )
    )
)
(defun count_leaves (tree)
    (if (null tree)
    0
    (if (not (listp tree))
        1
        (+ (count_leaves(car tree)) (count_leaves(cdr tree)))
        )
    )
)
(defun deep_reverse (_list)
    (if (null _list)
        _list
        (if (listp (car _list))
        (_append(deep_reverse(cdr _list)) (list(deep_reverse (car _list))))
        (_append(deep_reverse(cdr _list)) (list (car _list)))
        )
              
    )
)
(defun _append(list_1 list_2)
    (if (null list_1)
        list_2
        (cons (car list_1) (_append (cdr list_1) list_2)))
    )
(defun reverse_list (_list)
    (if (null _list)
    _list
    (_append(reverse_list (cdr _list)) (list (car _list))))
    )
(print (reverse_list w))
(print (deep_reverse w))

link

lisp

char mevsim[10];
   int sayi;
   printf("Hangi mevsimde gideceksiniz:");
   scanf("%s",&mevsim);
   printf("Kaç kişi ile katilacaksiniz:");
   scanf("%d",&sayi);
   int borc=0;
   switch(mevsim[10]){
    case 'kıs':
    borc=150*sayi;
    printf("Toplam borcunuz %d",borc);
    break;
    case 'ilkbahar':
        borc=50*sayi;
    printf("Toplam borcunuz:%d",borc);
    break;
    case 'yaz':
        borc=250*sayi;
    printf("Toplam borcunuz:%d",borc);
    break;
    case 'sonbahar':
        borc=100*sayi;
    printf("Toplam borcunuz:%d",borc);
    break;
    default:
        printf("yanlış girdi..");




   }

Execute LISP Online

lisp

(defun resolution(1c)

(cond 
((null(second 1c))  (cond ((equal (first 1c) '(NIL NIL)) nil)     ; (NIL NIL) contradiction case
                          ((eql (first (first 1c)) 'nil)  nil)  ; <- A case
                          (t                    t)      ; ow, not a contradiction 

                        ) )

(t (resolution(append (list(ResolveClauses (first 1c) (second 1c) )) (rest(rest 1c)) ))); append resolution of two clauses to end of list, run until only one list left

  )



    )
(defun ResolveClauses(x y)

    (print x)
    (print y)
    (print(first x))
    (print (second y))
    (print(second x))
    (print(first y))
    (print(first(second x)))
    (print(not (null (member (first(second x)) (first y)))))
   ; (print(append x (list(ResolveClauseMembers (first x)(second y))
    
    ;)))
    (print (ResolveClauseMembers(first x)(second y))) ;clause 1
    (print (mirror(ResolveClauseMembers(second x)(first y)))   ) ;clause 2
  ;  (print(append(first (ResolveClauseMembers (first x)(second y)) )
   ;              (first (ResolveClauseMembers(first y)(second x)))
    
    ;  )
    ;)
    
  ;  (print(append(second (ResolveClauseMembers (first x)(second y)) )
   ;              (second (ResolveClauseMembers(first y)(second x)))
    ;
     ; )
    ;)
    (print '(CLAUSES))
   (print (ResolveClauseMembers(first x)(second y))) ;clause 1
   (print (mirror(ResolveClauseMembers(second x)(first y)))) ;clause 2
    
    
    ;grab result without duplicates
    (setf z nil)
    
    ;(list(first(ResolveClauseMembers(first x)(second y))))
    
    
              ;  (print                 (append z (list(first(ResolveClauseMembers(first x)(second y))))))

;(if (null (first(ResolveClauseMembers(first x)(second y))) )
 ;   (setf z (append z (list nil)))

    (if (null (member z  (first(ResolveClauseMembers(first x)(second y)))) )
                 (setf z (append z (first(ResolveClauseMembers(first x)(second y)))))
                 
                 
            )

;)

;(if  (null (mirror(ResolveClauseMembers(second x)(first y))))
 ;       (setf z (append z (list nil)))
           ; (print(null (list (member z  (first(ResolveClauseMembers(first x)(second y)))) )))
            (if (null (member z (first (mirror(ResolveClauseMembers(second x)(first y)))) ))
                  (setf z (append z (first(mirror(ResolveClauseMembers(second x)(first y))))))
                 
            )
;)
    
    (setf v nil)
            
       ; (setf v (list(second(mirror(ResolveClauseMembers(second x)(first y))))))

;(if (null(second(mirror(ResolveClauseMembers(second x)(first y)))))
 ;   (setf v (append v (list nil)))
        (if (null (member v (second(mirror(ResolveClauseMembers(second x)(first y))))))
        (setf v (append v (second(mirror(ResolveClauseMembers(second x)(first y))))))
                 
            )

;)
;(if (null (second (ResolveClauseMembers(first x)(second y))) )
 ;   (setf v (append v (list nil)))
    (if (null (member v  (second (ResolveClauseMembers(first x)(second y))) ))
        (setf v (append v (second(ResolveClauseMembers(first x)(second y)))))
                 
            )
;)
            
                 ;(print z)
                 ;(print v)
                ; (print  (append z (list(first(mirror(ResolveClauseMembers(second x)(first y)))))))
                 ;(print (append z v)) ;result without duplicates
               
               
               (print 'ZVCombination)
               (print (append (list (RemoveDuplicateAtoms z)) (list (RemoveDuplicateAtoms v))))
               ;(print (eliminateDuplicates v))
               ;(print v)
               
                (cond 
                
                  (t (append (list (RemoveDuplicateAtoms z)) (list (RemoveDuplicateAtoms v))))
                )
                 
    ;combine result
   ; (print (append (list(append(first (ResolveClauseMembers (first x)(second y)) )
;                 (first (mirror(ResolveClauseMembers(second x)(first y))))))
;                 (list (append(second (ResolveClauseMembers (first x)(second y)) )
;                (second (mirror(ResolveClauseMembers(second x)(first y))))
;      ))
 ;     )
 ;   )
;TO-DO: Append combine result to end of 1c list
;       Check all cases for resolveclausemembers
)

(defun ResolveClauseMembers(x y )

;(print x)
;(print y)
(setf xval x)
(setf yval y)

;Iterate through clause x looking for matching members in clause y
(loop for x1 in x

      
      if (member x1 y) ;remove atom from both clauses, if match occurs
      do (progn (setf xval (RemoveAtomFromList x1 xval)) (setf yval (RemoveAtomFromList x1 yval)))
      
      )
      
      ;return value in ((X)(Y)) form
    (append (list xval) (list yval))
)




(defun mirror(e)
       (cond 
		( (null e)    '()) ;check if e is the empty list or nil
		((atom e) e) ;check if e is a single atom
		((append (mirror(rest e)) (cons(mirror(first e)) '())))  ;Otherwise, Reverse items in any sublist and append these lists in reverse order
		

	)
  )

; change this
(defun RemoveAtomFromList (atom array)
   (cond
      ((null array) ())
        ((eq (first array) atom) (RemoveAtomFromList atom (rest array)))
      (t (append (list (first array) ) (RemoveAtomFromList atom (rest array))))
    )

)

;change this
(defun RemoveDuplicateAtoms (array)
  (cond 
        ((null array) array)
        ((member (first array) (rest array)) (RemoveDuplicateAtoms (rest array)))
        (t (append (list (first array)) (RemoveDuplicateAtoms (rest array))))
    
    )
)
    

    
    
(print  (resolution '( ((C)()) (()(C))  )))

dickbutt

lisp

(defun triangle (x)
    (if (stringp x)
        (progn
            (write-line (concatenate 'string "(triangle " (write-to-string x) ") please enter an odd integer"))
            (return-from triangle 0)
        )
    )
    (if (= (mod x 2) 0)
        (progn
            (write-line (concatenate 'string "(triangle " (write-to-string x) ") even numbers are not valid input, please enter an odd integer"))
            (return-from triangle 0)
        )
    )
    (if (< (mod x 2) 1)
        (progn
            (write-line (concatenate 'string "(triangle " (write-to-string x) ") decimal numbers are not valid input, please enter an odd integer"))
            (return-from triangle 0)
        )
    )

    (setq str "1")
    (write-line str)
    (loop for i from 1 to (+ (/ x 2) 1) do
        ;; (print (format t "~d" i))
        (setq ci (+ (* i 2) 1))
        (setq str (concatenate 'string str " " (write-to-string ci)))
        (write-line str)
    )
    (write-line "-----")
)


(triangle 7)
(triangle 9)
(triangle 23)
(triangle 2.5)
(triangle 4)
(triangle "4")

Execute LISP Online

lisp

(SETQ L '(A B C D))
(PRINT L)
(PRINT (CAR L))
(PRINT (CAR (LAST L)))
(PRINT (SETQ L (SUBST 'X (CAR (LAST L)) L)))
(PRINT (SETQ L (SUBST 'D (CAR L) L)))
(PRINT (SUBST 'A (CAR (LAST L)) L))
;(PRINT (SUBST 'A 'D L))

ffff

lisp

(defun ispalindrome (list)
(equal list (reverse list)))

Execute LISP Online

lisp

;; 11) Escriba una función Filtra-vocales que reciba como argumento una lista (con elementos de
;; cualquier tipo y anidada a cualquier nivel de profundidad) y, como respuesta entregue una copia
;; de la lista argumento en la cual se han removido las letras vocales (tanto mayúsculas como
;; minúsculas).
;; Answer: A simbol is not a vowel
(defun vocal? (elem)
    (or (equal current #\a)
		 (equal current #\e)
		 (equal current #\i)
		 (equal current #\o)
		 (equal current #\u)
		 (equal current #\A)
		 (equal current #\E)
		 (equal current #\I)
		 (equal current #\O)
		 (equal current #\U)
		 (equal current "a")
		 (equal current "e")
		 (equal current "i")
		 (equal current "o")
		 (equal current "u")
		 (equal current "A")
		 (equal current "E")
		 (equal current "I")
		 (equal current "O")
		 (equal current "U")))

(defun vowelsFilter (list)
    (let ((current (first list))
         (left (rest list)))
        (cond ((null list) NIL)
            ((listp current) (append (flatten current) (flatten left)))
            ((not (vocal? current)) (append (list current) (flatten left))))))
;; Tests:
(print (vowelsFilter '(1 "a" c (a (#\a) #\c))))      ;; => (1 C A #\c)
(print (vowelsFilter '((4) (#\c) T ("b") (a (b) c))));; => (4 #\c T "b" A B C)
(print (vowelsFilter '(0 #\a (b) 1.2 (4 ("u") 3/2))));; => (0 B 1.2 4 3/2)
(print (vowelsFilter '(2 T "e" ((("o")) ("i") bc)))) ;; => (2 T BC)
(print "================================================")

JAB-Test-Lisp

lisp

(write-line "Hello World")
(write-line "13")
(write (car '(rose violet daisy buttercup)))
(write-line "")
(write (cdr '(rose violet daisy buttercup)))
(terpri)
(write (cons 1 2))
(terpri)
(write (cons 'a 'b))
(terpri)
(write (cons 1 nil))
(terpri)
(write (cons 1 (cons 2 nil)))
(terpri)
(write (cons 1 (cons 2 (cons 3 nil))))
(terpri)
(write (cons 'a (cons 'b (cons 'c nil))))
(terpri)
(write ( car (cons 'a (cons 'b (cons 'c nil)))))
(terpri)
(write ( cdr (cons 'a (cons 'b (cons 'c nil)))))

Follow

Newsletter