HackerRank Lambda Calculi March 2016: cky's answers

area.rkt

#lang racket
(define (determinant p1 p2)
  (- (* (car p1) (cdr p2))
     (* (cdr p1) (car p2))))

(define points (read))
(define first (cons (read) (read)))
(define-values (area last)
  (for/fold ([area 0] [last first])
            ([i (in-range (sub1 points))]
             [x (in-port)]
             [y (in-port)])
    (define cur (cons x y))
    (values (+ area (* 0.5 (determinant last cur))) cur)))
(abs (+ area (* 0.5 (determinant last first))))

concave.rkt

#lang racket
(require (only-in srfi/1 delete) srfi/26 data/collection)
(struct point (x y) #:transparent)

(define (point<? pt1 pt2)
  (or (< (point-x pt1) (point-x pt2))
      (and (= (point-x pt1) (point-x pt2))
           (< (point-y pt1) (point-y pt2)))))

(define (anglediff dir pt1 pt2)
  (define result (- (atan (- (point-y pt2) (point-y pt1))
                          (- (point-x pt2) (point-x pt1)))
                    dir))
  (if (negative? result) (+ result pi pi) result))

(define (distance pt1 pt2)
  (sqrt (+ (sqr (- (point-x pt1) (point-x pt2)))
           (sqr (- (point-y pt1) (point-y pt2))))))

(define (angle<? dir cur pt1 pt2)
  (define angle1 (anglediff dir cur pt1))
  (define angle2 (anglediff dir cur pt2))
  (or (< angle1 angle2)
      (and (= angle1 angle2)
           (< (distance cur pt1) (distance cur pt2)))))

(define (convex? points)
  (define leftmost (find-best points point<?))
  (let loop ([remaining (delete leftmost points)]
             [cur leftmost]
             [dir (atan -1 0)])
    (if (null? remaining)
        #t
        (let* ([next (find-best remaining (cut angle<? dir cur <> <>))]
               [diff (anglediff dir cur next)])
          (if (and (not (equal? cur leftmost))
                   (< (anglediff dir cur leftmost) diff))
              (null? remaining)
              (loop (delete next remaining) next (+ dir diff)))))))

(define points
  (for/list ([i (in-range (read))]
             [x (in-port)]
             [y (in-port)])
    (point x y)))
(display (if (convex? points) "NO" "YES"))

fighting-armies.rkt

#lang racket
(require data/leftist-tree)

(void (read)
      (for/fold ([armies '#hasheqv()])
                ([i (in-range (read))]
                 [cmd (in-port)]
                 [army (in-port)])
        (define tree (hash-ref armies army (thunk (leftist-tree >=))))
        (case cmd
          [(1) (displayln (leftist-tree-min tree))
               armies]
          [(2) (hash-set armies army (leftist-tree-remove-min tree))]
          [(3) (hash-set armies army (leftist-tree-add tree (read)))]
          [(4) (let ([other (read)])
                 (define tree2 (hash-ref armies other (thunk (leftist-tree >=))))
                 (hash-set (hash-remove armies other)
                           army
                           (leftist-tree-add-all tree (in-leftist-tree tree2))))])))

function-or-not.rkt

#lang racket
(for ([i (in-range (read))]
      [N (in-port)])
  (define h
    (for/fold ([h '#hasheqv()])
              ([j (in-range N)]
               [x (in-port)]
               [y (in-port)])
      (hash-update h x (lambda (z) (and (eqv? y z) y)) y)))
  (displayln (if (ormap not (hash-values h)) "NO" "YES")))

perimeter.rkt

#lang racket
(define (distance p1 p2)
  (sqrt (+ (sqr (- (car p1) (car p2)))
           (sqr (- (cdr p1) (cdr p2))))))

(define points (read))
(define first (cons (read) (read)))
(define-values (perim last)
  (for/fold ([perim 0] [last first])
            ([i (in-range (sub1 points))]
             [x (in-port)]
             [y (in-port)])
    (define cur (cons x y))
    (values (+ perim (distance last cur)) cur)))
(+ perim (distance last first))

simplify.rkt

#lang racket
(require parser-tools/lex parser-tools/yacc
         (prefix-in : parser-tools/lex-sre))

(define-empty-tokens literals (|(| |)| + - * / ^ x eof))
(define-tokens numbers (integer))

(define simplify-lexer
  (lexer [(:+ whitespace) (simplify-lexer input-port)]
         [(char-set "()+-*/^x") (string->symbol lexeme)]
         [(:+ numeric) (token-integer (string->number lexeme))]))

(define simplify-parser
  (parser (tokens literals numbers)
          (start expr0)
          (end eof)
          (error void)
          (grammar (expr0
                    ((expr1) $1)
                    ((expr0 + expr1) (add $1 $3))
                    ((expr0 - expr1) (add $1 (neg $3))))
                   (expr1
                    ((expr2) $1)
                    ((expr1 * expr2) (times $1 $3))
                    ((expr1 expr3) (times $1 $2))
                    ((expr1 / expr2) (divide $1 $3)))
                   (expr2
                    ((expr3) $1)
                    ((- expr2) (neg $2)))
                   (expr3
                    ((expr4) $1)
                    ((expr4 ^ expr3) (pow $1 $3)))
                   (expr4
                    ((|(| expr0 |)|) $2)
                    ((integer) (trim `#(,$1)))
                    ((x) '#(0 1))))))

(define (trim x)
  (define i (for/first ([i (in-range (vector-length x) 0 -1)]
                        #:unless (zero? (vector-ref x (sub1 i))))
              i))
  (vector-copy x 0 (or i 0)))

(define (extend x len)
  (if (>= (vector-length x) len)
      x
      (vector-append x (make-vector (- len (vector-length x)) 0))))

(define (scale x len)
  (if (zero? len)
      x
      (vector-append (make-vector len 0) x)))

(define (add x y)
  (define len (max (vector-length x) (vector-length y)))
  (trim (vector-map + (extend x len) (extend y len))))

(define (neg x)
  (vector-map - x))

(define (times1 x y)
  (if (zero? y)
      '#()
      (vector-map (curry * y) x)))

(define (times x y)
  (if (> (vector-length y) (vector-length x))
      (times y x)
      (for/fold ([result '#()])
                ([i (in-naturals)]
                 [d (in-vector y)]
                 #:unless (zero? d))
        (add result (scale (times1 x d) i)))))

(define (divide x y)
  (case (vector-length y)
    [(0) (raise-arguments-error 'divide "can't divide by zero" "y" y)]
    [(1) (times1 x (/ (vector-ref y 0)))]
    [else (raise-arguments-error 'divide "only defined for real divisor" "y" y)]))

(define (pow x y)
  (case (vector-length y)
    [(0) '#(1)]
    [(1) (let loop ([result '#(1)]
                    [base x]
                    [power (vector-ref y 0)])
           (if (zero? power)
               result
               (loop (if (odd? power) (times result base) result)
                     (times base base)
                     (quotient power 2))))]
    [else (raise-arguments-error 'pow "only defined for real exponent" "y" y)]))

(define (format x [out (current-output-port)])
  (define len (vector-length x))
  (if (zero? len)
      (display 0 out)
      (for ([i (in-range (sub1 len) -1 -1)]
            [d (in-vector x (sub1 len) -1 -1)]
            #:unless (zero? d))
        (if (= i (sub1 len))
            (display (case d
                       [(1) ""]
                       [(-1) "-"]
                       [else d])
                     out)
            (fprintf out
                     " ~a ~a"
                     (if (negative? d) #\- #\+)
                     (case d
                       [(1 -1) ""]
                       [else (abs d)])))
        (case i
          [(0) (case d
                 [(1 -1) (display 1 out)])]
          [(1) (display #\x out)]
          [else (fprintf out "x^~a" i)]))))

(for ([i (in-range (call-with-input-string (read-line) read))]
      [line (in-port read-line)])
  (define in (open-input-string line))
  (format (simplify-parser (thunk (simplify-lexer in))))
  (newline))

tree-manager.rkt

#lang racket
(struct node ([value #:mutable] parent [children #:mutable]))

(define (node-siblings cursor)
  (node-children (node-parent cursor)))

(define (get-index cursor)
  (vector-memq cursor (node-siblings cursor)))

(define (get-sibling cursor offset)
  (vector-ref (node-siblings cursor) (+ (get-index cursor) offset)))

(define (insert-child! cursor pos value)
  (define children (node-children cursor))
  (set-node-children! cursor (vector-append (vector-copy children 0 pos)
                                            (vector (node value cursor (vector)))
                                            (vector-copy children pos))))

(define (insert-sibling! cursor offset value)
  (insert-child! (node-parent cursor) (+ (get-index cursor) offset) value))

(define (delete! cursor)
  (define siblings (node-siblings cursor))
  (define pos (get-index cursor))
  (set-node-children! (node-parent cursor)
                      (vector-append (vector-copy siblings 0 pos)
                                     (vector-copy siblings (add1 pos)))))

(define tree (node 0 #f (vector)))
(void (for/fold ([cursor tree])
                ([i (in-range (read))]
                 [cmd (in-port)])
        (case cmd
          [(change)
           (set-node-value! cursor (read))
           cursor]
          [(print)
           (displayln (node-value cursor))
           cursor]
          [(visit)
           (case (read)
             [(left) (get-sibling cursor -1)]
             [(right) (get-sibling cursor 1)]
             [(parent) (node-parent cursor)]
             [(child) (vector-ref (node-children cursor) (sub1 (read)))])]
          [(insert)
           (let ([subcmd (read)]
                 [value (read)])
             (case subcmd
               [(left) (insert-sibling! cursor 0 value)]
               [(right) (insert-sibling! cursor 1 value)]
               [(child) (insert-child! cursor 0 value)]))
           cursor]
          [(delete)
           (delete! cursor)
           (node-parent cursor)])))