99 Lisp problems

99.lisp

(setf *random-state* (make-random-state t))

(defun my-last (lst) 
	(if (null (cdr lst))
		(car lst)
		(my-last (cdr lst))))

(print "1) my-last")
(print (my-last '(a b c d)))

(defun my-but-last (lst)
	(if (null (cddr lst))
		lst
		(my-but-last (cdr lst))))
(print "2) my-but-last:")
(print (my-but-last '(a b c d)))

(defun element-at (lst k)
	(if (= k 1)
		(car lst)
		(element-at (cdr lst) (- k 1))))
(print "3) element-at:")
(print (element-at '(a b c d) 1))

(defun my-length (lst)
	(if (null lst)
		0
		(+ 1 (my-length (cdr lst)))))
(print "4) my-length:")
(print (my-length '(a b c d)))

(defun my-reverse2 (lst)
	(if (null lst)
		'()
		(append (my-reverse2 (cdr lst)) (list (car lst)))))
(print "my-reverse2:")
(print (my-reverse2 '(a b c d)))

(defun my-reverse (lst)
	(my-reverse-inner lst '()))
(defun my-reverse-inner (lst res)
	(if (null lst)
		res
		(my-reverse-inner (cdr lst) (cons (car lst) res))))
(print "5) my-reverse:")
(print (my-reverse '(a b c d)))

(defun palindrome (lst)
	(equal lst (my-reverse lst)))
(print "6) palindrome:")
(print (palindrome '(x a m a x)))

(defun my-flatten (lst)
	(if (null lst)
		'()
		(if (listp (car lst))
			(append (my-flatten (car lst)) (my-flatten (cdr lst)))
			(append (list (car lst)) (my-flatten (cdr lst))))))
(print "7) my-flatten:")
(print (my-flatten '(a (b (c d) e))))

(defun compress (lst)
	(if (null lst)
		'()
		(if (equal (car lst) (cadr lst))
			(compress (cdr lst))
			(cons (car lst) (compress (cdr lst))))))
(print "8) compress:")
(print (compress '(a a a a b c c a a d e e e e)))

(defun pack (lst)
	(if (null lst)
		'()
		(let ((res (pack-same (cdr lst) (list (car lst)))))
			(if (null (cdr res))
				(list (car res))
				(cons (car res) (pack (cdr res)))))))
(defun pack-same (lst res)
	(if (equal (car res) (car lst))
		(pack-same (cdr lst) (cons (car lst) res))
		(cons res lst)))
(print "packe-same:")
(print (pack-same '(a a a) '(a)))
(print "9) pack:")
(print (pack '(a a a a b c c a a d e e e e)))

(defun encode (lst)
	(let ((packed (pack lst)))
		(mapcar (lambda (x)
			(list (my-length x) (car x))) packed)))
(print "10) encode:")
(print (encode '(a a a a b c c a a d e e e e)))

(defun encode-modified (lst)
	(let ((packed (pack lst)))
		(mapcar (lambda (x)
			(if (> (my-length x) 1)
				(list (my-length x) (car x))
				(car x))) packed)))
(print "11) encode-modified:")
(print (encode-modified '(a a a a b c c a a d e e e e)))

(defun decode (lst)
	(decode-inner lst '()))
(defun decode-inner (lst res)
	(if (null lst)
		res
		(if (listp (car lst))
			(decode-inner (cdr lst) (append res (repeat-elem (cadar lst) (caar lst))))
			(decode-inner (cdr lst) (append res (list (car lst)))))))
(defun repeat-elem (elem n)
	(if (zerop n)
		'()
		(cons elem (repeat-elem elem (- n 1)))))
(print "12) decode:")
(print (decode '((4 A) B (2 C) (2 A) D (4 E))))

(defun encode-direct (lst)
	lst)
(print "13) encode-direct:")
(print (encode-direct '(a a a a b c c a a d e e e e)))

(defun dupli (lst)
	(if (null lst)
		nil
		(append (list (car lst) (car lst)) (dupli (cdr lst)))))
(print "14) dupli:")
(print (dupli '(a b c c)))

(defun repli (lst n)
	(if (null lst)
		nil
		(append (repeat-elem (car lst) n) (repli (cdr lst) n))))

(print "15) repli:")
(print (repli '(a b c) 3))

(defun drop (lst n &optional (i n))
	(cond ((null lst) nil)
		((= i 1) (drop (cdr lst) n n))
		(t (cons (car lst) (drop (cdr lst) n (- i 1))))))
(print "16) drop n-th:")
(print (drop '(a b c d e f g h i k) 3))

(defun split (lst n &optional (left '()))
	(if (zerop n)
		(cons left (list lst))
		(split (cdr lst) (- n 1) (append left (list (car lst))))))
(print "17) split:")
(print (split '(a b c d e f g h i k) 3))

(defun slice (lst i k)
	(cond ((> i 1) (slice (cdr lst) (- i 1) (- k 1)))
		((> k 0) (cons (car lst) (slice (cdr lst) i (- k 1))))))
(print "18) slice:")
(print (slice '(a b c d e f g h i k) 3 7))

(defun rotate (lst n)
	(if (= n 0)
		lst
		(rotate (append (cdr lst) (list (car lst))) (- n 1))))
(print "19) rotate:")
(print (rotate '(a b c d e f g h) 3))

(defun remove-at (lst n &optional (i 1))
    (if (= n i)
        (cdr lst)
        (cons (car lst) (remove-at (cdr lst) n (+ i 1)))))
(print "20) remove-at:")
(print (remove-at '(a b c d) 1))

(defun insert-at (elm lst n &optional (left nil))
	(if (= n 1)
		(cons left (cons elm lst))
		(insert-at elm (cdr lst) (- n 1) (append left (car lst)))))
(print "21) insert-at:")
(print (insert-at 'alfa '(a b c d) 2))

(defun range (n k &optional res)
	(if (> n k)
		res
		(range n (- k 1) (cons k res) )))
(print "22) range:")
(print (range 4 9))

(defun rnd-select (lst n &optional res)
	(if (= n 0)
		res
		(let ((pos (+ 1 (random (my-length lst)))))
			(rnd-select (remove-at lst pos) (- n 1) (cons (element-at lst pos) res)))))
(print "23) rnd-select:")
(print (rnd-select '(a b c d e f g h) 3))

(defun lotto-select (n k)
	(rnd-select (range 1 k) n))
(print "24) lotto:")
(print (lotto-select 6 49))

(defun rnd-permu (lst &optional res)
	(rnd-select lst (my-length lst)))
(print "25) rnd-permu:")
(print (rnd-permu '(a b c d e f)))