Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Chromosone variance

Name: Anonymous 2011-04-14 6:07

Four snippets of "chromosomes":
 
A = "gtggcaacgtgc"
B = "gtagcagcgcgc"
C = "gcggcacagggt"
D = "gtgacaacgtgc"
 
There are two methods to find the "distance" of two chromosomes , how much the two have varied through mutations. One method is to go letter by letter and count the number of discrepancies. Another method is to sum the discrepancies of a's (e.g. chromosome x has 5 a's, chromosome y has 7 a's), c's, g's and t's.
 
Write a function that uses method 1. It will take two chromosomes, and go letter by letter in
each, comparing them. It then returns the total number of discrepancies it finds.
 
Write another function that uses method 2. It will take two chromosomes, and return the sum of
'a' discrepancies, 'c' ones, and so on.
 
Then call each function on each of the combinations (A,B), (A,C), (A,D), (B,C), (B,D) and (C,D) and see which methods tell you which pair of chromosomes is "furthest" (i.e. most varied) and which pair is "closest" (i.e. least varied).

Do it in the language of your choice.

Name: Anonymous 2011-04-14 7:20


(define l #((A . "gtggcaacgtgc")
            (B . "gtagcagcgcgc")
            (C . "gcggcacagggt")
            (D . "gtgacaacgtgc")))

(define (1+/char/=? i a b)
  ((if (char=? a b) values add1) i))

(define (method1 x y)
  (for/fold ((i 0))
    ((a (in-string x))
     (b (in-string y)))
    (1+/char/=? i a b)))

