Racket の自分用ライブラリ

概要

よく使う関数やマクロを編集したものです。
※使いどころが分からないものも含まれています。

動作環境

Windows 10
DrRacket 7.6

内容

my-lib.rkt

#lang racket
(require racket/list
         racket/string)

(provide
 ;; キュー操作 -----
 de-queue!
 en-queue!
 ;; スタック操作 -----
 pop!
 push!
 ;; 破壊的操作 -----
 inc!
 dec!
 add-accum!
 sub-accum!
 mul-accum!
 div-accum!
 modulo-accum!
 concat-accum!
 ;; リスト操作 -----
 uniq
 map-accum
 ;; 繰り返し -----
 do-times
 ;; I/O -----
 input-key
 ;; データ型 -----
 symbol->number
 number->symbol
 ;; 文字列 -----
 upper-case?
 lower-case?
 string-list
 string-reverse
 string-press
 ;; その他 -----
 map-effect
 filter-effect
 member-effect
)
; ----------------------------------------------------------------
;;; キュー操作

(define-syntax de-queue!
  (syntax-rules ()
    [(_ buffer)
     (if (null? buffer) '()
         (let ([v (car buffer)])
           (set! buffer (cdr buffer))
           v) ) ] ) )


(define-syntax en-queue!
  (syntax-rules ()
    [(_ buffer x)
     (set! buffer
           (append buffer (list x)) ) ] ) )
; ----------------------------------------------------------------
;;; スタック操作

(define-syntax pop!
  (syntax-rules ()
    [(_ stack)
     (if (null? stack) '()
         (let ([v (car stack)])
           (set! stack (cdr stack))
           v) ) ] ) )


(define-syntax push!
  (syntax-rules ()
    [(_ stack x)
     (set! stack
           (cons x stack) ) ] ) )
; ----------------------------------------------------------------
;;; 破壊的操作

(define-syntax inc!
  (syntax-rules ()
    [(_ num)
     (set! num (add1 num)) ] ) )


(define-syntax dec!
  (syntax-rules ()
    [(_ num)
     (set! num (sub1 num)) ] ) )


(define-syntax add-accum!
  (syntax-rules ()
    [(_ acc x)
     (set! acc (+ acc x)) ] ) )


(define-syntax sub-accum!
  (syntax-rules ()
    [(_ acc x)
     (set! acc (- acc x)) ] ) )


(define-syntax mul-accum!
  (syntax-rules ()
    [(_ acc x)
     (set! acc (* acc x)) ] ) )


(define-syntax div-accum!
  (syntax-rules ()
    [(_ acc x)
     (set! acc (/ acc x)) ] ) )


(define-syntax modulo-accum!
  (syntax-rules ()
    [(_ acc x)
     (set! acc (modulo acc x)) ] ) )


(define-syntax concat-accum!
  (syntax-rules ()
    [(_ acc str)
     (let ([a acc])
       (set! a (string-append a str))
       a) ]
    [(_ acc str ...)  ; 引数が複数
     (let ([a acc])
       (set! a (string-append a str ...))
       a) ] ) )

; (concat-accum! "a" "b")
;=> "ab"

; (concat-accum! "a" "b" "c")
;=> "abc"
; ----------------------------------------------------------------
;;; リスト操作

(define (uniq lst)  ; ユニークなリストを返す
  (for/lists (acc)
             ([l lst]
              #:unless (member l acc))
    l) )


(define-syntax map-accum
  (syntax-rules ()
    [(_ acc proc lst)
     (let ([a acc])
       (map (λ (x)
              (proc a x)
              a)
            lst) ) ] ) )

; (map-accum 0 add-accum! (range 10))
;=> '(0 1 3 6 10 15 21 28 36 45)
; ----------------------------------------------------------------
;;; 繰り返し

(define-syntax do-times
  (syntax-rules ()
    [(_ time expr ...)
     (begin
       (unless (positive-integer? time)
         (error "") )
       (do ([i 0 (add1 i)])
         [(= i time)]
         expr ...) ) ] ) )
; ----------------------------------------------------------------
;;; I/O

(define-syntax input-key
  (syntax-rules ()
    [(_ str)
     (begin
       (display str)
       (read) ) ]
    [(_ str ...)
     (begin
       (display (string-append str ...))
       (read) ) ] ) )
; ----------------------------------------------------------------
;;; データ型

(define (symbol->number sym)
  (string->number (symbol->string sym)) )


(define (number->symbol num)
  (string->symbol (number->string num)) )
; ----------------------------------------------------------------
;;; 文字列

(define (upper-case? str)
  (if (regexp-match #rx"[A-Z]" str)
      #t #f) )


(define (lower-case? str)
  (if (regexp-match #rx"[a-z]" str)
      #t #f) )


(define (string-list str)  ; 文字列を 1 文字ずつに分けたリストを返す
  (map (λ (chr) (list->string (list chr)))
       (string->list str) ) )

; (string-list "abcde")
;=> ("a" "b" "c" "d" "e")


(define (string-reverse str)  ; 反転させた文字列を返す
   (string-append* (reverse (string-list str))) )

; (string-reverse "abcde")
;=> "edcba"


(define (string-press str)  ; 大文字を小文字に、スペースを削除した文字列を返す  ; すべて半角
  (string-replace (string-downcase str) " " ""))

; (string-press "Abc dEF")
;=> "abcdef"
; ----------------------------------------------------------------
;;; その他

(define-syntax map-effect
  (syntax-rules (in)
    [(_ proc (in expr lst))
     (map (λ (x)
            (proc x)
            (expr x) )
          lst) ] ) )

; (map-effect displayln
;             (in number->string (range 10)) )
;=>
; 0
; 1
; 2
; 3
; 4
; 5
; 6
; 7
; 8
; 9
; '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")


(define-syntax filter-effect
  (syntax-rules (in)
    [(_ proc (in pred? lst))
     (filter (λ (x)
               (proc x)
               (pred? x) )
             lst) ] ) )

; (filter-effect (λ (x) (when (even? x) (displayln x)))
;                (in even? (range 10)) )
;=>
; 0
; 2
; 4
; 6
; 8
; '(0 2 4 6 8)


(define-syntax remove-effect
  (syntax-rules (in)
    [(_ proc (in pred? lst))
     (filter (λ (x)
               (proc x)
               (not (pred? x)) )
             lst) ] ) )
; (remove-effect (λ (x) (unless (even? x) (displayln x)))
;                (in even? (range 10)) )
;=>
; 1
; 3
; 5
; 7
; 9
; '(1 3 5 7 9)


(define-syntax member-effect
  (syntax-rules (in mem)
    [(_ proc (in (mem x) lst))
     (let ([results (member x lst)])
       (if results 
           (begin
             (proc results)
             results)
           lst) ) ] ) )

; (member-effect displayln
;               (in (mem 7)
;                   (member-effect displayln
;                                  (in (mem 5) (range 10)) ) ) )
;=>
; (5 6 7 8 9)
; (7 8 9)
; '(7 8 9)

; (member-effect displayln
;                (in (mem 1)
;                    (member-effect displayln
;                                   (in (mem 5) (range 10)) ) ) )
;=>
; (5 6 7 8 9)
; (5 6 7 8 9)
; '(5 6 7 8 9)

; (let* ([lst (member-effect displayln
;                            (in (mem 2) (range 10)) )]
;        [_lst (member-effect displayln
;                             (in (mem 4) lst) )] )
;   (member-effect displayln
;                  (in (mem 6) _lst) ) )
;=>
; (2 3 4 5 6 7 8 9)
; (4 5 6 7 8 9)
; (6 7 8 9)
; '(6 7 8 9)