Hatena::ブログ(Diary)

みずぴー日記

2010-10-03(日)

コインの両替

| コインの両替 - みずぴー日記 を含むブックマーク

30分プログラム、その804。コインの両替。

coin.scm - みずぴー日記に再チャレンジ。

使い方

gosh> exchange-coin
((2000 1) (100 1) (10 4) (1 2))

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-
(use util.match)
(use gauche.sequence)
(and '() 1)
(define (exchange cost coins)
  (if (< cost 0)
      '()
      (match coins
	     (() '())
	     ((c . cs) (if (<= c cost)
			   (cons c (exchange (- cost c) (cons c cs)))
			   (exchange cost cs))))))

(define (group xs)
  (map (lambda (xs) (list (car xs) (length xs)))
       (group-sequence xs)))

(define (exchange-coin cost)
  (group (exchange cost '(10000 5000 2000 1000 500 100 50 10 5 1))))

参考

2010-09-27(月)

マージソート

| マージソート - みずぴー日記 を含むブックマーク

30分プログラム、その802

3年前のマージソート(msort.rb - みずぴー日記)をまたやってみた。

使い方

gosh> (msort '(3 1 2))
(1 2 3)

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-
(use util.match)
(use srfi-1)

(define (merge xs ys)
  (match (cons xs ys)
	 [(() . ()) ()]
	 [(xs . ()) xs]
	 [(() . ys) ys]
	 [((x . xs) . (y . ys))
	  (if (< x y)
	      (cons x (merge  xs        (cons y ys)))
	      (cons y (merge (cons x xs) ys)))]))

(define (split xs)
  (receive (a b)  (partition cadr
			     (zip xs (circular-list #t #f)))
	   (values (map car a) (map car b))))

(define (msort xs)
  (if (or (null? xs) (null? (cdr xs)))
      xs
      (receive (ys zs) (split xs)
	       (merge (msort ys) (msort zs)))))

参考

2010-08-21(土)

Googolからの引き算

| Googolからの引き算 - みずぴー日記 を含むブックマーク

30分プログラム、その796。anarchy golf - Substract from a Googolにインスパイアされて、Googolからの引き算をやってみます。

きっと、32bitの整数しか扱えない処理系でやるとエキサイティングなんでしょうけど、Gaucheだとあっさりできてしましました。ステキだと思います。

使い方

$ gosh googol.scm  0
10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
$ gosh googol.scm  1
9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999
$ gosh googol.scm  123
9999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999877

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-

(define (pow n m)
  (cond
   ((eq? m 0) 1)
   ((even? m)
    (pow (* n n) (/ m 2)))
   (else
    (* n (pow n (- m 1))))))

(define googol (pow 10 100))

(define (main args)
  (for-each print
	    (map (cut - googol <>)
		 (map string->number (cdr args)))))

参考

2010-07-28(水)

n日後の日付を調べるプログラム

| n日後の日付を調べるプログラム - みずぴー日記 を含むブックマーク

30分プログラム、その789。n日後の日付を調べるプログラムを作ってみました。

EMチャージの30日定額の終了日が知りたかったので作ってみました。もっとも、作ったあとで管理画面で見れることを知りましたけれども。

使い方

$ gosh 789-after.scm 0
2010-08-01

$ gosh 789-after.scm 10
2010-08-11

$ gosh 789-after.scm 20
2010-08-21

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-

(use srfi-19)
(define n 30)


(define (after-time-from n from)
  (make-time 'time-utc n (+ (* 60 60 24 n)
			    (time-second from))))

(define (time->string time)
  (date->string (time-utc->date time)
		"~Y-~m-~d"))

(define (main args)
  (for-each print
	    (map time->string
		 (map (cute after-time-from <> (current-time))
		      (map x->number (cdr args))))))

参考

nobsunnobsun 2010/07/30 13:09 date -d '30 days'

nobsunnobsun 2010/07/30 13:23 (use gauche.process)
(define (main args)
(for-each (lambda (s) (run-process `(date -d ,(string-append s " days") +%Y-%m-%d) :wait #t)) (cdr args)))

BLUEPIXYBLUEPIXY 2010/07/30 19:16 実際にプログラムを動かしてみたわけではないんですが、
使い方で例示されているヤツおかしくないですか?

mzpmzp 2010/08/01 23:08 > BLUEPIXY
ホントだ。直しました。

2010-07-06(火)

最小公倍数

| 最小公倍数 - みずぴー日記 を含むブックマーク

30分プログラム、その780。

最小公倍数を求めてみました。

使い方

gosh> (lcm 3 2)
6
gosh> (lcm 21 6)
42

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-

(define (gcd x y)
  (if (= y 0)
      x
      (gcd y (modulo x y))))

(define (lcm x y)
  (/ (abs (* x y))
     (gcd x y)))

参考

2010-06-24(木)

奇数

| 奇数 - みずぴー日記 を含むブックマーク

30分プログラム、その775。anarchy golf - odd linesをやってみます。

いつものごとく、ゴルフにはこだわりません。

使い方

$ jot 10 | gosh odd-line.scm
2
4
6
8
10

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-

(use util.stream)

(define (filter-odd xs)
  (stream-map cdr
	      (stream-filter (lambda (x) (odd? (car x)))
			     (stream-map cons (stream-iota -1)
					 (list->stream xs)))))

(for-each print
	  (stream->list (filter-odd (port->string-list (standard-input-port)))))

参考

BLUEPIXYBLUEPIXY 2010/06/25 18:04 出力結果が偶数(even) になってますけど?

mzpmzp 2010/06/26 08:43 あ、ホントだ。はずい。

2010-06-01(火)

条件付き確率の問題をモンテカルロ法で解く

| 条件付き確率の問題をモンテカルロ法で解く - みずぴー日記 を含むブックマーク

30分プログラム、その768。no titleにインスパイアされました。

こういう打ち切り所をカチっと決めれない問題は、無限リストを使ってやるのがいいですよね。

使い方

gosh> (calc 10)
0.6
gosh> (calc 100)
0.34285714285714286

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-

(use srfi-27)
(use util.stream)
(define (rand-child)
  (if (= (random-integer 2) 0)
      'boy
      'girl))

(define (child-stream)
  (stream-map (lambda (_) (rand-child))
	      (stream-iota -1)))
(define try-stream
  (let ([xs (child-stream)]
	[ys (child-stream)])
    (stream-map cons xs ys)))

(define (peek s)
  (stream->list (stream-take s 2)))

(define (either-boy? pair)
  (or (eq? (car pair) 'boy)
      (eq? (cdr pair) 'boy)))

(define (both-boy? pair)
  (and (eq? (car pair) 'boy)
       (eq? (cdr pair) 'boy)))

(define (calc n)
  (let1 xs (stream-filter either-boy? (stream-take try-stream n))
	(/. (stream-length (stream-filter both-boy? xs))
	    (stream-length xs))))

参考

2010-05-06(木)

最長のコマンド名を探してみる

| 最長のコマンド名を探してみる - みずぴー日記 を含むブックマーク

30分プログラム、その763。最長のコマンド名を探してみます。

やっぱり、素数の計算とかよりかは実践的で楽しいです。

使い方

$ gosh longest-command.scm
scrollkeeper-get-extended-content-list

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-

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

(define (find-longest-command path)
  (car (sort (map sys-basename
		  (filter file-is-executable?
			  (sys-glob (map (cut string-append <> "/*")
					 path))))
	     (lambda (x y) (> (string-length x) (string-length y))))))

(print (find-longest-command (string-split (sys-getenv "PATH") ":")))

参考

2010-04-12(月)

配列から最大値を検索する

| 配列から最大値を検索する - みずぴー日記 を含むブックマーク

30分プログラム、その755。配列から最小値、最大値を検索する - 素人がプログラミングを勉強していたブログにインスパイアされました。

書き始めてすぐに(apply max xs)でいいことに気づいてしまいました。が、それだとつまんないので、色々書いてみました。

使い方

gosh> (maximum-1 '(1 3 2))
3

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-

(define (maximum-1 xs)
  (apply max xs))

(define (maximum-2 xs)
  (if (null? xs)
      xs
      (fold max (car xs) (cdr xs))))

(define (maximum-3 xs)
  (cond
   [(null? xs) '()]
   [(null? (cdr xs)) (car xs)]
   [else
    (max (car xs)
	 (maximum-3 (cdr xs)))]))

(define (maximum-4 xs)
  (car (sort xs >)))

参考

2010-03-31(水)

Phone Key Pad

| Phone Key Pad - みずぴー日記 を含むブックマーク

30分プログラム、その745。anarchy golf - Phone Key Padをやってみました。

問題の背景がよく分かんないんですが、変換表に従ってアルファベットを数字に変換する問題らしいです。

使い方

gosh> (string->key-pad "Ruby")
"7829"

gosh> (string->key-pad "Scheme")
"724363"

ソースコード

#! /opt/local/bin/gosh
;; -*- mode:scheme; coding:utf-8 -*-
(use srfi-1)
(use srfi-13)

(define *key-pads*
  '((#\1 "1+")
    (#\2 "2ABCabc")
    (#\3 "3DEFdef")
    (#\4 "4GHIghi")
    (#\5 "5JKLjkl")
    (#\6 "6MNmn")
    (#\7 "7PRSprs")
    (#\8 "8TUVtuv")
    (#\9 "9WXYwxy")
    (#\* "*-")
    (#\0 "0OQZoqz")
    (#\# "#")))

(define (alpha->key-pad c)
  (any (lambda (key)
	 (if (string-index (second key) c)
	     (first key)
	     #f))
       *key-pads*))

(define (string->key-pad s)
  (string-map alpha->key-pad s))

参考