２００５年７月 | 今日の一行 | column

2004: 01 02 03 04 05 06 07 08 09 10 11 12
2005: 01 02 03 04 05 06 07 08 09 10 11 12
2006: 01 02 03 04 05 06 07 08 09 10 11 12

2005-07-29 [Combinatorics] ラテン方陣の標準形

実験計画法の分野では必ず出てくるラテン方格法．その元になるのがラテン方格あるいはラテン方陣とよばれるもの．

n次のラテン方陣というのは，n行n列の桝に，各行各列に 1からnまでの整数をひとつずつ入れたもののことである． 3次のラテン方陣は，

:
1 2 3
2 3 1
3 1 2
:
1 2 3
3 1 2
2 3 1
:
1 3 2
3 2 1
2 1 3
:
1 3 2
2 1 3
3 2 1
:
2 1 3
1 3 2
3 2 1
:
2 1 3
3 2 1
1 3 2
:
2 3 1
3 1 2
1 2 3
:
2 3 1
1 2 3
3 1 2
:
3 1 2
1 2 3
2 3 1
:
3 1 2
2 3 1
1 2 3
:
3 2 1
2 1 3
1 3 2
:
3 2 1
1 3 2
2 1 3

の全部で12通りある．ラテン方陣のうち，第1行と第1列が共に昇順になる形のものを標準形という．3次のラテン方陣の標準形は上の12通りのうち最初の1つしかない．

今日のプログラムは n次のラテン方陣の標準形を列挙するというものである．

