콘솔에 삼각형

         *
       * *
      *   *
     *     *
    *       *
   *         *
  *           *
 *             *
*****************


을 출력하는 Common Lisp 소스 코드를 작성해 보자. 이런 소스 코드의 작성은 학원이나 학교에서 프로그래밍 입문자에게 과제로 많이 주어지는 것 중의 하나이다. 코끼리를 보거나 만진 사람들이 저마다 그 생김새를 말할 때 제각기 다르게 표현할 수 있듯이 이런 소스 코드의 작성도 알고 보면 얼마든지 많은 방법이 있을 것이다. 여기서는 쉬운 코드 부터 작성해 보고 차츰차츰 소스를 바꾸어 가면서 Common Lisp 프로그래밍의 기초부분을 터득해 보기로 한다.

모든 소스 코드에서는 삼각형 출력 부분 담당 함수 printTriange를 별도로 구현하였다.

우선 첫번 째 예제는 Common Lisp의 컨솔 출력 함수 format t 의 사용법만 알면 누구나 코딩할 수 있는 매우 단순한 소스 코드이다. 문자열 상수 내에서 ~%는 C, C++, Java, C#, Python 같은 대부분의 절차형 언어에서 사용하는 메타문자 \n에 해당한다.

아래의 모든 소스는 CLisp으로 실행되도록 작성되었다.


삼각형 출력 예제 1
;;  Filename: printTriangle1.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle1.lsp
;;
;;      Date:  2013. 9. 5.

(defun printTriange()
    (format t "        *        ~%")
    (format t "       * *       ~%")
    (format t "      *   *      ~%")
    (format t "     *     *     ~%")
    (format t "    *       *    ~%")
    (format t "   *         *   ~%")
    (format t "  *           *  ~%")
    (format t " *             * ~%")
    (format t "*****************~%") )

(printTriange)




위의 소스 코드는 아무 알고리즘도 없는 너무 단순한 코드이다. 이런 코드를 작성했다간 출력 모양이나 크기를 변경해야 하는 상황을 맞이하면 워드프로세서로 문서 만드는 것 이상으로 많은 수작업을 하거나 아니면 포기하는 지경에 이를 수도 있다. 그래서 다음 처럼 좀 더 나은 소스 코드를 작성하였다.  문자를 하나씩 출력하는 함수 my-write를 정의하여 이를 사용하였다. (write는 Common Lisp에서 이미 정의되어 있으므오 다른 이름 my-write으로 하였다.) C, C++, Java, C#, Python, Ruby 등의 대부분의 언어에서는 특수문자 +, -, * 등을 함수명이나 변수명에 사용하지 못하지만, Common Lisp 언어에서는 이들을 사용해도 된다.  특히 *variable-name* 처럼 변수명의 처음과 끝에 *를 사용하는 것은 (Common Lisp 소스 코드 작상 관습상) 전역변수인 것으로 본다.



삼각형 출력 예제 2
;;  Filename: printTriangle2.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle2.lsp
;;
;;      Date:  2013. 9. 5.

(defun my-write(s)
    (format t "~A" s) )

(defun printTriange()
    (loop for i from 0 below 8 do
        (loop for k from 0 below (- 8 i) do
            (my-write " ") )
        (loop for k from 0 below (+ (* 2 i) 1) do
            (if (or (zerop k) (= k (* 2 i)))
                (my-write "*")
                (my-write " ") ))
        (loop for k from 0 below (- 8 i) do
            (my-write " ") )
        (format t "~%") )

    (loop for i from 0 below 17 do
        (my-write "*") )
    (format t "~%")
)

(printTriange)



위의 소스 코드는 my-write 함수와 format t "~%"  를 적절히 사용하여 구현되었다. 숫자 몇 곳만 수정하면 출력되는 삼각형의 크기를 쉽게 바꿀 수 있다. 한 줄에 출력될 문자를 구성하는 알고리즘은 위의 예제와 근본적으로 같지만 한 문자식 출력하는 대신에 한 줄에 출력될 문자열을 만들어서 출력하는 소스 코드를 다음 예제와 같이 작성해 보았다.
또 빈칸 17개의 문자로 구성된 리스트를 생성하기 위한 구문은

        (setf line2 (make-list 17 :initial-element " "))

이다.


삼각형 출력 예제 3
;;  Filename: printTriangle3.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle3.lsp
;;
;;      Date:  2013. 9. 5.

(defun join-string-list (string-list)
    (format nil "~{~A~^~}" string-list))

