cflp #7

;Problema [1]

(defun suma(l)

    (apply '+ (remove-if-not '(lambda (x) (evenp (position x l))) l))

)

;> (suma '(0 1 0 1 0 1))
;0
;> (suma '(1 2 3 4 5))
;9

;Problema [2]

;Se sterg elementele ce se dubleaza (ce sunt si in lista1 si in lista2) apoi se adauga ce ramane la lista1
(defun reuniune (lista1 lista2)

    (append lista1 (remove-if-not '(lambda (x) (not (member x lista1))) lista2))

)
;> (reuniune '(a b c d) '(b d e f))
;(A B C D E F)

;Se sterg elementele din lista1 ce nu sunt si in lista2
(defun intersectie (lista1 lista2)

    (remove-if-not '(lambda (x) (member x lista2)) lista1)

)
;> (intersectie '(a b c d e) '(c b e))
;(B C E)

;Se sterg toti atomii din lista1 ce apartin si listei 2
(defun dif (lista1 lista2)

    (append (remove-if-not '(lambda (x) (not (member x lista2))) lista1))

)
;> (dif '(a b c d) '(b d))
;(A C)

;Problema [3]

 (defun aparitii (lista x)
    (setq count 0)
    (car (last (mapcar '(lambda (i) (if (eq i x) (setq count (+ count 1)))) lista)))
)

;>(aparitii '(a b c b b) 'b)
;3
;> (aparitii '(1 2 3 2 3 2) 2)
;3

;Problema [4]

(defun print-atom (a)

    (princ '|  |)
    (princ a)
)

(defun print-first-atom (a)

    (princ '|( |)
    (princ a)
)

(defun print-list (lista)

    (princ '|  (|)
    (princ '| |)
    (do ((l lista (cdr l)))

    ((null l) (princ '| )|))
    (princ (car l))
    (if (not (null (cdr l))) (or (terpri) (princ '|    |)))

    )

)

(defun print-spaces (level)

    (do ( (i 1 (+ 1 i)) )

    ((= level i) nil)

    (princ '| |)

    )

)

(defun print-first-list (lista)

    (princ '|( ( |)
    (do ((l lista (cdr l)))

    ((null l) (princ '| )|))
    (princ (car l))
    (if (not (null (cdr l))) (or (terpri) (princ '|    |)))

    )

)

(defun afis (lista)

    (setq pard '|(|)
    (setq parc '|)|)
    (setq space '| |)

    (setq first t)

    (do ((l lista (cdr l)))

    ((null l) t)
    (cond

    ((and (not first) (atom (car l))) (print-atom (car l)))
    ((not first) (print-list (car l)))
    ((and first (atom (car l))) (print-first-atom (car l)))
    (t (print-first-list (car l)))

    )
    (if (not (null (cdr l))) (terpri) (princ '| )|))
    (setq first nil)
    )
)

;>(afis '((a b) c (d e f) g))
;( ( A
;    B )
;  C
;  ( D
;    E
;   F )
;  G )

;> (afis '(a b (c d) (e f g) h))
;( A
;  B
;  ( C
;    D )
;  ( E
;    F
;    G )
;  H )