行番号を付加する

(define (put-line-number file)
  (let ((counter 0))
    (read-lines file
                (lambda (line)
                  (format #t "~4,'0d : ~a\n" counter line)
                  (inc! counter)))))

1文字毎に , を追加する

(define (put-comma file)
  (read-chars file (lambda (c)
                     (display
                       (cond ((char=? c #\newline) (string c))
                             (else
                               (string c #\,)))))))

プログラミングGauche

posted with amazlet at 10.01.25

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 202591

Amazon.co.jp で詳細を見る

(use gauche.sequence) ; for-each-with-index
(use srfi-27)         ; random-source-randomize!
(use srfi-19)         ; date-nanosecond
(use math.mt-random)  ; <mersenne-twister>

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-constant WALL_CHAR    #\*)
(define-constant ROAD_CHAR    #\space)
(define-constant START_CHAR   #\S)
(define-constant GOAL_CHAR    #\G)
(define-constant DEFAULT_SIZE 10)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-class <maze> ()
  ((width     :init-keyword :width    :init-value DEFAULT_SIZE)
   (height    :init-keyword :height   :init-value DEFAULT_SIZE)
   (maze-map                          :init-value '())
   ))

(define-method initialize ((self <maze>) initargs)
  (next-method)
  (let ((width (ref self 'width))
        (height (ref self 'height)))
    (when (even? width) (set! (ref self 'width) (+ width 1)))
    (when (even? height) (set! (ref self 'height) (+ height 1)))
    (set! (ref self 'maze-map)
          (make-vector (* (ref self 'width) (ref self 'height))
                       WALL_CHAR))))

;;; マップを印字
(define-method print-map ((self <maze>))
  (let1 width (ref self 'width)
    (for-each-with-index
      (lambda (i c)
        (cond ((= (remainder i width) (- width 1))
               (display c)
               (newline))
              (else (display c))))
      (ref self 'maze-map))))

;;; 座標 (x y) の vector 対応インデックスを生成
(define-method pos-to-index ((self <maze>) . args)
  (+ (car args)
     (* (cadr args) (ref self 'width))))

;;; (put maze 1 3 #\S) => x:1, y:3 に文字 S をセット
(define-method put ((self <maze>) . args)
  (vector-set! (ref self 'maze-map)
               (pos-to-index self (car args) (cadr args))
               (caddr args)))

;;; (get maze 1 3) => x:1, y:3 の文字をゲット
(define-method get ((self <maze>) . args)
  (vector-ref (ref self 'maze-map)
              (pos-to-index self (car args) (cadr args))))

;;; 穴掘り
(define-method dig ((self <maze>))
  (let* ((width (ref self 'width))
         (height (ref self 'height))
         (x-left 1)
         (y-top 1)
         (x-right (- width 2))
         (y-bottom (- height 2)))
    (put self x-left y-top ROAD_CHAR) ; 座標左上に空白文字を配置(スタート位置)
    (call/cc
      (lambda (break)
        (let loop ((pos (cons x-left y-top)) ; 現在位置座標
                   (from-list '())) ; これまでたどってきた位置座標リスト
          (let ((next-pos-list (get-next-pos self (car pos) (cdr pos))))
            (cond ((null? next-pos-list) ; 移動先が無い場合
                   (cond ((null? from-list) (break)) ; スタートに戻ってきたら終了
                         (else (loop (car from-list) (cdr from-list))))) ; 前の位置に戻って繰り返す
                  (else ; 移動先がある場合
                    (let* ((next-pos (list-ref-random next-pos-list))
                           (x (car pos))
                           (y (cdr pos))
                           (nx (car next-pos))
                           (ny (cdr next-pos))
                           (mx (if (= x nx) x (/ (+ x nx) 2)))
                           (my (if (= y ny) y (/ (+ y ny) 2))))
                      (put self nx ny ROAD_CHAR)
                      (put self mx my ROAD_CHAR)
                      (loop (cons nx ny) (cons pos from-list)))))))))
    (put self x-left y-top START_CHAR)    ; 座標左上にスタート文字 S を配置
    (put self x-right y-bottom GOAL_CHAR) ; 座標右下にゴール文字 G を配置
    ))

;;; 現在座標から2マス先の非空白座標を探す
(define-method get-next-pos ((self <maze>) . args)
  (let* ((x (car args))
         (y (cadr args))
         (width (ref self 'width))
         (height (ref self 'height))
         (next-pos-list (filter pair?
                                (list
                                  (if (> x 2) (cons (- x 2) y) '())
                                  (if (< x (- width 3)) (cons (+ x 2) y) '())
                                  (if (> y 2) (cons x (- y 2)) '())
                                  (if (< y (- height 3)) (cons x (+ y 2)) '())))))
    (fold
      (lambda (pos ret)
        (if (char=? (get self (car pos) (cdr pos)) WALL_CHAR)
            (cons pos ret)
            ret))
      '()
      next-pos-list)))

;;; リストからランダムに要素を1つ取り出す
(define (list-ref-random lis)
  (let1 mt (make <mersenne-twister> :seed (sys-time))
    (mt-random-set-seed! mt (date-nanosecond (current-date)))
    (let* ((range (length lis))
           (i (mt-random-integer mt range)))
      (list-ref lis i))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
(define (make-size args)
  (let ((args-length (length args)))
    (lambda (type)
      (cond ((> args-length 2)
             (string->number
               (cond ((eq? type 'width)
                      (cadr args))
                     ((eq? type 'height)
                      (caddr args))
                     (else
                       (error "Unknown type -- MAKE-SIZE" type)))))
            (else DEFAULT_SIZE)))))

;;;
(define (main args)
  (let* ((w ((make-size args) 'width))
         (h ((make-size args) 'height))
         (maze (make <maze> :width w :height h)))
    (dig maze)
    (print-map maze)
      )
  0)

"穴掘り法"については、以下のサイトを参考にした。

迷路作成プログラムの製作
穴掘り法

実行結果

引数に横と縦のサイズを渡している。
引数なしの場合は横11、縦11のサイズのマップとなる。

$ ./makemap.scm 51 15
***************************************************
*S*       *           *   *   *       *       *   *
* *** *** *** *** ***** * * * * *** * * ***** *** *
*     * *   *   * *     * * *   *   * * *       * *
******* *** *** *** ***** * ***** *** * ******* * *
*     *   * *   *   *   *   *   *   * *     * * * *
* ***** * * * *** ***** ***** * *** * ***** * * * *
* *   * *   *           *     *     * *     * *   *
* * * * *************** * *********** * ***** *** *
*   * * *       *       *       *   * *   *     * *
* *** * * ***** *********** *** *** * * * * ***** *
*   * * *   * * *     *   * *   *   * * * *     * *
*** * * *** * * * *** * * *** *** *** *** * *** * *
*   *       *     *     *     *           *   *  G*
***************************************************

"最短経路探索プログラム Gauche 版 その2" で作ったプログラムを標準入力から読み込みできるように修正して、作成した迷路をパイプで渡して最短経路を見つける。

$ ./makemap.scm 51 15 | ./maze2.scm
***************************************************
*S*         *     *   *       *      $$$*   *     *
*$* ******* *** * *** * *** *** *****$*$* * * *** *
*$*   *   *     *     * * *   * *$$$$$*$* * *   * *
*$* * * * ***** ******* * *** * *$*****$* * *** * *
*$* * * *   *   *       *   *   *$*$$$$$* *     * *
*$*** * *** ***** ******* * *****$*$***** ******* *
*$$$*   * *       *     * * *$$$$$*$* *         * *
***$* *** ********* *** * ***$*****$* * ******* ***
* *$*               * *   *$$$* *$$$*   *$$$$$*   *
* *$* *************** *** *$*** *$*******$***$*** *
* *$* *$$$$$$$$$$$$$*     *$$$* *$*  $$$*$* *$$$* *
* *$***$***********$*********$* *$***$*$*$* ***$* *
*  $$$$$*          $$$$$$$$$$$*  $$$$$*$$$*    $$G*
***************************************************

ファイル引数が与えられなかった場合に、標準入力からマップデータを読み込むために行った修正。

(define (main args)
  (let* ((map-list (make-map
                     (if (null? (cdr args))
                         (port->string (standard-input-port))
                         (file->string (cadr args)))))
         (walked-pos-list (drop-right (search (cons (cons (find-pos #\S map-list) '()) '()) map-list) 1)))
    (let loop ((walked walked-pos-list)
               (maps map-list))
      (if (null? walked)
          (print-map maps)
          (loop (cdr walked)
                (mark-pos (car walked) maps))))
    )
  0)

プログラミングGauche

posted with amazlet at 10.01.21

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 180753

Amazon.co.jp で詳細を見る

今回はマップのデータを文字のリストから成る行リストで作る。
隣接する座標に一歩づつ移動して経路を記録して文字を埋めてゆき、ゴールが見つかった時点で call/cc を使ってループを脱出する。
そして、結果の移動経路座標の文字を $ に書き換えていったマップデータを印字する。

(use file.util)       ; file->string
(use srfi-1)          ; list-index
(use gauche.sequence) ; fold-with-index

;;; マップ文字列からマップデータリストを作る
;;; マップデータリスト
;;; ((* * * * * * * * * * * * * * * * * * * * * * * * * *)
;;;  (* S *   *                                         *)
;;;  ... 省略 ...
;;;  (* * * * * * * * * * * * * * * * * * * * * * * * * *))
;;;
(define (make-map str)
  (let loop ((str-list (string->list str))
             (map-list '())
             (line-list '()))
       (if (null? str-list)
           (reverse map-list)
           (let ((c (car str-list))
                 (rest (cdr str-list)))
                (cond ((char=? c #\newline)
                       (loop rest (cons (reverse line-list) map-list) '()))
                      (else
                        (loop rest map-list (cons c line-list))))))))

;;; 文字 char の座標 (x . y) を探す
(define (find-pos char map-list)
  (let loop ((lines map-list) (x 0) (y 0))
       (if (null? lines)
           (cons x y)
           (let* ((line (car lines))
                  (_x (list-index
                        (lambda (c) (char=? char c))
                        line)))
                 (if (number? _x) ; 文字 char が見つかれば
                     (loop '() _x y) ; 検索終了
                     (loop (cdr lines) x (+ y 1)))))))

;;; 座標 pos => (x . y) の文字を取り出す
(define (get-char pos map-list)
  (let ((x (car pos))
        (y (cdr pos)))
       (list-ref
         (list-ref map-list y)
         x)))

;;; 座標 pos => (x . y) の文字を new-char に書き換えたマップデータリストを返す
(define (set-char pos new-char map-list)
  (let ((x (car pos))
        (y (cdr pos)))
       (reverse
         (fold-with-index
           (lambda (_y line result)
                   (cons
                     (reverse
                       (fold-with-index
                         (lambda (_x char rest)
                                 (if (and (= _x x) (= _y y))
                                     (cons new-char rest)
                                     (cons char rest)))
                         '()
                         line))
                       result))
           '()
           map-list))))

;;; 座標 pos に移動済みマーク $ を付ける
(define (mark-pos pos map-list)
  (let* ((x (car pos))
         (y (cdr pos))
         (new-char #\$))
       (set-char pos new-char map-list)))

;;; 経路探索処理 search
;;; 座標データリストとマップデータリストを渡し、移動可能な次の座標にマークを付けて再帰的に処理していく
;;; ゴールを見つけると、最短経路移動座標リスト(スタート位置を含む)を返す
;;; 座標データリスト: (<座標データ: (<座標:(x . y)> <移動経路座標リスト:((x . y) (x . y) ...)>)> <座標データ:(...)> <座標データ:(...)> ...)
(define (search pos-list map-list)
  (if (null? pos-list)
      '()
      (call/cc
        (lambda (break)
                (let ((next-pos-list '()))
                     (for-each
                       (lambda (pos-data) ; pos-data : 座標データ
                               (let* ((pos (car pos-data))
                                      (x (car pos))
                                      (y (cdr pos))
                                      (nexts (list (cons x (- y 1)) (cons x (+ y 1)) (cons (- x 1) y) (cons (+ x 1) y))))
                                     (for-each
                                       (lambda (next-pos)
                                               (let* ((next-x (car next-pos))
                                                      (next-y (cdr next-pos))
                                                      (char (get-char next-pos map-list)))
                                                     (cond ((char=? char #\G)
                                                            (break (cons pos (cdr pos-data))))
                                                           ((char=? char #\space)
                                                            (set! map-list (mark-pos next-pos map-list))
                                                            (set! next-pos-list (cons (cons next-pos (cons pos (cdr pos-data))) next-pos-list))))))
                                       nexts))) ; nexts : 移動先座標リスト
                       pos-list) ; pos-list : 座標データリスト
                     (search next-pos-list map-list))))))

;;; マップデータリストからマップを印字する
(define (print-map map-list)
  (if (null? map-list)
      '()
      (let ((line (car map-list)))
           (let loop ((l line))
                (if (null? l)
                    (newline)
                    (let ((c (car l)))
                         (display c)
                         (loop (cdr l)))))
           (print-map (cdr map-list)))))

;;;
(define (main args)
  (let* ((file (cadr args))
         (map-list (make-map (file->string file)))
         (walked-pos-list (drop-right (search (cons (cons (find-pos #\S map-list) '()) '()) map-list) 1)))
        (let loop ((walked walked-pos-list)
                   (maps map-list))
             (if (null? walked)
                 (print-map maps)
                 (loop (cdr walked)
                       (mark-pos (car walked) maps))))
        )
  0)

実行結果

$ ./maze2.scm map.txt
**************************
*S* * $$$                *
*$* *$$*$ *************  *
*$* $$* $$$************  *
*$$$$*    $$$$$          *
**************$***********
* $$$$$$$$$$$$$          *
**$***********************
* $$$$$* $$$$$$$$$$$$$G  *
*  *  $$$$*********** *  *
*    *        ******* *  *
*       *                *
**************************

プログラミングGauche

posted with amazlet at 10.01.18

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 134071

Amazon.co.jp で詳細を見る

こちらは、スタートからの移動距離を記録してゆき、ゴールから戻るかたちで最短経路にマークを付けてゆく方法で作った。

マップ座標(x, y)をキーにするハッシュテーブルでマップデータを作り、マップ上の "文字"、移動先の"座標リスト"、スタートからの"移動距離" を値とした。

(use file.util)
(use srfi-1)

;;; 文字列から各文字を、ハッシュテーブルに追加していく。
;;; 行を y 座標とし、各行の左からの文字位置を x 座標とする (x y) のリストをキーとする。
;;; ノードデータリスト構造を (<文字> <移動先座標リスト> <スタートからの距離>) とする。
(define (make-map-table str map-table)
  (define (set-table-iter lis key)
    (if (null? lis)
        map-table
        (let ((c (car lis)))
             (hash-table-put! map-table
                              key
                              (list c '() 0))
             (set-table-iter (cdr lis)
                             (if (char=? c #\newline)
                                 (list 0 (+ (get-y key) 1))
                                 (list (+ (get-x key) 1) (get-y key)))))))
  (set-table-iter (string->list str) (list 0 0)))

;;; 座標から x 座標を取り出す
(define (get-x key) (car key))
;;; 座標から y 座標を取り出す
(define (get-y key) (cadr key))
;;; ノードデータリストから文字を取り出す
(define (get-char node) (car node))
;;; ノードデータリストから移動先座標リストを取り出す
(define (get-nexts node) (cadr node))
;;; ノードデータリストからスタートからの移動距離を取り出す
(define (get-distance node) (caddr node))

;;; 特定文字の座標検索
(define (search-pos char map-table)
  (hash-table-map map-table
                  (lambda (key value)
                          (if (char=? (get-char value) char)
                              key
                              '()))))
;;; スタート座標の検索
(define (search-start map-table)
  (car (filter pair? (search-pos #\S map-table))))
;;; ゴール座標の検索
(define (search-goal map-table)
  (car (filter pair? (search-pos #\G map-table))))

;;; スタート地点からの移動距離をセットし、移動先座標をセットしていく。
(define (set-distances nexts current-distance map-table)
  (let ((next-nexts '()))
       (if (null? nexts)
           '()
           (for-each
             (lambda (key)
                     (let* ((x (get-x key))
                            (y (get-y key))
                            (move (list (list x (- y 1)) (list x (+ y 1)) (list (- x 1) y) (list (+ x 1) y))))
                           (for-each
                             (lambda (k)
                                     (let* ((nd (hash-table-get map-table k))
                                            (ch (get-char nd))
                                            (nx (get-nexts nd))
                                            (ds (get-distance nd)))
                                           (if (and (or (char=? #\space ch)
                                                        (char=? #\S ch)
                                                        (char=? #\G ch))
                                                    (= ds 0))
                                               (begin
                                                 (set! next-nexts (cons k next-nexts))
                                                 (hash-table-put! map-table k (list ch (list key) (+ current-distance 1)))))))
                             move)))
             nexts))
       (if (null? next-nexts)
           map-table
           (set-distances next-nexts (+ current-distance 1) map-table))))

;;; ゴールノードから隣接ノードのスタートからの距離がより短いものを探して、文字を $ に変更していく
(define (mark-root nexts distance map-table)
  (if (null? nexts)
      map-table
      (let* ((next-key (car nexts))
             (next-node (hash-table-get map-table next-key))
             (next-char (get-char next-node))
             (next-nexts (get-nexts next-node))
             (next-distance (get-distance next-node)))
            (if (char=? next-char #\S)
                map-table
                (if (= next-distance (- distance 1))
                    (begin
                      (hash-table-put! map-table next-key (list #\$ next-nexts next-distance))
                      (mark-root next-nexts next-distance map-table))
                    (mark-root (cdr nexts) distance map-table))))))

;;; マップを印字
(define (print-map map-table)
  (define (iter x y)
    (let ((key (list x y)))
         (if (hash-table-exists? map-table key)
             (let* ((node (hash-table-get map-table key))
                    (char (get-char node)))
                   (display char)
                   (if (char=? char #\newline)
                       (iter 0 (+ y 1))
                       (iter (+ x 1) y))))))
  (iter 0 0))

;;;
(define (main args)
  (let ((file (cadr args)))
       (let ((map-table (make-hash-table 'equal?)))
            (make-map-table (file->string file) map-table)
            (let ((start-key (search-start map-table))
                  (goal-key (search-goal map-table)))
                 (print-map
                   (let* ((measured-map (set-distances (cons start-key '()) 1 map-table))
                          (goal-node (hash-table-get measured-map goal-key))
                          (goal-nexts (get-nexts goal-node))
                          (goal-distance (get-distance goal-node)))
                         (mark-root goal-nexts goal-distance measured-map))))))
  0)

実行結果

$ ./maze.scm map.txt
**************************
*S* * $$$                *
*$* *$$*$ *************  *
*$* $$* $$$************  *
*$$$$*    $$$$$          *
**************$***********
* $$$$$$$$$$$$$          *
**$***********************
* $$$$$* $$$$$$$$$$$$$G  *
*  *  $$$$*********** *  *
*    *        ******* *  *
*       *                *
**************************

プログラミングGauche

posted with amazlet at 10.01.16

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 68658

Amazon.co.jp で詳細を見る

カード枚数が足りない場合を考えていたら20分かかってしまった・・・

var deal = function(numPlayers, cards) {
    var result = [];
    var len = Math.floor(cards.length / numPlayers) * numPlayers;
    for (var i=0; i<numPlayers; i++) {
        result.push('');
    }
    for (var i=0; i<len; i++) {
        result[i % numPlayers] += cards[i];
    }
    return result;
};

console.log(deal(3, "123123123"));
console.log(deal(4, "123123123"));
console.log(deal(2, "123123123"));
console.log(deal(6, "012345012345012345"));
console.log(deal(4, "111122223333"));
console.log(deal(1, "012345012345012345"));
console.log(deal(6, "01234"));
console.log(deal(2, ""));

追記：Gauche で作ってみた。

(use srfi-1)
(use gauche.sequence)

(define (deal num-players cards)
  (let* ((l-cards (string->list cards))
         (util-cards (drop-right l-cards (remainder (length l-cards) num-players))))
        (define (iter i p)
          (if (= i 0)
              p
              (iter (- i 1)
                    (cons
                      (map cadr (filter
                                  (lambda (x) (= (remainder (car x) num-players) (- i 1)))
                                  (map-with-index list util-cards)))
                      p))))
        (iter num-players '())))

(map list->string (deal 3 "123123123"))
(map list->string (deal 4 "123123123"))
(map list->string (deal 2 "123123123"))
(map list->string (deal 6 "012345012345012345"))
(map list->string (deal 4 "111122223333"))
(map list->string (deal 1 "012345012345012345"))
(map list->string (deal 6 "01234"))
(map list->string (deal 2 ""))

実行結果

gosh> ("111" "222" "333")
gosh> ("12" "23" "31" "12")
gosh> ("1321" "2132")
gosh> ("000" "111" "222" "333" "444" "555")
gosh> ("123" "123" "123" "123")
gosh> ("012345012345012345")
gosh> ("" "" "" "" "" "")
gosh> ("" "")

Scheme でリアルタイムにコードを書きながら音楽を作っている。
ryukyu がいい。
おもしろいな。

(use text.csv)
(use gauche.collection)
(use srfi-13)

(define *check-column-index* 1)

(define (quick-sort comp lis)
  (if (null? lis)
      '()
      (let ((p (car lis)))
           (receive (a b) (partition (lambda (x) (comp x p)) (cdr lis))
                    (append (quick-sort comp a)
                            (cons p (quick-sort comp b)))))))

(define (quick-sort-csv comp lis column-index)
  (quick-sort (lambda (lis-x lis-y)
                      (let ((x (list-ref lis-x column-index))
                            (y (list-ref lis-y column-index)))
                           (if (comp x y) #t #f)))
              lis))

(define (delete-repeated-record record-list)
  (define (iter record-list prev-record-item result-list)
    (if (null? record-list)
        result-list
        (let ((record (car record-list)))
             (let ((current-record-item (list-ref record *check-column-index*)))
                  (iter (cdr record-list) current-record-item
                        (if (string=? current-record-item prev-record-item)
                            result-list
                            (cons record result-list)))))))
  (iter record-list "" '()))

(define (print-csv record-list)
  (if (null? record-list)
      '()
      (let ((record (car record-list)))
           (print "\"" (string-join record "\",\"") "\"")
           (print-csv (cdr record-list)))))

(define (read-csv file)
  (let ((reader (make-csv-reader #\,)))
       (call-with-input-file file
                             (lambda (in)
                                     (port->list reader in)))))

(define (main args)
  (if (null? (cadr args))
      (error "CSV file is required")
      (let ((sorted-csv-list (quick-sort-csv string> (read-csv (cadr args)) *check-column-index*)))
           (print-csv (delete-repeated-record sorted-csv-list))))
  0)

実行結果

$ cat test.csv
"上杉謙信","ken@foo.com","09023421011"
"織田信長","oda@hoge.com","08034528761"
"徳川家康","toku@yahoo.com","0230989124"
"上杉輝虎","ken@foo.com","09023421011"
"豊臣秀吉","saru@gmail.com","08013457812"
"長尾景虎","ken@foo.com","09023421011"
"松平元康","toku@yahoo.com","0230989124"
"木下藤吉郎","saru@gmail.com","08013457812"
"毛利元就","nari@yahoo.com","02056720981"
$ ./delete-repeated-csv-record.scm test.csv
"上杉謙信","ken@foo.com","09023421011"
"毛利元就","nari@yahoo.com","02056720981"
"織田信長","oda@hoge.com","08034528761"
"豊臣秀吉","saru@gmail.com","08013457812"
"徳川家康","toku@yahoo.com","0230989124"

プログラミングGauche

posted with amazlet at 09.07.23

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 51330

Amazon.co.jp で詳細を見る

(use gauche.collection) ;; for partition
(use srfi-13) ;; for string>

;; CSV 形式データをリストに変換したもの。
;; port->list で CSV ファイルを読み込んでリスト化したものと仮定する。
(define dummy-csv '(("上杉謙信" "ken@foo.com" "09023421011")
                    ("織田信長" "oda@hoge.com" "08034528761")
                    ("徳川家康" "toku@yahoo.com" "0230989124")
                    ("豊臣秀吉" "saru@gmail.com" "08013457812")
                    ("毛利元就" "nari@yahoo.com" "02056720981")))

;; クイックソート手続き
(define (quick-sort comp lis)
  (if (null? lis)
      '()
      (let ((p (car lis)))
           (receive (a b) (partition (lambda (x) (comp x p)) (cdr lis))
                    (append (quick-sort comp a)
                            (cons p (quick-sort comp b)))))))

;; CSV 形式データの col-num 番目のセルを比較してソートする。
(define (quick-sort-csv comp lis col-num)
  (quick-sort (lambda (lis-x lis-y)
                      (let ((x (list-ref lis-x col-num))
                            (y (list-ref lis-y col-num)))
                           (if (comp x y) #t #f)))
              lis))

実行結果

(quick-sort-csv string> dummy-csv 0)
gosh> (("豊臣秀吉" "saru@gmail.com" "08013457812") ("織田信長" "oda@hoge.com" "08034528761") ("毛利元就" "nari@yahoo.com" "02056720981") ("徳川家康" "toku@yahoo.com" "0230989124") ("上杉謙信" "ken@foo.com" "09023421011"))

(quick-sort-csv string> dummy-csv 1)
gosh> (("徳川家康" "toku@yahoo.com" "0230989124") ("豊臣秀吉" "saru@gmail.com" "08013457812") ("織田信長" "oda@hoge.com" "08034528761") ("毛利元就" "nari@yahoo.com" "02056720981") ("上杉謙信" "ken@foo.com" "09023421011"))

(quick-sort-csv string> dummy-csv 2)
gosh> (("上杉謙信" "ken@foo.com" "09023421011") ("織田信長" "oda@hoge.com" "08034528761") ("豊臣秀吉" "saru@gmail.com" "08013457812") ("徳川家康" "toku@yahoo.com" "0230989124") ("毛利元就" "nari@yahoo.com" "02056720981"))

(quick-sort-csv string> dummy-csv 3)
gosh> *** ERROR: argument out of range: 3
Stack Trace:

プログラミングGauche

posted with amazlet at 09.07.23

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 51330

Amazon.co.jp で詳細を見る

(use text.csv)

(define (read-csv file)
  (let ((reader (make-csv-reader #\,)))
       (call-with-input-file file
                             (lambda (in)
                                     (port->list reader in)))))

(define (main args)
  (if (null? (cadr args))
      (error "CSV file is required")
      (print (read-csv (cadr args))))
  0)

実行結果

$ cat test.csv
"上杉謙信","ken@foo.com","09023421011"
"織田信長","oda@hoge.com","08034528761"
"徳川家康","toku@yahoo.com","0230989124"
"豊臣秀吉","saru@gmail.com","08013457812"
"毛利元就","nari@yahoo.com","02056720981"

$ ./read-csv.scm test.csv
((上杉謙信 ken@foo.com 09023421011) (織田信長 oda@hoge.com 08034528761) (徳川家康 toku@yahoo.com 0230989124) (豊臣秀吉 saru@gmail.com 08013457812) (毛利元就 nari@yahoo.com 02056720981))

参考：Gauche リファレンスマニュアル: CSVテーブル
　　　Gauche ユーザリファレンス: 6.19 入出力

プログラミングGauche

posted with amazlet at 09.07.23

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 51330

Amazon.co.jp で詳細を見る

(use file.util)

ホームディレクトリを調べる

(home-directory)
gosh> "/Users/hoge"

カレントディレクトリを調べる

(current-directory)
gosh> "/Users/hoge"

ディレクトリを移動する

移動先のディレクトリを引数として渡す。

(current-directory "foo")
gosh> #t
(current-directory)
gosh> "/Users/hoge/foo"

ディレクトリが存在しなければエラーとなる。

(current-directory "foom")
gosh> *** SYSTEM-ERROR: chdir failed: No such file or directory
(current-directory)
gosh> "/Users/hoge"

テンポラリディレクトリを調べる

(temporary-directory)
gosh> "/var/folders/yy/yy1T31dmF+af7zKSGI2d1E+++TI/-Tmp-/"

ディレクトリを作成する

(make-directory* "foo")
gosh> #t
(create-directory* "foom")
gosh> #t

ディレクトリを削除する

(remove-directory* "foo")
gosh> #t
(delete-directory* "foom")
gosh> #t

参考：Gauche ユーザリファレンス: 11.11 file.util – ファイルシステムユーティリティ

プログラミングGauche

posted with amazlet at 09.07.07

Kahuaプロジェクト
オライリージャパン
売り上げランキング: 141505

Amazon.co.jp で詳細を見る