Check Palindrome - LISP

Program:
(defun palindrome()
(format t "Enter the string(in \"\"):")
(setf x (read))
(if(string= x (reverse x))
    (format t "palindrome")
    (format t "Not palindrome")
    )                                                                          
)


Output:
[1]> (load 'pal.lsp)
;; Loading file pal.lsp ...
;; Loaded file pal.lsp
T
[2]> (palindrome)
Enter the string(in ""):"malayalam"
palindrome
NIL
[3]> (palindrome)
Enter the string(in ""):"HAI"
Not palindrome
NIL
 [4]>

Armstrong Number Check/Generation - LISP

1.To Check

Program

(defun str(n)
        (setf num n sum 0)
        (loop while (/= n 0) do
            (setf digit (mod n 10))
            (setf sum (+ sum (* (* digit digit) digit)))
            (setf n (floor n 10))
        )
        (if(= sum num) (print "Armstrong Number....")
            (print "Not a Armstrong Number....")
        )
t)

Output:

Break 20 [21]> (load 'arstr.lsp)
;;       Loading file arstr.lsp ...
;;       Loaded file arstr.lsp
T
Break 20 [21]> (str 153)

"Armstrong Number...."
T
Break 20 [21]>


2.To Generate

Program:

(defun arm(rang)
    (do((j 1 (+ j 1))) ((= j rang))
        (setf n j)
        (setf num n sum 1)
        (loop for i from n above 0 do
            (setf f1 (mod n 10))
            (setf sum (+ sum (* (* f1 f1) f1)))
            (setf n (floor n 10))
            (setf i n)
        )
        (if(= sum num) (print num))
    )
t       
)

Output:

Break 15 [16]> (load 'arm.lsp)
;;    Loading file arm.lsp ...
;;    Loaded file arm.lsp
T
Break 15 [16]> (str 157)

153
T
Break 15 [16]>

Strong number Check/Genration - LISP

1.To Check
 
Program:


(defun str(n)
        (setf num n sum 0)
        (loop while (/= n 0) do
            (setf digit (mod n 10))
            (setf sum (+ sum (fact digit)))
            (setf n (floor n 10))
        )
        (if(= sum num) (print "Strong Number....")
            (print "Not a Strong Number....")
        )
t       
)
                 
(defun fact(n)
    (if (= n 0) 1
         (* n (fact(- n 1)))
    )
)

Output:
Break 18 [19]> (load 'str1.lsp)
;;     Loading file str1.lsp ...
;;     Loaded file str1.lsp
T
Break 18 [19]> (str 145)

"Strong Number...."
T
Break 18 [19]>

2.To Generate


Program:
(defun str(nn)
    (do((j 1 (+ j 1))) ((= j nn))
        (setf n j)
        (setf num n sum 1)
        (loop for i from n above 0 do
            (setf f1 (mod n 10))
            (setf sum (+ sum (fact f1)))
            (setf n (floor n 10))
            (setf i n)
        )
        (if(= sum num) (print num))
    )
t       
)
(defun fact(n)
    (if (= n 0) 1
         (* n (fact(- n 1)))
    )
)
Output:

 Break 15 [16]> (load 'str.lsp)
;;    Loading file str.lsp ...
;;    Loaded file str.lsp
T
Break 15 [16]> (str 147)

145
T
Break 15 [16]>

Check Prime/Prime Generation -LISP

Program:

(defun gen(a b)
(if (<= a 1) (setf a 2))
(do ((i a (+ i 1) )) ((= i b))
    (prm i)
    ))
(defun prm( num)
    (setf flag 1) (print num)
    (do ((i 2 (+ i 1) )) ((= i  num))
        (if (= 0 (mod num i)) (setf flag 2)
            )
    )
    (if (= flag 1) (format t "prime") (format t "not prime"))
)

Output:

Break 13 [15]> (load 'pr2.lsp)
;; Loading file pr2.lsp ...
;; Loaded file pr2.lsp
T
Break 13 [15]> (gen 1 20)

2 prime
3 prime
4 not prime
5 prime
6 not prime
7 prime
8 not prime
9 not prime
10 not prime
11 prime
12 not prime
13 prime
14 not prime
15 not prime
16 not prime
17 prime
18 not prime
19 prime
NIL
Break 13 [15]>

Download Runnable Code

String Sort - LISP

Program:

Download Runnable Code

;;BUBBLESORT (STRING)

(defun breadn(n)
(setf arr (make-array n))
(format t "Enter the strings:~&")
(dotimes (x n t)
(setf (aref arr x) (read))))


(defun bprintn(n)
(dotimes(x n t)
    (print (aref arr x))))
(defun swap(x y)
    (setf temp (aref arr x))
    (setf (aref arr x) (aref arr y))
    (setf (aref arr y) temp)
)

(defun bsortn ( n )
    (breadn n);;(bprintn n)
    (do (( i 1 (+ i 1)))
    ((= i n))
    (setf k (- n 1))
    (do((j 0 (+ j 1    )))
    ((= j k))
    (setf m (+ j 1))
    (if (string> (aref arr j) (aref arr m))
        (swap j m))
))
    (bprintn n)
)
Output:
Break 2 [4]> (load 'bbs.lsp)
;; Loading file bbs.lsp ...
;; Loaded file bbs.lsp
T
Break 2 [4]> (bsortn 5)
Enter the strings:
orange
guava
apple
banana
mango

APPLE
BANANA
GUAVA
MANGO
ORANGE
T
Break 2 [4]>

Download

Abundant Numbers - LISP

Download Runnable Program

Program:

;Abundant numbers
(defun abn(n)
        (format t "<<<GENERATING ABUNDANT NUMBERS IN THE RANGE 1 TO ~D" N)
      ;; (setf sum 1)
    (do((i 1 (+ i 1))) ((= i (+ n 1)))
            (setf sum (sumd i)    dbl (* 2 i))
             (if(> sum dbl)    (print i))
    )
   
)
 
(defun sumd(n)
    (setf m (floor n 2))(setf sum 1 )
    (do((i 2(+ i 1))) ((> i m))
        (if(= (mod n i) 0)
                (setf sum (+ sum i) )
        )
       
    )
    (setf sum (+ sum n) )
    sum
)
Output:
Break 2 [4]> (load 'abn.lsp)
;; Loading file abn.lsp ...
;; Loaded file abn.lsp
T
Break 2 [4]> (abn 50)
<<<GENERATING ABUNDANT NUMBERS IN THE RANGE 1 TO 50
12
18
20
24
30
36
40
42
48
NIL
Break 2 [4]>




Download

* Tree Generation - Lisp

Lisp programme to generate the following structure:

*
**
***
****
*****
******

Program: 

Download Runnable Code

(defun gen(n)
    (dotimes(x (+ n 1) t)
        (dotimes(y x t)  (format t "*")
        )
        (format t "~&")
    )
)

Output:

Break 2 [4]> (load 'ge.lsp)
;; Loading file ge.lsp ...
;; Loaded file ge.lsp
T

Break 2 [4]> (gen 6)
*
**
***
****
*****
******
 

Download 

LISP PROGRAMS -S5

Factorial of number

Fibonacci Series

Bubblesort

Linearsearch

Binarysearch

Tower of Hanoi

Bubblesort - LISP

;;BUBBLESORT
(defun bsortn (n)
    (format t "    <<<BUBBLESORT FOR ~D NUMBERS>>>~&" n)
    (breadn n)
    (do (( i 0 (+ i 1))) ((= i (- n 1)))
        (do ((j 0 (+ j 1))) ((= j (- (- n i) 1)))
            (if (> (aref arr j) (aref arr (+ j 1)))
                (swap j (+ j 1))
            )
        )
    )
    (bprintn n)
)
(defun breadn(n)
    (setf arr (make-array n))
    (format t "Enter the numbers:~&")
    (dotimes (x n t)
        (setf (aref arr x) (read) )
    )
)
(defun bprintn(n)
    (dotimes(x n t)
        (print (aref arr x) )
    )
)
(defun swap(x y)
    ( setf temp (aref arr x) )
    ( setf (aref arr x) (aref arr y) )
    ( setf (aref arr y) temp )
)

Output:
Break 1 [2]> (load 'b.lsp)
;; Loading file b.lsp ...
;; Loaded file b.lsp
T
Break 1 [2]> (bsortn 5)
<<<BUBBLESORT FOR 5 NUMBERS>>>
Enter the numbers:
5
4
3
2
1
1
2
3
4
5
T
Break 1 [2]>            http://www.2k8618.blogspot.com/

Linearsearch - LISP

Program:
(defun linsearch(n)
    (format t "~&<<LINEARSEARCH >>")
    (readn n)
    (format t "~&Enter the number to be searched:")
    (setf num (read))
    (setf flag 1)
    (do ((x 0 (+ x 1))) ((= x n))
        (if(= num (aref arr x))
            (setf flag 2)
        )
    )
    (if (= flag 2)
        (format t "Number present...")
        (format t "Number not present...")
    )
)
(defun readn(n)
    (setf arr (make-array n))
    (format t "~&Enter the ~d numbers:" n )
    (dotimes (x n t)
        (setf (aref arr x) (read))
    )
)

Output:
Break 4 [5]> (load 'ls.lsp)
;;  Loading file ls.lsp ...
;;  Loaded file ls.lsp
T
Break 4 [5]> (linsearch 5)
<<LINEARSEARCH >>
Enter the 5 numbers:1
2
3
4
5
Enter the number to be searched:4
Number present...
NIL
Break 4 [5]>

Towers of Hanoi - Programming Environment Lab - LISP

Program:
(defun hanoi(n)
    (dohanoi n 3 1 2)
)

(defun dohanoi(ndisks destination source temp)
    (cond
        ((> ndisks 0) (dohanoi (- ndisks 1) temp source destination)
                (format t "Move the top disk from peg~d to peg~d ~&" source destination)
                (dohanoi (- ndisks 1) destination temp source)
        )
    )
)

Output:
Break 4 [5]> (load 'h.lsp)
;; Loading file h.lsp ...
;; Loaded file h.lsp
T
Break 4 [5]> (hanoi 3)
Move the top disk from peg1 to peg3
Move the top disk from peg1 to peg2
Move the top disk from peg3 to peg2
Move the top disk from peg1 to peg3
Move the top disk from peg2 to peg1
Move the top disk from peg2 to peg3
Move the top disk from peg1 to peg3
NIL
Break 4 [5]>

Generation of Fibonacci Series - Recursion & Iteration -LISP

Program:
;;FIBONACCI SERIES
(defun fib(n)
    (setf a 0 b 1)
    (format t "~&<<<Generation of Fibonacci series with ~D terms>>>~&1.Iterative method~&2.Recursive method~&Enter your choice:" n)
    (setf x (read))
    (cond
        ((= n 1) (print a))
        ((= n 2) (print a)(print b))
        ((> n 2) (if (= x 1)
                (fib1 n))
        (if (= x 2)
             (do ((i 0 (+ i 1))) ((= i n))
                (print (fib2 i)))))
    )
)
(defun fib1(n)
                ;Iterative method
    (print a)(print b)
    (do((i 2 (+ i 1))) ((= i n))
        (setf c (+ a b))
        (print c)
        (setf a b b c))
)
(defun fib2(n)
    (cond
        ((= n 0) 0)
        ((= n 1) 1)
        ((> n 1)(+ (fib2 (- n 1)) (fib2 (- n 2))))
                ;Recursive method
    )
)

Output:
Break 2 [3]> (load 'f.lsp)
;;  Loading file f.lsp ...
;;  Loaded file f.lsp
T
Break 2 [3]> (fib 5)
<<<Generation of Fibonacci series with 5 terms>>>
1.Iterative method
2.Recursive method
Enter your choice:1

0
1
1
2
3
NIL
Break 2 [3]> (fib 5)
<<<Generation of Fibonacci series with 5 terms>>>
1.Iterative method
2.Recursive method
Enter your choice:2

0
1
1
2
3
NIL
Break 2 [3]>

Factorial of a number - LISP

Program:
;;FACTORIAL OF A NUMBER USING RECURSION AND ITERATION
(defun factorial(n)
    (format t "~&<<<Finding factorial of ~D>>>~&1.Iterative method~&2.Recursive method~&Enter your choice:" n)
    (setf x (read))
    (if (= x 1) (format t "factorial = ~D (using iteration)" (fact1 n)))
    (if (= x 2) (format t "factorial = ~D (using recursion)" (fact2 n)))
)
(defun fact1(n) ;;function for iterative method
    (setf f 1)
    (do ((i n (- i 1))) ((= i 1))
        (setf f (* f i))
    )
f)
(defun fact2(n) ;;function for recursive method
    (if (= n 0) 1
        (* n (fact2(- n 1)))
    )
)

Output:
Break 1 [2]> (load 'fact.lsp)
;; Loading file fact.lsp ...
;; Loaded file fact.lsp
T
Break 1 [2]> (factorial 5)
<<<Finding factorial of 5>>>
1.Iterative method
2.Recursive method
Enter your choice:1
factorial = 120 (using iteration)
NIL
Break 1 [2]> (factorial 5)
<<<Finding factorial of 5>>>
1.Iterative method
2.Recursive method
Enter your choice:2
factorial = 120 (using recursion)
NIL                   
Break 1 [2]>

Binary Search - LISP

Program:
;;BINARYSEARCH
(defun binsearch(n)
    (format t "~&<<BINARYSEARCH>>~&")
    (bsreadn n)
    (bssortn n)
    (format t "~&Enter the number to be searched:")
    (setf p (read))
    (setf flag 1)
    (setf first 0)
    (setf last (- n 1))
    (dotimes (x n t)
        (setf mid (floor (+ first last) 2))
        (if (= (aref arr mid) p)(setf flag 0))
        (cond
            ( (>(aref arr mid) p) (setf last (- mid 1)))
            ( (<(aref arr mid) p) (setf first (+ mid 1)))
        )
    )
    (if (= flag 1)
        (format t "Number Not found..."))
    (if (= flag 0)
        (format t "Number found..."))
)
(defun bsreadn(n)
    (setf arr (make-array n))
    (format t "Enter the ~d numbers:" n)
    (dotimes (x n t)
        (setf (aref arr x) (read))
    )
)
                        ;;http://www.2k8618.blogspot.com/
(defun bssortn(n)
    (do (( i 1 (+ i 1))) ((= i n))
        (do ((j 0 (+ j 1))) ((= j (- n 1)))
            (if (> (aref arr j) (aref arr (+ j 1)))
                (bswap j (+ j 1))
            )
        )
    )
    (format t "Sorting....")
    (bprintn n)
)
(defun bprintn(n)
    (dotimes(x n t)
        (print (aref arr x))
    )
)
(defun bswap(x y)
    (setf temp (aref arr x))
    (setf (aref arr x) (aref arr y))
    (setf (aref arr y) temp)
)

Output:
Break 2 [3]> (load 'bin.lsp)
;;  Loading file bin.lsp ...
;;  Loaded file bin.lsp
T
Break 2 [3]> (binsearch 5)
<<BINARYSEARCH>>
Enter the 5 numbers:5
4
3
2
1
Sorting....
1
2
3
4
5
Enter the number to be searched:3
Number found...
NIL
Break 2 [3]> (binsearch 5)
<<BINARYSEARCH>>
Enter the 5 numbers:1
4
2
3
5
Sorting....
1
2
3
4
5
Enter the number to be searched:6
Number Not found...
NIL
Break 2 [3]>