結果
| 問題 |
No.708 （＋ー）の式
|
| コンテスト | |
| ユーザー |
 norioc
|
| 提出日時 | 2025-10-14 23:20:25 |
| 言語 | Scheme (Gauche-0.9.15) |
| 結果 |
AC
|
| 実行時間 | 136 ms / 2,000 ms |
| コード長 | 12,030 bytes |
| コンパイル時間 | 183 ms |
| コンパイル使用メモリ | 7,968 KB |
| 実行使用メモリ | 29,440 KB |
| 最終ジャッジ日時 | 2025-10-14 23:20:30 |
| 合計ジャッジ時間 | 3,471 ms |
|
ジャッジサーバーID （参考情報） |
judge3 / judge5 |
（要ログイン）
| ファイルパターン | 結果 |
|---|---|
| sample | AC * 3 |
| other | AC * 12 |
ソースコード
(use srfi.13) ; string
(use srfi.42) ; list-ec
;; (use srfi.210) ; compose-left
(use scheme.list)
(use scheme.vector)
(use data.queue)
(use gauche.generator)
(use gauche.sequence)
(use util.match)
(define input read-line)
(define (read-words)
(string-split (input) " "))
(define (ii)
(string->number (input)))
(define (li)
(map string->number (read-words)))
(define-method prn* ((coll <collection>) :key (sep " "))
(for-each-with-index (^(i x)
(when (> i 0)
(display sep))
(display x))
coll)
(newline))
(define (prn . args)
(prn* args))
(define (prn-yn b)
(prn (if b "Yes" "No")))
(define-syntax def define)
(define-macro (defmemo vars . body)
`(begin
(define ,vars ,@body)
(define ,(car vars) (memoize ,(car vars)))))
(define-reader-directive 'memo
(^(sym port ctx)
(let1 expr (read port)
(let1 name (car (cadr expr))
`(begin
,expr
(define ,name (memoize ,name)))))))
(define-syntax ->
(syntax-rules ()
((_ init fn)
(call-with-values (^() init)
fn))
((_ init fns ...)
(call-with-values (^() init)
(apply compose (reverse (list fns ...)))))))
(define-syntax ->/prn
(syntax-rules ()
((_ x fns ...)
(-> x fns ... prn))))
(define-syntax let/g
(syntax-rules ()
((_ var body ...)
(generate (lambda (var) body ...)))))
(define-macro (do1 pat expr . body)
(let1 var (gensym)
`(do-ec (: ,var ,expr)
(mlet1 ,pat ,var
,@body))))
(define-syntax do*
(syntax-rules ()
((_ (qualifier1 qualifier2 ...) body ...)
(do-ec qualifier1 qualifier2 ... (begin body ...)))))
(define-syntax max0-ec
(syntax-rules ()
((_ qualifier ... body)
(fold-ec 0 qualifier ... body max))))
(define-method reverse ((s <string>))
(string-reverse s))
(define-method reverse ((vs <vector>))
(rlet1 res (vector-copy vs)
(vector-reverse! res)))
(define ord char->integer)
(define chr integer->char)
(define str x->string)
(define-method int ((x <integer>)) x)
(define-method int ((x <real>)) (truncate->exact x))
(define-method int ((s <string>))
(let1 v (string->number s)
(if (exact-integer? v)
v
(errorf "invalid string for integer: ~w" s))))
(define-method int ((c <char>))
(if (char-numeric? c)
(digit->integer c)
(errorf "invalid char for integer: ~w" c)))
(define (minmax . xs)
(values->list (apply min&max xs)))
(define (sum xs)
(fold + 0 xs))
(define (prod xs)
(fold * 1 xs))
(define (divmod a b)
(values->list (div-and-mod a b)))
(define (ceildiv a b)
(div (+ a (1- b)) b))
(define (divide? a b)
(zero? (mod a b)))
(define (1+ n) (+ n 1))
(define (1- n) (- n 1))
(define (!= a b) (not (= a b)))
(define (midpoint a b) (div (+ a b) 2))
(define pow
(case-lambda
((a b) (expt a b))
((a b m) (expt-mod a b m))))
(define sq square)
(define isqrt exact-integer-sqrt)
(define (sq? n)
(let1 x (isqrt n)
(= (sq x) n)))
(define len size-of)
(define pos? positive?)
(define neg? negative?)
(define == equal?)
(define ++ string-append)
(define all every)
(define any-ec any?-ec)
(define all-ec every?-ec)
(define concat concatenate)
(define foldl fold-left)
(define (pairwise xs)
(zip xs (cdr xs)))
(define-method indexed ((coll <collection>) :optional (start 0))
(list-ec (: x (index i) coll)
(list (+ i start) x)))
(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 <collection>))
(let1 d (make-dict)
(for-each (^x (d'update! x 1+ 0)) xs)
d))
;; '(a b c) -> op(op(op(init, a), b), c)
(define (scanl op init xs)
(define (f a b)
(let1 t (op b a)
(values t t)))
(map-accum f init xs))
;; '(a b c) -> op(a, op(b, op(c, init)))
(define (scanr op init xs)
(define (f a b)
(let1 t (op a b)
(values t t)))
(reverse (map-accum f init (reverse xs))))
(define (map-accuml op init xs)
(values-ref (map-accum (^(a b) (op b a)) init xs)
0))
(define min* (apply$ min))
(define-method min* ((v <vector>))
(assume (> (len v) 0))
(fold min (vector-ref v 0) v))
(define max* (apply$ max))
(define-method max* ((v <vector>))
(assume (> (len v) 0))
(fold max (vector-ref v 0) v))
(define minmax* (apply$ minmax))
(define zip* (apply$ zip))
(define string* (apply$ string))
(define mlet match-let)
(define mlet* match-let*)
(define mlet1 match-let1)
(define (==$ x)
(pa$ == x))
(define-macro (input! . vars)
(define (group xs)
(if (null? xs)
'()
(let1 x (car xs)
(cond
((keyword? x) ; (:i VAR)
(assume (and (pair? (cdr xs))
(symbol? (cadr xs))))
(cons (list x (cadr xs)) (group (cddr xs))))
((symbol? x) ; default :i
(cons (list :i x) (group (cdr xs))))
((pair? x)
(cons (group x) (group (cdr xs))))
(else
(error "parse error: " xs))))))
(define (gen-define-values binds)
(let* ((ss (gensym))
(vars (map cadr binds))
(vals (map-with-index
(^(i x)
(ecase x
((:i) `(int (list-ref ,ss ,i)))
((:i-1) `(- (int (list-ref ,ss ,i)) 1))
((:s) `(list-ref ,ss ,i))))
(map car binds))))
`(define-values ,vars (let1 ,ss (read-words)
(values ,@vals)))))
(define (gen-define-values-1 kind var)
(let* ((val (ecase kind
((:i) `(map int (read-words)))
((:i-1) `(map (^x (- (int x) 1)) (read-words)))
((:s) `(read-words)))))
`(define-values (,var) (values ,val))))
(define (gen bind)
(match bind
((':i var) `(define ,var (int (input))))
((':i-1 var) `(define ,var (- (int (input)) 1)))
((':s var) `(define ,var (input)))
(else
(match-let1 (x . more) bind
(if (null? more)
(gen-define-values-1 (car x) (cadr x))
(gen-define-values bind))))))
(let ((binds (group vars)))
`(begin
,@(map gen binds))))
(define-macro (d/ . args)
(let ((ss (map (^x
`(format #f "~a=~:w" (quote ,x) ,x))
args)))
`(print (string-join (list ,@ss) " "))))
(define-macro (mfn pat . body)
(let ((args (gensym)))
`(lambda ,args
(mlet1 ,pat ,args
,@body))))
(define-macro (mfn1 pat . body)
(let ((arg (gensym)))
`(lambda (,arg)
(mlet1 ,pat ,arg
,@body))))
(define (digits n)
(map digit->integer (str n)))
(define (digits->int ds)
(fold-left (^(a b) (+ (* 10 a) b)) 0 ds))
(define (rep n thunk)
(list-ec (: _ n)
(thunk)))
(define (memoize fn)
(let1 cache (make-hash-table 'equal?)
(lambda args
(if (hash-table-exists? cache args)
(hash-table-get cache args)
(rlet1 val (apply fn args)
(hash-table-put! cache args val))))))
(define (accumulate xs)
(list->vector (scanl + 0 xs)))
(define (accum xs)
(let ((vs (accumulate xs)))
(case-lambda
((l r) ; [l, r]
(- (~ vs r) (if (> l 0) (~ vs (1- l)) 0)))
((r) ; [0, r]
(~ vs r)))))
(define (uniq xs)
(let1 used (make-hash-table 'equal?)
(let loop ((xs xs))
(if (null? xs)
'()
(mlet1 (x . more) xs
(if (hash-table-contains? used x)
(loop more)
(begin
(hash-table-put! used x #t)
(cons x (loop more)))))))))
(define (make-dict)
(let1 ht (make-hash-table equal-comparator)
(match-lambda*
(('get key)
(hash-table-get ht key))
(('get key default)
(hash-table-get ht key default))
(('put! key val)
(hash-table-put! ht key val))
(('update! key proc default)
(hash-table-update! ht key proc default))
(('push! key val)
(hash-table-push! ht key val))
(('contains? key)
(hash-table-contains? ht key))
(('keys)
(hash-table-keys ht))
(('values)
(hash-table-values ht))
(('items)
(hash-table->alist ht))
(('size)
(hash-table-num-entries ht))
(('map proc)
(hash-table-map ht proc)))))
(define (tap/d . args)
(pprint args)
(apply values args))
(define (make-comparator/less less?)
(make-comparator #t equal? less? #f))
(define-reader-directive '$
(^(sym port ctx)
(define (read-to-$)
(let1 res '()
(let loop ((c (read-char port)))
(unless (eqv? c #\$)
(push! res c)
(loop (read-char port))))
(string-trim-both (string* (reverse! res)))))
(define (tokenize s)
(d/ s)
(string-split s #/ +/))
(define (parse tokens)
(list tokens))
(let1 tokens (tokenize (read-to-$))
(d/ tokens)
(d/ (parse tokens))
123)))
;; (prn #!$ 2 + 3 + a $)
(use gauche.record)
(define-record-type operator #t #t
symbol ; str
precedence ; int
arity ; int
assoc ; 'left | 'right
fn ; callable
)
(define (make-operator-table)
(let1 ops (list (make-operator "**" 10 2 'right pow)
(make-operator "%" 9 2 'left mod)
(make-operator "/" 9 2 'left div)
(make-operator "*" 9 2 'left *)
(make-operator "+" 8 2 'left +)
(make-operator "-" 8 2 'left -))
(let1 ht (make-hash-table 'equal?)
(dolist (op ops)
(hash-table-put! ht (operator-symbol op) op))
ht)))
(define (parse tokens)
(let1 optable (make-operator-table)
(define (get-op token)
(hash-table-get optable token))
(let loop ((tokens tokens)
(ops '())
(rpn '()))
(if (null? tokens)
(reverse (append (map get-op (reverse ops))
rpn))
(let1 token (car tokens)
(cond ((hash-table-contains? optable token)
(let/cc return
(while (and (pair? ops)
(string<> (car ops) "("))
(let ((op1 (get-op token))
(op2 (get-op (car ops))))
(if (or (and (eq? (operator-assoc op1) 'left)
(<= (operator-precedence op1)
(operator-precedence op2)))
(< (operator-precedence op1)
(operator-precedence op2)))
(push! rpn (get-op (pop! ops)))
(return)))))
(loop (cdr tokens)
(cons token ops)
rpn))
((string= token "(")
(loop (cdr tokens)
(cons token ops)
rpn))
((string= token ")")
(while (and (pair? ops)
(string<> (car ops) "("))
(push! rpn (get-op (pop! ops))))
(assume (and (pair? ops) (string= (car ops) "(")))
(pop! ops)
(loop (cdr tokens)
ops
rpn))
(else
(loop (cdr tokens)
ops
(cons (int token) rpn)))))))))
(define (run-rpn rpn)
(let loop ((st '())
(rpn rpn))
(match rpn
((x . rest)
(if (operator? x)
(mlet1 (rhs lhs . more) st
(loop (cons ((operator-fn x) lhs rhs) more)
rest))
(loop (cons x st)
rest)))
(()
(assume (= 1 (len st)))
(car st)))))
(input! :s S)
(let1 tokens (string-split S #//)
(->/prn
(parse tokens)
run-rpn))