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

Fibonacci

Name: Anonymous 2010-06-13 8:57


(define (avl-node data left right)
  (list data left right))

(define (avl-node-data a)
  (car a))

(define (avl-node-left a)
  (list-ref a 1))

(define (avl-node-right a)
  (list-ref a 2))

(define (_height root)
  (if (null? root)
      0
      (cond ((and (null? (avl-node-left root)) (null? (avl-node-right root)))
             1)
            ((null? (avl-node-left root))
             (+ 1 (_height (avl-node-right root))))
            ((null? (avl-node-right root))
             (+ 1 (_height (avl-node-left root))))
            (else
             (+ 1 (max (_height (avl-node-left root)) (_height (avl-node-right root))))))))
 
(define (bfs f tree)
  (define (inner f tree queue)
    (if (not (null? queue))
        (let ((node (car queue)))
          (f node)
          (inner
           f
           tree
           (append (cdr queue)
                   (if (null?(avl-node-left node))
                       '()
                       (list (avl-node-left node)))
                   (if (null?(avl-node-right node))
                       '()
                       (list (avl-node-right node))))))))
  (inner f tree (list tree)))

(define (print-tree tree) (bfs (lambda(x) (display (avl-node-data x))) tree))
            
(define (rotate-right root pivot)
  (list
   (avl-node-data pivot)
   (avl-node-left pivot)
   (list (avl-node-data root)
         (avl-node-right pivot)
         (avl-node-right root))))

(define (rotate-left root pivot)
  (list
   (avl-node-data pivot)
   (list (avl-node-data root)
         (avl-node-left root)
         (avl-node-left pivot))
   (avl-node-right pivot)))