(defun printTriange()
    (let ((line2 (list)))
        (setf line2 (make-list 17 :initial-element " "))
        (loop for i from 0 below 8 do
            (setf line2 (make-list 17 :initial-element " "))
            (setf (nth (- 8 i) line2) #\*)
            (setf (nth (+ 8 i) line2) #\*)
            (format t "~A~%" (join-string-list line2)) )

        (setf line2 (make-list 17 :initial-element " "))
        (loop for i from 0 below 17 do
            (setf (nth i line2) #\*) )
        (format t "~A~%" (join-string-list line2))
    )
)

(printTriange)




별(*) 문자를 이용하여 삼각형을 출력하는 일은 빈칸 문자와 별 문자를 적당한 좌표(위치)에 촐력하는 일이다. 출력될 한 줄의 스트링을 완성한 후 하나의 format t 구문으로 출력하는 기법으로 소스 코드를 작성해 보았다. 소스 코드 중에

           (whites (make-string 17 :initial-element #\Space))
           (stars (make-string 17 :initial-element #\*))

은 지정된 개수(여기서는 17) 만큼 :initial-element 옵션에 주어진 character를 중복 연결하는 구문이다.




삼각형 출력 예제 4
;;  Filename: printTriangle4.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle4.lsp
;;
;;      Date:  2008/04/02

(defun printTriange()
    (let* ((whites (make-string 17 :initial-element #\Space))
           (stars (make-string 17 :initial-element #\*))
           (line2 (concatenate 'string (substring whites 0 8) "*" (substring whites 0 7))) )
   
        (format t "~A~%" line2)
        (loop for i from 1 below 8 do
            (setf line2 (concatenate 'string (substring whites 0 (- 8 i)) "*" (substring whites (- 8 i) (+ 7 i)) "*" (substring whites (+ 7 i) 17)))
            (format t "~A~%" line2))
        (format t "~A~%" stars)
    )
)

(printTriange)




string은 immutable이라 그 내용을 변경할 수 없지만, 리스트는 그 요소(item)를 아무 때 나 변경할 수 있다. 한줄에 출력될 각 문자를 리스트 타입의 변수 line2에 저장한 다음 format t 문으로 출력 시

    (join-string-list line2)

로 그 리스트의 모든 요소(item)가 모두 연결되어 출력되게 하였다.



삼각형 출력 예제 5
;;  Filename: printTriangle5.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle5.lsp
;;
;;      Date:  2013. 9. 5.

(defun join-string-list (string-list)
    (format nil "~{~A~^~}" string-list))

(defun printTriange()
    (let* ((whites (make-string 17 :initial-element #\Space))
           (stars (make-string 17 :initial-element #\*))
           (start 8)
           (line2 (make-list 17 :initial-element " ")))

        (setf (nth start line2) "*")
        (format t "~A~%" (join-string-list line2))

        (loop for i from 1 below 8 do
            (setf line2 (make-list 17 :initial-element " "))
            (setf (nth (- start i) line2) (format nil "~A" (aref stars (- start i))))
            (setf (nth (+ start i) line2) (format nil "~A" (aref stars (+ start i))))
            (format t "~A~%" (join-string-list line2)) )

        (format t "~A~%" stars)
    )
)


(printTriange)



출력되는 삼각형이 좌우 대칭이라는 사실에 착안하여, 다음 소스 코드에서는  각 줄을 처음 8자, 중앙 한 문자, 끝 8자(처음 8자의 역순)로 string을 만들어 출력하였다.



삼각형 출력 예제 6
;;  Filename: printTriangle6.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle6.lsp
;;
;;      Date:  2013. 9. 5.

(defun printTriange()
    (let* ((whites (make-string 8 :initial-element #\Space))
           (stars (make-string 8 :initial-element #\*))
           (start 8)
           (line (concatenate 'string whites "*" whites)))

        (format t "~A~%" line)

        (loop for i from 1 below 8 do
            (setf line (concatenate 'string (substring whites 0 (- 8 i)) "*" (substring whites (- 8 i) (1- 8))))
            (format t "~A ~A~%" line (reverse line)) )

        (setf line (concatenate 'string stars "*" stars))
        (format t "~A~%" line)
    )
)

(printTriange)




다음 소스 코드는 한 줄에 출력될 문자열의 데이터를 17비트 이진법 수로 구성하고, 이 이진법수의 비트가 0인 곳에는 빈칸을, 1인 곳에는 별(*)을 출력하는 기법으로 작성되었다.



삼각형 출력 예제 7
;;  Filename: printTriangle7.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle7.lsp
;;
;;      Date:  2013. 9. 5.

(setf *BASE36* "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")

(defun itoa(num radix)
    (let* ((isNegative nil)
           (a 0)
           (arr (list))
           (q 0)
           (r 0))

        (if (equal radix nil) (setf radix 10))
  
        (if (minusp num) (progn
            (setf isNegative t)
            (setf inum (- num)) ))

        (setf q num)
      
        (loop while (>= q radix) do
            (setf r (mod q radix))
            (setf q (floor (/ q radix)))
            (setf arr (nconc arr (list (substring *BASE36* r (1+ r)))))
        )

       (setf arr (nconc arr (list (substring *BASE36* q (1+ q)))))
       (if isNegative (nconc (ncons arr (list "-"))) )

       (setf arr (reverse arr))
       (join-string-list arr)
    )
)

(defun join-string-list (string-list)
    (format nil "~{~A~^~}" string-list))

(defun printTriange()
    (let* ((start #x100)
           (total 0)
           (val start)
           (s "")
           (data ""))
        (loop for k from 0 below 8 do
            (setf val (logior (ash start k) (ash start (- k))))
            (setf data (itoa val 2))
            (setf s "")
            (loop for i from 0 below (- 17 (length data)) do
                (setf s (concatenate 'string s " ")) )
            (loop for i from 0 below (length data) do
                (if (equal (aref data i) #\0)
                   (setf s (concatenate 'string s " "))
                   (setf s (concatenate 'string s "*")) ))
            (format t "~A~%" s)
            (setf total (+ total val)) )

        (setf val (logior (ash start 8) (ash start -8)))
        (setf total (+ total val))
        (setf data (itoa total 2))
        (setf s "")
        (loop for i from 0 below (- 17 (length data)) do
            (setf s (concatenate 'string s " ")) )
        (loop for i from 0 below (length data) do
            (if (equal (aref data i) #\0)
                (setf s (concatenate 'string s " "))
                (setf s (concatenate 'string s "*")) ))
        (format t "~A~%" s)
    )
)

(printTriange)




기본적인 원리는 위의 소스 코드와 같지만 이진법수의 한 비트 마다 한 문자씩 츨력하는 대신에 출력될 한 줄의 string을 완성하여 이를 format t 구문으로 출력하는 기법으로 재작성한 것이 다음의 소스 코드이다. (setf 새스트링 (string-replace-char 원래스트링 원본문자 타겟문자)) 을 이용하여 모든 0을 빈칸으로, 모든 1을 별(*) 문자로 바꾸었으며, 별(*) 문자만으로 이루어진 마지막 줄 출력을 위해 변수 total을 준비하였다. loop for 반복 구문의 블럭 내에서 구문

            (setf total (+ total val))

이 하는 일이 무엇인지 이해할 수 있으면 좋겠다.




삼각형 출력 예제 8
;;  Filename: printTriangle8.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle8.lsp
;;
;;      Date:  2013. 9. 5.

   
(setf *BASE36* "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")

(defun itoa(num radix)
    (let* ((isNegative nil)
           (a 0)
           (arr (list))
           (q 0)
           (r 0))

        (if (equal radix nil) (setf radix 10))
  
        (if (minusp num) (progn
            (setf isNegative t)
            (setf inum (- num)) ))

        (setf q num)
      
        (loop while (>= q radix) do
            (setf r (mod q radix))
            (setf q (floor (/ q radix)))
            (setf arr (nconc arr (list (substring *BASE36* r (1+ r)))))
        )

       (setf arr (nconc arr (list (substring *BASE36* q (1+ q)))))
       (if isNegative (nconc (ncons arr (list "-"))) )

       (setf arr (reverse arr))
       (join-string-list arr)
    )
)

(defun join-string-list (string-list)
    (format nil "~{~A~^~}" string-list))

(defun char-replace (a b c)
    (if (= (char-code a) (char-code b))
          c
          a ))

(defun string-to-list (s)
    (loop for char across s
            collect char) )

(defun list-to-string (a)
    (format nil "~{~A~^~}" a))

(defun replacer(b c) #'(lambda (x) (char-replace x b c)))

(defun string-replace-char (s a b)
    (let* ((arr (string-to-list s))
           (arr2 (mapcar (replacer a b) arr)))
       (list-to-string arr2) ))

(defun printTriange()
    (let* ((zeros "00000000")
           (start #x100)
           (total 0)
           (val start)
           (line ""))

        (loop for k from 0 below 8 do
            (setf val (logior (ash start k) (ash start (- k))))
            (setf line (itoa val 2))
            (setf line (concatenate 'string (substring zeros 0 (- 17 (length line))) line))
            (setf line (string-replace-char line #\0 #\Space))
            (setf line (string-replace-char line #\1 #\*))
            (format t "~A~%" line)
            (setf total (+ total val)) )

        (setf val (logior (ash start 8) (ash start -8)))
        (setf total (+ total val))
        (setf line (itoa total 2))
        (setf line (string-replace-char line #\0 #\Space))
        (setf line (string-replace-char line #\1 #\*))
        (format t "~A~%" line)
    )
)

(printTriange)




소스 코드가 처음 것 보다 매우 복잡해졌지만, Common Lisp의 리스트를 이용해서 구현해 보았다. Common Lisp 언어 처럼 함수형 언어에서는 리스트가 매우 중요한 지료형(타입)이다. 별(*) 문자만으로 구성된 마지막 줄 출력을 위해 리스트 타입의 변수 last를 준비하였다. 또 리스트에 속한 모든 item을 출력하도록 구현된 Common Lisp 함수의 정의

    (defun join-string-list (data sep)
        (format nil (concatenate 'string "~{~A" sep "~^~}") data))

과 이의 사용

            (format t "~A~%" (join-string-list 리스트 구분자))

은 음미해볼 만한 부분이다.



삼각형 출력 예제 9
;;  Filename: printTriangle9.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle9.lsp
;;
;;      Date:  2013. 9. 6.

#|
(setf *BASE36* "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")

(defun itoa(num radix)
    (let* ((isNegative nil)
           (a 0)
           (arr (list))
           (q 0)
           (r 0))

        (if (equal radix nil) (setf radix 10))
  
        (if (minusp num) (progn
            (setf isNegative t)
            (setf inum (- num)) ))

        (setf q num)
      
        (loop while (>= q radix) do
            (setf r (mod q radix))
            (setf q (floor (/ q radix)))
            (setf arr (nconc arr (list (substring *BASE36* r (1+ r)))))
        )

       (setf arr (nconc arr (list (substring *BASE36* q (1+ q)))))
       (if isNegative (nconc (ncons arr (list "-"))) )

       (setf arr (reverse arr))
       (join-string-list arr)
    )
)

(defun char-replace (a b c)
    (if (= (char-code a) (char-code b))
          c
          a ))

(defun string-to-list (s)
    (loop for char across s
            collect char) )

(defun list-to-string (a)
    (format nil "~{~A~^~}" a))

(defun replacer(b c) #'(lambda (x) (char-replace x b c)))

(defun string-replace-char (s a b)
    (let* ((arr (string-to-list s))
           (arr2 (mapcar (replacer a b) arr)))
       (list-to-string arr2) ))
|#

(defun join-string-list (data sep)
    (format nil (concatenate 'string "~{~A" sep "~^~}") data))

(defun printTriange()
    (let* ((data (make-list 17 :initial-element " "))
           (last (make-list 17 :initial-element " "))
           (start 8))

        (setf (nth start data) "*")
        (setf (nth start last) "*")
        (format t "~A~%" (join-string-list data ""))

        (setf (nth start data) " ")

        (loop for k from 1 below 8 do
            (setf (nth (- start k) data) "*")
            (setf (nth (- start k) last) "*")
            (setf (nth (+ start k) data) "*")
            (setf (nth (+ start k) last) "*")
            (format t "~A~%" (join-string-list data ""))
            (setf (nth (- start k) data) " ")
            (setf (nth (+ start k) data) " ")
        )

        (setf (nth (- start 8) last) "*")
        (setf (nth (+ start 8) last) "*")
        (format t "~A~%" (join-string-list las ""t))
    )
)

(printTriange)





다음 예제는 수학에서 xy-좌표평면에 점을 찍듯이 논리 구문

             (x + y - 8 == 0) or (y - x + 8 == 0) or (y - 8 == 0)

가 참이 되는 위치에 별(*) 문자를 표시하는 기법으로 작성된 소스 코드이다.




삼각형 출력 예제 10
;;  Filename: printTriangle10.lsp
;;            Print a triangle on console.
;;
;;  Execute: clisp printTriangle10.lsp
;;
;;      Date:  2013. 9. 6.

(defun printTriange()
    (let* ((x 0)
           (y 0)
           (a ""))
          
        (loop for y from 0 below 9 do
            (loop for x from 0 below 17 do
                (if (or (zerop (- (+ x y) 8)) (zerop (+ (- y x) 8)) (zerop (- y 8)))
                    (setf a "*")
                    (setf a " "))
                (format t "~A" a)
            )
            (format t "~%")
        )
    )
)

(printTriange)





Posted by Scripter
,

ASCII(애스키)란 American Standard Code for Information Interchange의 줄임글로서, 영문자에 기초한 문자 인코딩이다.  이 문자 인코딩에는 C0 제어문자(C0 control character)도 포함되어 있다.  ( 참고:  ASCII - Wikipedia, the free encyclopedia )

다음은  7bit ASCII 코드표를 만들어 보여주는 Common Lisp 소스 코드이다. 소스 코드 중에 진법변환에 필요한 함수

        ()convertItoA number  radix)

의 구현도 포함되어 있다.

(아래의 소스는 CLisp으로 실행된다.)


  1. ;;  Filename: makeAsciiTable.lsp
  2. ;;            Make a table of ascii codes.
  3. ;;
  4. ;;  Execute: clisp makeAsciiTable.lsp
  5. ;;
  6. ;;      Date:  2013.9. 5.
  7. (setf *BASE36* "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  8. (defun printUsage()
  9.     (format t "Usage: lisp makeAsciiTable.lsp~%")
  10.     (format t "Make a table of ascii codes.~%") )
  11. (defun join-string-list (string-list)
  12.     ; (format nil "~{~A~^ ~}" string-list))
  13.     (format nil "~{~A~^~}" string-list))
  14. (defun to-right-align(s)
  15.     (let* ((n (length s))
  16.            (a (get-token s))
  17.            (k (length a)))
  18.          (if (= n 0) s)
  19.          (concatenate 'string (substring s k n) a) ))
  20. (defun get-token (s)
  21.   (let* ((i (if (find (elt s 0) "+-") 1 0))
  22.          (d (position-if 'nonwhite-char-p s :start i))
  23.          (f 0))
  24.     (if (equal d nil) s
  25.            (progn
  26.                (setf f (position-if 'white-char-p s :start (1+ d)))
  27.                (if (equal f nil) s
  28.                    (progn 
  29.                         (substring s d f) )) )) ))
  30. (defun nonwhite-char-p (c)
  31.     (> (char-code c) (char-code #\Space)))
  32. (defun white-char-p (c)
  33.     (<= (char-code c) (char-code #\Space)))
  34. (defun convertItoA(num radix)
  35.     (let* ((isNegative nil)
  36.            (a 0)
  37.            (arr (list))
  38.            (q 0)
  39.            (r 0))
  40.         (if (equal radix nil) (setf radix 10))
  41.         (if (minusp num) (progn
  42.             (setf isNegative t)
  43.             (setf inum (- num)) ))
  44.         (setf q num)
  45.         (loop while (>= q radix) do
  46.             (setf r (mod q radix))
  47.             (setf q (floor (/ q radix))) 
  48.             (setf arr (nconc arr (list (substring *BASE36* r (1+ r)))))
  49.         )
  50.        (setf arr (nconc arr (list (substring *BASE36* q (1+ q)))))
  51.        (if isNegative (nconc (ncons arr (list "-"))) )
  52.        (setf arr (reverse arr))
  53.        (join-string-list arr)
  54.     )
  55. )
  56. (setf *asc* (list
  57.     "NUL" "SOH"  "STX"  "ETX"  "EOT"
  58.     "ENQ" "ACK"  "BEL"  "BS"   "HT"
  59.     "LF"  "VT"   "FF"   "CR"   "SO"
  60.     "SI"  "DLE"  "DC1"  "DC2"  "DC3"
  61.     "DC4" "NAK"  "SYN"  "ETB"  "CAN"
  62.     "EM"  "SUB"  "ESC"  "FS"   "GS"
  63.     "RS"  "US"   "Spc"
  64.     ))
  65. (setf *control* (list
  66.     "NUL (null)"
  67.     "SOH (start of heading)"
  68.     "STX (start of text)"
  69.     "ETX (end of text)"
  70.     "EOT (end of transmission)"
  71.     "ENQ (enquiry)"
  72.     "ACK (acknowledge)"
  73.     "BEL (bell)"
  74.     "BS  (backspace)"
  75.     "TAB (horizontal tab)"
  76.     "LF  (line feed, NL new line)"
  77.     "VT  (vertical tab)"
  78.     "FF  (form feed, NP new page)"
  79.     "CR  (carriage return)"
  80.     "SO  (shift out)"
  81.     "SI  (shift in)"
  82.     "DLE (data link escape)"
  83.     "DC1 (device control 1)"
  84.     "DC2 (device control 2)"
  85.     "DC3 (device control 3)"
  86.     "DC4 (device control 4)"
  87.     "NAK (negative acknowledge)"
  88.     "SYN (synchronous idle)"
  89.     "ETB (end of trans. block)"
  90.     "CAN (cancel)"
  91.     "EM  (end of medium)"
  92.     "SUB (substitute, EOF end of file)"
  93.     "ESC (escape)"
  94.     "FS  (file separator)"
  95.     "GS  (group separator)"
  96.     "RS  (record separator)"
  97.     "US  (unit separator)"
  98.     ))
  99. (defun makeTable()
  100.     (let* ((sbuf "")
  101.            (abuf "")
  102.            (tbuf "")
  103.            (c #\Space))
  104.         (setf sbuf "    ")
  105.         (loop for i from 0 below 8 do
  106.             (setf sbuf (concatenate 'string sbuf "+----")))
  107.         (setf sbuf (concatenate 'string sbuf "+"))
  108.         (format t "~A~%" sbuf)
  109.         (setf sbuf "    ")
  110.         (setf sbuf (concatenate 'string sbuf "| 0- "))
  111.         (setf sbuf (concatenate 'string sbuf "| 1- "))
  112.         (setf sbuf (concatenate 'string sbuf "| 2- "))
  113.         (setf sbuf (concatenate 'string sbuf "| 3- "))
  114.         (setf sbuf (concatenate 'string sbuf "| 4- "))
  115.         (setf sbuf (concatenate 'string sbuf "| 5- "))
  116.         (setf sbuf (concatenate 'string sbuf "| 6- "))
  117.         (setf sbuf (concatenate 'string sbuf "| 7- "))
  118.         (setf sbuf (concatenate 'string sbuf "|"))
  119.         (format t "~A~%" sbuf)
  120.         (setf sbuf "+---")
  121.         (loop for i from 0 below 8 do
  122.             (setf sbuf (concatenate 'string sbuf "+----")))
  123.         (setf sbuf (concatenate 'string sbuf "+"))
  124.         (format t "~A~%" sbuf)
  125.         (loop for i from 0 below 16 do
  126.             (setf tbuf "")
  127.             (setf sbuf (convertItoA i 16))
  128.             (setf tbuf (concatenate 'string "| " sbuf " "))
  129.             (loop for j from 0 below 8 do
  130.                 (if (<= (+ (* j 16) i)  32)
  131.                     (setf abuf (format nil "| ~3A" (nth (+ (* j 16) i) *asc*)))
  132.                     (if (= (+ (* j 16) i)  127)
  133.                         (setf abuf (format nil "| ~3A" "DEL"))
  134.                         (progn
  135.                             (setf c (code-char (+ (* j 16) i)))
  136.                             (setf abuf (format nil "|  ~2A" c)) )))
  137.                 (setf tbuf (concatenate 'string tbuf abuf))
  138.             )
  139.             (setf tbuf (concatenate 'string tbuf "|"))
  140.             (format t "~A~%" tbuf)
  141.         )
  142.         (setf sbuf "+---")
  143.         (loop for i from 0 below 8 do
  144.             (setf sbuf (concatenate 'string sbuf "+----")))
  145.         (setf sbuf (concatenate 'string sbuf "+"))
  146.         (format t "~A~%" sbuf)
  147.         (format t "~%")
  148.         (loop for i from 0 below 16 do
  149.             (setf tbuf (format nil "~30A  ~34A" (nth i *control*) (nth (+ i 16) *control*)))
  150.             (format t "~A~%" tbuf)
  151.         )
  152.     ))
  153. (if (and (> (length ext:*args*) 0) (equal (nth 0 ext:*args*) "-h")) (progn
  154.     (printUsage)
  155.     (quit) ))
  156. (makeTable)




실행> clisp makeAsciiTable.lsp

   
    +----+----+----+----+----+----+----+----+
    | 0- | 1- | 2- | 3- | 4- | 5- | 6- | 7- |
+---+----+----+----+----+----+----+----+----+
| 0 | NUL| DLE| Spc|  0 |  @ |  P |  ` |  p |
| 1 | SOH| DC1|  ! |  1 |  A |  Q |  a |  q |
| 2 | STX| DC2|  " |  2 |  B |  R |  b |  r |
| 3 | ETX| DC3|  # |  3 |  C |  S |  c |  s |
| 4 | EOT| DC4|  $ |  4 |  D |  T |  d |  t |
| 5 | ENQ| NAK|  % |  5 |  E |  U |  e |  u |
| 6 | ACK| SYN|  & |  6 |  F |  V |  f |  v |
| 7 | BEL| ETB|  ' |  7 |  G |  W |  g |  w |
| 8 | BS | CAN|  ( |  8 |  H |  X |  h |  x |
| 9 | HT | EM |  ) |  9 |  I |  Y |  i |  y |
| A | LF | SUB|  * |  : |  J |  Z |  j |  z |
| B | VT | ESC|  + |  ; |  K |  [ |  k |  { |
| C | FF | FS |  , |  < |  L |  \ |  l |  | |
| D | CR | GS |  - |  = |  M |  ] |  m |  } |
| E | SO | RS |  . |  > |  N |  ^ |  n |  ~ |
| F | SI | US |  / |  ? |  O |  _ |  o | DEL|
+---+----+----+----+----+----+----+----+----+

NUL (null)                      DLE (data link escape)
SOH (start of heading)          DC1 (device control 1)
STX (start of text)             DC2 (device control 2)
ETX (end of text)               DC3 (device control 3)
EOT (end of transmission)       DC4 (device control 4)
ENQ (enquiry)                   NAK (negative acknowledge)
ACK (acknowledge)               SYN (synchronous idle)
BEL (bell)                      ETB (end of trans. block)
BS  (backspace)                 CAN (cancel)
TAB (horizontal tab)            EM  (end of medium)
LF  (line feed, NL new line)    SUB (substitute, EOF end of file)
VT  (vertical tab)              ESC (escape)
FF  (form feed, NP new page)    FS  (file separator)
CR  (carriage return)           GS  (group separator)
SO  (shift out)                 RS  (record separator)
SI  (shift in)                  US  (unit separator)




 

Posted by Scripter
,

컴퓨터 프로그래밍에서 꼭 알아두어야 할 주요 진법은 당연히 10진법, 2진법, 8진법, 16진법이다.
다음은  0 에서 15 까지의 정수를 10진법, 2진법, 8진법, 16진법의 표로 만들어 보여주는 Common Lisp 소스 코드이다. 진법 변환에 필요한 함수

        (convertItoA number  radix)

를 Common Lisp 코드로 자체 작성하여 사용하였다.

(아래의 소스는 CLisp으로  실행된다.)


  1. ;;  Filename: makeRadixTable.lsp
  2. ;;            Show the radix table with 10-, 2-, 8-, 16-radices.
  3. ;;
  4. ;;  Execute: clisp makeRadixTable.lsp
  5. ;;
  6. ;;      Date:  2013. 9. 5.
  7. (setf *BASE36* "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  8. (defun println(s)
  9.     (if (equal s nil)
  10.         (format t "~%")
  11.         (format t "~A~%" s) ))
  12. (defun printUsage()
  13.     (println "Usage: clisp makeRadixTable.lsp")
  14.     (println "Show the radix table with 10-, 2-, 8-, 16-radices.") )
  15. (defun join-string-list (string-list)
  16.     ; (format nil "~{~A~^ ~}" string-list))
  17.     (format nil "~{~A~^~}" string-list))
  18. (defun to-right-align(s)
  19.     (let* ((n (length s))
  20.            (a (get-token s))
  21.            (k (length a)))
  22.          (if (= n 0) s)
  23.          (concatenate 'string (substring s k n) a) ))
  24. (defun get-token (s)
  25.   (let* ((i (if (find (elt s 0) "+-") 1 0))
  26.          (d (position-if 'nonwhite-char-p s :start i))
  27.          (f 0))
  28.     (if (equal d nil) s
  29.            (progn
  30.                (setf f (position-if 'white-char-p s :start (1+ d)))
  31.                (if (equal f nil) s
  32.                    (progn
  33.                         (substring s d f) )) )) ))
  34. (defun nonwhite-char-p (c)
  35.     (> (char-code c) (char-code #\Space)))
  36. (defun white-char-p (c)
  37.     (<= (char-code c) (char-code #\Space)))
  38. (defun convertItoA(num radix)
  39.     (let* ((isNegative nil)
  40.            (a 0)
  41.            (arr (list))
  42.            (q 0)
  43.            (r 0))
  44.         (if (equal radix nil) (setf radix 10))
  45.         (if (minusp num) (progn
  46.             (setf isNegative t)
  47.             (setf inum (- num)) ))
  48.         (setf q num)
  49.         (loop while (>= q radix) do
  50.             (setf r (mod q radix))
  51.             (setf q (floor (/ q radix)))
  52.             (setf arr (nconc arr (list (substring *BASE36* r (1+ r)))))
  53.         )
  54.        (setf arr (nconc arr (list (substring *BASE36* q (1+ q)))))
  55.        (if isNegative (nconc (ncons arr (list "-"))) )
  56.        ; (format t "~A~%" arr)
  57.        (setf arr (reverse arr))
  58.        (join-string-list arr)
  59.     )
  60. )
  61. (defun makeTable()
  62.     (let* ((sbuf "")
  63.            (abuf "")
  64.            (tbuf ""))
  65.         (loop for i from 0 below 4 do
  66.             (setf sbuf (concatenate 'string sbuf "+-------")) )
  67.         (setf sbuf (concatenate 'string sbuf "+"))
  68.         (format t "~A~%" sbuf)
  69.         (setf sbuf "|  Dec")
  70.         (setf sbuf (concatenate 'string sbuf (format nil "  |  Bin")))
  71.         (setf sbuf (concatenate 'string sbuf (format nil "  |  Oct")))
  72.         (setf sbuf (concatenate 'string sbuf (format nil "  |  Hex  |")))
  73.         (format t "~A~%" sbuf)
  74.         (setf sbuf "")
  75.         (loop for i from 0 below 4 do
  76.             (setf sbuf (concatenate 'string sbuf "+-------")) )
  77.         (setf sbuf (concatenate 'string sbuf "+"))
  78.         (format t "~A~%" sbuf)
  79.         (loop for i from 0 below 16 do
  80.             (setf sbuf (format nil "|   ~2D" i))
  81.             (setf abuf (convertItoA i 2))
  82.             (setf tbuf (format nil "  |  ~A" (to-right-align (format nil "~4A" abuf))))
  83.             (setf sbuf (concatenate 'string sbuf tbuf))
  84.             (setf abuf (convertItoA i 8))
  85.             (setf tbuf (format nil " |   ~A" (to-right-align (format nil "~2A" abuf))))
  86.             (setf sbuf (concatenate 'string sbuf tbuf))
  87.             (setf abuf (convertItoA i 16))
  88.             (setf tbuf (format nil "  |   ~A  |" (to-right-align (format nil "~2A" abuf))))
  89.             (setf sbuf (concatenate 'string sbuf tbuf))
  90.             (format t "~A~%" sbuf)
  91.         )
  92.         (setf sbuf "")
  93.         (loop for i from 0 below 4 do
  94.             (setf sbuf (concatenate 'string sbuf "+-------")) )
  95.         (setf sbuf (concatenate 'string sbuf "+"))
  96.         (format t "~A~%" sbuf)
  97. ))
  98. (if (and (> (length ext:*args*) 0) (equal (nth 0 ext:*args*) "-h")) (progn
  99.     (printUsage)
  100.     (quit) ))
  101. (makeTable)



실행> clisp makeRadixTable.lsp

+-------+-------+-------+-------+
|  Dec  |   Bin |  Oct  |  Hex  |
+-------+-------+-------+-------+
|    0  |     0 |    0  |    0  |
|    1  |     1 |    1  |    1  |
|    2  |    10 |    2  |    2  |
|    3  |    11 |    3  |    3  |
|    4  |   100 |    4  |    4  |
|    5  |   101 |    5  |    5  |
|    6  |   110 |    6  |    6  |
|    7  |   111 |    7  |    7  |
|    8  |  1000 |   10  |    8  |
|    9  |  1001 |   11  |    9  |
|   10  |  1010 |   12  |    A  |
|   11  |  1011 |   13  |    B  |
|   12  |  1100 |   14  |    C  |
|   13  |  1101 |   15  |    D  |
|   14  |  1110 |   16  |    E  |
|   15  |  1111 |   17  |    F  |
+-------+-------+-------+-------+




 

Posted by Scripter
,

다음은  대화형 모드(interactive mode)에서 진법 변환(radix conversion)하는 Common Lisp 소스 코드이다.


메뉴는 주메뉴 Command: (S)et radix, (A)bout, (Q)uit or E(x)it
와 부메뉴 SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit
로 구성되어 있으며, 진법 변환의 핵심은 아래 소스의 52째 줄과 53째 줄에 있는

       (setf val (parse-integer s :radix srcRdx))
        (setf ret (write-to-string val :base destRdx))

이다. 지원되는 진법은 2진법에서 36진법까지이다.


  1. ;;  Filename: convertRadix.lsp
  2. ;;            Convert radix in a interactive mode.
  3. ;;
  4. ;;  Execute: clisp convertRadix.lsp
  5. ;;
  6. ;;      Date:  2013. 9. 5.
  7. (defun printUsage()
  8.     (format t "Usage: clisp convertRadix.lsp~%")
  9.     (format t "Convert radix in a interactive mode, where the maximum radix is 36.~%") )
  10. (defun printAbout()
  11.     (format t "    About: Convert radix in a interactive mode.~%") )
  12. (defun printMainMenu()
  13.     (format t "  Command: (S)et radix, (A)bout, (Q)uit or E(x)it~%") )
  14. (defun printMainPrompt()
  15.     (format t "  Prompt> ") )
  16. (defun printSubMenu(srcRadix destRadix)
  17.     (format t "    Convert Radix_~D to Radix_~D~%" srcRadix destRadix)
  18.     (format t "    SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit~%") )
  19. (defun printSubPrompt()
  20.     (format t "    Input Value>> ") )
  21. (setf *BASE36* "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  22. (defun join-string-list (string-list)
  23.     "Concatenates a list of strings and puts spaces between the elements."
  24.     (format nil "~{~A~^~}" string-list))
  25. (define-condition invalid-src-radix (error)
  26.   ((msg :reader msg :initarg :msg))
  27.   (:report (lambda (condition stream)
  28.              (format stream "Exception: ~A." (msg condition)))))
  29. (define-condition invalid-dest-radix (error)
  30.   ((msg :reader msg :initarg :msg))
  31.   (:report (lambda (condition stream)
  32.              (format stream "Exception: ~A." (msg condition)))))
  33. (defun convertRadix(s srcRdx destRdx)
  34.   (ignore-errors
  35.     (if (or (< srcRdx 2) (> srcRdx 36))
  36.         (error 'invalid-src-radix :msg (format nil "Invalid source radix: ~A" srcRdx)))
  37.     (if (or (< destRdx 2) (> destRdx 36))
  38.         (error 'invalid-dest-radix :msg (format nil "Invalid destination radix: ~A" destRdx)))
  39.     (let ((ret ""))
  40.         (setf val (parse-integer s :radix srcRdx))
  41.         (setf ret (write-to-string val :base destRdx))
  42.         (string-upcase ret)))
  43.   )
  44. (defun nonwhite-char-p (c)
  45.     (> (char-code c) (char-code #\Space)))
  46. (defun white-char-p (c)
  47.     (<= (char-code c) (char-code #\Space)))
  48. (defun safe-parse-integer (s)
  49.         (handler-case
  50.              (parse-integer s :radix 10)
  51.              (parse-error (c)
  52.                        (format t "예외상황 발생: ~A" c)
  53.                )
  54.         )
  55. )
  56. (defun get-token (s)
  57.   (let* ((i (if (find (elt s 0) "+-") 1 0))
  58.          (d (position-if 'nonwhite-char-p s :start i))
  59.          (f (position-if 'white-char-p s :start (1+ d))))
  60.     ; (format t "d = ~A~%" d)
  61.     ; (format t "f = ~A~%" f)
  62.     (substring s d f)))
  63. (defun get-two-tokens (s)
  64.   (let* ((i (if (find (elt s 0) "+-") 1 0))
  65.          (d (position-if 'nonwhite-char-p s :start i))
  66.          (f (position-if 'white-char-p s :start (1+ d)))
  67.          (d2 (position-if 'nonwhite-char-p s :start (1+ f)))
  68.          (f2 (position-if 'white-char-p s :start (1+ d2))))
  69.     (format t "d = ~A~%" d)
  70.     (format t "f = ~A~%" f)
  71.     (format t "d2 = ~A~%" d2)
  72.     (format t "f2 = ~A~%" f2)
  73.     (list (substring s d f) (substring s d2 f2)) ))
  74. (defun get-tokens (s)
  75.   (let ((arr (list))
  76.         (n (length s))
  77.         (x "")
  78.         (c #\Space))
  79.       (loop for i from 0 below n do
  80.           (setf c (aref s i))
  81.           (if (white-char-p c)
  82.               (if (> (length x) 0) (progn
  83.                    (push x arr)
  84.                    (setf x "") )))
  85.           (if (nonwhite-char-p c) (progn
  86.                    (setf x (concatenate 'string x (format nil "~A" c))) ))
  87.       )
  88.       (if (> (length x) 0)
  89.                    (push x arr))
  90.       (reverse arr) ))
  91. (defun doConvert(srcRadix destRadix)
  92.     (let ((line "")
  93.           (cmd "")
  94.           (innerLoop t)
  95.           (srcStr "")
  96.           (destStr ""))
  97.         (format t "~%")
  98.         (printSubMenu srcRadix destRadix)
  99.         (handler-case
  100.           (progn
  101.             (loop while innerLoop do
  102.                 (printSubPrompt)
  103.                 (setf cmd (read-line))
  104.                 (setf cmd (string-trim " " cmd))
  105.                 (if (equal (string-downcase cmd) "main()")
  106.                     (progn
  107.                         (setf innerLoop nil)
  108.                         (return nil) ))
  109.                 (if (or (equal (string-downcase cmd) "exit()") (equal (string-downcase cmd) "quit()"))
  110.                     (quit))
  111.                 (handler-case
  112.                   (progn
  113.                      (parse-integer cmd :radix srcRadix)
  114.                      (setf srcStr (string-upcase cmd))
  115.                      (setf destStr (convertRadix srcStr srcRadix destRadix))
                         (format t "        ( ~A )_~A   --->   ( ~A )_~A~%" srcStr srcRadix destStr destRadix)
  116.                      (format t "~%")
  117.                   )
  118.                  (parse-error (c)
  119.                        (format t "예외상황 발생: ~A" c)
  120.                        (format t "다시 입력하시오,~%~%") )
  121.                )
  122.             )
  123.         ))
  124.     t
  125.     ))
  126. (defun doStart()
  127.     (let ((line "")
  128.           (cmd "")
  129.           (outerLoop t)
  130.           (srcRadix 10)
  131.           (destRadix 10)
  132.           (srcStr "")
  133.           (destStr "")
  134.           (onlyOnce t))
  135.         (handler-case
  136.           (progn
  137.             (loop while outerLoop do
  138.                    (format t "~%")
  139.                    (if (equal onlyOnce t) (progn
  140.                         (format t "  The supported maximum radix is 36.~%")
  141.                         (setf onlyOnce nil)
  142.                         (printMainMenu)
  143.                         (printMainPrompt)
  144.                         (setf cmd (read-line))
  145.                         (setf cmd (string-trim " " cmd))
  146.                         (if (or (equal cmd "q") (equal cmd "Q") (equal cmd "x") (equal cmd "X")) (quit) )
  147.                         (if (or (equal cmd "a") (equal cmd "A")) (progn (printAbout) (setf onlyOnce t)) )
  148.                         (if (or (equal cmd "s") (equal cmd "S")) (progn
  149.                                (format t "  Input the source and target radices (say, 16 2): ")
  150.                                (setf line (read-line))
  151.                                (setf st (get-tokens line))
  152.                                (loop while (not (= (length st) 2)) do
  153.                                    (format t "  Input the source and target radices (say, 16 2): ")
  154.                                    (setf line (read-line))
  155.                                    (setf st (get-tokens line)) )
  156.                                ; (setf srcRadix (parse-integer (nth 0 st) :radix 10))
  157.                                ; (setf destRadix (parse-integer (nth 1 st) :radix 10))
  158.                                (setf srcRadix (safe-parse-integer (nth 0 st)))
  159.                                (setf destRadix (safe-parse-integer (nth 1 st)))
  160.                                (if (and (not (equal srcRadix nil)) (not (equal destRadix nil)))
  161.                                    (progn
  162.                                        (doConvert srcRadix destRadix)
  163.                                        (setf onlyOnce t)
  164.                                    )
  165.                                    (progn
  166.                                        (format t "두 수를 다시 입력하시오.~%")
  167.                                        (setf onlyOnce t)
  168.                                    )
  169.                                )
  170.                         ))
  171.             ))
  172.           )
  173.         ))
  174.     ))
  175. ;; Begin here
  176. (if (and (> (length ext:*args*) 0) (equal (nth 0 ext:*args*) "-h")) (progn
  177.     (printUsage)
  178.     (quit) ))
  179. (doStart)



실행> clisp convertRadix.lsp

  The supported maximum radix is 36.
  Command: (S)et radix, (A)bout, (Q)uit or E(x)it
  Prompt> s
  Input the source and target radices (say, 16 2): 10 8

    Convert Radix_10 to Radix_8
    SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit
    Input Value>> 200
        ( 200 )_10   --->   ( 310 )_8

    Input Value>> main()

  Command: (S)et radix, (A)bout, (Q)uit or E(x)it
  Prompt> S
  Input the source and target radices (say, 16 2): 8 10

    Convert Radix_8 to Radix_10
    SubCommand: 'main()' to goto Main menu, 'exit()' or 'quit()' to exit
    Input Value>> 2666
        ( 2666 )_8   --->   ( 1462 )_10

    Input Value>> main()

  Command: (S)et radix, (A)bout, (Q)uit or E(x)it
  Prompt> x




Posted by Scripter
,

다음은  이차방정식 x^2 - x - 1  = 0 의 양의 근 즉 황금비율(golden ratio)을 구하는 Common Lisp 애플리케이션 소스이다. 황금비율을 구하는 비례방정식은   1 : x = x : (x+1) 이며, 이를 이차방정식으로 표현한 것이 x^2 - x - 1  = 0 이다.

See:  http://en.wikipedia.org/wiki/Golden_ratio

아래의 소스는 CLisp 으로 테스트되었다.


 

  1. ;;  Filename: testGoldenRatio.lsp
  2. ;;    황금률(즉, 이차방정식 x^2 - x - 1  = 0 의 양의 근)을 계산한다.
  3. ;;
  4. ;;   Execute: clisp testGoldenRatio.lsp
  5. ;;
  6. ;;      Date:  2013. 9. 1.
  7. (defun printUsing()
  8.     (format t "Using: lisp testGoldenRatio.lsp [-h|-help]~%")
  9.     (format t "This calculates the value of the golden ratio.~%")
  10. )
  11. (defun handle-zero-error(msg)
  12.     (catch 'handle-zero-error
  13.       (foprmat t msg)
  14.       (quit)))
  15. ;; 이차방정식 a x^2 + b x + c  = 0 의 근을 구한다.
  16. (defun findQuadraticRoot(a b c)
  17.     (if (zerop a)
  18.         (throw 'fn-a 'done))
  19.     (if (< (- (* b b) (* 4 a c)) 0.0)
  20.         (throw 'fn-a 'done))
  21.     (setf x1 (/ (+ (- b) (sqrt (- (* b b) (* 4 a c)))) (* 2.0 a)))
  22.     (setf x2 (/ (- (- b) (sqrt (- (* b b) (* 4 a c)))) (* 2.0 a)))
  23.     (list x1 x2)
  24. )
  25. ;; 실행 시작 지점
  26. (if (and (> (length ext:*args*) 0) (or (equal (nth 0 ext:*args*) "-h") (equal (nth 0 ext:*args*) "-help"))) (progn
  27.     (printUsing)
  28.     (quit) ))
  29. (setf values (findQuadraticRoot 1.0 (- 1.0) (- 1.0)))
  30. (setf x1 (nth 0 values))
  31. (setf x2 (nth 1 values))
  32. (if (>= x1 x2) (progn
  33.     (format t "The bigger root is ~F, ~%" x1)
  34.     (format t "and the less root is ~F.~%" x2) )
  35.        (progn
  36.     (format t "The bigger root is ~F, ~%" x2)
  37.     (format t "and the less root is ~F.~%" x1) )
  38. )



실행> clisp testGoldenRatio.lsp
The bigger root is 1.618034,
and the less root is -0.618034.



Posted by Scripter
,

현재 시각을 컨솔에 보여주는 간단한 애플리케이션의 Python 언어 소스 코드이다.
UTC란 1970년 1월 1일 0시 0분 0초를 기준으로 하여 경과된 초 단위의 총 시간을 의미한다.
* UTC(Universal Time Coordinated, 협정세계시, 協定世界時)

 

Common Lisp 언어에서 (get-universal-time) 하여 얻은 값은 UTC(1970년 1월 1일 0시 0분 0초를 기준으로 하여 경과된 초)가 아니라, 1900년 1월 1일 0시 0분 0초를 기준으로 하여 경과된 초이다. 따라서 이 값을 기준으로 UTC를 구하려면 1900년 1월 1일 0시 0분 0초부터 1970년 1월 1일 0시 0분 0초까지 경과된 초를 구하여 빼 주어야 나온다. 그런데 Common Lisp 언어에서는 GMT 시각값을 초로 환산하여 보정해주어야 제대로 된 UTC 값을 구할 수 있다.


GMT 시각값을 초로 환산한 값이 (* (nth 8 cNow) 60 60) 이고, 이 만큼 보정하는 과정이 아래 소스의 20째 줄

      (setf utctime (+ (- univ-time *base*) (- *base2* *base*) (* (nth 8 cNow) 60 60)))

이다. 여기서 (* (nth 8 cNow) 는 GMT 시각값의 반대 부호이다.

 

  1. #!/usr/bin/env clisp
  2. ;;  Filename: testCTime.lsp
  3. ;;
  4. ;;  Execute: clisp testCTime.lsp
  5. ;; Common Lisp case
  6. (setf *weekNames* (list "월" "화" "수" "목" "금" "토" "일"))
  7. (setf univ-time (get-universal-time))
  8. (setf cNow (multiple-value-list (decode-universal-time univ-time)))
  9. (setq *base* (encode-universal-time 0 0 0 1 1 1971))
  10. (setq *base2* (encode-universal-time 0 0 0 1 1 1972))
  11. (setq *takeoff* (encode-universal-time 0 0 0 1 1 2013))
  12. (setq *takeoff2* (encode-universal-time 0 0 0 2 1 2013))
  13. (setq *one-day-secs* (- *takeoff2* *takeoff*))
  14. (setq *secs* univ-time)
  15. (setq *daysecs* (- *secs* *takeoff*))
  16. (setf utctime (+ (- univ-time *base*) (- *base2* *base*) (* (nth 8 cNow) 60 60)))
  17. (format t "UTC: ~D초~%" utctime)
  18. ;; 현재 시각 표시: 200x년 x월 xx일 (x요일) xx시 xx분 xx초 (GMT nn)
  19. (format t "~D년 ~D월 ~D일 (~A요일) ~D시 ~D분 ~D초 (GMT~@D)~%"
  20.         (nth 5 cNow)
  21.         (nth 4 cNow)
  22.         (nth 3 cNow)
  23.         (nth (nth 6 cNow) *weekNames*)
  24.         (nth 2 cNow)
  25.         (nth 1 cNow)
  26.         (nth 0 cNow)
  27.         (- (nth 8 cNow)) )
  28. ;; 1월 1일은 1, 1월 2일은 2
  29. (setf strIsDST (if (equal (nth 7 cNow) nil)
  30.                     "안함"
  31.                     "함" ) )
  32. (setq *days* (1+ (floor *daysecs* *one-day-secs*)))
  33. (format t "올해 몇 번째 날: ~D, 서머타임 적용 여부: ~A~%" *days* strIsDST)



실행> clisp testCTime.lsp
UTC: 1378044909초
2013년 9월 1일 (일요일) 23시 15분 9초 (GMT+9)
올해 몇 번째 날: 244, 서머타임 적용 여부: 안함



 

Posted by Scripter
,

다항식 p(x) 를 1차 다항식 x - a 로 나눌 때의 몫과 나머지를 구하는 조립제법을
Common Lisp 언어로 구현해 보았다. 조립제법은 일명 Horner의 방법이라고도 불리우는데, 이는 x = a 에서 다항식 p(x)의 값 p(a)을 계산하는 가장 빠른 알고리즘이기도 하다.

         p(x) = (x - a)q(x) + r

여기서 r은 나머지이며 r = p(a) 이다. 또 q(x)는 몫이다.

[참고]
    * 온라인으로 조립제법 표 만들기 손으로 계산하는 조립제법 표 
    * 온라인으로 구하는 다항식의 도함수: 조립제법을 이용한 다항식의 도함수


아래의 소스파일은 Python용 소스파일 testSyntheticDivision.py를 Common Lisp용으로 수정한 것이다. 

실행은 CLisp을 사용한다.


  1. #!/usr/bin/env clisp
  2. ;;  Filename: testSyntheticDivision.lsp
  3. ;;
  4. ;;  Purpose:  Find the quotient and remainder when some polynomial is
  5. ;;            divided by a monic polynomial of the first degree.
  6. ;;
  7. ;;  Execute:  clisp testSyntheticDivision.lsp -2 1 3 3 1
  8. ;;
  9. ;;  Date: 201. 8. 31.
  10. ;; 사용법 표시
  11. (defun printUsage()
  12.     (format t "사용법: python testSyntheticDivision.py [수] [피제식의 계수들]~%")
  13.     (format t "조립제법(synthetic method)에 의한 다항식 나눗셈 결과를 보여준다.~%"))
  14. ;; 스트링을 부동소수점수로 변환하는 함수
  15. (defun parse-number (v)
  16.      (with-input-from-string (s v) (read s)))
  17. ;; 부동소수점수의 표현이 .0 으로 끝나는 경우 이를 잘라낸다.
  18. ;; 전체 문자열 표시 너비는 매개변수 width 로 전달받아 처리한다.
  19. (defun simplify(v width)
  20.     (setf tt (format nil "~F" v))
  21.     (setf tlen (length tt))
  22.     (if (> tlen 1) (progn
  23.         (if (equal (substring tt (- tlen 2) tlen) ".0") (progn
  24.             (setf tt (substring tt 0 (- tlen 2)))
  25.             (setf tlen (length tt))
  26.             )
  27.           )
  28.     ))
  29.     (if (not (equal width nil)) (progn
  30.         (if (< tlen width) (progn
  31.             (setf tt (concatenate 'string (substring "              " 0 (- width tlen)) tt)) ))
  32.         )
  33.     )
  34.     tt )
  35. ;; 다항식을 내림차순의 스트링 표현으로 반환
  36. (defun toPolyString(c)
  37.     (setf ttt "")
  38.     (setf sc0 (simplify (nth 0 c) nil ))
  39.     (setf sc0 (simplify (nth 0 c) nil ))
  40.     (if (> (length c) 2)
  41.         (cond
  42.            ((equal sc0 "1") (setf ttt (concatenate 'string ttt (format nil "x^~D" (- (length c) 1)))))
  43.            ((equal sc0 "-1") (setf ttt (concatenate 'string ttt (format nil "-x^~D" (- (length c) 1)))))
  44.            (t (setf ttt (concatenate 'string ttt sc0 (format nil " x^~D" (- (length c) 1)))))
  45.         )
  46.     )
  47.     (if (= (length c) 2)
  48.         (cond
  49.            ((equal sc0 "1") (setf ttt (concatenate 'string ttt "x")))
  50.            ((equal sc0 "-1") (setf ttt (concatenate 'string ttt "-x")))
  51.            (t (setf ttt (concatenate 'string ttt sc0 " x")))
  52.         )
  53.     )
  54.     (if (= (length c) 1)
  55.            (setf ttt (concatenate 'string ttt sc0))
  56.     )
  57.     (loop for i from 1 below (length c) do
  58.         (setf k (- (length c) 1 i))
  59.         (setf sc (simplify (nth i c) nil))
  60.         (if (> k 1) (progn
  61.             (cond
  62.                 ((> (nth i c) 0.0)
  63.                     (if (equal sc "1")
  64.                         (setf ttt (concatenate 'string ttt " + " (format nil "x^~D" k)))
  65.                         (setf ttt (concatenate 'string ttt " + " sc (format nil " x^~D" k)))
  66.                     ) )
  67.                 ((< (nth i c) 0.0)
  68.                     (if (equal sc "-1")
  69.                         (setf ttt (concatenate 'string ttt " - " (format nil "x^~D" k)))
  70.                         (setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c)) nil) (format nil " x^~D" k)))
  71.                     ) )
  72.                 )
  73.             )
  74.         )
  75.         (if (= k 1)
  76.             (cond
  77.                 ((> (nth i c) 0.0)
  78.                     (if (equal sc "1")
  79.                         (setf ttt (concatenate 'string ttt " + " "x"))
  80.                         (setf ttt (concatenate 'string ttt " + " sc " x"))
  81.                     ) )
  82.                 ((< (nth i c) 0.0)
  83.                     (if (equal sc "-1")
  84.                         (setf ttt (concatenate 'string ttt " - " "x"))
  85.                         (setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c)) nil) " x"))
  86.                     ) )
  87.             )
  88.         )
  89.         (if (= k 0)
  90.             (cond
  91.                 ( (> (nth i c) 0.0) (setf ttt (concatenate 'string ttt " + " sc)) )
  92.                 ( (< (nth i c) 0.0) (setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c)) nil) )) )
  93.             )
  94.         )
  95.     )
  96. ;; 다항식 나눗셈 결과를
  97. ;;     (피제식) = (제식)(몫) + (나머지)
  98. ;; 형태로 출력
  99. (defun printDivisionResult(a c b)
  100.     (setf strLine (concatenate 'string "  " (toPolyString c)))
  101.     (format t "~A~%" strLine)
  102.     (setf strLine (concatenate 'string "    = ( " (toPolyString (list 1.0 (- a))) " )"))
  103.     (setf tmp (make-list (- (length b) 1) :initial-element 0.0)) 
  104.     (loop for i from 0 below (length tmp) do
  105.         (setf (nth i tmp) (nth i b)) )
  106.     (setf strLine (concatenate 'string strLine "( " (toPolyString tmp) " )"))
  107.     (setf r (nth (- (length b) 1) b))
  108.     (cond
  109.        ((> r 0.0)  (setf strLine (concatenate 'string strLine " + " (simplify r nil) )))
  110.        ((< r 0.0)  (setf strLine (concatenate 'string strLine " - " (simplify (abs r) nil) )))
  111.     )
  112.     (format t "~A~%" strLine)
  113. )
  114. ;; 조립제법 계산표 출력 함수
  115. (defun printSyntheticTable(a c s q)
  116.     (setf strLine "       | ")
  117.     (setf strLine (concatenate 'string strLine (simplify (nth 0 c) 6) ))
  118.     (loop for i from 1 below (length c) do
  119.         (setf strLine (concatenate 'string strLine "  " (simplify (nth i c) 6) )))
  120.     (format t "~A~%" strLine)
  121.     (setf strLine (concatenate 'string (simplify a 6) " |"))
  122.     (setf strLine (concatenate 'string strLine "         "))
  123.     (setf strLine (concatenate 'string strLine (simplify (nth 1 s) 6)))
  124.     (loop for i from 2 below (length s) do
  125.         (setf strLine (concatenate 'string strLine "  " (simplify (nth i s) 6) )))
  126.     (format t "~A~%" strLine)
  127.     (setf strLine "       |")
  128.     (loop for i from 0 below (length q) do
  129.         (setf strLine (concatenate 'string strLine "--------")))
  130.     (format t "~A~%" strLine)
  131.     (setf strLine "         ")
  132.     (setf strLine (concatenate 'string strLine (simplify (nth 0 q) 6)))
  133.     (loop for i from 1 below (length q) do
  134.         (setf strLine (concatenate 'string strLine "  " (simplify (nth i q) 6) )))
  135.     (format t "~A~%" strLine)
  136. )
  137. ;; 실행 시작 지점
  138. (if (< (length ext:*args*) 3) (progn
  139.     (printUsage)
  140.     (quit) ))
  141. ;; ----------------------------------------------------
  142. ;; 피제식은 c_0 x^n +  c_1 x^(n -1) + ... + c_n
  143. ;; 제식은 x -  a
  144. (setf a (parse-number (nth 0 ext:*args*)) )
  145. (setf c (make-list (- (length ext:*args*) 1) :initial-element 0.0) )
  146. (setf s (make-list (- (length ext:*args*) 1) :initial-element 0.0) )
  147. (setf b (make-list (- (length ext:*args*) 1) :initial-element 0.0) )
  148. (loop for i from 0 below (length c) do
  149.     (setf (nth i c) (parse-number (nth (+ i 1) ext:*args*))))
  150. ;; ----------------------------------------------------
  151. ;; 조립제법의 주요 부분
  152. (setf (nth 0 s) 0.0)
  153. (setf (nth 0 b) (nth 0 c))
  154. (loop for i from 1 below (length c) do
  155.     (setf (nth i s) (* (nth (- i 1) b) a))
  156.     (setf (nth i b) (+ (nth i c) (nth i s))) )
  157. ;; ----------------------------------------------------
  158. ;; 몫의 계수와 나머지를 출력한다.
  159. (format t "몫의 계수는 ")
  160. (loop for i from 0 below (- (length b) 2) do
  161.     (format t (concatenate 'string (simplify (nth i b) nil) ",  ")))
  162. (format t (concatenate 'string (simplify (nth (- (length b) 2) b) nil) " "))
  163. (format t (concatenate 'string "이고, 나머지는 " (simplify (nth (- (length b) 1) b) nil) " 이다.~%"))
  164. (terpri)
  165. ;; ----------------------------------------------------
  166. ;; 조립제법 표를 출력한다.
  167. (printSyntheticTable a c s b)
  168. (terpri)
  169. ;; ----------------------------------------------------
  170. ;; (피제식) = (제식) x (몫) + (나머지)
  171. (printDivisionResult a c b)




실행> clisp testSyntheticDivision.lsp 1 2 3 4 5
몫의 계수는 2, 5, 9 이고, 나머지는 14 이다.

       |      2       3       4       5
     1 |              2       5       9
       |---------------------------------
              2       5       9      14

  2 x^3 + 3 x^2 + 4 x + 5
    = ( x - 1 )( 2 x^2 + 5 x + 9 ) + 14



 

Posted by Scripter
,

다음은 Python용 소스파일 testForFor.py를 Common Lisp용으로 수정한 것이다.
Common Lisp 언어에서 format 함수로 출력할 때 ~% 는 개행문자를 의미한다.

Python 언어에서 쓰이는 조건 분기 구문

        if 조건식1:
            블럭1
        elif 조건식2:
            블럭2
        elif 조건식3:
            블럭3
        else:
            블럭4

에 해딩하는 Common Lisp 언어의 구문은

        (cond
            ((조건식1) 블럭1) 
            (조건식2) 블럭2) 
            (조건식3) 블럭3)
            (t 블럭4) )


이다. Comon Lisp 언어에서 t와 nil은 각각 Java 언어의 true와 false에 해당하는 불리란 타입의 상수이다. 그러므로 Comon Lisp 언어에서 t와 nil을 변수명으로 사용할 수 없다. 

  1. #!/use/bin/env clisp
  2. ;; Filename: testForFor.lsp
  3. ;;
  4. ;; Execute: clisp testForFor.lsp
  5. ;;
  6. ;; Date: 20013. 8. 30.
  7. (defun getDan(dan)
  8.     (setf tt (make-list 19 :initial-element "" )
  9.     (loop for j from 0 below 19 do
  10.         (setf sa (format nil "~D" dan))
  11.         (if (< (length sa) 2)
  12.             (setf sa (format nil " ~D" dan)))
  13.         (setf sb (format nil "~D" (+ j 1)))
  14.         (if (< (length sb) 2)
  15.             (setf sb (format nil " ~D" (+ j 1))))
  16.         (setf sval (format nil "~D" (* dan (+ j 1))))
  17.         (cond ((< (length sval) 2) (setf sval (format nil "  ~D" (* dan (+ j 1)))))
  18.               ((< (length sval) 3) (setf sval (format nil " ~D" (* dan (+ j 1))))))
  19.         (setf (nth j tt) (format nil "~A x ~A = ~A" sa sb sval )))
  20.     tt )
  21. ;; 19단표를 모두 80컬럼 컨솔에 출력한다.
  22. (defun printAllNineteenDan()
  23.     (setf arr (make-list 18 :initial-element '() ))
  24.     (loop for j from 0 below 18 do
  25.         (setf (nth j arr) (make-list 19 :initial-element '() )))
  26.     (loop for i from 2 below 20 do
  27.         (setf (nth (- i 2) arr) (getDan i)))
  28.     ;; Common Lisp 소스 코드에서도 배열 대신 리스트를 사용한다.
  29.     (setf d (list 2 7 11 16))        ;; 각 줄단위 블럭의 첫단
  30.     (setf counter (list 5 4 5 4 ))   ;; 각 줄단위 블럭에 속한 단의 개수
  31.     (setf lines (make-list 19 :initial-element "" ))
  32.     (loop for k from 0 below (length d) do
  33.         ;; 8-바이트 길이의 한 줄씩 완성
  34.         (loop for i from 0 below 19 do
  35.             (setf (nth i lines) (nth i (nth (- (nth k d) 2) arr)))
  36.             (loop for j from 1 below (nth k counter) do
  37.                 (setf (nth i lines) (concatenate  'string (nth i lines) "   " (nth i (nth (+ (- (nth k d) 2) j) arr)))) ))
  38.         ;; 80 바이트 길이의 한 줄씩 출력
  39.         (loop for i from 0 below 19 do
  40.             (format t "~A~%" (nth i lines)))
  41.         (terpri) ))    ;; same to (format t "~%") ))
  42. (terpri)    ;; (format t "~%")
  43. (printAllNineteenDan)


실행> clisp ForFor.sp

 2 x  1 =   2    3 x  1 =   3    4 x  1 =   4    5 x  1 =   5    6 x  1 =   6
 2 x  2 =   4    3 x  2 =   6    4 x  2 =   8    5 x  2 =  10    6 x  2 =  12
 2 x  3 =   6    3 x  3 =   9    4 x  3 =  12    5 x  3 =  15    6 x  3 =  18
 2 x  4 =   8    3 x  4 =  12    4 x  4 =  16    5 x  4 =  20    6 x  4 =  24
 2 x  5 =  10    3 x  5 =  15    4 x  5 =  20    5 x  5 =  25    6 x  5 =  30
 2 x  6 =  12    3 x  6 =  18    4 x  6 =  24    5 x  6 =  30    6 x  6 =  36
 2 x  7 =  14    3 x  7 =  21    4 x  7 =  28    5 x  7 =  35    6 x  7 =  42
 2 x  8 =  16    3 x  8 =  24    4 x  8 =  32    5 x  8 =  40    6 x  8 =  48
 2 x  9 =  18    3 x  9 =  27    4 x  9 =  36    5 x  9 =  45    6 x  9 =  54
 2 x 10 =  20    3 x 10 =  30    4 x 10 =  40    5 x 10 =  50    6 x 10 =  60
 2 x 11 =  22    3 x 11 =  33    4 x 11 =  44    5 x 11 =  55    6 x 11 =  66
 2 x 12 =  24    3 x 12 =  36    4 x 12 =  48    5 x 12 =  60    6 x 12 =  72
 2 x 13 =  26    3 x 13 =  39    4 x 13 =  52    5 x 13 =  65    6 x 13 =  78
 2 x 14 =  28    3 x 14 =  42    4 x 14 =  56    5 x 14 =  70    6 x 14 =  84
 2 x 15 =  30    3 x 15 =  45    4 x 15 =  60    5 x 15 =  75    6 x 15 =  90
 2 x 16 =  32    3 x 16 =  48    4 x 16 =  64    5 x 16 =  80    6 x 16 =  96
 2 x 17 =  34    3 x 17 =  51    4 x 17 =  68    5 x 17 =  85    6 x 17 = 102
 2 x 18 =  36    3 x 18 =  54    4 x 18 =  72    5 x 18 =  90    6 x 18 = 108
 2 x 19 =  38    3 x 19 =  57    4 x 19 =  76    5 x 19 =  95    6 x 19 = 114

 7 x  1 =   7    8 x  1 =   8    9 x  1 =   9   10 x  1 =  10
 7 x  2 =  14    8 x  2 =  16    9 x  2 =  18   10 x  2 =  20
 7 x  3 =  21    8 x  3 =  24    9 x  3 =  27   10 x  3 =  30
 7 x  4 =  28    8 x  4 =  32    9 x  4 =  36   10 x  4 =  40
 7 x  5 =  35    8 x  5 =  40    9 x  5 =  45   10 x  5 =  50
 7 x  6 =  42    8 x  6 =  48    9 x  6 =  54   10 x  6 =  60
 7 x  7 =  49    8 x  7 =  56    9 x  7 =  63   10 x  7 =  70
 7 x  8 =  56    8 x  8 =  64    9 x  8 =  72   10 x  8 =  80
 7 x  9 =  63    8 x  9 =  72    9 x  9 =  81   10 x  9 =  90
 7 x 10 =  70    8 x 10 =  80    9 x 10 =  90   10 x 10 = 100
 7 x 11 =  77    8 x 11 =  88    9 x 11 =  99   10 x 11 = 110
 7 x 12 =  84    8 x 12 =  96    9 x 12 = 108   10 x 12 = 120
 7 x 13 =  91    8 x 13 = 104    9 x 13 = 117   10 x 13 = 130
 7 x 14 =  98    8 x 14 = 112    9 x 14 = 126   10 x 14 = 140
 7 x 15 = 105    8 x 15 = 120    9 x 15 = 135   10 x 15 = 150
 7 x 16 = 112    8 x 16 = 128    9 x 16 = 144   10 x 16 = 160
 7 x 17 = 119    8 x 17 = 136    9 x 17 = 153   10 x 17 = 170
 7 x 18 = 126    8 x 18 = 144    9 x 18 = 162   10 x 18 = 180
 7 x 19 = 133    8 x 19 = 152    9 x 19 = 171   10 x 19 = 190

11 x  1 =  11   12 x  1 =  12   13 x  1 =  13   14 x  1 =  14   15 x  1 =  15
11 x  2 =  22   12 x  2 =  24   13 x  2 =  26   14 x  2 =  28   15 x  2 =  30
11 x  3 =  33   12 x  3 =  36   13 x  3 =  39   14 x  3 =  42   15 x  3 =  45
11 x  4 =  44   12 x  4 =  48   13 x  4 =  52   14 x  4 =  56   15 x  4 =  60
11 x  5 =  55   12 x  5 =  60   13 x  5 =  65   14 x  5 =  70   15 x  5 =  75
11 x  6 =  66   12 x  6 =  72   13 x  6 =  78   14 x  6 =  84   15 x  6 =  90
11 x  7 =  77   12 x  7 =  84   13 x  7 =  91   14 x  7 =  98   15 x  7 = 105
11 x  8 =  88   12 x  8 =  96   13 x  8 = 104   14 x  8 = 112   15 x  8 = 120
11 x  9 =  99   12 x  9 = 108   13 x  9 = 117   14 x  9 = 126   15 x  9 = 135
11 x 10 = 110   12 x 10 = 120   13 x 10 = 130   14 x 10 = 140   15 x 10 = 150
11 x 11 = 121   12 x 11 = 132   13 x 11 = 143   14 x 11 = 154   15 x 11 = 165
11 x 12 = 132   12 x 12 = 144   13 x 12 = 156   14 x 12 = 168   15 x 12 = 180
11 x 13 = 143   12 x 13 = 156   13 x 13 = 169   14 x 13 = 182   15 x 13 = 195
11 x 14 = 154   12 x 14 = 168   13 x 14 = 182   14 x 14 = 196   15 x 14 = 210
11 x 15 = 165   12 x 15 = 180   13 x 15 = 195   14 x 15 = 210   15 x 15 = 225
11 x 16 = 176   12 x 16 = 192   13 x 16 = 208   14 x 16 = 224   15 x 16 = 240
11 x 17 = 187   12 x 17 = 204   13 x 17 = 221   14 x 17 = 238   15 x 17 = 255
11 x 18 = 198   12 x 18 = 216   13 x 18 = 234   14 x 18 = 252   15 x 18 = 270
11 x 19 = 209   12 x 19 = 228   13 x 19 = 247   14 x 19 = 266   15 x 19 = 285

16 x  1 =  16   17 x  1 =  17   18 x  1 =  18   19 x  1 =  19
16 x  2 =  32   17 x  2 =  34   18 x  2 =  36   19 x  2 =  38
16 x  3 =  48   17 x  3 =  51   18 x  3 =  54   19 x  3 =  57
16 x  4 =  64   17 x  4 =  68   18 x  4 =  72   19 x  4 =  76
16 x  5 =  80   17 x  5 =  85   18 x  5 =  90   19 x  5 =  95
16 x  6 =  96   17 x  6 = 102   18 x  6 = 108   19 x  6 = 114
16 x  7 = 112   17 x  7 = 119   18 x  7 = 126   19 x  7 = 133
16 x  8 = 128   17 x  8 = 136   18 x  8 = 144   19 x  8 = 152
16 x  9 = 144   17 x  9 = 153   18 x  9 = 162   19 x  9 = 171
16 x 10 = 160   17 x 10 = 170   18 x 10 = 180   19 x 10 = 190
16 x 11 = 176   17 x 11 = 187   18 x 11 = 198   19 x 11 = 209
16 x 12 = 192   17 x 12 = 204   18 x 12 = 216   19 x 12 = 228
16 x 13 = 208   17 x 13 = 221   18 x 13 = 234   19 x 13 = 247
16 x 14 = 224   17 x 14 = 238   18 x 14 = 252   19 x 14 = 266
16 x 15 = 240   17 x 15 = 255   18 x 15 = 270   19 x 15 = 285
16 x 16 = 256   17 x 16 = 272   18 x 16 = 288   19 x 16 = 304
16 x 17 = 272   17 x 17 = 289   18 x 17 = 306   19 x 17 = 323
16 x 18 = 288   17 x 18 = 306   18 x 18 = 324   19 x 18 = 342
16 x 19 = 304   17 x 19 = 323   18 x 19 = 342   19 x 19 = 361



 

Posted by Scripter
,

소스 파일명: testWhile.lsp

  1. #!/usr/bin/env clisp
  2. ;; Filename: testWhile.lsp
  3. ;;
  4. ;;  Purpose:  Example using the while loop syntax
  5. ;;                (loop while (cond) do .... )
  6. ;;
  7. ;; Execute: clisp testWhile.lsp -200 300
  8. ;; 사용법 표시
  9. (defun printUsage()
  10.     (format t "Usage: clisp testWhile.lsp [integer1] [integer2]~%")
  11.     (format t "This finds the greatest common divisor of the given two integers.~%") )
  12. ;; 스트링을 부동소수점수로 변환하는 함수
  13. (defun parse-number (v)
  14.      (with-input-from-string (s v) (read s)))
  15. (if (not(= (length ext:*args*) 2)) (printUsage))
  16. (if (not(= (length ext:*args*) 2)) (quit))
  17. ;; --------------------------------------
  18. ;; 명령행 인자의 두 스트링을 가져와서
  19. ;; 정수 타입으로 변환하여
  20. ;; 변수 val1과 val2에 저장한다.
  21. (setf val1 (parse-integer (nth 0 ext:*args*)))
  22. (setf val2 (parse-integer (nth 1 ext:*args*)))
  23. ;; a는 |val1|, |val2| 중 큰 값
  24. (setf a (abs val1))
  25. (setf b (abs val2))
  26. (setf once 1)
  27. (if (< a b) (loop while (= once 1) do
  28.     (setf a (abs val2))
  29.     (setf b (abs val1))
  30.     (format t "a = ~D, b = ~D~%" a b)
  31.     (setf once 0) ))
  32. ;; 블럭문이 두 개 이상의 문으로 구성되어 있으면 progn을 사용한다.
  33. (if (zerop b) (progn
  34.     (format t "GCD(~D, ~D) = ~D~%" val1 val2 a)
  35.     (quit) ))
  36. ;; --------------------------------------
  37. ;; Euclidean 알고리즘의 시작
  38. ;;
  39. ;; a를 b로 나누어 몫은 q에, 나머지는 r에 저장
  40. (setf q (floor (/ a b)))
  41. (setf r (mod a b))
  42. ; (format t "q = ~D, r = ~D~%" q r)
  43. ;; --------------------------------------
  44. ;; Euclidean 알고리즘의 반복 (나머지 r이 0이 될 때 까지)
  45. (loop while (not(zerop r)) do
  46.     (setf a b)
  47.     (setf b r)
  48.     (setf q (floor (/ a b)))
  49.     (setf r (mod a b)))
  50. ;; 나머지가 0이면 그 때 나눈 수(제수) b가 최대공약수(GCD)이다.
  51. (setf gcd b)
  52. ;; 최대공약수(GCD)를 출력한다.
  53. (format t "GCD(~D, ~D) = ~D~%" val1 val2 gcd)
  54. (quit)


실행:

Command> clisp testWhile.lsp
Usage: clisp testWhile.lsp [integer1] [integer2]
This finds the greatest common divisor of the given two integers.


Command> clisp testWhile.lsp -200 300
GCD(-200, 300) = 100

Command> clisp testWhile.lsp -200 0
GCD(-200, 0) = 200

Command> clisp testWhile.lsp 125 100
GCD(125, 100) = 25

Command> clisp testWhile.lsp 23 25
GCD(23, 25) = 1







Posted by Scripter
,

소스 파일명: testIf.lisp

  1. #!/usr/bin/env clisp
  2. #|
  3.    Filename: testIf.lisp
  4.    Purpose:  Example using the conditional control structure syntax
  5.                  (if cond block1 block2)
  6.    Execute: clisp testIf.lisp [number]
  7. |#
  8. ;; 사용법을 보여주는 함수
  9. (defun printUsing()
  10.    (format t "Using: clisp testIf.lisp [number]~%")
  11.    (format t "This determines whether the number is positive or not.~%") )
  12. ;; 스트링을 부동소수점수로 변환하는 함수
  13. (defun parse-number (v)
  14.      (with-input-from-string (s v) (read s)))
  15. ;; 명령행 인자의 개수가 1이 아니면 사용법을 보여준다.
  16. (if (< (length ext:*args*) 1)
  17.     (printUsing) )
  18. (if (< (length ext:*args*) 1)
  19.     (quit) )
  20. ; 명령행 인자의 스트링을 가져와서
  21. ; 배정밀도 부동소수점수로 변환하여
  22. ; 변수 val에 저장한다.
  23. (setf val (parse-number (nth 0 ext:*args*)) )
  24. ; 변수 val에 저장된 값이 양수인지 음수인지 0인지를
  25. ; 판단하는 (if cond block1 block2) 조건문
  26. (if (> val 0.0)
  27.     (format t "~F is a positive number.~%" val)
  28.     (if (< val 0.0)
  29.         (format t "~F is a negative number.~%" val)
  30.         (format t "~F is zero." val)))


 

실행> clisp testIf.lisp
Using: clisp testIf.lisp [number]
This determines whether the number is positive or not.

실행> clisp testIf.lisp 1.02
1.02 is a positive number.

실행> clisp testIf.lisp -1.02
-1.02 is a negative number.

실행> clisp testIf.lisp 0
0.0 is zero.




Posted by Scripter
,