Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
Tutorialspoint

save

;(setq a '(a b c))
;(print a)


(defun endcons (A L)
    (cond 
        ((null L) (cons A nil))
        (T(cons (car L) (endcons A (cdr L))))
    )
)

(defun my-length(L)(cond
    ((null L) 0)
    (T(+ 1(my-length(cdr L))))
    )
)
    
(defun my-memq(_symbol _list)(cond
    ((null _list) nil)
    ((eq _symbol (car _list)) _list)
    (T (my-memq _symbol (cdr _list)))
    )
)


;(defun my-append(_list1 _list2)(cond
;    ((null _list2) _list1)
;    ;(T (my-append (reverse (cons (car _list2) (reverse _list1))) (cdr _list2)))
;    ;(T (my-append (endcons (car _list2) _list1) (cdr _list2)))
;    ;(T (my-append (cons (car _list2) _list1) (cdr _list2)))
;    (T (my-append (cons _list1 _list2) nil))
;    )
;)


(defun my-append(L1 L2)(cond
    ((null L2) L1)
    ((null L1) L2)
    ((Listp L1) (cons (car L1) (my-append (cdr L1) L2)))
    ((Listp L2) (cons (car L1) (my-append L1 (cdr L2))))
    ;(T (my-append (cdr L1) (cdr L2)))
    )
)

(defun my-attach(O L)
    (cond 
        ((null L) (cons O nil))
        (T(cons (car L) (my-attach O (cdr L))))
    )
)


(defun my-assoc(A L)(cond
    ((null L) nil)
    ((eq A (car (car L))) (car L))
    (T (my-assoc A (cdr L)))
    )
)


;(defun freq(A L)(cond
;    ((null L) 0)
;    ;((and (atom L) ) 1)
;    (T(+ (freq A (car L)) (freq A (cdr L))))
;    )
;)


(defun freq(A L)
    (cond
        ((null L) 0)
        ((Atom L)
            (cond 
                ((eq A L) 1)
                (T 0)
            )
        )
        (T(+ (freq A (car L)) (freq A (cdr L))))
    )
)


(defun mapping(L val)
    (cond
        ((null L) nil)
        ((> val (car (car L)))  (cons (car (cdr (car L))) (mapping (cdr L) val)) )
        (T(mapping (cdr L) val))
    )  
)


;(defun my-last(A L)
;    (cond
;        ((null L) nil)
;        ;((eq A (car L)) (cons A (my-last A (cdr L))))
;        ((eq A (car L)) (cons nil (cons A (my-last A (cdr L)))))
;        ;;((eq A (car L)) (cons A (my-last A (cdr L))))
;        ;(T(cons (car L) (cdr L)))
;        (T(cons (car L) (my-last A (cdr L))))
;        ;;(T(my-last A (cdr L)))
;    )
;)

;(defun my-last(A L)
;    (cond
;        ((null L) nil)
;        ;((eq A (car (my-reverse L))) (cons(car (my-reverse L)) nil))
;        ;((eq A (car (my-reverse L))) (cons(car (my-reverse L)) (my-last A nil)))
;        ;(T(cons(car (my-reverse L)) (cdr (my-reverse L))))
;        ((eq A (car (my-reverse L)))(cons(car (my-reverse L)) (cdr (my-reverse L))))
;        (T (my-last A (reverse (cdr (reverse L)))))
;    )
;)


;(defun my-last(A L)
;    (cond
;        ((null L) nil)
;        ((eq A (car (my-reverse L))) nil)
;        (T (cons (car (my-reverse L)) (my-last A (my-reverse (cdr (my-reverse L))))))
;    )
;)


;(defun my-last(A L)
;    (cond
;        ((null L) nil)
;        ;((eq A (car (my-reverse L))) A)
;        ;(T (cons (my-last A (my-reverse (cdr (my-reverse L)))) (car (my-reverse L))))
;        ((eq A (car (my-reverse L))) (my-attach A nil) )
;        (T (my-append (my-last A (my-reverse (cdr (my-reverse L)))) (my-attach(car (my-reverse L)) nil)))
;    )
;)



;(defun my-last(A L)
;    (cond
;        ((eq A (car (my-reverse L)))(cons(car (my-reverse L)) (cdr (my-reverse L))))
;        (T (my-last A (reverse (cdr (reverse L)))))
;    )
;)



;(defun my-last(A L)
;  javascript:void(0)  (cond
;        ((null L) nil)
;        ;((eq A (car (my-reverse L))) A)
;        ;(T (cons (my-last A (my-reverse (cdr (my-reverse L)))) (car (my-reverse L))))
;        ((eq A (car (my-reverse L))) (my-attach A nil) )
;        (T (my-append (my-last A (my-reverse (cdr (my-reverse L)))) (my-attach(car (my-reverse L)) nil)))
;    )
;)


(defun my-last-helper-two(A L)
    (cond
        ((null L) nil)
        ((eq A (car L)) (my-last A (cdr L)))
        (T(my-last A  L))
    )
)



(defun my-last-two(A L)
    (cond
        ((null L) nil)
        ((null (my-memq A L)) nil)
        ((null (my-memq A (cdr L))) L)
        (T(my-last-two A (cdr L)))
    )
)


(defun my-last-three(A L)
    (cond
        ;((eq L (my-last-helper-two A L)) nil)
        ;((equal L (my-last-helper-two A L)) nil)
        ((eq (my-length L) (my-length (my-last-helper-two A L))) nil)
        (T(my-last-helper-two A L))
    )
)









(defun my-last-helper(A L)
    (cond
        ((null L) nil)
        ;((eq A (car L)) (cdr L) )
        ;((eq A (car L)) (cdr L))
        ((eq A (car L)) (cdr L))
        ;(T(my-last-helper A (cdr L)))
        (T(my-last-helper A (cdr L)))
    )
)




(defun my-last(A L)
    (cond
        ((null L) nil)
        ((eq A (car (my-reverse L))) (my-attach A nil) )
        (T (my-append (my-last A (my-reverse (cdr (my-reverse L)))) (my-attach(car (my-reverse L)) nil)))
    )
)





(defun my-reverse(L)
    (cond
        ((null L) nil)
        (T(my-append (my-reverse (cdr L)) (my-attach (car L) nil) ))
        ;((Atom L) L)
        ;(T(my-append (my-reverse (cdr L)) (List (car L)) ))
        ;(T(cons (my-reverse (cdr L)) (car L) ))
        ;(T(my-append (my-reverse (cdr L)) ('(car L)) ))
    )

)



;(defun my-last-two(A L)
;    (cond
;        ((null L) nil)
        ;((null (my-last-helper A L)) (cons A L))
        ;((null (my-last-helper A L)) L)
        ;((null (my-last-helper A L)) nil)
        ;((null (cdr (my-last-helper A L))) A)
;        ((null (my-last-helper A L)) (cons A L))
        ;(T(my-last-two A (my-last-helper A  L)))
;        (T(my-last-two A (my-last-helper A  L)))
;    )
;)

;(print (my-last-two 'g '(a b c a b c a b c d e f g)))
;(print (my-last-two  'f '(a b c a b c a b c d e f g)));

;(print (my-last-two  'h '(a b c a b c a b c d e f g)))
;(print (my-last-two  'a '(a b c a b c a b c d e f g)))
;(print (my-last-two  'b '(a b c a b c a b c d e f g)))


;(print (my-last-helper 'g '(a b c a b c a b c d e f g)))


;(print (my-last-helper 'c (my-last-helper 'c '(a b c a b c a b c d e f g))))

;(print (my-last-helper 'a (my-last-helper 'a '(a b c a b c a b c d e f g))))

;(print(my-memq 'a (my-memq 'a '(a b c a b c a b c d e f g))))




(print (my-last-two 'a '(a b c a b c a b c d e f g)))
(print (my-last-two 'b '(a b c a b c a b c d e f g)))
(print (my-last-two 'c '(a b c a b c a b c d e f g)))
(print (my-last-two 'g '(a b c a b c a b c d e f g)))
(print (my-last-two 'h '(a b c a b c a b c d e f g)))




(defun is-pattern?(pat str)
    (cond
        ((null pat) nil)
        ((null str) nil)
        ;((eq (car pat) (car str)) (car pat))
        ;((eq (car pat) (car str)) (cons (car pat) (is-pattern? (cdr pat) (cdr str)) ))
        ;(T((cons is-pattern? (cdr pat) (cdr str))))
        ((eq (car pat) (car str)) 
            (cond
                    ((null (cdr pat)) str)
                    (T(cons (car pat) (is-pattern? (cdr pat) (cdr str)))) 
            )
        )
        (T(is-pattern? pat (cdr str)))
    )
)


(defun first-atom(L)
    (cond
        ((null L) nil)
        ((Atom L) L)
        ((Listp L) (first-atom (car L)))
    )
)


;(defun find-all(A L)
;    (cond
;        ((null L) nil)
;        ((eq A (car L)) (cons (car (cdr L)) (find-all A (cdr L))) )
;        (T(find-all A (cdr L)))
;    )
;)


(defun find-all(A L)
    (cond
        ((null L) nil)
        (T )
        
    )
)



    ;(cond
    ;    ((null L) 0)
    ;    ((Atom L)
    ;        (cond 
    ;            ((eq A L) 1)
    ;            (T 0)
    ;        )
    ;   )
    ;    (T(+ (freq A (car L)) (freq A (cdr L))))
    ;)
    


;(print (my-length a))


(print (my-last-helper 'b '(a b c a b c a b c d e f g)))

(print (endcons 'a '(b c d)))
(print (my-memq 'a'(a b c)))
(print (my-append '(a b c) '(d e f)))
(print (my-append '(a b c) '()))
(print (my-append '() '(d e f)))
(print (my-append '(a b c) '(d e f g)))
(print (my-append '(a b c d) '(e f g)))

(print (my-attach 'a'()))
(print (my-attach 'd '(a b c)))
(print (my-attach '(a) '(b c)))


(print (my-assoc 'a nil) )
(print (my-assoc 'a '((a . b)(c e f)(b))))
(print (my-assoc 'c '((a . b)(c e f)(b))))
(print (my-assoc 'b '((a . b)(c e f)(b))))
(print (my-assoc 'f '((a . b)(c e f)(b))))
(print (my-assoc 'f '(()()())))


(print (freq  'c '((a c) c e)))
(print (freq  'f '(((s) o ) d)))
(print (freq  'f '(((f) f) f f)))
(print (freq  'f '(((f) f) f (()()()(()(()()((()(f))))())(f)(((f)))(f)) f)))

(print (mapping '((35 kim) (67 clinton) (45 emma))  40))
(print (mapping '((35 kim) (30 chi) (67 clinton) (45 emma))  40))
(print (mapping '((35 kim) (30 chi) (67 clinton) (45 emma) (20 ma) )  40))

(print (my-last 'a '(a b c a b c a b c d e f g)))
(print (my-last 'b '(a b c a b c a b c d e f g)))
(print (my-last 'c '(a b c a b c a b c d e f g)))
(print (my-last 'g '(a b c a b c a b c d e f g)))
(print (my-last 'h '(a b c a b c a b c d e f g)))

(print (my-reverse nil))
(print (my-reverse '(a)))
(print (my-reverse '(1 2 3 4 5)))
(print (my-reverse '((1 2 3) 4 ((5 6)))))


(print (is-pattern? '(a b s) '(c d b a s)))
(print (is-pattern? '(c a c) '(b a j a c a c t u s)))
(print (is-pattern? nil '(a n y l i s t)))
(print (is-pattern? '(l i s p) nil))


(print (first-atom nil))
(print (first-atom '((2 (1) 4) 6)))
(print (first-atom '((((s)) o ))))
(print (first-atom '(1 (((2)) 3 4))))


(print (find-all 'a nil))
(print (find-all 'a '(b a c a e)))
(print (find-all 'a '(b d c e)))
(print (find-all 'a '(b (a a) c)))
(print (find-all 'a '((b a) ((c a b)))))


;(setq a '((a . b)(c e f)(b)))
;(print (car (car a)))

;(print (car (car (cdr a))))


;(print (car  '(((f) f) f f)))

;(print (car (car '(((f) f) f f))))



(defun subhelp(pat str)
	;Checks pattern to be an atom.  If it is, check the pattern against the first character in the string.
	(cond ((atom pat) (eq pat (car str)))
		;else, if the cdr of the pattern is null (last letter of pattern), then check the letter against the
		;string.
		((null (cdr pat)) (eq (car pat) (car str)))
		;else, recursively call subhelp on each letter of pattern to the string respectively.
		(T (and (subhelp (car pat) str) (subhelp (cdr pat) (cdr str))))))
		
		
		;((subhelp (car pat) str)
		;    (cond
		;        ((subhelp (cdr pat) (cdr str)))
		;    )
		;)
	;)
;)


(defun is-pattern?-helper(pat str)
	(cond
	    ((Atom pat) (eq pat (car str)))
		((null (cdr pat)) (eq (car pat) (car str)))
		((is-pattern?-helper (car pat) str)
		    (cond
		        ((is-pattern?-helper (cdr pat) (cdr str)))
		    )
		)
	)
)

		
		
		
(defun is-pattern?(pat str)
	(cond
	    ((null (car str)) nil)
		((is-pattern?-helper pat str) str)
		(T (is-pattern? pat (cdr str)))
	)
)

		
		
(print (is-pattern? '(a b s) '(c d b a s)))
(print (is-pattern? '(c a c) '(b a j a c a c t u s)))
(print (is-pattern? nil '(a n y l i s t)))
(print (is-pattern? '(l i s p) nil))





(defun find-all-helper (L)
	;Check if L is an atom.
	(cond
	    ((Atom (car L)) (cdr L))
		;If L is not an atom, check to see if L is a one element list.  If so return cdr of L.
		((Null (find-all-helper (car L))) (cdr L))
		;Else recursively call the function to the first car and cons with the cdr.
		(T (cons (find-all-helper (car L)) (cdr L)))
	)
)


(defun find-all (A L)
	;checks if list is empty
	(cond 
	    ((Null L) nil)
		;checks if A is the same as first atom, if so, cons the first atom of the rest of the list to a
		;recursive call to the rest of the list.
		((eq A (first-atom L)) (cons (first-atom (find-all-helper L)) (find-all A (find-all-helper L))))
		;Else just check the rest of the list.
		(T (find-all A (find-all-helper L)))
	)
)



(print (find-all 'a nil))
(print (find-all 'a '(b a c a e)))
(print (find-all 'a '(b d c e)))
(print (find-all 'a '(b (a a) c)))
(print (find-all 'a '((b a) ((c a b)))))





Advertisements
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.