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

Pages: 1-

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 6:35

Do your own homework.

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 7:33

codes = ['gtggcaacgtgc', 'gtagcagcgcgc', 'gcggcacagggt', 'gtgacaacgtgc']
dist1 = lambda a, b: sum(x != y for x, y in zip(a, b))
count = lambda x, s: sum(c == x for c in s)
dist2 = lambda a, b: sum(abs(count(x, a) - count(x, b)) for x in 'acgt')
pairs = [(a, b) for a in codes for b in codes if a < b]
maxd = lambda m: max((m(a, b), a, b) for a, b in pairs)
mind = lambda m: min((m(a, b), a, b) for a, b in pairs)
print maxd(dist1)
print mind(dist1)
print maxd(dist2)
print mind(dist2)

Name: >>4 2011-04-14 7:35

>>3 LISP is clearly unsuitable for functional programming.

Name: Anonymous 2011-04-14 8:06

what if we all forgot about this programming shite for a moment and just ate a whole big thing of icecream

think about it

Name: Anonymous 2011-04-14 8:13

>>4-5
>>> dist1(codes[0],codes[1])[br]3[br]>>> dist2(codes[0],codes[1])[br]2

ONE WORD: THE WRONG RESULT OF FUNCTIONS. REWRITE YOUR SHIT

It didn't say ``count the letters'', it said ``count the discrepancies''.

Name: Anonymous 2011-04-14 8:13

>>7
I also fucked my BBCode.

Name: Anonymous 2011-04-14 9:38

>>7,8 Honest question: are you retarded?

Another method is to sum the discrepancies of a's (e.g. chromosome x has 5 a's, chromosome y has 7 a's)

Name: Anonymous 2011-04-14 9:45

>>3
table-set!
fail

Name: Anonymous 2011-04-14 9:48

>>10
I'm rewriting it.

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)

Name: Anonymous 2011-04-14 13:27


def method1(x,y):
    count=0
    for i in range(len(x)):
        if x[i]!= y[i]:
            count+=1
    return count

def method2(x,y):
    ax=x.count('a')
    tx=x.count('t')
    gx=x.count('g')
    cx=x.count('c')

    ay=y.count('a')
    ty=y.count('t')
    gy=y.count('g')
    cy=y.count('c')

    return abs(ax-ay)+abs(tx-ty)+abs(gx-gy)+abs(cx-cy)

Name: Anonymous 2011-04-14 14:12

>>12-13
Well I never.

Name: Anonymous 2011-04-14 14:19

meth1 a b = length $ filter id $ zipWith (/=) a b

meth2 a b = error "stack overflow"

Name: Anonymous 2011-04-14 17:33

"gtggcaacgtgc":A;
"gtagcagcgcgc":B;
"gcggcacagggt":C;
"gtgacaacgtgc":D;

{z{c~=!}%P}:meth1;
{"you're a retard"}:meth2;

[[A B] [A C] [A D] [B C] [B D] [C D]] {~meth1}%S

Output: 3 5 1 6 4 6

Name: Anonymous 2011-04-14 18:13

>>14 is a typical retarded newbie Pythonista with Java background.

But I'm grateful to her, because I totally forgot about the existence of that method, so my solution is one line shorter now:

codes = ['gtggcaacgtgc', 'gtagcagcgcgc', 'gcggcacagggt', 'gtgacaacgtgc']
dist1 = lambda a, b: sum(x != y for x, y in zip(a, b))
dist2 = lambda a, b: sum(abs(a.count(x) - b.count(x)) for x in 'acgt')
pairs = [(a, b) for a in codes for b in codes if a < b]
maxd = lambda m: max((m(a, b), a, b) for a, b in pairs)
mind = lambda m: min((m(a, b), a, b) for a, b in pairs)
print maxd(dist1)
print mind(dist1)
print maxd(dist2)
print mind(dist2)
In other news, LISP is still unsuitable for functional programming.

Name: Anonymous 2011-04-14 18:16

>>3,12,13
Rule 34.001 of /prog/: there is a solution in Lisp.

Name: Anonymous 2011-04-14 18:29

>>1
>>9
comparing the number of a,t,g, and c's is obviously an invalid method of comparing the difference between two pieces of DNA:

A = atatatat
B = tatatata

same number of a's and t's, obviously two completely different sequences.

Name: Anonymous 2011-04-15 1:17

>>18
her
Also, >>12,13 does not use your jewish pseudo-Haskal comprehensions.

FIOC is clearly unsuitable for lambda calculus.

bampu pantsu.

Name: Anonymous 2011-04-15 1:25

>>13

(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)))))))) (cons one-hundred-three)) (cons one-hundred-sixteen)) (cons ninety-nine)) (cons 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)))

Name: Anonymous 2011-04-15 2:16

>>22
It's complete now, the output is human-readable.

(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 (c 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 (c (g (t (g (c nil)))))))))))))
                                          nil))))))))
                              (cons one-hundred-three)) (cons one-hundred-sixteen)) (cons ninety-nine)) (cons 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)
      ((((< x) y) x) y))))

(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 caar
  (λ (x)
    (car (car x))))
(define cadr
  (λ (x)
    (car (cdr x))))
(define cdar
  (λ (x)
    (cdr (car x))))
(define cddr
  (λ (x)
    (cdr (cdr x))))

(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))))))


(define (church-string->string x)
  (list->string (rkt:map (compose integer->char church->int) (church-list->list x))))

(define (convert x)
  (let ((c1 (church-string->string (caar x)))
        (c2 (church-string->string (cdar x)))
        (r1 (church->int (cadr x)))
        (r2 (church->int (cddr x))))
    (rkt:cons (rkt:cons c1 c2) (rkt:cons r1 r2))))


(convert (((mm <) cddr) m))
(convert (((mm >) cddr) m))
(convert (((mm <) cadr) m))
(convert (((mm >) cadr) m))

Name: Anonymous 2011-04-15 2:40

The thread without all the lambda calculus thing:
>>1-11,14-21,23-

Name: Anonymous 2011-04-15 6:00

>>20
https://secure.wikimedia.org/wikipedia/en/wiki/Insertion_%28genetics%29
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 -