25 martie 2010

Probleme in Scheme

; verificare daca o lista e palindroma

(define (palindrome? lista)
(let secv ((l1 lista) (l2 (reverse lista)))
(cond
((null? l1)
#t) ; s-a ajuns la sfarsitul listelor fara probleme => palindrom
((= (car l1) (car l2)) ; daca sunt egale se apeleaza secventa pt restul listelor
(secv (cdr l1) (cdr l2)))
(#t ; nu s-a apelat secventa din nou => inegalitate si lista nu e palindroma
#f)))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


; toate elementele dintr-o lista de liste etc, adunate intr-o sg lista

(define flatten
(lambda (lista)
(cond ((null? lista) '())
((pair? (car lista)) ; daca car este o lista
(append (flatten (car lista)) ; apeleaza fct flatten pt car si pt cdr , si apoi le impreuneaza
(flatten (cdr lista))))
(else ; daca car este un sg element
(cons (car lista) ; il insereaza
(flatten (cdr lista))))))) ; la lista rezultata in urma aplicarii flatten asupra restului de lista curenta

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


; multimea tuturor submultimilor ale unei multimi

(define (power-set lista)
(if (null? lista) '(())
(let ((rest (power-set (cdr lista)))) ; salveaza fct aplicata pe restul de lista
(append rest ; pe care il adauga
(map (lambda (sublista) ; la ceea ce rezulta prin aplicarea cons inceputului de lista dintr-o sublista si acelui rest
(cons (car lista) sublista))
rest))
)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


; produsul cartezian a 2 liste

(define make ; produs cartezian de un singur element cu o lista
(lambda(x lista)
(if (null? lista) '()
(cons (append (list x) (list(car lista))) (make x (cdr lista)) )
)))

(define cart-2
(lambda(list1 list2)
(if (or (null? list2)(null? list1)) '()
(append (make(car list1) list2) ; aplica fct make pentru fiecare prim elem din prima lista, cu lista a doua
(cart-2 (cdr list1) list2)) ; se aplica acelasi procedeu pt ceea ce ramane din prima lista cu lista a doua
)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; produsul cartezian a n liste

(define (cart-22 l1 l2) ; var mai buna de a calcula cart-2
(foldl
(lambda (x res)
(append
(foldl
(lambda (y acc) (cons (cons x y) acc))
'() l2) res))
'() l1))

(define (cp lofl) ; cart-n insa cu puncte
( if(null? lofl) '()
( foldl cart-22 (first lofl) (rest lofl))))

(define conv-dot ; converteste o lista cu puncte intr-una fara
(lambda (lista)
( if (null? lista) '()
( if (pair? lista)
(append (list(car lista)) (conv-dot (cdr lista) ) ) (cons lista '())
))))

(define cart-n
(lambda (lista)
(map conv-dot (cp lista))) ; aplica fct de conversie pt toate listele rezultate cu pct
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


; calcularea nr e

(define inv_fact ; calculeaza 1/nr!
(lambda (nr)
(let loop ((n nr) (index 1))
(if (= n 1)
(if (= index 1)
index
(- index 1))
(loop (/ n index) (+ index 1))))))

(define succ ; succesorul lui n
(lambda (n)
(* n (/ 1 (+ (inv_fact (/ 1 n)) 1)))))

(define make_prog
(lambda (k)
(cons k (lambda ()
(make_prog (succ k))))))

(define prog_stream
(make_prog 1)) ; 1/1! + ....

(define take
(lambda (nr stream)
(let loop((n nr) (st stream) (aux 1))
(if (= n 0)
aux
(loop (- n 1) ((cdr st)) (+ aux (car st)))))))

; verificare:
;(log (take 30 prog_stream))

Niciun comentariu: