Latest comments replied to kacchi

kacchi's comment on 文字列のセンタリング

#4160は、はじめにgaucheで書いてみて、そのままEmacs Lispに直したものです。gaucheで書いたのも投稿しちゃいます。

(define (string-centering s c)
  (define (p k) (make-string k #\ ))
  (let ((d (- c (string-length s))))
    (receive (n m) (quotient&remainder d 2)
      (if (>= d 0)
          (string-append (p n) s (p (+ n m)))
          (substring s (abs n) (- (string-length s) (abs (+ n m))))))))

[ Scheme ] [ download code ] ]

kacchi's comment on ファイル内の重複行削除(後優先)

ファイル内の重複行削除(後優先) (Nested Flatten)

port-fold がありました。

(use srfi-1)
(define (uniq-file file)
  (define (rp ls) (unless (null? ls) (rp (cdr ls)) (print (car ls))))
  (with-input-from-file file
    (lambda () (rp (delete-duplicates (port-fold cons '() read-line))))))

[ Scheme ] [ download code ] ]

shiro's comment on 隣り合う二項の差

隣り合う二項の差 (Nested Flatten)

:parallelで複数の変数に対してループを回せます。

1	(define (diff xs) (list-ec (:parallel (: x xs) (: y (cdr xs))) (- y x)))

[ Scheme ] [ download code ] ]

kacchi's comment on n日後を返す関数を返す関数

n日後を返す関数を返す関数 (Nested Flatten)

あせって投稿したら失敗してしまいました。ちらかしてすみません。

(require 'cl)

(defun make-ndays-later (n)
  (lexical-let ((n n))
    (lambda (time)
      (apply (lambda (s mi h d m y dow dst zone)
               (encode-time s mi h (+ d n) m y))
             (decode-time time)))))

(fset 'five-days-later (make-ndays-later 5))
(fset 'five-days-later- (make-ndays-later -5))

[ Emacs Lisp ] [ download code ] ]

kacchi's comment on n日後を返す関数を返す関数

n日後を返す関数を返す関数 (Nested Flatten)

お題を読み違えてました。すみません。日時ですね。今度は大丈夫?

(defun make-ndays-later (n)
  (lexical-let ((n n))
    (lambda (time)
      (apply (lambda (s mi h d m y dow dst zone)
               (encode-time s mi h (+ d n) m y))
             (decode-time time)))))

(fset 'five-days-later (make-ndays-later 10))
(fset 'five-days-later- (make-ndays-later -10))

(format-time-string "%Y/%m/%d %T" (five-days-later (current-time)))
=>"2007/07/31 21:39:38"

(format-time-string "%Y/%m/%d %T" (five-days-later- (current-time)))
=>"2007/07/11 21:39:59"

(format-time-string
 "%Y/%m/%d %T"
 ;; encode-time: SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE
 (five-days-later (encode-time 49 43 21 21 7 2007)))
=>"2007/07/31 21:43:49"

[ Emacs Lisp ] [ download code ] ]

kacchi's comment on 議席数をドント方式で

議席数をドント方式で (Nested Flatten)

同じくEmacs Lispで。
(dhondt 100 '(123 4 56 78))
=>(48 1 21 30)

(require 'cl)
(defun dhondt (seats votes)
  (let ((max1+ (lambda (l s d)
                 (let ((m (apply #'max l)))
                   (do ((l l (cdr l)) (i 0 (+ i 1)))
                       ((null l) (cons s d))
                     (when (= (car l) m)
                       (incf (car (nthcdr i s)))
                       (incf (car (nthcdr i d))))))))
        (len (length votes)))
    (do ((score (make-list len 0))
         (denom (make-list len 1)))
        ((>= (apply #'+ score) seats) score)
      (let ((s&d (funcall max1+ (map 'list #'(lambda (a b) (/ (* a 1.0) b))
                                     votes denom)
                          score denom)))
        (setq score (car s&d)
              denom (cdr s&d))))))

[ Emacs Lisp ] [ download code ] ]

kacchi's comment on ダブル完全数

ダブル完全数 (Nested Flatten)

同じく、Emacs Lispでも。ベクタを使えば速いので、調子に乗って 1000000 まで調べてみました。
(test 1000001)
=>(523776 672 120)

(defun test (limit)
  (require 'cl)
  (defun pnumber (k limit)
    (do ((i 1 (+ i 1)) (v (make-vector limit 0))
	 (a nil (if (= (aref v i) (* i k)) (cons i a) a)))
        ((= i limit) a)
      (do ((n i (+ n i)))
          ((>= n limit))
        (aset v n (+ (aref v n) i)))))
  (byte-compile 'pnumber)
  (pnumber 3 limit)
  )

[ Emacs Lisp ] [ download code ] ]

にしお's comment on 税込み価格への修正

税込み価格への修正 (Nested Flatten)

一瞬、投稿ミスで重複になってしまったのかと思ってしまいました(笑)