(define chr->idx-table '((#\a . 0) (#\c . 1) (#\g . 2) (#\t . 3)))
(define (table-ref v a)
  (vector-ref v (cdr (assv a chr->idx-table))))
(define (table-set! v a x)
  (vector-set! v (cdr (assv a chr->idx-table)) x))
(define (1+ i a b)
  (table-set! i a (1+/char/=? (table-ref i a) a b)) i)

(define (method2 x y)
  (call-with-values (λ ()
                      (vector->values
                       (for/fold ((i (vector 0 0 0 0)))
                         ((a (in-string x))
                          (b (in-string y)))
                         (1+ i a b))))
                    +))

(first+last
 (sort (filter
        values
        (for*/list (((a i) (in-indexed (in-vector l)))
                    (b (in-vector l i)))
          (let-values (((caa cda) (car+cdr a))
                       ((cab cdb) (car+cdr b)))
            (and (not (eq? caa cab))
                 (list* (cons caa cab)
                        (method1 cda cdb)
                        (method2 cda cdb))))))
       < #:key cadr))

Name: Anonymous 2011-04-14 11:47

Done.

(require (prefix-in rkt: racket/base))

(define (church->int f)
  ((f add1) 0))

(define (int->church x)
  (rkt:let loop ((x x)
                 (r zero))
           (rkt:if (rkt:zero? x) r
                   (loop (sub1 x)
                         (1+ r)))))

(define (church-cons->cons f)
  (rkt:cons (car f) (cdr f)))

(define (church-list->list f)
  (((foldr (λ (x) (λ (y) (rkt:cons x y)))) '()) f))

(define-syntax if
  (syntax-rules ()
    ((_ p a b)
     (((p (λ () a))
       (λ () b))))))

(define S
  (λ (x)
    (λ (y)
      (λ (z)
        ((x z) (y z))))))
(define K
  (λ (x)
    (λ (y) x)))
(define I ((S K) K))

(define eq?
  (λ (x)
    (λ (y)
      (rkt:eq? x y))))

(define 1+
  (λ (n)
    (λ (f)
      (λ (x)
        (f ((n f) x))))))

(define +
  (λ (m)
    (λ (n)
      ((m 1+) n))))

(define *
  (λ (m)
    (λ (n)
      (λ (f)
        (m (n f))))))

(define ^
  (λ (b)
    (λ (e)
      (e b))))

(define 1-
  (λ (n)
    (λ (f)
      (λ (x)
        (((n (λ (g)
               (λ (h)
                 (h (g f)))))
          (K x))
         I)))))

(define -
  (λ (m)
    (λ (n)
      ((n 1-) m))))

(define true
  (λ (x) (K x)))
(define false
  (λ (x) I))

(define zero (K I))
(define one ((S K) K))

(define not
  (λ (x)
    ((x false) true)))

(define and
  (λ (p)
    (λ (q)
      ((p q) p))))

(define or
  (λ (p)
    (λ (q)
      ((p p) q))))

(define zero?
  (λ (n)
    ((n (K false)) true)))

(define <=
  (λ (m)
    (λ (n)
      (zero? ((- m) n)))))

(define =
  (λ (m)
    (λ (n)
      ((and ((<= m) n))
       ((<= n) m)))))

(define /=
  (λ (m)
    (λ (n)
      (not ((= m) n)))))

(define <
  (λ (m)
    (λ (n)
      ((and ((<= m) n))
       (not ((<= n) m))))))

(define >
  (λ (m)
    (λ (n)
      (not ((<= m) n)))))

(define >=
  (λ (m)
    (λ (n)
      (not ((< m) n)))))

(define cons
  (λ (x)
    (λ (y)
      (λ (f)
        ((f x) y)))))

(define car
  (λ (x) (x true)))
(define cdr
  (λ (x) (x false)))

(define nil
  (λ (x) true))
(define null?
  (λ (x)
    (x (λ (x) (λ (y) false)))))

(define Z
  (λ (f)
    ((λ (x)
       (f (λ (y)
            ((x x) y))))
     (λ (x)
       (f (λ (y)
            ((x x) y)))))))

(define reverse
  (λ (xs)
    (((Z (λ (loop)
           (λ (xs)
             (λ (r)
               (if (null? xs) r
                   ((loop (cdr xs))
                    ((cons (car xs)) r)))))))
      xs) nil)))

(define map
  (λ (f)
    (λ (xs)
      (((Z (λ (loop)
             (λ (xs)
               (λ (r)
                 (if (null? xs) (reverse r)
                     ((loop (cdr xs))
                      ((cons (f (car xs))) r)))))))
        xs) nil))))

(define map2
  (λ (f)
    (λ (xs)
      (λ (ys)
        ((((Z (λ (loop)
                (λ (xs)
                  (λ (ys)
                    (λ (r)
                      (if (or (null? xs) (null? ys))
                          (reverse r)
                          (((loop (cdr xs)) (cdr ys)) ((cons ((f (car xs)) (car ys))) r))))))))
           xs) ys) nil)))))

(define filter
  (λ (p)
    (λ (xs)
      (((Z (λ (loop)
             (λ (xs)
               (λ (r)
                 (if (null? xs) (reverse r)
                     ((loop (cdr xs))
                      (if (p (car xs))
                          ((cons (car xs)) r) r)))))))
        xs) nil))))

(define foldl
  (Z (λ (foldl)
       (λ (f)
         (λ (z)
           (λ (xs)
             (if (null? xs) z (((foldl f) ((f (car xs)) z)) (cdr xs)))))))))

(define foldr
  (Z (λ (foldr)
       (λ (f)
         (λ (z)
           (λ (xs)
             (if (null? xs) z
                 ((f (car xs))
                  (((foldr f) z) (cdr xs))))))))))

(define sum
  (λ (xs)
    (((foldl +) false) xs)))

(define product
  (λ (xs)
    (((foldl *) one) xs)))

(define append
  (λ (xs)
    (λ (ys)
      (((Z (λ (loop)
             (λ (xs)
               (λ (r)
                 (if (null? xs) ((cons r) ys)
                     ((loop (cdr xs))
                      ((cons (car xs)) r)))))))
        xs) nil))))

(define acons
  (λ (x)
    (λ (y)
      (λ (a)
        ((cons ((cons x) y)) a)))))

(define assf
  (λ (f)
    (λ (x)
      (λ (a)
        ((Z (λ (loop)
              (λ (a)
                (if ((f (car (car a))) x)
                    (car a)
                    (loop (cdr a)))))) a)))))

(define assq (assf eq?))
(define ass= (assf =))

(define l
  ((λ (two)
     ((λ (five)
        ((λ (ten)
           ((λ (one-hundred)
              ((((λ (one-hundred-sixteen)
                   (λ (ninety-nine)
                     (λ (one-hundred-three)
                       ((λ (ninety-seven)
                          (((((λ (g)
                                (λ (t)
                                  (λ (c)
                                    (λ (a)
                                      ((cons (g (t (g (g (c (a (a (c (g (t (g (a nil)))))))))))))
                                       ((cons (g (t (a (g (c (a (g (c (g (c (g (c nil)))))))))))))
                                        ((cons (g (c (g (g (c (a (c (a (g (g (g (t nil)))))))))))))
                                         ((cons (g (t (g (a (c (a (a (g (g (t (g (c nil)))))))))))))
                                          nil)))))))) one-hundred-three) one-hundred-sixteen) ninety-nine) ninety-seven))
                        ((- ninety-nine) two)))))
                 ((+ one-hundred) ((+ five) (1+ ten))))
                (1- one-hundred))
               ((+ one-hundred) (1+ two))))
            ((* ten) ten)))
         ((* five) two)))
      ((+ (1+ two)) two)))
   (1+ one)))

(define bool->int
  (λ (p)
    ((p one) zero)))

(define m1
  (λ (x)
    (λ (y)
      (((foldl +) zero)
       (((map2 (λ (x) (λ (y) (bool->int ((= x) y))))) x) y)))))
 
(define count
  (λ (c)
    ((foldl (λ (x xs) (if ((= x) c) (1+ xs) xs))) zero)))

(define max
  (λ (x)
    (λ (y)
      ((((> x) y) x) y))))

(define min
  (λ (x)
    (λ (y)
      ((max y) x))))

(define m2
  (λ (x)
    (λ (y)
      (((foldl +) zero)
       ((map (λ (c)
               (((λ (x1)
                   (λ (y1)
                     ((- ((max x1) y1)) ((min x1) y1))))
                 ((count c) x))
                ((count c) y))))
        ((cons (int->church 97))
         ((cons (int->church 99))
          ((cons (int->church 103))
           ((cons (int->church 116)) nil)))))))))

(define m
  (((Z (λ (l)
         (λ (r)
           (if (null? l) (reverse r)
               ((loop (cdr l))
                (((Z (λ (ll)
                       (λ (r)
                         (if (null? ll) (reverse r)
                             ((loop (cdr ll)
                                    ((cons ((cons ((cons (car l)) (car ll)))
                                            ((cons ((m1 (car l)) (car ll)))
                                             ((m2 (car l)) (car ll))))) r))))))) (cdr l)) r)))))) l) nil))

(define mm
  (λ (f)
    (λ (a)
      (λ (m)
        (((foldl
           (λ (x)
            (λ (xs)
              (if ((f (a x)) (a xs)) x xs)))) (car m)) (cdr m))))))

(((mm <) (λ (x) (cdr (cdr x)))) m)
(((mm >) (λ (x) (cdr (cdr x)))) m)
(((mm <) (λ (x) (car (cdr x)))) m)
(((mm >) (λ (x) (car (cdr x)))) m)

Name: Anonymous 2011-04-14 11:50

>>12
Forgot to bind loop.

(require (prefix-in rkt: racket/base))

(define (church->int f)
  ((f add1) 0))

(define (int->church x)
  (rkt:let loop ((x x)
                 (r zero))
           (rkt:if (rkt:zero? x) r
                   (loop (sub1 x)
                         (1+ r)))))

(define (church-cons->cons f)
  (rkt:cons (car f) (cdr f)))

(define (church-list->list f)
  (((foldr (λ (x) (λ (y) (rkt:cons x y)))) '()) f))

(define-syntax if
  (syntax-rules ()
    ((_ p a b)
     (((p (λ () a))
       (λ () b))))))

(define S
  (λ (x)
    (λ (y)
      (λ (z)
        ((x z) (y z))))))
(define K
  (λ (x)
    (λ (y) x)))
(define I ((S K) K))

(define eq?
  (λ (x)
    (λ (y)
      (rkt:eq? x y))))

(define 1+
  (λ (n)
    (λ (f)
      (λ (x)
        (f ((n f) x))))))

(define +
  (λ (m)
    (λ (n)
      ((m 1+) n))))

(define *
  (λ (m)
    (λ (n)
      (λ (f)
        (m (n f))))))

(define ^
  (λ (b)
    (λ (e)
      (e b))))

(define 1-
  (λ (n)
    (λ (f)
      (λ (x)
        (((n (λ (g)
               (λ (h)
                 (h (g f)))))
          (K x))
         I)))))

(define -
  (λ (m)
    (λ (n)
      ((n 1-) m))))

(define true
  (λ (x) (K x)))
(define false
  (λ (x) I))

(define zero (K I))
(define one ((S K) K))

(define not
  (λ (x)
    ((x false) true)))

(define and
  (λ (p)
    (λ (q)
      ((p q) p))))

(define or
  (λ (p)
    (λ (q)
      ((p p) q))))

(define zero?
  (λ (n)
    ((n (K false)) true)))

(define <=
  (λ (m)
    (λ (n)
      (zero? ((- m) n)))))

(define =
  (λ (m)
    (λ (n)
      ((and ((<= m) n))
       ((<= n) m)))))

(define /=
  (λ (m)
    (λ (n)
      (not ((= m) n)))))

(define <
  (λ (m)
    (λ (n)
      ((and ((<= m) n))
       (not ((<= n) m))))))

(define >
  (λ (m)
    (λ (n)
      (not ((<= m) n)))))

(define >=
  (λ (m)
    (λ (n)
      (not ((< m) n)))))

(define cons
  (λ (x)
    (λ (y)
      (λ (f)
        ((f x) y)))))

(define car
  (λ (x) (x true)))
(define cdr
  (λ (x) (x false)))

(define nil
  (λ (x) true))
(define null?
  (λ (x)
    (x (λ (x) (λ (y) false)))))

(define Z
  (λ (f)
    ((λ (x)
       (f (λ (y)
            ((x x) y))))
     (λ (x)
       (f (λ (y)
            ((x x) y)))))))

(define reverse
  (λ (xs)
    (((Z (λ (loop)
           (λ (xs)
             (λ (r)
               (if (null? xs) r
                   ((loop (cdr xs))
                    ((cons (car xs)) r)))))))
      xs) nil)))

(define map
  (λ (f)
    (λ (xs)
      (((Z (λ (loop)
             (λ (xs)
               (λ (r)
                 (if (null? xs) (reverse r)
                     ((loop (cdr xs))
                      ((cons (f (car xs))) r)))))))
        xs) nil))))

(define map2
  (λ (f)
    (λ (xs)
      (λ (ys)
        ((((Z (λ (loop)
                (λ (xs)
                  (λ (ys)
                    (λ (r)
                      (if (or (null? xs) (null? ys))
                          (reverse r)
                          (((loop (cdr xs)) (cdr ys)) ((cons ((f (car xs)) (car ys))) r))))))))
           xs) ys) nil)))))

(define filter
  (λ (p)
    (λ (xs)
      (((Z (λ (loop)
             (λ (xs)
               (λ (r)
                 (if (null? xs) (reverse r)
                     ((loop (cdr xs))
                      (if (p (car xs))
                          ((cons (car xs)) r) r)))))))
        xs) nil))))

(define foldl
  (Z (λ (foldl)
       (λ (f)
         (λ (z)
           (λ (xs)
             (if (null? xs) z (((foldl f) ((f (car xs)) z)) (cdr xs)))))))))

(define foldr
  (Z (λ (foldr)
       (λ (f)
         (λ (z)
           (λ (xs)
             (if (null? xs) z
                 ((f (car xs))
                  (((foldr f) z) (cdr xs))))))))))

(define sum
  (λ (xs)
    (((foldl +) false) xs)))

(define product
  (λ (xs)
    (((foldl *) one) xs)))

(define append
  (λ (xs)
    (λ (ys)
      (((Z (λ (loop)
             (λ (xs)
               (λ (r)
                 (if (null? xs) ((cons r) ys)
                     ((loop (cdr xs))
                      ((cons (car xs)) r)))))))
        xs) nil))))

(define acons
  (λ (x)
    (λ (y)
      (λ (a)
        ((cons ((cons x) y)) a)))))

(define assf
  (λ (f)
    (λ (x)
      (λ (a)
        ((Z (λ (loop)
              (λ (a)
                (if ((f (car (car a))) x)
                    (car a)
                    (loop (cdr a)))))) a)))))

(define assq (assf eq?))
(define ass= (assf =))

(define l
  ((λ (two)
     ((λ (five)
        ((λ (ten)
           ((λ (one-hundred)
              ((((λ (one-hundred-sixteen)
                   (λ (ninety-nine)
                     (λ (one-hundred-three)
                       ((λ (ninety-seven)
                          (((((λ (g)
                                (λ (t)
                                  (λ (c)
                                    (λ (a)
                                      ((cons (g (t (g (g (c (a (a (c (g (t (g (a nil)))))))))))))
                                       ((cons (g (t (a (g (c (a (g (c (g (c (g (c nil)))))))))))))
                                        ((cons (g (c (g (g (c (a (c (a (g (g (g (t nil)))))))))))))
                                         ((cons (g (t (g (a (c (a (a (g (g (t (g (c nil)))))))))))))
                                          nil)))))))) one-hundred-three) one-hundred-sixteen) ninety-nine) ninety-seven))
                        ((- ninety-nine) two)))))
                 ((+ one-hundred) ((+ five) (1+ ten))))
                (1- one-hundred))
               ((+ one-hundred) (1+ two))))
            ((* ten) ten)))
         ((* five) two)))
      ((+ (1+ two)) two)))
   (1+ one)))

(define bool->int
  (λ (p)
    ((p one) zero)))

(define m1
  (λ (x)
    (λ (y)
      (((foldl +) zero)
       (((map2 (λ (x) (λ (y) (bool->int ((= x) y))))) x) y)))))
 
(define count
  (λ (c)
    ((foldl (λ (x xs) (if ((= x) c) (1+ xs) xs))) zero)))

(define max
  (λ (x)
    (λ (y)
      ((((> x) y) x) y))))

(define min
  (λ (x)
    (λ (y)
      ((max y) x))))

(define m2
  (λ (x)
    (λ (y)
      (((foldl +) zero)
       ((map (λ (c)
               (((λ (x1)
                   (λ (y1)
                     ((- ((max x1) y1)) ((min x1) y1))))
                 ((count c) x))
                ((count c) y))))
        ((cons (int->church 97))
         ((cons (int->church 99))
          ((cons (int->church 103))
           ((cons (int->church 116)) nil)))))))))

(define m
  (((Z (λ (loop)
         (λ (l)
           (λ (r)
             (if (null? l) (reverse r)
                 ((loop (cdr l))
                  (((Z (λ (loop)
                         (λ (ll)
                           (λ (r)
                             (if (null? ll) (reverse r)
                                 ((loop (cdr ll))
                                  ((cons ((cons ((cons (car l)) (car ll)))
                                          ((cons ((m1 (car l)) (car ll)))
                                           ((m2 (car l)) (car ll))))) r))))))) (cdr l)) r))))))) l) nil))

(define mm
  (λ (f)
    (λ (a)
      (λ (m)
        (((foldl
           (λ (x)
            (λ (xs)
              (if ((f (a x)) (a xs)) x xs)))) (car m)) (cdr m))))))

(((mm <) (λ (x) (cdr (cdr x)))) m)
(((mm >) (λ (x) (cdr (cdr x)))) m)
(((mm <) (λ (x) (car (cdr x)))) m)
(((mm >) (λ (x) (car (cdr x)))) m)
Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List
All trademarks and copyrights on this site are owned by their respective parties. All comments and posts are the responsibility of their own posters.
- Tinychan + 2ch Mode -