概要
よく使う関数やマクロを編集したものです。
※使いどころが分からないものも含まれています。
動作環境
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)