#----------------------------- # PicoLisp has only a single numeric type, the bignum. # The function 'format' returns NIL if the argument is # not a legal number : (format "12345") -> 12345 # is a number : (format "123a5") -> NIL # is not #----------------------------- : (format "1234.5678") -> 1235 : (format "1234,5678" 2 ",") -> 123457 : (format "-1,234.5" 2 "." ",") -> -123450 #----------------------------- |
# PicoLisp has no real floating point numbers # Only scaled (fixpoint) integers #----------------------------- : (= (format "1234.5678" 2) (format "1234.572" 2)) -> T #----------------------------- |
#----------------------------- : (format "1234.5678") -> 1235 : (format "1234.5678" 2) -> 123457 : (scl 3) -> 3 : (setq A 0.255) -> 255 : (prinl "Unrounded: " (format A *Scl) "^JRounded: " (round A 2)) Unrounded: 0.255 Rounded: 0.26 -> "0.26" #----------------------------- : (scl 1) -> 1 : (let Fmt (7 7 7 7) (tab Fmt "number" "int" "floor" "ceil") (for N (3.3 3.5 3.7 -3.3) (tab Fmt (format N *Scl) (format (* 1.0 (/ N 1.0)) *Scl) (format (* 1.0 (*/ (- N 0.5) 1.0)) *Scl) (format (* 1.0 (*/ (+ N 0.5) 1.0)) *Scl) ) ) ) number int floor ceil 3.3 3.0 3.0 4.0 3.5 3.0 3.0 4.0 3.7 3.0 3.0 4.0 -3.3 -3.0 -4.0 -3.0 -> NIL #----------------------------- |
#----------------------------- : (bin 54) -> "110110" : (bin "110110") -> 54 #----------------------------- |
#----------------------------- : (prin "Infancy is: ") (for N 3 (printsp (dec N))) (prinl) Infancy is: 0 1 2 #----------------------------- : (prin "Toddling is: ") (println 3 4) Toddling is: 3 4 #----------------------------- : (prin "Childhood is: ") (apply println (range 5 12)) Childhood is: 5 6 7 8 9 10 11 12 # or : (prin "Childhood is: ") (mapc printsp (range 5 12)) (prinl) Childhood is: 5 6 7 8 9 10 11 12 # or : (prin "Childhood is: ") (for (N 5 (>= 12 N) (inc N)) (printsp N)) (prinl) #----------------------------- |
#----------------------------- : (de roman (N) (pack (make (mapc '((C D) (while (>= N D) (dec 'N D) (link C) ) ) '(M CM D CD C XC L XL X IX V IV I) (1000 900 500 400 100 90 50 40 10 9 5 4 1) ) ) ) ) -> roman : (prinl "Roman for fifteen is " (roman 15)) Roman for fifteen is XV -> "XV" : (de arabic (R) (let N 0 (for (L (chop (uppc R)) L) (find '((C D) (when (head C L) (cut (length C) 'L) (inc 'N D) ) ) '`(mapcar chop '(M CM D CD C XC L XL X IX V IV I)) (1000 900 500 400 100 90 50 40 10 9 5 4 1) ) ) N ) ) -> arabic : (prinl "Converted back, " (roman 15) " is " (arabic (roman 15))) Converted back, XV is 15 -> 15 #----------------------------- |
#----------------------------- : (rand) -> 643875838651014379 #----------------------------- : (rand 1 6) # Dice -> 3 #----------------------------- : (rand 900000 999999) -> 989901 #----------------------------- : (rand T) # Boolean -> NIL : (rand T) -> T #----------------------------- : (setq Password (pack (head 8 (by '(NIL (rand)) sort (conc (chop "!@$%\^&*") (mapcar char (conc (range `(char "A") `(char "Z")) (range `(char "a") `(char "z")) (range `(char "0") `(char "9")) ) ) ) ) ) ) ) #----------------------------- |
#----------------------------- : (seed 42) -> 62419389940 : (seed "Hello world") -> -967786026117696633 : (seed (time)) -> -54340987292621 #----------------------------- |
#----------------------------- : (in "/dev/urandom" (rd 12)) -> 50416291644794614409246112035 #----------------------------- |
#----------------------------- (load "@lib/math.l") (de rand2 () (rand `(inc -1.0) `(dec 1.0)) ) (de gaussianRand () (use (U1 U2 W) (while (>= (setq W (+ (*/ (setq U1 (rand2)) U1 1.0) (*/ (setq U2 (rand2)) U2 1.0) ) ) 1.0 ) ) (setq W (sqrt (*/ 1.0 -2.0 (log W) W))) (*/ U2 W 1.0) ) ) (prinl "You have been hired at $" (round (+ 25.0 (* 2 (gaussianRand))) 2) ) #----------------------------- |
#----------------------------- (load "@lib/math.l") (de deg2rad (Deg) (*/ Deg pi 180.0) ) (de rad2deg (Rad) (*/ Rad 180.0 pi) ) #----------------------------- |
#----------------------------- (load "@lib/math.l") : (format (cos 0.333333) *Scl) -> "0.944957" : (format (acos 0.944957) *Scl) -> "0.333333" : (format (tan pi/2) *Scl) -> "3060023.306953" #----------------------------- |
#----------------------------- (load "@lib/math.l") : (format (log 10.0) *Scl) -> "2.302585" (de logBase(Base Val) (*/ (log Val) 1.0 (log Base)) ) : (format (logBase 10.0 10000.0) *Scl) -> "4.000000" #----------------------------- |
#----------------------------- (de mmult (Mat1 Mat2) (unless (= (length Mat1) (length (car Mat2))) (quit "IndexError: matrices don't match") ) (mapcar '((Row) (apply mapcar Mat2 '(@ (apply + (mapcar * Row (rest)))) ) ) Mat1 ) ) #----------------------------- : (mmult '((3 2 3) (5 9 8)) '((4 7) (9 3) (8 8)) ) -> ((54 51) (165 126)) #----------------------------- |
# PicoLisp doesn't have a complex library, but a set of # functions for complex numbers can be easily written #----------------------------- (load "@lib/math.l") (de addComplex (A B) (cons (+ (car A) (car B)) # Real (+ (cdr A) (cdr B)) ) ) # Imag (de mulComplex (A B) (cons (- (*/ (car A) (car B) 1.0) (*/ (cdr A) (cdr B) 1.0) ) (+ (*/ (car A) (cdr B) 1.0) (*/ (cdr A) (car B) 1.0) ) ) ) (de invComplex (A) (let Denom (+ (*/ (car A) (car A) 1.0) (*/ (cdr A) (cdr A) 1.0) ) (cons (*/ (car A) 1.0 Denom) (- (*/ (cdr A) 1.0 Denom)) ) ) ) (de negComplex (A) (cons (- (car A)) (- (cdr A))) ) (de sqrtComplex (A) (let (R (sqrt (+ (* (car A) (car A)) (* (cdr A) (cdr A)))) Y (sqrt (* (- R (car A)) 0.5)) X (*/ (cdr A) 0.5 Y) ) (cons # Return both results (cons X Y) (cons (- X) (- Y)) ) ) ) (de fmtComplex (A) (pack (round (car A) (dec *Scl)) (and (gt0 (cdr A)) "+") (round (cdr A) (dec *Scl)) "i" ) ) #----------------------------- : (let (A (3.0 . 5.0) B (2.0 . -2.0)) (prinl "c = " (fmtComplex (mulComplex A B))) ) c = 16.00000+4.00000i #----------------------------- : (let D (3.0 . 4.0) (prinl "sqrt(" (fmtComplex D) ") = " (fmtComplex (car (sqrtComplex D)))) ) sqrt(3.00000+4.00000i) = 2.00000+1.00000i #----------------------------- |
#----------------------------- (prin "Gimme a number in decimal, octal, or hex: ") (let Num (in NIL (clip (line))) (setq Num (if2 (= "0" (car Num)) (= "x" (cadr Num)) (hex (cddr Num)) (oct (cdr Num)) NIL (format Num) ) ) (prinl Num " " (hex Num) " " (oct Num)) ) #----------------------------- (prin "Enter file permission in octal: ") (let Permissions (oct (in NIL (clip (line)))) (prinl "The decimal value is " Permissions) ) #----------------------------- |
#----------------------------- : (let Cnt -1740525205 (prinl "Your web page received " (format Cnt 0 "." ",") " accesses last month." ) ) Your web page received -1,740,525,205 accesses last month. #----------------------------- |
#----------------------------- (prinl "It took " Time " hour" (unless (= 1 Time) "s")) (prinl Time " hour" (unless (= 1 Time) "s") (if (= 1 Time) " is" " are") " enough." ) (prinl "It took " Time " centur" (if (= 1 Time) "y" "ies")) #----------------------------- (de nounPlural (Str) (let (S (chop Str) @A) (cond ((find tail '((s s) (p h) (s h) (c h) (z)) (circ S)) (pack Str "es") ) ((tail '(f f) S) (pack S "s")) ((match '(@A f) S) (pack @A "ves")) ((tail '(e y) S) (pack S "s")) ((match '(@A y) S) (pack @A "ies")) ((match '(@A i x) S) (pack @A "ices")) ((or (tail '(s) S) (tail '(x) S)) (pack S "es") ) (T (pack S "s")) ) ) ) #----------------------------- (for S (quote fish fly ox species genus phylum cherub radius jockey index matrix mythos phenomenon formula ) (prinl "One " S ", two " (nounPlural S) ".") ) #----------------------------- |
#----------------------------- # download the following standalone program #!/usr/bin/picolisp /usr/lib/picolisp/lib.l (load "@lib/misc.l") (de factor (N) (make (let (D 2 L (1 2 2 . (4 2 4 2 4 6 2 6 .)) M (sqrt N)) (while (>= M D) (if (=0 (% N D)) (setq M (sqrt (setq N (/ N (link D))))) (inc 'D (pop 'L)) ) ) (link N) ) ) ) (while (opt) (let? N (format @) (let Factors (factor N) (tab (-11 1 -60) N " " (ifn (cdr Factors) "PRIME" (glue " " (mapcar '((L) (if (cdr L) (pack (car L) "**" (length L)) (car L) ) ) (by prog group Factors) ) ) ) ) ) ) ) (bye) #----------------------------- $ ./bigfact 17 60 125 239322000000000000000000 17 PRIME 60 2**2 3 5 125 5**3 239322000000000000000000 2**19 3 5**18 39887 #----------------------------- |