;;this function translates nucleotids to aminoacids
(define (amino x)
 (cond ((member? x '(uuu uuc)) 'phe)
       ((member? x '(uau uac)) 'tyr)
       ((member? x '(ugu ugc)) 'cys)
       ((member? x '(uua uug cuu cuc cua cug)) 'leu)
       ((member? x '(ucu ucc uca ucg agu agc)) 'ser)
       ((member? x '(uaa uag uga)) 'stop)
       ((member? x '(ugg)) 'trp)
       ((member? x '(ccu ccc cca ccg)) 'pro)
       ((member? x '(cgu cgc cga cgg aga agg)) 'arg)
       ((member? x '(cau cac)) 'his)
       ((member? x '(caa cag)) 'gln)
       ((member? x '(auu auc aua)) 'ile)
       ((member? x '(aug)) 'met)
       ((member? x '(acu acc aca acg)) 'thr)
       ((member? x '(aau aac)) 'asn) 
       ((member? x '(aaa aag)) 'lys)
       ((member? x '(guu guc gua gug)) 'val) 
       ((member? x '(gcu gcc gca gcg)) 'ala)
       ((member? x '(ggu ggc gga ggg)) 'gly)
       ((member? x '(gau gac)) 'asp)
       ((member? x '(gaa gag)) 'glu)))
;;*********************************************************************
;;this function translates (dna) into (rna)
(define (f sent) (every (lambda (wd) (cond ((equal? wd 't) 'a)
                                           ((equal? wd 'c) 'g)
                                           ((equal? wd 'g) 'c)
                                           (else 'u))) sent))
;;**********************************************************************
;;this function finds the length of first exon
(define (exon1  x y)
  (cond ((or (empty? x) (empty?  y)) 0)
        ((equal? (amino (trans x)) (first y))
 ( + 3 (exon1 (cdddr x) (cdr y))))
        (else 0)))
;;*********************************************************************
;;this function finds the length of third exon
(define (exon3 x y)
 (cond ((or (empty? x) (empty? y)) 0)
       ((equal? (amino (trans2 x)) (last y))
(+ 3 (exon3 (bl(bl(bl x))) (bl y)))) 
       (else 0)))
;;*********************************************************************
;;this function removes the nucleotids till the intron from the beginning
(define (bastan_eleyici x y)
   (let ((counter (exon1 x y)))
         (list ((repeated bf counter) x)
              ((repeated bf (/ counter 3)) y))))
;;********************************************************************
;;this function removes the nucleotids till the intron from the end
(define (sondan_eleyici x y)
    (let ((counter (exon3 x y)))
          (list ((repeated bl counter) x)
               ((repeated bl (/ counter 3)) y))))
;;*********************************************************************
;;this function forms the part with intron-exon-intron
(define (exon2 sent1 sent2)
    (let ((c_op (sondan_eleyici sent1 sent2)))
        (bastan_eleyici (first c_op) (last c_op))))
;;**********************************************************************
;;this function translates the first three nucleotids into rna
(define (trans sent)
 (accumulate word (f (se (car sent) (cadr sent) (caddr sent)))))
;;**********************************************************************
;;this function translates the last three nucleotids into rna
(define (trans2 sent)
 (accumulate word (f (se (last(bl (bl sent))) (last(bl sent)) (last sent)))))
;;**********************************************************************
;;this function checks if the part is exon or not
(define (checker a b)
 (cond ((empty?  b) #t)
       ((< (count a) 3) #f)
       (else (and (equal? (amino(trans a)) (first b))
                  (checker ((repeated bf 3) a) (bf b))))))
;;**********************************************************************
;;this function finds the place of second exon
(define (finder z)
 (if (< (count (cdr z)) 1) '()
 (if (< (count (car z)) 3) (car z)
 (if (checker (first z) (last z))
  (se '? ((repeated bf (* 3 (count (last z)))) (first z)))
  (se (first (first z)) (finder (list (bf (first z)) (last z))))))))
;;**********************************************************************
;;this function calculates the length of first intron
(define (topla a)
  (cond ((empty? a) 0)
        ((equal? (first a) '?) 0)
        (else (+ 1 (topla (bf a))))))
;;**********************************************************************
;;this function calculates the length of second intron
(define (geriden_say a)
   (cond ((empty? a) 0) 
         ((equal? (last a) '?)   0) 
         (else (+ 1 (geriden_say (bl a))))))
;;**********************************************************************
;;this function gives the locations of the two introns
(define  (firstlocate x y)
 (let ((find (finder (exon2 x y)))
       (count1 (exon1 x y))
       (count3 (exon3 x y)))
 (cond (( or (empty? x) (empty? y)) '())
       ((not (equal? (last y) 'stop)) '())
       ((empty? find) '())
       (else (list (se (+ 1 count1) (+ count1 (topla find)))
                   (se (+ 1 (- (- (count x) count3) (geriden_say find)))  (- (count x) count3)))))))
;;**************************************************************************
;;this function checks the result if it's reasonable or not
(define (locate_intron x y)
      (let ((result (firstlocate x y)))
           (cond ((empty? result) '())
                 ((or (>= (caar result) (caadr result))
                      (>= (cadar result) (cadadr result))) '())
                 (else result))))