(define tree '(A (B (1 () ()) (2 () ())) (3 () ())))
     
(define (left-left tree)
  (rotate-right tree (avl-node-left tree)))

(define (right-right tree)
  (rotate-left tree (avl-node-right tree)))

(define (left-right tree)
  (rotate-right tree (rotate-left (avl-node-left tree) (avl-node-right (avl-node-left tree)))))

(define (right-left tree)
  (rotate-left tree (rotate-right (avl-node-right tree) (avl-node-left (avl-node-right tree)))))

(define test1 '(5 (3 (2 (D () ()) (C () ())) (B () ())) (A () ())))
(define test2 '(3 (A () ()) (5 (B () ()) (7 (C () ()) (D () ())))))
(define test3 '(5 (3 (B () ()) (4 (C () ()) (D () ()))) (A () ())))
(define test4 '(3 (A () ()) (5 (4 (D () ()) (C () ())) (B () ()))))


(define (balance-factor tree)
  (- (_height (avl-node-left tree)) (_height (avl-node-right tree))))

(define (balance tree)
  (let ((bf (balance-factor tree)))
;   (display bf)
    (cond ((and (= bf 2) (>= (balance-factor (avl-node-left tree)) 0))
           (begin
           (left-left tree)))
          ((= bf 2)
           (begin
           (left-right tree)))
          ((and (= bf -2) (<= (balance-factor (avl-node-right tree)) 0))
           (begin
           (right-right tree)))
          ((= bf -2)
           (begin
           (right-left tree)))
          (else
           tree))))
         
(define asdf '(3 (2 () ()) (4 () (5 () ()))))

(define (insert elm tree)
  (if (null? tree)
      (avl-node elm '() '())
  (cond ((< (avl-node-data tree) elm)
         (balance (avl-node (avl-node-data tree) (avl-node-left tree) (insert elm (avl-node-right tree)))))
        ((> (avl-node-data tree) elm)
         (balance (avl-node (avl-node-data tree (insert elm (avl-node-left tree)) (avl-node-right tree)))))
         (else
          tree))))
How do I write a delete procedure?

Name: Anonymous 2010-06-13 9:53

What is this?

Name: Anonymous 2010-06-13 11:32

>>2
A scheme newbie writing AVL trees

Name: Anonymous 2010-06-13 18:39

I messed with your code.

#lang racket

(require srfi/67)

(struct avl-node (key value height left right) #:transparent)

(define (avl-height n)
  (if n (avl-node-height n) 0))

(define (make-avl-leaf k v)
  (avl-node k v 1 #f #f))

(define (make-derived-node n l r)
  (avl-node
   (avl-node-key n)
   (avl-node-value n)
   (+ 1 (max (avl-height l) (avl-height r)))
   l r))

(define (lookup tree k (fail (lambda () (error "Could not find key"))))
  (let loop ((tree tree))
    (match tree
      (#f (if (procedure? fail) (fail) fail))
      ((struct* avl-node ((right r) (left l) (key key)))
       (if3 (integer-compare key k)
            (loop r)
            (avl-node-value tree)
            (loop l))))))

(define (insert tree k v)
  (let loop ((tree tree))
    (match tree
      (#f (make-avl-leaf k v))
      ((struct* avl-node ((left l) (right r) (key key)))
       (if3 (integer-compare key k)
            (balance (make-derived-node tree l (loop r tree)))
            tree
            (balance (make-derived-node tree (loop l) r)))))))

(define (delete tree k)
  (let loop ((tree tree))
    (match tree
      (#f #f)
      ((struct* avl-node ((left l) (right r) (key key)))
       (if3 (integer-compare key k)
            (balance (make-derived-node tree l (loop r)))
            (cond ((and l r)
                   (let-values (((l rm) (delete-rightmost l)))
                     (make-derived-node rm l r)))
                  (l l)
                  (r r)
                  (else #f))
            (balance (make-derived-node tree (loop l) r)))))))

(define (delete-rightmost tree)
  (match tree
    ((struct* avl-node ((right #f) (left l)))
     (values l tree))
    ((struct* avl-node ((right r) (left l)))
     (let-values (((new-r n) (delete-rightmost r)))
       (values (balance (make-derived-node tree l new-r)) n)))))

(define (balance-factor tree)
  (- (avl-height (avl-node-left tree)) (avl-height (avl-node-right tree))))

(define (balance tree)
  (if (not tree)
      #f
      (let ((bf (balance-factor tree)))
        (cond
          ((= bf 0) tree)
          ((= bf 1) tree)
          ((= bf -1) tree)
          ((= bf 2)
           (if (>= (balance-factor (avl-node-left tree)) 0)
               (left-left tree)
               (left-right tree)))
          ((= bf -2)
           (if (<= (balance-factor (avl-node-right tree)) 0)
               (right-right tree)
               (right-left tree)))
          (else
           (error "unbalanced tree detected"))))))

(define (rotate-right root pivot)
  (make-derived-node
   pivot
   (avl-node-left pivot)
   (make-derived-node
    root
    (avl-node-right pivot)
    (avl-node-right root))))

(define (rotate-left root pivot)
  (make-derived-node
   pivot
   (make-derived-node
    root
    (avl-node-left root)
    (avl-node-left pivot))
   (avl-node-right pivot)))

(define (left-left tree)
  (rotate-right tree (avl-node-left tree)))

(define (right-right tree)
  (rotate-left tree (avl-node-right tree)))

(define (left-right tree)
  (rotate-right tree (rotate-left (avl-node-left tree) (avl-node-right (avl-node-left tree)))))

(define (right-left tree)
  (rotate-left tree (rotate-right (avl-node-right tree) (avl-node-left (avl-node-right tree)))))

(define (stupid-benchmark)
  (define n 100000)
  (time
   (do ((i n (- i 1)) (t #f (insert t i (* i i))))
     ((zero? i)
      (do ((i n (- i 1)))
        ((zero? i)
         (do ((i n (- i 1)) (t t (delete t i)))
           ((zero? i) t)))
        (when (not (= (lookup t i) (* i i)))
          (error "inconsistency detected")))))))

Name: Anonymous 2010-06-15 6:07

Fuck parenthesis

Name: Anonymous 2010-06-15 7:45

>>5
acquire currency

Name: Anonymous 2010-06-15 10:18

>>6
Back to /b/, please.

Name: Anonymous 2010-06-15 10:54

>>7
wat

Name: Anonymous 2010-06-15 11:31

somebody make a red-black tree

Name: Anonymous 2010-06-15 11:40

jesus fucking christ

Name: Anonymous 2010-06-15 11:45

, you wanna be my main squeeze nigga
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 -