youz · January 2, 2024 00:46 · youz · Jan 1, 2024
diff --git a/dragon-curve.lisp b/dragon-curve.lisp
 (defun f1 (z) (* z #C(1/2 1/2)))
 (defun f2 (z) (- 1 (* z #C(1/2 -1/2))))
 (defun c2p (z) (list (realpart z) (imagpart z)))

 (defun gen (n)
  (let ((b (expt 2 (ash (1+ n) -1))))
    (loop
      for i from 0 to n
      for s = (list (list 0 1))
      then (mapcan (lambda (l) (list (mapcar #'f1 l) (mapcar #'f2 l))) s)
      finally
      (return (mapcar (lambda (l) (mapcar (lambda (z) (c2p (* b z))) l)) s)))))

 (defun rng (s)
  (let ((xlb 0) (xub 0) (ylb 0) (yub 0))
    (loop for ((sx sy) (ex ey)) in s
      do (setq xlb (min xlb sx ex)
 	       xub (max xub sx ex)
 	       ylb (min ylb sy ey)
 	       yub (max yub sy ey))
      finally (return (values xlb xub ylb yub)))))

 (defun dragon-curve (n)
  (let ((s (gen (1+ (* n 2)))))
    (multiple-value-bind (xlb xub ylb yub) (rng s)
      (let* ((w (- xub xlb))
 	     (h (- yub ylb))
 	     (a (format nil (format nil "~~V@{~V@{ ~}~~%~~}" w t) h t)))
 	(dolist (l s)
 	  (let* ((m (sort l #'< :key #'car))
 		 (x (caar m))
 		 (y (min (cadar m) (cadadr m)))
 		 (c (char "/\\" (/ (1+ (- (cadadr m) (cadar m))) 2))))
 	    (setf (char a (+ (- x xlb) (* (1+ w) (- y ylb)))) c)))
 	(format t "~A" a)))))


 #+:sbcl
 (let ((n (if #0=(cadr sb-ext:*posix-argv*)
 	   (parse-integer #0#)
 	   5)))
  (dragon-curve n))
diff --git a/dragon-curve.rb b/dragon-curve.rb
 def dragon_curve(n)
  s = [[0, 1]]
  (n*2+1).times{
    s = s.collect_concat{|l|
      [l.map{|z| z*(1+1i)/2r}, l.map{|z| 1-(z*(1-1i)/2r) }]
    }
  }
  m = 2**(n+1)
  l = r = t = b = 0
  s.map!{|s, e|
    s *= m
    e *= m
    l, r = [l, r, s.real, e.real].minmax
    t, b = [t, b, s.imag, e.imag].minmax
    s.real < e.real ? [s, e] : [e, s]
  }
  w = r - l
  h = b - t
  a = (" " * w + "\n") * h
  s.each{|s, e|
    x = s.real
    y = [s.imag, e.imag].min
    dy = e.imag-s.imag
    a[x-l+(w+1)*(y-t)] = "/\\"[(1+dy)/2]
  }
  a
 end

 def main(args)
  wide = false
  n = 4
  args.each{|a|
    case a
    when "-w" then wide = true
    when /^\d+$/ then n = a.to_i
    end
  }
  aa = dragon_curve(n)
  if wide
    aa.tr!(" /\\", "　／＼")
  end
  puts aa
 end

 main($*)
	(defun f1 (z) (* z #C(1/2 1/2)))
	(defun f2 (z) (- 1 (* z #C(1/2 -1/2))))
	(defun c2p (z) (list (realpart z) (imagpart z)))

	(defun gen (n)
	(let ((b (expt 2 (ash (1+ n) -1))))
	(loop
	for i from 0 to n
	for s = (list (list 0 1))
	then (mapcan (lambda (l) (list (mapcar #'f1 l) (mapcar #'f2 l))) s)
	finally
	(return (mapcar (lambda (l) (mapcar (lambda (z) (c2p (* b z))) l)) s)))))

	(defun rng (s)
	(let ((xlb 0) (xub 0) (ylb 0) (yub 0))
	(loop for ((sx sy) (ex ey)) in s
	do (setq xlb (min xlb sx ex)
	xub (max xub sx ex)
	ylb (min ylb sy ey)
	yub (max yub sy ey))
	finally (return (values xlb xub ylb yub)))))

	(defun dragon-curve (n)
	(let ((s (gen (1+ (* n 2)))))
	(multiple-value-bind (xlb xub ylb yub) (rng s)
	(let* ((w (- xub xlb))
	(h (- yub ylb))
	(a (format nil (format nil "~~V@{~V@{ ~}~~%~~}" w t) h t)))
	(dolist (l s)
	(let* ((m (sort l #'< :key #'car))
	(x (caar m))
	(y (min (cadar m) (cadadr m)))
	(c (char "/\\" (/ (1+ (- (cadadr m) (cadar m))) 2))))
	(setf (char a (+ (- x xlb) (* (1+ w) (- y ylb)))) c)))
	(format t "~A" a)))))


	#+:sbcl
	(let ((n (if #0=(cadr sb-ext:posix-argv)
	(parse-integer #0#)
	5)))
	(dragon-curve n))
	def dragon_curve(n)
	s = [[0, 1]]
	(n*2+1).times{
	s = s.collect_concat{\|l\|
	[l.map{\|z\| z(1+1i)/2r}, l.map{\|z\| 1-(z(1-1i)/2r) }]
	}
	}
	m = 2**(n+1)
	l = r = t = b = 0
	s.map!{\|s, e\|
	s *= m
	e *= m
	l, r = [l, r, s.real, e.real].minmax
	t, b = [t, b, s.imag, e.imag].minmax
	s.real < e.real ? [s, e] : [e, s]
	}
	w = r - l
	h = b - t
	a = (" " * w + "\n") * h
	s.each{\|s, e\|
	x = s.real
	y = [s.imag, e.imag].min
	dy = e.imag-s.imag
	a[x-l+(w+1)*(y-t)] = "/\\"[(1+dy)/2]
	}
	a
	end

	def main(args)
	wide = false
	n = 4
	args.each{\|a\|
	case a
	when "-w" then wide = true
	when /^\d+$/ then n = a.to_i
	end
	}
	aa = dragon_curve(n)
	if wide
	aa.tr!(" /\\", "　／＼")
	end
	puts aa
	end

	main($*)