'프로그래밍/Common Lisp' 카테고리의 글 목록

(Common Lisp 언어로 구현해 보는) 십진법의 신비: 숫자 계산 피라미드 세 가지

프로그래밍/Common Lisp 2013. 9. 23. 20:30

다음 소스는 GNU CLisp 으로 실행됨을 확인하였다.

세 함수 pyra1(int int), pyra2(int int), pyra3(int int) 는 재귀호출을 사용하였고, 세 함수 pyramid1(), pyramid2(), pyramid3() 은 loop for 반복문을 사용하였다.

#!/usr/bin/env clisp

;; Filename: pyramidOfDigits2.lsp
;;
;;   Execute: clisp pyramidOfDigits2.lsp
;;
;;     Or
;;
;;   Execute: ./pyramidOfDigits2.lsp
;;
;;     See: http://darvish.wordpress.com/2008/03/16/the-beauty-of-mathematics-and-the-love-of-god/
;;
;; Date: 2013. 9. 23.
;; Copyright (c) 2013 PH Kim (pkim __AT__ scripts.pe.kr)

(setf *TEN* 10)
(setf *NINE* 9)
(setf *EIGHT* 8)

(defun pyra1(n i)
    (if (<= i *NINE*) (progn
(format t "~9D x ~A + ~A = ~A~%" n *EIGHT* i (+ (* n *EIGHT*) i))
        (if (< i *NINE*)
      (pyra1 (+ (* n *TEN*) (+ i 1)) (+ i 1))))))

(defun pyra2(n i)
    (if (>= i 0) (progn
        (format t "~8D x ~A + ~A = ~A~%" n *NINE* i (+ (* n *NINE*) i))
        (if (> i 0)
      (pyra2 (+ (* n *TEN*) (+ i 1)) (- i 1))))))

(defun pyra3(n i)
    (if (<= i *TEN*) (progn
(format t "~9D x ~A + ~2D = ~A~%" n *NINE* i (+ (* n *NINE*) i))
        (if (< i *TEN*)
      (pyra3 (+ (* n *TEN*) i) (+ i 1))))))

