K1.scm

K1.scm

;Pravo kontrolno po FP
;KN - 20.11.2010
;Georgi Ivanov Hristozov - 1 adm. grupa, FN 80430
;Ostavil sum testovete dadeni po uslovie ili ot asistentite.
;Polzvam Pretty Big.

;;;;;;;;;;;;;;;;;;;;;
;Task 1 - prod-sum-div

;get-divisors vrushta spisak ot delitelite v intervala [1;n]
(define (get-divisors n)
  (define (get-divisors-helper n k)
    (cond
      ((< k 1) ())
      ((= (remainder n k) 0) (append (list k) (get-divisors-helper n (- k 1))))
      (else (get-divisors-helper n (- k 1)))))
  ;(get-divisors-helper n (+ (quotient n 2) 1)))
  (get-divisors-helper n n))
;(get-divisors 19)
;(get-divisors 16)

;sum-divisors presmqta sumata na delitelite na n
(define (sum-divisors n)
  (apply + (get-divisors n)))
;(sum-divisors 19)
;(sum-divisors 16)

;get-range vrushta spisak ot vsichki elementi v [a;b]
(define (get-range a b)
  (if (> a b)
      ()
      (cons a (get-range (+ a 1) b))))
;(map sum-divisors (get-range 3 6))
;(filter (lambda (x) (if (= (remainder x 4) 0) #t #f)) (map sum-divisors (get-range 3 6)))

;proverqva dali sumata na delitelite na n e kratna na k
(define (k-sum-divisors? n k)
  (if (= (remainder (sum-divisors n) k) 0)
      #t
      #f))

;filtrirame elementite v intervala [a;b] za koito e izpulnen gornia predikat
(define (prod-sum-div a b k)
  (apply * (filter (lambda (x) (k-sum-divisors? x k)) (get-range a b))))
(prod-sum-div 3 6 4) ;vrushta 18, ot Trifon

;;;;;;;;;;;;;;;;;;;;;
;Task 2 - average / calcsum
;na povecheto mesta sum ostavil 'ruchna' proverka pod testa, za da vidia dali stoinostite sa ravni

;funkciata average ot uslovieto na zadachata
(define (average f g)
  (lambda (x) (sqrt (* (f x) (g x)))))
;((average (lambda (x) (* x 2)) (lambda (x) (+ x 1))) 3)
;(sqrt (* (* 3 2) (+ 3 1)))

;presmiata gi(x)
(define (g-i i)
  (lambda (x) (expt x i)))
;((g-i 3) 2)
;((g-i 10) 2)

;presmiata i-tia chlen ot sumata
(define (sum-member f i)
  (average f (g-i i)))
;((sum-member (lambda (x) (* x 2)) 3) 2)
;(sqrt (* (* 2 2) (expt 2 3)))

;calcsum...
;(define (calcsum f n)
;  (cond
;    ((< n 1) (lambda (x) 0))
;    (else (lambda (x) (+ ((sum-member f n) x) ((calcsum f (- n 1)) x))))))
;((calcsum (lambda (x) (* x 2)) 3) 5)
;(+ (sqrt (* (* 2 5) (expt 5 1))) (sqrt (* (* 2 5) (expt 5 2))) (sqrt (* (* 2 5) (expt 5 3))))

;calcsum (tozi put otgovaria na uslovieto)
(define (calcsum f n)
  (cond
    ((< n 1) 0)
    (else (+ ((sum-member f n) n) (calcsum f (- n 1))))))
(calcsum (lambda (x) (* x x)) 4) ;vrushta ~84.58846, ot Trifon

;;;;;;;;;;;;;;;;;;;;;
;Task 3 - duplicates

;n-member vrushta kolko puti se sreshta atoma a v spisaka l
(define (n-member a l)
  (cond
    ((null? l) 0)
    ((= a (car l)) (+ 1 (n-member a (cdr l))))
    (else (n-member a (cdr l)))))
;(n-member 1 '(1 2 3 4 5 1))
;(n-member 1 '(1 2 3 4 5 6))
;(n-member 1 '(2 3 4 5 6 7))

;duplicates raboti s proverka dali rezultata ot n-member e >1
(define (duplicates l1 l2)
  (cond
    ((null? l1) ())
    ((> (n-member (car l1) l2) 1) (cons (car l1) (duplicates (cdr l1) l2)))
    (else (duplicates (cdr l1) l2))))
(duplicates '(1 2 3) '(1 2 1 3 2)) ;vrushta (1 2), ot uslovieto
;(duplicates '(1 2 3 4 5) '(1 2 5 6 5))

;;;;;;;;;;;;;;;;;;;;;
;Task 4 - image

;check-x proveriava dali razlikata ai-bi na vseki 2 chlena ai bi na l1 i l2 e ravna na x
(define (check-x x l1 l2)
  (cond
    ((or (null? l1) (null? l2)) #t)
    ((not (= (- (car l1) (car l2)) x)) #f)
    (else (check-x x (cdr l1) (cdr l2)))))
;(check-x 1 '(2 3 4) '(1 2 3))
;(check-x -3 '(1 2 3) '(4 5 6))
;(check-x 3 '(1 2 3) '(4 5 6))

;imageof? dava razlikata na purvite elementi na l1 i l2 kato argument x na checkx
(define (imageof? l1 l2)
  (cond
    ((or (null? l1) (null? l2)) #f)
    (else (check-x (- (car l1) (car l2)) (cdr l1) (cdr l2)))))
(imageof? '(1 2 3) '(4 5 6)) ;vrushta #t, ot uslovieto
(imageof? '(1 2 3) '(1 2 2)) ;vrushta #f, ot uslovieto
;(imageof? '(11 21 31 41) '(250 260 270 280))
;(imageof? '(11 21 31 51) '(250 260 270 290))
;(imageof? '(11 21 31 51) '(250 260 270 280))