(define (reduced-latin-square n)
  (define (group xs)
    (cond ((null? xs) '())
          ((null? (cdr xs)) (list xs))
          (else (let1 fst (car (car xs))
                      (receive (as bs) (span (lambda (x) (= (car x) fst)) xs)
                        (cons as (group bs)))))))
  (define (dearrange? l ls)
    (define (disjoint? xs ys)
      (or (null? xs)
          (and (not (= (car xs) (car ys))) (disjoint? (cdr xs) (cdr ys)))))
    (or (null? ls)
        (and (disjoint? l (car ls)) (dearrange? l (cdr ls)))))
  (define (add-dearranged-line ls acc) 
    (define (rec l acc)
      (append-map (lambda (xs)
                 (if (dearrange? l xs) (list (append xs (list l))) '())) acc))
    (append-map (cut rec <> acc) ls))
  (let ((first-row (iota n 1))
        (cands (group (dearrangement n))))
    (fold add-dearranged-line (list (list first-row)) cands)))

dearrangement は 2005-07-27 で定義したものを使う． append-map は SRFI-1 にある． 2005-07-27 で定義した flatmap と同じ．ついでに専用印字手続きもつくっておく．

(define (print-latin-square sq)
  (for-each (lambda (r) (display r) (newline)) sq)
  (newline))

実行してみよう

gosh> (define latin3s (reduced-latin-square 3))
latin3s
gosh> (for-each print-latin-square latin3s)
(1 2 3)
(2 3 1)
(3 1 2)

#<undef>
gosh> (define latin4s (reduced-latin-square 4))
latin4s
gosh> (for-each print-latin-square latin4s)
(1 2 3 4)
(2 3 4 1)
(3 4 1 2)
(4 1 2 3)

(1 2 3 4)
(2 1 4 3)
(3 4 2 1)
(4 3 1 2)

(1 2 3 4)
(2 4 1 3)
(3 1 4 2)
(4 3 2 1)

(1 2 3 4)
(2 1 4 3)
(3 4 1 2)
(4 3 2 1)

#<undef>

--nobsun

ved: (Tue Nov 8 17:27:16 2005 )

write in englesh

2005-07-28 [srfi-13] Gaucheライブラリ探訪 - string-filter

やっぱりスクリプトの短さ、シンプルさを競うとライブラリをある程度知ってる方が有利ですねぇ。

という反省も込めて Gauche のサポートするライブラリをちょろちょろ眺めつつ、おもしろそうなのを取り上げてみる。

gosh> (string-filter "今日も良い天気ですねBob" (lambda (c) (char-set-contains? #[ぁ-ん] c)))
"もいですね"
gosh> (string-filter "今日も良い天気ですねBob" (lambda (c) (char<? #\亜 c)))
"今日良天気"

この通りGaucheの場合は日本語もおっけーなのが嬉しいでしょ?

--cut-sea

There is no comment.

2005-07-27 [misc] 攪乱順列(改良？版)

順列をフィルタしない方法．

(define (dearrangement n)
  (define (dearr i xs)
    (if (null? xs)
        (list '())
        (flatmap (lambda (x) 
                     (if (= i x)
                         '()
                         (map (lambda (d) (cons x d))
                              (dearr (+ i 1) (delete x xs))))) xs)))
  (dearr 1 (iota n 1)))

(define (flatmap f xs)
  (apply append (map f xs)))

でどう？

--nobsun

shiro: (Thu Jul 28 14:57:18 2005 )

flatmap は srfi-1 の append-map かな。

2005-07-26 [misc] 攪乱順列(dearrangement)

1からnまでの番号の付いた箱と玉が1つずつあって，各箱にひとつずつ玉を入れるとき，箱の番号と玉の番号が一致しないような入れかたをすべて示せ．

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

(define (dearrangement n)
  (define (dearrange? xs ys)
    (or (null? xs) (and (not (equal? (car xs) (car ys)))
                        (dearrange? (cdr xs) (cdr ys)))))
  (let1 ns (iota n 1)
    (filter (cut dearrange? ns <>) (permutations ns))))

gosh> (dearrangement 3)
((2 3 1) (3 1 2))
gosh> (dearrangement 4)
((2 1 4 3) (2 3 4 1) (2 4 1 3) (3 1 4 2) (3 4 1 2) (3 4 2 1) (4 1 2 3) (4 3 1 2) (4 3 2 1))
gosh>

なるほど．ふむ．

だけど，順列をつくってからフィルターしているのが，チョット残念．もちょっと効率よくつくるには？

--nobsun

t15u: (Wed Jul 27 19:06:30 2005 )

repl i zs xs = take i xs ++ zs ++ drop (i+1) xs
gen [_] = []
gen [x,y] = [[y,x]]
gen (x:xs) = concat [[y:x:zs | zs <- gen (repl i [] xs)] ++ [y:zs | zs <- gen (repl i [x] xs)] | (i, y) <- zip [0..] xs]
dearrangement n = gen [1..n]

t15u: (Wed Jul 27 19:52:22 2005 )

途中の一行をほんの少し短くした
gen (x:xs) = zip [0..] xs >>= (\(i,y) -> map (y:) (map (x:) (gen (repl i [] xs)) ++ gen (repl i [x] xs)))

2005-07-25 [misc] スクリプトのコマンドライン引数

コマンドライン引数を取得する方法は，スクリプト言語によっていろいろ．

Gauche なら main関数

(define (main args)
  (for-each print args))

% gosh args.scm 1 2 3
args.scm
1
2
3

Haskell なら getArgs関数

import System
main = getArgs >>= mapM_ putStrLn

% runhaskell args.hs 1 2 3
1
2
3

Ruby なら ARGV定数

puts ARGV

% ruby args.rb 1 2 3
1
2
3

--nobsun

There is no comment.

2005-07-22 [LaTeX] 数独スタイル

今年春あたりから，英国あたりから火が付いた数独． Wikipediaの数独ページには面白い情報があつまっている．

なんと sudoku.sty というのも CTAN に登録されている．

\documentclass{jsarticle}
\usepackage{sudoku}
\begin{document}
\begin{sudoku}
| | |1| | | |8| | |.
| |7| |3|1| | |9| |.
|3| | | |4|5| | |7|.
| |9| |7| | |5| | |.
| |4|2| |5| |1|3| |.
| | |3| | |9| |4| |.
|2| | |5|7| | | |4|.
| |3| | |9|1| |6| |.
| | |4| | | |3| | |.
\end{sudoku}
\end{document}

Puzzle Japanで数々の「美しい」数独の問題を楽しむことができます．上の問題は，Puzzle Japan にある例題のひとつです．

というわけで，来週は，数独ソルバかしらん :)

--nobsun

There is no comment.

2005-07-21 [misc] 行列の行列の入れ換え(gosh)

awkのツッコミも頂いたことだし、昨日のお題をGaucheで書いてみる。

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

(receive (r w) (values (make-csv-reader #[\s])
                       (make-csv-writer #\space))
  (for-each (cut w (current-output-port) <>)
            (apply zip (file->list r "test.txt"))))

onelinerにならなんだ。orz

転置したいだけなら zip 一発(つまり最後の行の半分)なんだが、入出力をリストと文字列間で変換せにゃならんのがえらいハンデだなぁ。

--cut-sea

nobsun: (Thu Jul 21 07:31:00 2005 )

(use srfi-1)(for-each(lambda(l)(for-each(lambda(w)(display w)(display " "))l)(newline))(apply zip(map(cut call-with-input-string <> port->sexp-list)(port->string-list(current-input-port)))))

cut-sea: (Thu Jul 21 10:02:02 2005 )

あー、この一行(^^;)後半部分は途中まで私もチャレンジした形だ。
出力の事を予想したときにcsvに逃げたんですけど。

最初file->sexp-listが惜しいな〜って思ったなぁ。
(行単位から生成したリストのリストで返してくれればと)

#srfi-1とかfile.utilあたりはまだ秘境だ。8-(

shiro: (Fri Jul 22 11:14:47 2005 )

(use srfi-13)(apply map(lambda l(print(string-join l" ")))(map string-tokenize(port-map values read-line)))

shiro: (Fri Jul 22 11:16:04 2005 )

あ、違う、ここまで減らせる。
(use srfi-13)(apply map(lambda l(print(string-join l" ")))(port-map string-tokenize read-line))

kou: (Fri Jul 22 14:31:53 2005 )

GNU R の場合
write.table(t(read.table('test.txt')), col.name= FALSE, row.name = FALSE)
理解不足なのでもっとマシな方法があるかも？

cut-sea: (Sat Jul 23 05:56:44 2005 )

string-tokenizeってのがあるんだ。

マジにコマンドラインから実行する時には

>  gosh -usrfi-13 -e'(apply map(lambda l(print(string-join l" ")))(port-map string-tokenize read-line))' -E'exit' < test.txt

こうですかね?
goshはマニュアルによると

OPTIONS
       Command  line  options  are  processed  before loading the
       script file or entering the interactive mode.

なので明示的に(exit)するのがonelinerのミソ。:-)

cut-sea: (Sat Jul 23 05:59:55 2005 )

あ、-E'exit'は-Eexitって書いた方がよりオプションぽいか。

cut-sea: (Sat Jul 23 10:52:55 2005 )

さらにstring-join のオプション" "も無くせますな

(apply map(lambda l(print(string-join l)))(port-map string-tokenize read-line))

2005-07-20 [misc] 行列の行列の入れ換え

% cat hoge.txt
1 2 3 4
5 6 7 8
9 10 11 12
% runhaskell transpose.hs < hoge.txt
1 5 9
2 6 10
3 7 11
4 8 12

コードは無理矢理 oneliner

import List;main=getContents>>=putStr.unlines.unwords.transpose.map words.lines

AWK でもちょちょいと書けるという噂があったんだけど，ぜんぜん思いつかなかった．

--nobsun

kou: (Wed Jul 20 13:02:58 2005 )

awk '{for (i = 1; i <= NF; i++) a[i] = a[i] $i " ";} END {for (i = 1; i <= NF; i++) print a[i];}
' < hoge.txt

さすらいのPython使い: (Thu Jul 21 01:22:31 2005 )

コードは無理矢理 oneliner

import sys; print "\n".join(map(lambda x:' '.join(x), zip(*(line.split() for line in sys.stdin.readlines()))))

--G

cut-sea: (Thu Jul 21 10:05:27 2005 )

pythonってインデントの件があるから
onelinerって無理だと思い込んでました。(^^;

さすらいのPython使い: (Fri Jul 22 23:56:29 2005 )

標準入力から読み込むのにわざわざ "import sys" としなければいけない辺りにPython のダルさがありますけれども、この程度ならまだ何とかonelinerぽく書けますよ。

2005-07-19 [errno] エラー番号の意味を知りたい

こんなの組込のshellコマンドとかにありそうなんだけど見つけられなかった．

#include <string.h>
int main (int argc, char** argv)
{  printf ("%s\n", strerror(atoi(argv[1]))); return 0; }

とか安直にやって，hoge.c とかに保存して，

% gcc -o strerr hoge.c

で，実行ファイル strerr を作る．実行してみると

% ./strerr 23
Too many open files in system

まっ．こんなもんか．

--nobsun

shiro: (Tue Jul 19 02:19:09 2005 )

そういやGaucheにもないな。strerror。いつも/usr/includeの下のヘッダファイルを探したりしてました。sys-strerrorを作ろうかな。

2005-07-15 [bash] echo に \ を解釈させる

zsh だと，

% echo "123\tabc"
123     abc
% echo "123\nabc"
123
abc

だけど，bash だと，

$ echo "123\tabc"
123\tabc
$ echo "123\nabc"
123\nabc

で，\t とか \n を echo に解釈させるには -e オプション．

$ echo -e "123\tabc"
123     abc
$ echo -e "123\nabc"
123
abc

2004-11-11は

$ echo -e "sum [1..10] \n product [1..10]" | ghci -v0
55
3628800

でよかったのねぇ．「おぃおぃ」．．．

--nobsun

There is no comment.

2005-07-14 [caca] AAカラー対応版

「だからなに」シリーズ？

ASCII ART のライブラリとしては AAlib というのがあるけど，こちらは，カラー対応版 Colour AsCii Art の略で CACA

caca ってフランスの幼児語で「うん○」のこと．libcaca のサイトを見ると，かつて大人気を博した漫画に出てくるキャラクターがそのまま使われてたりして．．．大丈夫なんかいな？

http://sam.zoy.org/libcaca/

--nobsun

There is no comment.

2005-07-13 [linux] マシンの CPU スペック

すこし古い PC を使っていて，遅さがそろそろ気になってきた． CPU のスペックはどうだったっけ．

そんなとき，Linux なら，/proc/cpuinfo を見ればよい．

% cat /proc/cpuinfo
processor       : 0
vendor_id       : GenuineIntel
cpu family      : 6
model           : 11
model name      : Intel(R) Pentium(R) III Mobile CPU       866MHz
stepping        : 1
cpu MHz         : 863.806
cache size      : 512 KB
fdiv_bug        : no
hlt_bug         : no
f00f_bug        : no
coma_bug        : no
fpu             : yes
fpu_exception   : yes
cpuid level     : 2
wp              : yes
flags           : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 mmx fxsr sse
bogomips        : 1723.59

ううむ．物欲の季節だなぁ．．．

--nobsun

There is no comment.

2005-07-12 [lsof] プロセスがオープンしているファイルやデバイス一覧

lsof というコマンドを使う．

# lsof -p lsof -p 2946
COMMAND  PID   USER   FD   TYPE     DEVICE     SIZE    NODE NAME
gosh    2946 nobsun  cwd    DIR        3,2     4096  196226 /home/nobsun
gosh    2946 nobsun  rtd    DIR        3,2     4096       2 /
gosh    2946 nobsun  txt    REG        3,2    58564 1226887 /usr/local/bin/gosh
gosh    2946 nobsun  mem    REG        3,2   661793  163538 /lib/ld-2.3.3.so
gosh    2946 nobsun  mem    REG        3,2  2944025 2960238 /usr/local/lib/libgauche.so.0.8.5
gosh    2946 nobsun  mem    REG        3,2    76016 2992955 /usr/local/lib/gauche/0.8.5/i686-pc-linux-gnu/fcntl.so
gosh    2946 nobsun  mem    REG        3,2    85655 2994257 /usr/local/lib/gauche/0.8.5/i686-pc-linux-gnu/vport.so
gosh    2946 nobsun  mem    REG        3,2   142795  163573 /lib/libdl-2.3.3.so
gosh    2946 nobsun  mem    REG        3,2    67032  163571 /lib/libcrypt-2.3.3.so
gosh    2946 nobsun  mem    REG        3,2    60159  163611 /lib/libutil-2.3.3.so
gosh    2946 nobsun  mem    REG        3,2  1258640 1782391 /lib/i686/libm-2.3.3.so
gosh    2946 nobsun  mem    REG        3,2  1071708 1782393 /lib/i686/libpthread-0.10.so
gosh    2946 nobsun  mem    REG        3,2 20273330 1782382 /lib/i686/libc-2.3.3.so
gosh    2946 nobsun  mem    REG        3,2   252975 2992951 /usr/local/lib/gauche/0.8.5/i686-pc-linux-gnu/libcharconv.so
gosh    2946 nobsun  mem    REG        3,2   203455 2992953 /usr/local/lib/gauche/0.8.5/i686-pc-linux-gnu/libnet.so
gosh    2946 nobsun  mem    REG        3,2   648864 2992950 /usr/local/lib/gauche/0.8.5/i686-pc-linux-gnu/libgauche-uvector.so
gosh    2946 nobsun  mem    REG        3,2    76034 2994254 /usr/local/lib/gauche/0.8.5/i686-pc-linux-gnu/mt-random.so
gosh    2946 nobsun  mem    REG        3,2    72808 2994256 /usr/local/lib/gauche/0.8.5/i686-pc-linux-gnu/sha1.so
gosh    2946 nobsun  mem    REG        3,2   400848  163593 /lib/libnss_files-2.3.3.so
gosh    2946 nobsun    0r   CHR        1,3            67223 /dev/null
gosh    2946 nobsun    1w   CHR        1,3            67223 /dev/null
gosh    2946 nobsun    2w   CHR        1,3            67223 /dev/null
gosh    2946 nobsun    3u  unix 0xd7fe8420           260400 /home/nobsun/tmp/kahua/kahua
gosh    2946 nobsun    4u  IPv4     260403              TCP localhost:webcache (LISTEN)
gosh    2946 nobsun    6r  FIFO        0,5           260407 pipe

--nobsun

There is no comment.

2005-07-11 [misc] 同じ basename をもつパスを列挙

あるディレクトリ以下に同じファイル名があるかをチェックする.

% find Kahua-0.3.2 -type f | samename.lhs
("Makefile","Kahua-0.3.2/cgi/Makefile")
("Makefile","Kahua-0.3.2/emacs/Makefile")
("Makefile","Kahua-0.3.2/examples/Makefile")
("Makefile","Kahua-0.3.2/plugins/Makefile")
("Makefile","Kahua-0.3.2/src/Makefile")
("Makefile","Kahua-0.3.2/test/Makefile")
("Makefile","Kahua-0.3.2/Makefile")
("Makefile.in","Kahua-0.3.2/Makefile.in")
("Makefile.in","Kahua-0.3.2/cgi/Makefile.in")
("Makefile.in","Kahua-0.3.2/emacs/Makefile.in")
("Makefile.in","Kahua-0.3.2/examples/Makefile.in")
("Makefile.in","Kahua-0.3.2/plugins/Makefile.in")
("Makefile.in","Kahua-0.3.2/src/Makefile.in")
("Makefile.in","Kahua-0.3.2/test/Makefile.in")
...

Haskell でナイーブに書くと(samename.lhs)

#!/usr/bin/env runhaskell
\begin{code}
module Main where
import System 
import Data.List

main :: IO ()
main = do cs <- getContents
          mapM_ putStrLn $ map show
                         $ concat
                         $ filter ((1 <) . length)
                         $ groupBy eqBase
                         $ sortBy cmpBase
                         $ map basename 
                         $ lines cs

eqBase :: (String, String) -> (String, String) -> Bool
eqBase x y = fst x == fst y

cmpBase :: (String, String) -> (String, String) -> Ordering
cmpBase x y = compare (fst x) (fst y)

basename :: String -> (String, String)
basename l = (bn,l)
  where bn = case break ('/'==) (reverse l) of
               (nb,nd) -> reverse nb
\end{code}

awk とか sort とか uniq とか．．．を使えば oneliner で書けるかなぁ．

--nobsun

shibata: (Mon Jul 11 12:06:43 2005 )

こう書けました。
 find . -printf '%f %P\n' | sort | uniq -W 1 --all-repeated=separate

とおる。: (Mon Jul 11 21:56:18 2005 )

FreeBSD の sort とか uniq は GNU 版ほど便利じゃないので、こんな風に書きました。
> find . | tee hoge1 | xargs basename | paste - hoge1 | sort | \
  tee hoge2 | cut -f1 | uniq -d | join - hoge2

kou: (Wed Jul 20 14:13:02 2005 )

onliner じゃないのがかっこ悪いけど php だと
#! /usr/bin/env php
<?php
if ($argc == 1) {
  echo "usage: samename.php <path> [ignore count]\n";
  exit;
}
$n = 2 < $argc ? $argv[2] : 1;
$fp = popen("find ".$argv[1], "r");
while($fn = trim(fgets($fp))) {
  $a[basename($fn)][] = $fn;
}
fclose($fp);
while(list($k, $v) = each($a)) {
  if ($n < count($v)) {
    echo $k."\n";
    foreach($v as $fn) {
      echo "\t".$fn."\n";
    }
  }
}
?>

kou: (Wed Jul 20 14:18:46 2005 )

１行変えて同一ファイルのチェックにしてみたり
#! /usr/bin/env php
<?php
if ($argc == 1) {
  echo "usage: samefile.php <path> [ignore count]\n";
  exit;
}
$n = 2 < $argc ? $argv[2] : 1;
$fp = popen("find ".$argv[1], "r");
while($fn = trim(fgets($fp))) {
  $a[md5_file($fn)][] = $fn;
}
fclose($fp);
while(list($k, $v) = each($a)) {
  if ($n < count($v)) {
    echo $k."\n";
    foreach($v as $fn) {
      echo "\t".$fn."\n";
    }
  }
}
?>

2005-07-08 [GIMP] 画像に影を付ける

GIMPを起動してマウスをポチポチすれば画像の周りに影を付けられる．簡単だけど面倒臭い．

そんな時は~/.gimp-2.2/scripts/shadow.scmファイル

(define (shadow in-file out-file)
  (let* ((image (car (gimp-file-load RUN-NONINTERACTIVE in-file in-file)))
         (drawable (car (gimp-image-get-active-layer image))))
    (gimp-convert-rgb image)
    (script-fu-drop-shadow image drawable 2 2 15 '(0 0 0) 80 TRUE)
    (let ((new (car (gimp-image-merge-visible-layers RUN-NONINTERACTIVE image 1))))
      (gimp-file-save RUN-NONINTERACTIVE image new out-file out-file))
    (gimp-image-delete image)))

を作って

 gimp -d -f -i -b '(shadow "hoge.png" "hoge_shadow.png")' '(gimp-quit 0)'

を実行すれば良い．

dropshadowコマンド

#!/bin/sh
gimp -d -f -i -b "(shadow \"$1\" \"$2\")" "(gimp-quit 0)"

を作れば

 dropshadow kahua.png kahua_s.png

でがになる．

--shibata

There is no comment.

2005-07-07 [LaTeX] Euler フォント

Concrete Mathematics: A Foundation for Computer Science (邦訳：コンピュータの数学) で使われている Euler フォントはなかなか格好いい．使うのは簡単で，プリアンブルに

\usepackage{euler}

と入れるだけ．

Error in expanding macro: (img "img/20050707.jpeg" (width "400px"))
Invalid Image URL:  "img/20050707.jpeg"

--nobsun

There is no comment.

2005-07-06 [a2pdf] プレーンテキストを PDF にする

Vine Linux 3.1 には，a2pdf というコマンドがある． a2ps と ps2pdf14 を組みあわせているらしい．

% a2pdf 20050706.wiliki
[20050706.wiliki (プレーン): 1ページ, 1シート]
[合計: 1ページ, 1シート] ファイル`20050706.wiliki.ps'へ保存します

表示されるけど，実際には 20050706.wiliki.pdf へ出力されている．整形のオプションは a2ps のものと同じにだろうね．

--nobsun

There is no comment.

2005-07-05 [misc] パス名の簡略化

パス名に含まれる，親ディレクトリへの参照 .. と自分自身への参照 . をできる限りとりのぞく．このスクリプトを書いてみるのは，ちょっとした練習になるね．

import Data.List
simplifyPath :: String -> String
simplifyPath path = concat
                  $ (hd :)
                  $ reverse 
                  $ (tl :)
                  $ reverse
                  $ intersperse "/" 
                  $ canonicalize 
                  $ filter (not . ("" ==))
                  $ wordsBy (=='/') path
  where hd = if (head path == '/') then "/" else ""
        tl = if (head (reverse path) == '/') then "/" else ""

wordsBy :: (Char -> Bool) -> String -> [String]
wordsBy _ "" = []
wordsBy p s  = xs : wordsBy p ys
  where (xs,ys) = break p (dropWhile p s)

canonicalize :: [String] -> [String]
canonicalize ps = iter [] ps 
  where iter ac []        = reverse ac
        iter ac ("." :rs) = iter ac rs
        iter ac ("..":rs) = case cancelTop ac of
                              []  -> ac ++ rs
                              ac' -> iter ac' rs
        iter ac (r   :rs) = iter (r:ac) rs
        cancelTop []     = []
        cancelTop (x:xs) = xs

実行例

*Main> simplifyPath "/a/b/../c/../../d"
"/a/d"
*Main> simplifyPath "/a/b//.///c//d/./e"
"/a/b/c/d/e"
*Main> simplifyPath "/a/b//.///c//d/./e/"
"/a/b/c/d/e/"
*Main> simplifyPath "/a/B//./../c/d/../../b//c/d/e/f/.."
"/a/b/c/d/e"
*Main> simplifyPath "a/b/c/../../../../.."
"a/../.."

There is no comment.

2004-07-04 [command] パス名から上位ディレクトリパス部分を取り出す

2005-06-20の basename と対になるコマンド

% dirname /usr/local/src/Gauche-0.8.5/doc/gauche-refj.texi
/usr/local/src/Gauche-0.8.5/doc

--nobsun

There is no comment.

2005-07-01 [emacs] 以前にキルしたリージョンのヤンク

「そんなんも知らんで XXX つことったんかシリーズ」？

Emacs で C-w でキルしたリージョンをヤンク(ペースト?)するには

C-y

とするのだが，これは直前にキルしたものを貼るだけである．それ以前にキルしたリージョンがキルリングに残っていれば，続けて M-y をやると直前のさらに直前にキルしたリージョンが貼れる．

C-y M-y M-y

とやると前の前の前にキルしたリージョンが貼れる．

--nobsun

There is no comment.

Chat (Lingr.com)

Informaiton

Daily

Column

Zope Solution

Extra

アーカイブ

OSS案内所

Site Info

関連リンク

2005-07-29 [Combinatorics] ラテン方陣の標準形

2005-07-28 [srfi-13] Gaucheライブラリ探訪 - string-filter

2005-07-27 [misc] 攪乱順列(改良？版)

2005-07-26 [misc] 攪乱順列(dearrangement)

2005-07-25 [misc] スクリプトのコマンドライン引数

2005-07-22 [LaTeX] 数独スタイル

2005-07-21 [misc] 行列の行列の入れ換え(gosh)

2005-07-20 [misc] 行列の行列の入れ換え

2005-07-19 [errno] エラー番号の意味を知りたい

2005-07-15 [bash] echo に \ を解釈させる

2005-07-14 [caca] AAカラー対応版

2005-07-13 [linux] マシンの CPU スペック

2005-07-12 [lsof] プロセスがオープンしているファイルやデバイス一覧

2005-07-11 [misc] 同じ basename をもつパスを列挙

2005-07-08 [GIMP] 画像に影を付ける

2005-07-07 [LaTeX] Euler フォント

2005-07-06 [a2pdf] プレーンテキストを PDF にする

2005-07-05 [misc] パス名の簡略化

2004-07-04 [command] パス名から上位ディレクトリパス部分を取り出す

2005-07-01 [emacs] 以前にキルしたリージョンのヤンク