競技プログラミングでよく使いそうなSchemeの関数メモ

AtCoderやProjectEulerをやっていく上で、よく使いそうだなぁというのを自分用メモも兼ねてこの記事に書いておく。随時加筆したい。

ソート(自分で比較関数を作ってもよい)

> (sort '(1 0 9) <)
(0 1 9)
> (sort '(1 0 9) >)
(9 1 0)
> (define (mod3< a b) (let ((aa (modulo a 3)) (bb (modulo b 3))) (< aa bb)))
> (sort '(2 1 9) mod3<)
(9 1 2)

四捨五入など、小数->整数について

;(round <値>)	値にもっとも近い整数，小数部が0.5のとき，最も近い偶数
;(floor <値>)	値を越えない最大整数（切り捨て）フロア
;(ceiling <値>)	値を下回らない最小整数（切り上げ）シーリング
;> (floor 3.5)
;3.0
;> (= 3 (floor 3.5))
;#t

複数のdisplayをしたい場合などに使えるbegin関数

(define (printn n)
  (if (> n 10) 0
      (begin
        (display n)
        (newline)
        (printn (+ n 1)))))
(printn 1)

※これだと、1,2,3,,,,10と表示される

文字列として読み込む

(define inp (symbol->string (read)))
(display (string-ref inp 2))

※ただreadしただけだとsymbolとして読み込まれちゃう

n個の数字を入力順に入れたリストを作る

(define (readN n)
  (if (= n 0) '()
      (let* ((ele (read)))
        (cons ele (readN (- n 1))))))

n個の数字を入力順に入れたベクトルを作る

(define N (read))
(define (readN n)
  (if (= n 0) '()
      (let* ((ele (read)))
        (cons ele (readN (- n 1))))))
(define vec (list->vector (readN N)))

(display vec)

重複を許す組み合わせを生成する関数

;> (p-generate 2 '(1 2 3))
;((1 1) (1 2) (1 3) (2 1) (2 2) (2 3) (3 1) (3 2) (3 3))

(define (p-generate count list)
  (define (e-l ele lislis)
    (if (null? lislis) '()
        (cons (cons ele (car lislis)) (e-l ele (cdr lislis)))))
  (define (multi-list listA listB)
    (if (null? listA) '()
        (append (e-l (car listA) listB) (multi-list (cdr listA) listB))))
  (define (p-list count base ans)
    (if (= count 0) ans
        (p-list (- count 1) base (multi-list base ans))))  
  (p-list count list '(())))

順列を生成する関数

;> (permutations-list '(1 2 3))
;((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))

(define (permutations-list ls)
  (define (fold-right fn a ls . args)
    (if (null? args)
        (letrec ((recr (lambda (a ls) (if (null? ls) a (fn (car ls) (recr a (cdr ls)))))))
          (recr a ls))
        (letrec ((recr (lambda (a xs)
                         (if (member? '() xs) a
                             (apply fn (append (map car xs) (list (recr a (map cdr xs)))))))))
          (recr a (cons ls args)))))
  (define (remove func list)
    (cond ((null? list) list)
          ((func (car list)) (remove func (cdr list)))
          (#t (cons (car list) (remove func (cdr list))))))
  (define (remove-item x ls)
    (remove (lambda (a) (equal? a x)) ls))
  (define (perm ls a b)
        (if (null? ls) (cons (reverse a) b)
            (fold-right (lambda (x y) (perm (remove-item x ls) (cons x a) y)) b ls)))
  (perm ls '() '()))

素数の生成

;> (primenum-list 50)
;(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47)

(define (primenum-list limit)
  (define (num-gene start end) (if (> start end) '() (cons start (num-gene (+ start 1) end))))
  (define (erat list)
    (define (remove ele lis)
      (if (null? lis) '()
          (if (= 0 (modulo (car lis) ele)) (remove ele (cdr lis))
              (cons (car lis) (remove ele (cdr lis))))))
    (if (null? list) '() (cons (car list) (erat (remove (car list) (cdr list))))))
  (erat (num-gene 2 limit)))

ベクトルでの二分探索、ベクトルが降順のとき(注意！)

(define (binary-search n vec);vecにnが含まれているか探す、vec降順ver
  (define (sub left right center)
    (let ((center-val (vector-ref vec center)))
      (cond ((>= (+ left 1) right) (or (= (vector-ref vec left) n) (= (vector-ref vec right) n)))
            ((= n center-val) #t)
            ((> n center-val) (sub left center (quotient (+ left center) 2)))
            (#t (sub center right (quotient (+ center right) 2))))))
  (if (= 0 (vector-length vec)) #f (sub 0 (- (vector-length vec) 1) (quotient (vector-length vec) 2))))

もともとある関数

;numerator ->分子を返す関数
;denominator ->分母を返す関数