(defun pyramid1()
     (let ((i 0)
           (n 0)
           (s (make-list *TEN* :initial-element #\Space)))
(loop for i from 1 below *TEN* do
  (setf (nth (- i 1) s) (code-char (+ 48 i)))
  (setf (nth i s) #\Space)
  (setf n (parse-integer (list-to-string s)))
  (format t "~9D x ~A + ~A = ~A~%" n *EIGHT* i (+ (* n *EIGHT*) i)))
    ))

(defun pyramid2()
     (let ((i 0)
           (n 0)
           (s (make-list *TEN* :initial-element #\Space)))
(loop for i from *NINE* downto 2 do
                ; (format t " i = ~A~%" i)
  (setf (nth (- *NINE* i) s) (code-char (+ 48 i)))
  (setf (nth (+ (- *NINE* i) 1) s) #\Space)
  (setf n (parse-integer (list-to-string s)))
  (format t "~8D x ~A + ~2A = ~A~%" n *NINE* (- i 2) (+ (* n *NINE*) (- i 2))))
    ))

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

(defun pyramid3()
     (let ((i 0)
           (n 0)
           (s (make-list *TEN* :initial-element #\Space)))
(loop for i from 1 below *TEN* do
  (setf (nth (- i 1) s) (code-char (+ 48 i)))
  (setf (nth i s) #\Space)
  (setf n (parse-integer (list-to-string s)))
  (format t "~9D x ~A + ~2D = ~A~%" n *NINE* (+ i 1) (+ (* n *NINE*) (+ i 1))))))

(format t "Use for loops~%")
(format t "Pyramid 1~%")
(pyramid1)
(format t "~%")

(format t "Pyramid 2~%")
(pyramid2)
(format t "~%")

(format t "Pyramid 3~%")
(pyramid3)
(format t "~%")

(format t "Use recursively called functions~%")
(format t "Pyramid 1~%")
(pyra1 1 1)
(format t "~%")

(format t "Pyramid 2~%")
(pyra2 9 7)
(format t "~%")

(format t "Pyramid 3~%")
(pyra3 1 2)
(format t "~%")

#|
Output:
Use for loops
Pyramid 1
        1 x 8 + 1 = 9
       12 x 8 + 2 = 98
      123 x 8 + 3 = 987
     1234 x 8 + 4 = 9876
    12345 x 8 + 5 = 98765
   123456 x 8 + 6 = 987654
1234567 x 8 + 7 = 9876543
12345678 x 8 + 8 = 98765432
123456789 x 8 + 9 = 987654321

Pyramid 2
       9 x 9 + 7 = 88
      98 x 9 + 6 = 888
     987 x 9 + 5 = 8888
    9876 x 9 + 4 = 88888
   98765 x 9 + 3 = 888888
987654 x 9 + 2 = 8888888
9876543 x 9 + 1 = 88888888
98765432 x 9 + 0 = 888888888

Pyramid 3
        1 x 9 + 2 = 11
       12 x 9 + 3 = 111
      123 x 9 + 4 = 1111
     1234 x 9 + 5 = 11111
    12345 x 9 + 6 = 111111
   123456 x 9 + 7 = 1111111
1234567 x 9 + 8 = 11111111
12345678 x 9 + 9 = 111111111
123456789 x 9 + 10 = 1111111111

Use recursively called functions
Pyramid 1
        1 x 8 + 1 = 9
       12 x 8 + 2 = 98
      123 x 8 + 3 = 987
     1234 x 8 + 4 = 9876
    12345 x 8 + 5 = 98765
   123456 x 8 + 6 = 987654
1234567 x 8 + 7 = 9876543
12345678 x 8 + 8 = 98765432
123456789 x 8 + 9 = 987654321

Pyramid 2
       9 x 9 + 7 = 88
      98 x 9 + 6 = 888
     987 x 9 + 5 = 8888
    9876 x 9 + 4 = 88888
   98765 x 9 + 3 = 888888
987654 x 9 + 2 = 8888888
9876543 x 9 + 1 = 88888888
98765432 x 9 + 0 = 888888888

Pyramid 3
        1 x 9 + 2 = 11
       12 x 9 + 3 = 111
      123 x 9 + 4 = 1111
     1234 x 9 + 5 = 11111
    12345 x 9 + 6 = 111111
   123456 x 9 + 7 = 1111111
1234567 x 9 + 8 = 11111111
12345678 x 9 + 9 = 111111111
123456789 x 9 + 10 = 1111111111
|#

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 언어로 한 번의 floor 함수 호출로 몫과 나머지 구하기 (0)	2013.09.15
스트링 벡터에서 스트링 찾기(find) with Common Lisp (0)	2013.09.12
Common Lisp 언어로 역삼각함수, 역쌍곡선함수 값을 구하는 예제 (0)	2013.09.11
감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스 (0)	2013.09.08
Common Lisp 언어로 복소수 계산하기 (0)	2013.09.07

Posted by Scripter

,

Common Lisp 언어로 한 번의 floor 함수 호출로 몫과 나머지 구하기

프로그래밍/Common Lisp 2013. 9. 15. 13:46

(실수) = (정수부) + (소수부) (단, 0 <= 소수부 < 1)

x = floor(x) + err (단, 0<= err < 1)

예: 3.14159 = 3 + 0.14150

-2.71828 = -3 + 0.26172

즉, floor(x) 는 x 보다 크지 않은 죄대의 정수를 의미한다. 수학에서 (기호 [x] 로 표기되는) 가우스 기호라고 부르는 함수에 해당한다.

C, C++, Java, Python, Ruby, C# 등의 대부분 언어에서는 floor 함수가 부동소수점수의 소소부를 잘라낸 정수부를 구하는데 쓰인다.

Common Lisp 언어에서는 floor 함수가 그런 용도로도 쓰이지만, Python 언어의 divmod 함수 처럼 몫과 나머지를 함께 구하는데 쓰이기도 한다.

우선 C 언어와 C++ 언어로 floor 함수를 사용하는 소스이다.

[ C 소스 파일명: testFloor.c ]

#include <stdio.h>
#include <math.h>

int main()
{
printf("floor(-20.0/7) = %f\n", floor(-20.0/7));
return 0;
}

/*
Output:
floor(-20.0/7) = -3.000000
*/

[ C++ 소스 파일명: testFloor.cpp ]

#include <iostream>
#include <iomanip>
#include <cmath>

using namespace std;

int main()
{
    cout << "floor(-20.0/7) = ";
    cout << setprecision(6) << fixed;
    cout << floor(-20.0/7) << endl;
    return 0;
}

/*
Output:
floor(-20.0/7) = -3.000000
*/

그어면 Python 의 경우 divmod 함수의 사용 예를 알아 보자.

명령 프롬프트> python
Python 2.7.3 (default, Apr 10 2012, 23:31:26) [MSC v.1500 32 bit (Intel)] on win32
Type "help", "copyright", "credits" or "license" for more information.
>>> divmod(23, 7)
(3, 2)
>>> (q, r) = divmod(23, 7)
>>> q
3
>>> r
2
>>> divmod(-20, 7)
(-3, 1)
>>>>>> quit()

이제 CLisp 의 경우에 대해서 알아 보자.

Common Lisp 언어의 floor 함수는 몫과 나머지를 함께 리턴하지만 리턴된 값들을 받으려면 다소 까다롭다. setq 나 setf 로는 안 되고 multiple-value-setq 를 사용해야 한다.

명령 프롬프트> clisp
i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo
I I I I I I I      8     8   8           8     8     o 8    8
I \ `+' / I      8         8           8     8        8    8
   \ `-+-' /       8         8           8      ooooo   8oooo
    `-__|__-'        8         8           8           8 8
        |            8     o   8           8     o     8 8
------+------       ooooo    8oooooo ooo8ooo   ooooo   8

Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>

Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010

Type :h and hit Enter for context help.

[1]> (floor 23 7)
3 ;
2
[2]> (multiple-value-setq (q r) (floor 23 7))
3
[3]> q
3
[4]> r
2
[5]> (floor -20 7)
-3 ;
1
[6]> (quit)
Bye.

multiple-value-setq 를 사용하는 더 간단한 예를 알아보자.

[1]> (multiple-value-setq (x y) (values 1 2))
1
[2]> (list x y)
(1 2)
[3]> (multiple-value-setq (x y) (values y x)) ; swapped here
2
[4]> (list x y)
(2 1)

단 한 번의 함수 호출로 변수 x, y 의 값이 교환(swap)되였다.

만일 이를 Python 으로 한다면

>>> x, y = 1, 2
>>> x, y
(1, 2)
>>> x, y = y, x # swapped here
>>> x, y
(2, 1)

'프로그래밍 > Common Lisp' 카테고리의 다른 글

(Common Lisp 언어로 구현해 보는) 십진법의 신비: 숫자 계산 피라미드 세 가지 (0)	2013.09.23
스트링 벡터에서 스트링 찾기(find) with Common Lisp (0)	2013.09.12
Common Lisp 언어로 역삼각함수, 역쌍곡선함수 값을 구하는 예제 (0)	2013.09.11
감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스 (0)	2013.09.08
Common Lisp 언어로 복소수 계산하기 (0)	2013.09.07

Posted by Scripter

,

스트링 벡터에서 스트링 찾기(find) with Common Lisp

프로그래밍/Common Lisp 2013. 9. 12. 14:56

[파일명: testStringFindInVector.lsp]------------------------------------------------
#!/usr/bin/env clisp

;; Filename: testStringFindInVector.lsp
;;
;; Approximate square roots, cubic roots and n-th roots of a given number.
;;
;; Execute: clisp testStringFindInVector.lsp
;; Or
;; Execute: ./testStringFindInVector.lsp
;;
;; Date: 2013. 9. 12.

(defun my-exact-find(arr s)
    ; (position s arr))
   (let ((r -1))
        (loop for i from 0 below (length arr) do
            (if (string= s (aref arr i))
       (progn
        (setf r i)
     (return i))))
        r))

(defun printArray(arr)
    (format t "[")
    (loop for i from 0 below (- (length arr) 1) do
        (format t "~A, " (aref arr i)))
    (if (plusp (length arr))
        (format t "~A" (aref arr (- (length arr) 1))))
    (format t "]~%"))

(setf *words* (vector "하나" "둘" "셋" "넷" "다섯" "여섯"))
(setf where (my-exact-find *words* "셋"))

(format t "vector: ")
(printArray *words*)
; (format t "where = ~A~%" where)
(if (and where (>= where 0))
    (progn
        (format t "발견! ~%")
        (if (< where (length *words*))
            (format t "Next word of 셋 in vector: ~A~%" (aref *words* (+ where 1))))))

(format t "Sorting...~%")
(sort *words* #'string<)

(setf where (my-exact-find *words* "셋"))
(format t "vector: ")
(printArray *words*)
(if (and where (>= where 0))
    (progn
        (format t "발견! ~%")
        (if (< where (length *words*))
            (format t "Next word of 셋 in vector: ~A~%" (aref *words* (+ where 1))))))

#|
Output:
vector: [하나, 둘, 셋, 넷, 다섯, 여섯]
발견!
Next word of 셋 in vector: 넷
Sorting...
vector: [넷, 다섯, 둘, 셋, 여섯, 하나]
발견!
Next word of 셋 in vector: 여섯
|#
------------------------------------------------

'프로그래밍 > Common Lisp' 카테고리의 다른 글

(Common Lisp 언어로 구현해 보는) 십진법의 신비: 숫자 계산 피라미드 세 가지 (0)	2013.09.23
Common Lisp 언어로 한 번의 floor 함수 호출로 몫과 나머지 구하기 (0)	2013.09.15
Common Lisp 언어로 역삼각함수, 역쌍곡선함수 값을 구하는 예제 (0)	2013.09.11
감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스 (0)	2013.09.08
Common Lisp 언어로 복소수 계산하기 (0)	2013.09.07

Posted by Scripter

,

Common Lisp 언어로 역삼각함수, 역쌍곡선함수 값을 구하는 예제

프로그래밍/Common Lisp 2013. 9. 11. 15:00

역삼각함수란 삼각함수의 역함수를 의미하고,

역쌍곡선함수란 쌍곡선함수의 역함수를 의미한다.

수학에서 sin 함수의 역함수는 arcsin 으로 표기되는데, Common Lisp 언어에서는 asin 함수로 이미 구현되어 있다. 마찬가지로 쌍곡선 함수 sihh, cosh 들의 역함수들도 각각 asinh, acosh 라는 이름으로 이미 구현되어 있다.

#!~/usr/bin/env clisp

;; Filename: testArcSine.lsp
;;
;; Execute: clisp testArcSine.lsp
;; Or
;; Execute: ./testArcSine.lsp
;;
;; Date: 2013. 9. 12.

#|
def asinh(x):
y = math.log(x + math.sqrt(x*x + 1))
return y

def acosh(x):
y = math.log(x + math.sqrt(x*x - 1))
return y
|#

(format t "Using the type of float, ~%")
(setf x -0.9)
(setf y (asin x))
(format t " y = asin(~,1f) = ~,9f~%" x y)
(format t " sin(y) = sin(~,9f) = ~,1f~%" y (sin y))

(setf x 1.1)
(setf u (acosh x))
(setf v (asinh x))
(format t " u = acosh(~,1f) = ~,9f~%" x u)
(format t " v = asinh(~,1f) = ~,9f~%" x v)
(format t " cosh(u) = cosh(~,9f) = ~,1f~%" u (cosh u))
(format t " sinh(u) = sinh(~,9f) = ~,1f~%" v (sinh v))
(format t "~%")

(format t "Using the type of short-float, ~%")
(setf x -0.9S0)
(setf y (asin x))
(format t " y = asin(~f) = ~f~%" x y)
(format t " sin(y) = sin(~f) = ~f~%" y (sin y))

(setf x 1.1S0)
(setf u (acosh x))
(setf v (asinh x))
(format t " u = acosh(~f) = ~f~%" x u)
(format t " v = asinh(~f) = ~f~%" x v)
(format t " cosh(u) = cosh(~f) = ~f~%" u (cosh u))
(format t " sinh(u) = sinh(~f) = ~f~%" v (sinh v))
(format t "~%")

(format t "Using the type of double-float, ~%")
(setf x -0.9D0)
(setf y (asin x))
(format t " y = asin(~f) = ~f~%" x y)
(format t " sin(y) = sin(~f) = ~f~%" y (sin y))

(setf x 1.1D0)
(setf u (acosh x))
(setf v (asinh x))
(format t " u = acosh(~f) = ~f~%" x u)
(format t " v = asinh(~f) = ~f~%" x v)
(format t " cosh(u) = cosh(~f) = ~f~%" u (cosh u))
(format t " sinh(u) = sinh(~f) = ~f~%" v (sinh v))
(format t "~%")

(format t "Using the type of long-float, ~%")
(setf x -0.9L0)
(setf y (asin x))
(format t " y = asin(~f) = ~f~%" x y)
(format t " sin(y) = sin(~f) = ~f~%" y (sin y))

(setf x 1.1L0)
(setf u (acosh x))
(setf v (asinh x))
(format t " u = acosh(~f) = ~f~%" x u)
(format t " v = asinh(~f) = ~f~%" x v)
(format t " cosh(u) = cosh(~f) = ~f~%" u (cosh u))
(format t " sinh(u) = sinh(~f) = ~f~%" v (sinh v))
(format t "~%")

#|
Output:
Using the type of float,
y = asin(-0.9) = -1.119769600
sin(y) = sin(-1.119769600) = -0.9
u = acosh(1.1) = 0.443568350
v = asinh(1.1) = 0.950346950
cosh(u) = cosh(0.443568350) = 1.1
sinh(u) = sinh(0.950346950) = 1.1

Using the type of short-float,
y = asin(-0.9) = -1.11978
sin(y) = sin(-1.11978) = -0.9
u = acosh(1.1) = 0.443573
v = asinh(1.1) = 0.95035
cosh(u) = cosh(0.443573) = 1.1
sinh(u) = sinh(0.95035) = 1.1

Using the type of double-float,
y = asin(-0.9) = -1.1197695149986342
sin(y) = sin(-1.1197695149986342) = -0.9
u = acosh(1.1) = 0.4435682543851155
v = asinh(1.1) = 0.9503469298211343
cosh(u) = cosh(0.4435682543851155) = 1.1
sinh(u) = sinh(0.9503469298211343) = 1.1

Using the type of long-float,
y = asin(-0.9) = -1.1197695149986341867
sin(y) = sin(-1.1197695149986341867) = -0.90000000000000000003
u = acosh(1.1) = 0.44356825438511518925
v = asinh(1.1) = 0.95034692982113425026
cosh(u) = cosh(0.44356825438511518925) = 1.1
sinh(u) = sinh(0.95034692982113425026) = 1.1
|#

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 언어로 한 번의 floor 함수 호출로 몫과 나머지 구하기 (0)	2013.09.15
스트링 벡터에서 스트링 찾기(find) with Common Lisp (0)	2013.09.12
감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스 (0)	2013.09.08
Common Lisp 언어로 복소수 계산하기 (0)	2013.09.07
Common Lisp 를 이용한 간단한 수학식 계산하기 (0)	2013.09.07

Posted by Scripter

,

감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스

프로그래밍/Common Lisp 2013. 9. 8. 07:16

Lanczos 알고리즘은 Stirlng 공식에 의한 알고리즘 보다 정밀하며, 십진수로 유효숫자 약 15자리 까지는 정확하게 계산해 준다. 단지 exp 함수를 이용하는 부분에서는 exp 함수의 구현에 따라 오차가 더 있을 수 있다. 단, Common Lisp 언어의 float 타입은 유효숫자를 약 7개~8개 밖에 알아내지 못한다.

Comon Lisp 언어의 디퐁트 부동소수점수는 단정밀도 부동소수점수이다. 단정밀도 부동소수점수는 그 처리 가능한 양수의 범위가 최소 2⁻¹²⁶ ≈ 1.18 × 10⁻³⁸ 부터 최대 (2−2⁻²³) × 2¹²⁷ ≈ 3.4 × 10³⁸ 밖에 되지 않는다. 이 범위를 벗어나는 양수에 대해서는 overflow 에러가 나게 마련이다.

이런 이유로 100! 을 계산하기 위해 (gamma 101) 하면 floating point overflow 에러가 발생한다. 아래의 소스에서 (gamma 101) 을 구하는 부분을 ignore-errors 로 처리한 것은 floating point overflow 에러가 나서 실행이 멈추는 것을 방지하기 위함이다.

#!/usr/bin/env clisp

;; Filename: testLanczos-01.lsp
;;
;; An approximation for the gamma function by using the Lanczos algorithm
;;
;; Execute: clisp testLanczos-01.lsp
;; or
;; Execute: ./testLanczos-01.lsp
;;
;; See: http://en.wikipedia.org/wiki/Lanczos_approximation
;; See:http://www-history.mcs.st-and.ac.uk/Biographies/Lanczos.html
;; See: http://www.thinbasic.com/community/showthread.php?11279-Gamma-function

;; Coefficients used by the GNU Scientific Library
(setf *g* 7)
(setf *p* (list
            0.99999999999980993   676.5203681218851       -1259.1392167224028
          771.32342877765313     -176.61502916214059         12.507343278686905
           -0.13857109526572012     9.9843695780195716e-6    1.5056327351493116e-7) )

(defun gamma(z)
    (let ((tt (complex 0.0 0.0)))
        (if (realp z) (setf z (complex z 0.0)))
        ;; Reflection formula
        (if (< (realpart z) 0.5)
            (/ pi (sin (* (* pi z) (gamma (- 1 z)))))
            (progn
                (setf z (- z 1))
                (setf x (nth 0 *p*))
                (loop for i from 1 below (+ *g* 2) do
                    (setf x (+ x (/ (nth i *p*) (+ z i)))))
                (setf tt (+ z *g* 0.5))
                (* (sqrt (* 2 pi)) (expt tt (+ z 0.5)) (exp (- tt)) x) ))))

(defun factorial(n)
    (let ((k 0))
        (if (< n 2)
            1
            (progn
                (setf k 1)
                (if (evenp n)
                    (loop for i from 0 below (floor (/ n 2)) do
                        (setf k (* k (* (+ i 1) (- n i)))))
                    (progn
                        (loop for i from 0 below (floor (/ n 2)) do
                            (setf k (* k (* (+ i 1) (- n 1 i)))))
                        (setf k (* k n))))
                k))))

(defun facto(n)
    (let ((k 0))
        (if (< n 2)
            1
            (progn
                (setf k 1)
                (loop for i from 2 to n do
                    (setf k (* k i)) )
                k ))))

;; Begin here
(format t "gamma(10) = 9! = ~A asymptotically~%" (gamma 10))

(format t "gamma(21) = 20! = ~16A asymptotically~%" (gamma 21))
(format t "gamma(21) = 20! = ~16G asymptotically~%" (gamma 21))
(format t "gamma(21) = 20! = ~16G asymptotically~%" (realpart (gamma 21)))
(format t "gamma(21) = 20! = ~16F asymptotically~%" (gamma 21))
(format t "gamma(21) = 20! = ~16F asymptotically~%" (realpart (gamma 21)))
; (format t "gamma(101) = 100! = ~16A asymptotically~%" (gamma 101))
;; "{0.real:.15f}{0.imag:+.5f}j".format(gamma(101))

(ignore-errors
(format t "gamma(101) = 100! = ~16A asymptotically~%" (gamma 101))
)

(setf i 10)
(format t "factorial(~D) = ~D! = ~D~%" i i (factorial i))
(format t "facto(~D) = ~D! = ~D~%" i i (facto i))

(setf i 20)
(format t "factorial(~D) = ~D! = ~D~%" i i (factorial i))
(format t "facto(~D) = ~D! = ~D~%" i i (facto i))

(setf i 100)
(format t "factorial(~D) = ~D! = ~D~%" i i (factorial i))
(format t "facto(~D) = ~D! = ~D~%" i i (facto i))

#|
if __name__ == "__main__":
    print "gamma(10) = 9! = %s asymptotically" % gamma(10)
    # print "gamma(101) = 100! = %16s asymptotically" % gamma(101)
    print "gamma(101) = 100! = %16s asymptotically" % "{0.real:.15f}{0.imag:+.5f}j".format(gamma(101))

for i in range(11):
print "%d! = %d" % (i, factorial(i))

    i = 100
    print "factorial(%d) = %d! = %d" % (i, i, factorial(i))
    print "facto(%d) = %d! = %d" % (i, i, facto(i))
|#

#|
Output:
gamma(10) = 9! = #C(362880.16 0.0) asymptotically
gamma(21) = 20! = #C(2.4329015E18 0.0) asymptotically
gamma(21) = 20! = #C(2.4329015E18 0.0) asymptotically
gamma(21) = 20! = 2432901500000000000. asymptotically
gamma(21) = 20! = #C(2.4329015E18 0.0) asymptotically
gamma(21) = 20! = 2432901500000000000. asymptotically
factorial(10) = 10! = 3628800
facto(10) = 10! = 3628800
factorial(20) = 20! = 2432902008176640000
facto(20) = 20! = 2432902008176640000
factorial(100) = 100! = 93326215443944152681699238856266700490715968264381621468
59296389521759999322991560894146397615651828625369792082722375825118521091686400
0000000000000000000000
facto(100) = 100! = 933262154439441526816992388562667004907159682643816214685929
63895217599993229915608941463976156518286253697920827223758251185210916864000000
000000000000000000
|#

GNU CLisp 에서는 네가지 타입의 부동소수점수

short-float, single-float, double-float, long-float

들을 지원한다. clisp 를 대화형 모드로 실행하여 간단한 테스트를 해보자.

명령프롬프트> clisp
i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo
I I I I I I I      8     8   8           8     8     o 8    8
I \ `+' / I      8         8           8     8        8    8
   \ `-+-' /       8         8           8      ooooo   8oooo
    `-__|__-'        8         8           8           8 8
        |            8     o   8           8     o     8 8
------+------       ooooo    8oooooo ooo8ooo   ooooo   8

Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>

Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010

Type :h and hit Enter for context help.

[1]> pi
3.1415926535897932385L0
[2]> (/ 1 3)
1/3
[3]> (+ (/ 1 3) 0.0)
0.33333334
[4]> (coerce (/ 1 3) 'double-float)
0.3333333333333333d0
[5]> (coerce (/ 1 3) 'long-float)
0.33333333333333333334L0
[6]> (defun double-float(x)
(coerce x 'double-float))
DOUBLE-FLOAT
[7]> (double-float (/ 1 3))
0.3333333333333333d0
[8]> (defun long-float(x)
(coerce x 'long-float))
LONG-FLOAT
[9]> (long-float (/ 1 3))
0.33333333333333333334L0
[10]> (quit)
Bye.

#!/usr/bin/env clisp

;; Filename: testLanczos-02.lsp
;;
;; An approximation for the gamma function by using the Lanczos algorithm
;;
;; Execute: clisp testLanczos-02.lsp
;; or
;; Execute: ./testLanczos-02.lsp
;;
;; See: http://en.wikipedia.org/wiki/Lanczos_approximation
;; See:http://www-history.mcs.st-and.ac.uk/Biographies/Lanczos.html
;; See: http://www.thinbasic.com/community/showthread.php?11279-Gamma-function

;; Coefficients used by the GNU Scientific Library
(setf *g* 7)
(setf *p* (list
            0.99999999999980993L0   676.5203681218851L0       -1259.1392167224028L0
          771.32342877765313L0     -176.61502916214059L0         12.507343278686905L0
           -0.13857109526572012L0     9.9843695780195716L-6    1.5056327351493116L-7) )

(defun gamma(z)
    (let ((z (coerce z 'long-float))
          (tt (complex 0.0L0 0.0L0)))
        (if (realp z) (setf z (complex z 0.0L0)))
        ;; Reflection formula
        (if (< (realpart z) 0.5L0)
            (/ pi (sin (* (* pi z) (gamma (- 1L0 z)))))
            (progn
                (setf z (- z 1))
                (setf x (nth 0 *p*))
                (loop for i from 1 below (+ *g* 2) do
                    (setf x (+ x (/ (nth i *p*) (+ z i)))))
                (setf tt (+ z *g* 0.5L0))
                (* (sqrt (* 2L0 pi)) (expt tt (+ z 0.5L0)) (exp (- tt)) x) ))))

(defun factorial(n)
    (let ((k 0))
        (if (< n 2)
            1
            (progn
                (setf k 1)
                (if (evenp n)
                    (loop for i from 0 below (floor (/ n 2)) do
                        (setf k (* k (* (+ i 1) (- n i)))))
                    (progn
                        (loop for i from 0 below (floor (/ n 2)) do
                            (setf k (* k (* (+ i 1) (- n 1 i)))))
                        (setf k (* k n))))
                k))))

(defun facto(n)
    (let ((k 0))
        (if (< n 2)
            1
            (progn
                (setf k 1)
                (loop for i from 2 to n do
                    (setf k (* k i)) )
                k ))))

;; Begin here
(format t "gamma(10) = 9! = ~A asymptotically~%" (gamma 10))

(format t "gamma(21) = 20! = ~16A asymptotically~%" (gamma 21))
(format t "gamma(21) = 20! = ~16G asymptotically~%" (gamma 21))
(format t "gamma(21) = 20! = ~16G asymptotically~%" (realpart (gamma 21)))
(format t "gamma(21) = 20! = ~16F asymptotically~%" (gamma 21))
(format t "gamma(21) = 20! = ~16F asymptotically~%" (realpart (gamma 21)))
; (format t "gamma(101) = 100! = ~16A asymptotically~%" (gamma 101))
;; "{0.real:.15f}{0.imag:+.5f}j".format(gamma(101))

(ignore-errors
(format t "gamma(101) = 100! = ~16A asymptotically~%" (gamma 101))
)

(format t "tgamma(~D) = ~D! = ~D~%" 101 100 (tgamma 101))

(setf i 10)
(format t "factorial(~D) = ~D! = ~D~%" i i (factorial i))
(format t "facto(~D) = ~D! = ~D~%" i i (facto i))

(setf i 20)
(format t "factorial(~D) = ~D! = ~D~%" i i (factorial i))
(format t "facto(~D) = ~D! = ~D~%" i i (facto i))

(setf i 100)
(format t "factorial(~D) = ~D! = ~D~%" i i (factorial i))
(format t "facto(~D) = ~D! = ~D~%" i i (facto i))

#|
Output:
gamma(10) = 9! = #C(362880.0000000007251L0 0.0L0) asymptotically
gamma(21) = 20! = #C(2.4329020081766424835L18 0.0L0) asymptotically
gamma(21) = 20! = #C(2.4329020081766424835L18 0.0L0) asymptotically
gamma(21) = 20! = 2432902008176642483.5 asymptotically
gamma(21) = 20! = #C(2.4329020081766424835L18 0.0L0) asymptotically
gamma(21) = 20! = 2432902008176642484. asymptotically
gamma(101) = 100! = #C(9.332621544393798272L157 0.0L0) asymptotically
tgamma(101) = 100! = 9.332621544394416d157
factorial(10) = 10! = 3628800
facto(10) = 10! = 3628800
factorial(20) = 20! = 2432902008176640000
facto(20) = 20! = 2432902008176640000
factorial(100) = 100! = 93326215443944152681699238856266700490715968264381621468
59296389521759999322991560894146397615651828625369792082722375825118521091686400
0000000000000000000000
facto(100) = 100! = 933262154439441526816992388562667004907159682643816214685929
63895217599993229915608941463976156518286253697920827223758251185210916864000000
000000000000000000
|#

'프로그래밍 > Common Lisp' 카테고리의 다른 글

스트링 벡터에서 스트링 찾기(find) with Common Lisp (0)	2013.09.12
Common Lisp 언어로 역삼각함수, 역쌍곡선함수 값을 구하는 예제 (0)	2013.09.11
Common Lisp 언어로 복소수 계산하기 (0)	2013.09.07
Common Lisp 를 이용한 간단한 수학식 계산하기 (0)	2013.09.07
조립제법(Horner의 방법) 예제 2 for Common Lisp (0)	2013.09.07

Posted by Scripter

,

Common Lisp 언어로 복소수 계산하기

프로그래밍/Common Lisp 2013. 9. 7. 14:45

아래는 GNU CLisp 로 실행한 것인데. Clozure CL 로 실행해도 거의 같은 결과를 얻는다.

명령프롬프트> clisp
i i i i i i i       ooooo    o        ooooooo   ooooo   ooooo
I I I I I I I      8     8   8           8     8     o 8    8
I \ `+' / I      8         8           8     8        8    8
   \ `-+-' /       8         8           8      ooooo   8oooo
    `-__|__-'        8         8           8           8 8
        |            8     o   8           8     o     8 8
------+------       ooooo    8oooooo ooo8ooo   ooooo   8

Welcome to GNU CLISP 2.49 (2010-07-07) <http://clisp.cons.org/>

Copyright (c) Bruno Haible, Michael Stoll 1992, 1993
Copyright (c) Bruno Haible, Marcus Daniels 1994-1997
Copyright (c) Bruno Haible, Pierpaolo Bernardi, Sam Steingold 1998
Copyright (c) Bruno Haible, Sam Steingold 1999-2000
Copyright (c) Sam Steingold, Bruno Haible 2001-2010

Type :h and hit Enter for context help.

[1]> (setf x #c(1 (/ 2.0 3.0))

*** - READ from
       #<INPUT CONCATENATED-STREAM #<INPUT STRING-INPUT-STREAM>
         #<IO TERMINAL-STREAM>>
      : bad syntax for complex number: #C(1 (/ 2.0 3.0))
The following restarts are available:
ABORT          :R1      Abort main loop
Break 1 [2]> (setf z (complex 1 (/ 2.0 3.0)))
#C(1 0.6666667)
Break 1 [2]> (setf y (/ 2.0 3.0))
0.6666667
Break 1 [2]> (setf z (complex 1 y))
#C(1 0.6666667)
Break 1 [2]> z
#C(1 0.6666667)
Break 1 [2]> (setf z (complex 1 (/ 2.0 3)))
#C(1 0.6666667)
Break 1 [2]> (setf z (- (complex 1 (/ 2.0 3))))
#C(-1 -0.6666667)
Break 1 [2]> z
#C(-1 -0.6666667)
Break 1 [2]> (realpart z)
-1
Break 1 [2]> (imagpart z)
-0.6666667
Break 1 [2]> (conjugate z)
#C(-1 0.6666667)
Break 1 [2]> (- z)
#C(1 0.6666667)
Break 1 [2]> (1- z)
#C(-2 -0.6666667)
Break 1 [2]> (1+ z)
#C(0 -0.6666667)
Break 1 [2]> (zerop z)
NIL
Break 1 [2]> (zerop (- z z))
T
Break 1 [2]> (zerop (+ z (- z)))
T
Break 1 [2]> (abs z)
1.2018504
Break 1 [2]> (sqrt z)
#C(0.31768727 -1.0492499)
Break 1 [2]> (zerop (+ z (- z)))
T
Break 1 [2]> (* z (conjuate z))

*** - EVAL: undefined function CONJUATE
The following restarts are available:
USE-VALUE      :R1      Input a value to be used instead of (FDEFINITION 'CONJUA
TE).
RETRY          :R2      Retry
STORE-VALUE    :R3      Input a new value for (FDEFINITION 'CONJUATE).
ABORT          :R4      Abort debug loop
ABORT          :R5      Abort main loop
Break 2 [3]> (* z (conjugate z))
#C(1.4444444 0.0)
Break 2 [3]> (defun distance-from-origin(z)
                          (realpart (sqrt (* z (conjugate z)))))
DISTANCE-FROM-ORIGIN
Break 2 [3]> (distance-from-origin z)
1.2018504
Break 2 [3]> ((distance-from-origin z) (abs z))

*** - EVAL: (DISTANCE-FROM-ORIGIN Z) is not a function name; try using a
      symbol instead
The following restarts are available:
USE-VALUE      :R1      Input a value to be used instead.
ABORT          :R2      Abort debug loop
ABORT          :R3      Abort debug loop
ABORT          :R4      Abort main loop
Break 3 [4]> (= (distance-from-origin z) (abs z))
T
Break 3 [4]> (- (distance-from-origin z) (abs z))
0.0
Break 3 [4]> (= (distance-from-origin z) (sqrt (+ (* (realpart z)
(realpart z)) (* (imagpart z) (imagpart z)))))
T
Break 3 [4]> (- (distance-from-origin z) (sqrt (+ (* (realpart z)
(realpart z)) (* (imagpart z) (imagpart z)))))
0.0
Break 3 [4]> (sin z)
#C(-1.0354936 -0.38748237)
Break 3 [4]> (cos z)
#C(0.66488284 -0.60346806)
Break 3 [4]> (tan z)
#C(-0.56391037 -1.0946053)
Break 3 [4]> (asin z)
#C(-0.8048969 -0.85406184)
Break 3 [4]> (acos z)
#C(2.3756933 0.85406184)
Break 3 [4]> (atan z)
#C(-0.89473265 -0.30594388)
Break 3 [4]> (sinh z)
#C(-0.92357564 -0.9541945)
Break 3 [4]> (cosh z)
#C(1.2126874 0.72670895)
Break 3 [4]> (tanh z)
#C(-0.9072973 -0.2431405)
Break 3 [4]> (asinh z)
#C(-0.9614137 -0.4609276)
Break 3 [4]> (acosh z)
#C(0.8540618 -2.375693)
Break 3 [4]> (atanh z)
#C(-0.5756463 -0.94627345)
Break 3 [4]> (log z)
#C(0.1838624 -2.55359)
Break 3 [4]> (exp z)
#C(0.28911176 -0.22748554)
Break 3 [4]> (log (exp z))
#C(-1.0 -0.6666667)
Break 3 [4]> (exp (log z))
#C(-1.0 -0.6666667)
Break 3 [4]> (expt 2 z)
#C(0.44755954 -0.22291358)
Break 3 [4]> (expt z 2)
#C(0.5555555 1.3333334)
Break 3 [4]> (* z z)
#C(0.5555555 1.3333334)
Break 3 [4]> (quit)
Bye.

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 언어로 역삼각함수, 역쌍곡선함수 값을 구하는 예제 (0)	2013.09.11
감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스 (0)	2013.09.08
Common Lisp 를 이용한 간단한 수학식 계산하기 (0)	2013.09.07
조립제법(Horner의 방법) 예제 2 for Common Lisp (0)	2013.09.07
숫자 맞추기 게임 with Common Lisp (0)	2013.09.07

Posted by Scripter

,

Common Lisp 를 이용한 간단한 수학식 계산하기

프로그래밍/Common Lisp 2013. 9. 7. 13:54

Commonn Lisp 언어는 S-신택스라고 불리우는 구문 즉,

(함수명 파라미터1 파라미터2 ... 파라미터n)

인 형태의 구문을 사용한다. 예를 들어 뺄셈을 할 때에도

(- 2 3 5 7)

라는 구문은 수학식 2 - 3 - 5 - 7 을 계산한 결과를 얻는다.

* CLisp 용 소스 파일: first-sample-2.lsp

#!/usr/bin/env clisp

;; 파일명: first-sample-2.lsp

(defun lg(x):
    (/ (log x) (log 2)) )

(defun log10(x):
    (/ (log x) (log 10)) )

(format t "이 소스는 CLisp 를 이용하여 실행됨!~%")
(format t "----------------~%")
(format t "수학식 계산하기:~%")
(format t "----------------~%")
(format t "pi + e = (+ pi (exp 1)) = ~A~%" (+ pi (exp 1)))
(format t "pi * e = (* pi (exp 1)) = ~A~%" (* pi (exp 1)))
(format t "sqrt(pi) + sqrt(e) = (+ (sqrt pi) (sqrt (exp 1))) = ~A~%" (+ (sqrt pi) (sqrt (exp 1))))
(format t "sqrt(pi + e) = (sqrt (+ pi (exp 1))) = ~A~%" (sqrt (+ pi (exp 1))))
(format t "sqrt(pi) - sqrt(e) = (- (sqrt pi) (sqrt (exp 1))) = ~A~%" (- (sqrt pi) (sqrt (exp 1))))
(format t "sqrt(pi - e) = ~A~%" (sqrt (- pi (exp 1))))
(format t "sin(pi) = (sin pi) = ~A~%" (sin pi))
(format t "cos(pi) = (cos pi = ~A~%" (cos pi))
(format t "tan(pi) = (tan pi) = ~A~%" (tan pi))
(format t "ln(e) = (log (exp 1)) = ~A~%" (log (exp 1)))
(format t "(lg 2) = (log2 2) = ~A~%" (lg 2))
(format t "(log10 (/ 1.0 10)) = ~A~%" (log10 (/ 1.0 10)))
(format t "pow(2, 10) = (expt 2 10) = ~A~%" (expt 2 10))
(format t "pow(2, 100) = (expt 2 10) = ~A~%" (expt 2 100))
(format t "pow(2, 1000) = (expt 2 1000) = ~A~%" (expt 2 1000))
(format t "len(str(pow(2, 1000))) = ~A = ~A~%" "(length (format nil \"~A\" (expt 2 100000)))" (length (format nil "~A" (expt 2 100000))))

* 실행 결과:

이 소스는 CLisp 를 이용하여 실행됨!
----------------
수학식 계산하기:
----------------
pi + e = (+ pi (exp 1)) = 5.8598742
pi * e = (* pi (exp 1)) = 8.539734
sqrt(pi) + sqrt(e) = (+ (sqrt pi) (sqrt (exp 1))) = 3.421175
sqrt(pi + e) = (sqrt (+ pi (exp 1))) = 2.4207177
sqrt(pi) - sqrt(e) = (- (sqrt pi) (sqrt (exp 1))) = 0.123732634
sqrt(pi - e) = 0.6506235
sin(pi) = (sin pi) = -5.0165576136843360246L-20
cos(pi) = (cos pi = -1.0L0
tan(pi) = (tan pi) = 5.0165576136843360246L-20
ln(e) = (log (exp 1)) = 0.99999994
(lg 2) = (log2 2) = 1.0
(log10 (/ 1.0 10)) = -1.0
pow(2, 10) = (expt 2 10) = 1024
pow(2, 100) = (expt 2 10) = 1267650600228229401496703205376
pow(2, 1000) = (expt 2 1000) = 1071508607186267320948425049060001810561404811705
53360744375038837035105112493612249319837881569585812759467291755314682518714528
56923140435984577574698574803934567774824230985421074605062371141877954182153046
47498358194126739876755916554394607706291457119647768654216766042983165262438683
7205668069376
len(str(pow(2, 1000))) = (length (format nil "~A" (expt 2 100000))) = 30103

'프로그래밍 > Common Lisp' 카테고리의 다른 글

감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스 (0)	2013.09.08
Common Lisp 언어로 복소수 계산하기 (0)	2013.09.07
조립제법(Horner의 방법) 예제 2 for Common Lisp (0)	2013.09.07
숫자 맞추기 게임 with Common Lisp (0)	2013.09.07
스트링 리스트에서 스트링 찾기(find) with Common Lisp (0)	2013.09.06

Posted by Scripter

,

조립제법(Horner의 방법) 예제 2 for Common Lisp

프로그래밍/Common Lisp 2013. 9. 7. 00:33

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

p(x) = (ax - b)q(x) + r

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

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

아래의 소스파일은 이전에 작성했던 파일 testSyntheticDivision.lsp 를 수정한 것이다.

;; Filename: testSyntheticDivision2.lsp
;;
;; Purpose: Find the quotient and remainder when some polynomial is
;; divided by a monic polynomial of the first degree.
;;
;; Execute: clisp testSyntheticDivision2.lsp 5 -4 7 8 6 8
;;
;; Date: 2013. 9. 7.
;; 사용법 표시
(defun printUsage()
(format t "사용법: clisp testSyntheticDivision2.lsp [제식의 계수] [피제식의 계수들]~%")
(format t "조립제법(synthetic method)에 의한 다항식 나눗셈 결과를 보여준다.~%")
)
;; 부동소수점수의 표현이 .0 으로 끝나는 경우 이를 잘라낸다.
;; 전체 문자열 표시 너비는 매개변수 width 로 전달받아 처리한다.
(defun simplify(v &optional width)
(let* ((tt "")
(slen 0))
(setf tt (format nil "~A" v))
(setf slen (length tt))
(if (and (>= slen 2) (string= (substring tt (- slen 2) slen) ".0"))
(setf tt (substring tt 0 (- slen 2))) )
(setf slen (length tt))
(if width
(if (< slen width)
(setf tt (concatenate 'string (make-string (- width slen) :initial-element #\Space) tt)) ))
tt
)
)
;; "/수" 표시하기
;; 부동소수점수의 표현이 .0 으로 끝나는 경우 이를 잘라낸다.
;; 전체 문자열 표시 너비는 매개변수 width 로 전달받아 처리한다.
(defun simplifyReciprocal(v &optional width)
(let* ((tt "")
(tlen 0))
(setf tt (format nil "/~A" v))
(setf tlen (length tt))
(if (and (>= tlen 2) (string= (substring tt (- tlen 2) tlen) ".0"))
(setf tt (substring tt 0 (- tlen 2))) )
(setf tlen (length tt))
(if width
(if (< tlen width)
(setf tt (concatenate 'string (make-string (- width tlen) :initial-element #\Space) tt)) ))
tt
)
)
;; 다항식을 내림차순의 스트링 표현으로 반환
(defun toPolyString(c)
(let* ((ttt "")
(sc0 "")
(sc "")
(k 0))
(setf ttt "")
(setf sc0 (simplify (nth 0 c) nil ))
(if (> (length c) 2)
(cond
((string= sc0 "1") (setf ttt (concatenate 'string ttt (format nil "x^~D" (- (length c) 1)))))
((string= sc0 "-1") (setf ttt (concatenate 'string ttt (format nil "-x^~D" (- (length c) 1)))))
(t (setf ttt (concatenate 'string ttt sc0 (format nil " x^~D" (- (length c) 1)))))
)
)
(if (= (length c) 2)
(cond
((string= sc0 "1") (setf ttt (concatenate 'string ttt "x")))
((string= sc0 "-1") (setf ttt (concatenate 'string ttt "-x")))
(t (setf ttt (concatenate 'string ttt sc0 " x")))
)
)
(if (= (length c) 1)
(setf ttt (concatenate 'string ttt sc0))
)
(loop for i from 1 below (length c) do
(setf k (- (length c) 1 i))
(setf sc (simplify (nth i c) nil))
(if (> k 1) (progn
(cond
((> (nth i c) 0.0)
(if (string= sc "1")
(setf ttt (concatenate 'string ttt " + " (format nil "x^~D" k)))
(setf ttt (concatenate 'string ttt " + " sc (format nil " x^~D" k)))
) )
((< (nth i c) 0.0)
(if (string= sc "-1")
(setf ttt (concatenate 'string ttt " - " (format nil "x^~D" k)))
(setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c)) nil) (format nil " x^~D" k)))
) )
)
)
)
(if (= k 1)
(cond
((> (nth i c) 0.0)
(if (string= sc "1")
(setf ttt (concatenate 'string ttt " + " "x"))
(setf ttt (concatenate 'string ttt " + " sc " x"))
) )
((< (nth i c) 0.0)
(if (string= sc "-1")
(setf ttt (concatenate 'string ttt " - " "x"))
(setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c))) " x"))
) )
)
)
(if (= k 0)
(cond
( (> (nth i c) 0.0) (setf ttt (concatenate 'string ttt " + " sc)) )
( (< (nth i c) 0.0) (setf ttt (concatenate 'string ttt " - " (simplify (abs (nth i c))) )) )
)
)
)
ttt
)
)
;; 다항식 나눗셈 결과를
;; (피제식) = (제식)(몫) + (나머지)
;; 형태로 출력
(defun printDivisionResult(a c d b)
(let* ((strLine ""))
(setf strLine (concatenate 'string " " (toPolyString c)))
(format t "~A~%" strLine)
(setf strLine (concatenate 'string " = ( " (toPolyString (list (nth 0 a) (- (nth 1 a)))) " )"))
(setf tmp (make-list (- (length b) 1) :initial-element 0.0))
(loop for i from 0 below (length tmp) do
(setf (nth i tmp) (nth i b)) )
(setf strLine (concatenate 'string strLine "( " (toPolyString tmp) " )"))
(setf r (nth (- (length d) 1) d))
(cond
((> r 0.0) (setf strLine (concatenate 'string strLine " + " (simplify r nil) )))
((< r 0.0) (setf strLine (concatenate 'string strLine " - " (simplify (abs r) nil) )))
)
(format t "~A~%" strLine)
)
)
;; 조립제법 계산표 출력 함수
(defun printSyntheticTable(a c s d q)
(let* ((strLine ""))
(setf strLine " | ")
(setf strLine (concatenate 'string strLine (simplify (nth 0 c) 10) ))
(loop for i from 1 below (length c) do
(setf strLine (concatenate 'string strLine " " (simplify (nth i c) 10) )))
(format t "~A~%" strLine)
(setf strLine (concatenate 'string (simplify (nth 1 a) 8) " |"))
(setf strLine (concatenate 'string strLine " "))
(setf strLine (concatenate 'string strLine (simplify (nth 1 s) 10)))
(loop for i from 2 below (length s) do
(setf strLine (concatenate 'string strLine " " (simplify (nth i s) 10) )))
(format t "~A~%" strLine)
(setf strLine " |")
(loop for i from 0 below (length q) do
(setf strLine (concatenate 'string strLine "------------")))
(format t "~A~%" strLine)
(setf strLine " | ")
(setf strLine (concatenate 'string strLine (simplify (nth 0 d) 10)))
(loop for i from 1 below (length d) do
(setf strLine (concatenate 'string strLine " " (simplify (nth i d) 10))))
(format t "~A~%" strLine)
(setf strLine (concatenate 'string (simplifyReciprocal (nth 0 a) 8) " | "))
(setf strLine (concatenate 'string strLine (simplify (nth 0 q) 10)))
(loop for i from 1 below (1- (length q)) do
(setf strLine (concatenate 'string strLine " " (simplify (nth i q) 10) )))
(format t "~A~%" strLine)
)
)
;; 실행 시작 지점
(if (< (length ext:*args*) 3) (progn
(printUsage)
(quit) ))
;; ----------------------------------------------------
;; 피제식은 c_0 x^n + c_1 x^(n -1) + ... + c_n
;; 제식은 a x - b
(setf a (list (read-from-string (nth 0 ext:*args*)) (- (read-from-string (nth 1 ext:*args*)))) )
(setf c (make-list (- (length ext:*args*) 2) :initial-element 0.0) )
(setf s (make-list (- (length ext:*args*) 2) :initial-element 0.0) )
(setf d (make-list (- (length ext:*args*) 2) :initial-element 0.0) )
(setf b (make-list (- (length ext:*args*) 2) :initial-element 0.0) )
(loop for i from 0 below (length c) do
(setf (nth i c) (read-from-string (nth (+ i 2) ext:*args*))))
;; ----------------------------------------------------
;; 조립제법의 주요 부분
(setf (nth 0 s) 0.0)
(setf (nth 0 d) (nth 0 c))
(setf (nth 0 b) (+ 0.0 (/ (nth 0 c) (nth 0 a))))
(loop for i from 1 below (length c) do
(setf (nth i s) (* (nth (- i 1) b) (nth 1 a)))
(setf (nth i d) (+ (nth i c) (nth i s)))
(setf (nth i b) (+ 0.0 (/ (nth i d) (nth 0 a)))) )
;; ----------------------------------------------------
;; 몫의 계수와 나머지를 출력한다.
(format t "몫의 계수는 ")
(loop for i from 0 below (- (length b) 2) do
(format t (concatenate 'string (simplify (nth i b)) ", ")))
(format t (concatenate 'string (simplify (nth (- (length b) 2) b)) " "))
(format t (concatenate 'string "이고, 나머지는 " (simplify (nth (- (length d) 1) d)) " 이다.~%"))
(terpri)
;; ----------------------------------------------------
;; 조립제법 표를 출력한다.
(printSyntheticTable a c s d b)
(terpri)
;; ----------------------------------------------------
;; (피제식) = (제식) x (몫) + (나머지)
(printDivisionResult a c d b)
(format t "~%")

실행> clisp testSyntheticDivision2.lsp 5 -4 7 8 6 8

몫의 계수는 1.4, 2.72, 3.3760002 이고, 나머지는 21.504002 이다. | 7 8 6 8 4 | 5.6 10.88 13.504001 |------------------------------------------------ | 7 13.6 16.880001 21.504002 /5 | 1.4 2.72 3.3760002 7 x^3 + 8 x^2 + 6 x + 8 = ( 5 x - 4 )( 1.4 x^2 + 2.72 x + 3.3760002 ) + 21.504002

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 언어로 복소수 계산하기 (0)	2013.09.07
Common Lisp 를 이용한 간단한 수학식 계산하기 (0)	2013.09.07
숫자 맞추기 게임 with Common Lisp (0)	2013.09.07
스트링 리스트에서 스트링 찾기(find) with Common Lisp (0)	2013.09.06
스트링 배열 정렬(sorting)하기 with Common Lisp (0)	2013.09.06

Posted by Scripter

,

숫자 맞추기 게임 with Common Lisp

프로그래밍/Common Lisp 2013. 9. 7. 00:11

Common Lisp 언어로 숫자 맞추기 게임을 작성해 보았다.

아래 소스의 18째 줄 (setf guess (parse-integer sbuf)) 는 스트링을 정수로 변환하는 과정이다.

소스 파일명: guessNumber01.lsp

#!/usr/bin/env clisp
;; Filename: guessNumber01.lsp
;; Purpose: Interatice game guessing a given number.
;; (if condition
;; (........) ; when condition is true
;; (........) ; when condition is flase
;; )
;; Execute: clisp guessNumber01.lsp
;; ......
;; Date: 2013. 9. 7.
(defun doGuessing(num)
(let* ((sbuf "")
(guess 0))
(format t "Enter your guess:~%")
(setf sbuf (read-line))
(setf guess (parse-integer sbuf))
(if (= guess num)
(progn
(format t "You win!~%")
(quit)
)
)
;; we won't get here if (= guessnum)
(if (< guess num)
(progn
(format t "Too low!~%")
(doGuessing num)
)
(progn
(format t "Too high!~%")
(doGuessing num)
)
)
)
)
(doGuessing 123)

실행> clisp guessNumber01.lsp
Enter your guess:
111
Too low!
Enter your guess:
222
Too high!
Enter your guess:
123
You win!

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 를 이용한 간단한 수학식 계산하기 (0)	2013.09.07
조립제법(Horner의 방법) 예제 2 for Common Lisp (0)	2013.09.07
스트링 리스트에서 스트링 찾기(find) with Common Lisp (0)	2013.09.06
스트링 배열 정렬(sorting)하기 with Common Lisp (0)	2013.09.06
Pollard's rho method 소개: 정수의 인수분해(factorizing integers) with Common Lisp (0)	2013.09.06

Posted by Scripter

,

스트링 리스트에서 스트링 찾기(find) with Common Lisp

프로그래밍/Common Lisp 2013. 9. 6. 23:41

[파일명: testStringFindInList.lsp]------------------------------------------------
(defun my-find(arr s)
    (let ((k -1)
          (r -1))
        (loop for i from 0 below (length arr) do
            (setf k (search s (nth i arr)))
            (if k (progn (setf r i) (return i)))
        )
        r
    )
)

(defun printList(arr)
    (format t "[")
    (loop for i from 0 below (1- (length arr)) do
        (format t "~A, " (nth i arr))
    )
    (if (plusp (length arr))
        (format t "~A" (nth (1- (length arr)) arr))
    )
    (format t "]~%")
)

(setf words (list "하나" "둘" "셋" "넷" "다섯" "여섯"))

(format t "list: ")
(printList words)
(setf w (my-find words "셋"))
(if (>= w 0)
    (progn
        (format t "발견! ~%")
        (format t "Next word of 셋 in list: ~A~%" (nth (1+ w) words))
    )
)

(format t "Sorting...~%")
(sort words #'string<)

(format t "list: ")
(printList words)
(setf w (my-find words "셋"))
(if (>= w 0)
    (progn
        (format t "발견! ~%")
        (format t "Next word of 셋 in list: ~A~%" (nth (1+ w) words))
    )
)
------------------------------------------------

실행> clisp testStringFindInList.lsp
list: [하나, 둘, 셋, 넷, 다섯, 여섯]
발견! Next word of 셋 in list: 넷
Sorting...
list: [넷, 다섯, 둘, 셋, 여섯, 하나]
발견! Next word of 셋 in list: 여섯

'프로그래밍 > Common Lisp' 카테고리의 다른 글

조립제법(Horner의 방법) 예제 2 for Common Lisp (0)	2013.09.07
숫자 맞추기 게임 with Common Lisp (0)	2013.09.07
스트링 배열 정렬(sorting)하기 with Common Lisp (0)	2013.09.06
Pollard's rho method 소개: 정수의 인수분해(factorizing integers) with Common Lisp (0)	2013.09.06
손으로 계산하는 긴자리 곱셈표 만들기 with Common Lisp (0)	2013.09.06

Posted by Scripter

,

Script Programming(스크립트 프로그래밍)

'프로그래밍/Common Lisp'에 해당되는 글 28건

(Common Lisp 언어로 구현해 보는) 십진법의 신비: 숫자 계산 피라미드 세 가지

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 언어로 한 번의 floor 함수 호출로 몫과 나머지 구하기

'프로그래밍 > Common Lisp' 카테고리의 다른 글

스트링 벡터에서 스트링 찾기(find) with Common Lisp

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 언어로 역삼각함수, 역쌍곡선함수 값을 구하는 예제

'프로그래밍 > Common Lisp' 카테고리의 다른 글

감마함수(gamma function)의 값을 (유효수자 15자리 까지 정밀하게) 계산하는 Common Lisp 언어 소스

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 언어로 복소수 계산하기

'프로그래밍 > Common Lisp' 카테고리의 다른 글

Common Lisp 를 이용한 간단한 수학식 계산하기

'프로그래밍 > Common Lisp' 카테고리의 다른 글

조립제법(Horner의 방법) 예제 2 for Common Lisp

'프로그래밍 > Common Lisp' 카테고리의 다른 글

숫자 맞추기 게임 with Common Lisp

'프로그래밍 > Common Lisp' 카테고리의 다른 글

스트링 리스트에서 스트링 찾기(find) with Common Lisp

'프로그래밍 > Common Lisp' 카테고리의 다른 글

카테고리

태그목록

최근에 올라온 글

최근에 달린 댓글

최근에 받은 트랙백

글 보관함

달력

링크

티스토리툴바