(use scheme.list) (use util.match) (use srfi.13) ; string (use srfi.42) ; list-ec (use srfi.197) ; chain (use gauche.collection) (use gauche.generator) (use gauche.sequence) (define input read-line) (define (ii) (string->number (read-line))) (define (li) (let ((s (read-line))) (map string->number (string-split s " ")))) (define (prn . args) (for-each-with-index (lambda (i x) (when (> i 0) (display " ")) (display x)) args) (newline)) (define prn* (pa$ apply prn)) (define int string->number) (define str x->string) (define-method min ((xs )) (fold min (~ xs 0) xs)) (define-method max ((xs )) (fold max (~ xs 0) xs)) (define (minmax . xs) (values->list (apply min&max xs))) (define-method minmax ((xs )) (values->list (apply min&max xs))) (define (sum xs) (fold + 0 xs)) (define (divmod a b) (values->list (div-and-mod a b))) (define (1+ n) (+ n 1)) (define (1- n) (- n 1)) (define (!= a b) (not (= a b))) (define pow (case-lambda ((a b) (expt a b)) ((a b m) (expt-mod a b m)))) (define isqrt exact-integer-sqrt) (define ++ string-append) (define (comb n k) (if (or (< k 0) (> k n)) 0 (let loop ((i 0) (x 1)) (if (= i k) x (loop (1+ i) (div (* x (- n i)) (1+ i))))))) (define-method frequencies ((xs )) (rlet1 ht (make-hash-table eqv-comparator) (for-each (^x (hash-table-update! ht x 1+ 0)) xs))) (define (pairwise xs) (zip xs (cdr xs))) (define (group xs test) (define (sub ys) (assume (not (null? ys))) (let loop ((g (list (car ys))) (ys (cdr ys))) (if (null? ys) (values (reverse g) ys) (match-let1 (y . rest) ys (if (test (car g) y) (loop (cons y g) rest) (values (reverse g) ys)))))) (if (null? xs) '() (receive (g rest) (sub xs) (if (null? rest) (list g) (cons g (group rest test)))))) (define (yn b) (prn (if b "Yes" "No"))) (define-macro (input! bindings . body) (let loop ((bs (reverse bindings)) (res '())) (if (null? bs) `(let*-values ,res ,@body) (cond ((symbol? (car bs)) (loop (cdr bs) (cons `((,(car bs)) (values (ii))) res))) ((list? (car bs)) (loop (cdr bs) (cons `(,(car bs) (apply values (li))) res))) (else 'error))))) (define mlet1 match-let1) (define (slide xs k :key step) (let* ((n (length xs)) (step (if (undefined? step) k step))) (let loop ((xs xs) (res '())) (if (null? xs) (reverse res) (loop (drop* xs step) (cons (take* xs k) res)))))) (define-macro (mfn pat . body) (let ((arg (gensym))) `(lambda (,arg) (mlet1 ,pat ,arg ,@body)))) (define (accum xs) (define (proc a b) (let1 t (+ a b) (values t t))) (map-accum proc 0 xs)) (define (bsearch low high pred :key (complement? #f)) (define satisfy? (if complement? (complement pred) pred)) (let loop ((lo low) (hi high) (res low)) (cond ((<= lo hi) (let1 m (div (+ lo hi) 2) (if (satisfy? m) (loop (1+ m) hi (max res m)) (loop lo (1- m) res)))) (else (if complement? (1+ res) res))))) (define (digits n) (map digit->integer (str n))) (define-class () ((x :getter vec2-x :init-value 0 :init-keyword :x) (y :getter vec2-y :init-value 0 :init-keyword :y))) (define-method write-object ((v ) port) (format port "#" (vec2-x v) (vec2-y v))) (define-method + ((a ) (b )) (make :x (+ (vec2-x a) (vec2-x b)) :y (+ (vec2-y a) (vec2-y b)))) (define-method - ((a ) (b )) (make :x (- (vec2-x a) (vec2-x b)) :y (- (vec2-y a) (vec2-y b)))) (define-method dot ((a ) (b )) (+ (* (vec2-x a) (vec2-x b)) (* (vec2-y a) (vec2-y b)))) (define-method cross ((a ) (b )) (- (* (vec2-x a) (vec2-y b)) (* (vec2-x b) (vec2-y a)))) ;; 三角形abcの面積 (define-method triangle-area ((a ) (b ) (c )) (/ (abs (cross (- b a) (- c a))) 2)) (define (vec2 x y) (make :x x :y y)) (define (area a b c) (let ((ab (- b a)) (ac (- c a))) (/ (abs (- (* (vec2-x ab) (vec2-y ac)) (* (vec2-y ab) (vec2-x ac)))) 2))) (input! ((X1 Y1 X2 Y2 X3 Y3)) (chain (let ((p1 (vec2 X1 Y1)) (p2 (vec2 X2 Y2)) (p3 (vec2 X3 Y3)) (d (map (apply$ vec2) '((1 0) (-1 0) (0 1) (0 -1))))) (max-ec (: a d) (: b d) (: c d) (triangle-area (+ p1 a) (+ p2 b) (+ p3 c)))) (exact->inexact _) (prn _)))