aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

tasks a-s

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 23:57:08 -07:00
parent 47bf37c096
commit b83f433714
12433 changed files with 156208 additions and 123 deletions
Download patch file Download diff file Expand all files Collapse all files

94
Task/Numeric-error-propagation/PicoLisp/numeric-error-propagation-1.l Normal file
View file

@ -0,0 +1,94 @@
(scl 12)
(load "@lib/math.l")
# Overload arithmetic operators +, -, *, / and **
(redef + @
(let R (next)
(while (args)
(let N (next)
(setq R
(if2 (atom R) (atom N)
(+ R N) # c + c
(cons (+ R (car N)) (cdr N)) # c + a
(cons (+ (car R) N) (cdr R)) # a + c
(cons # a + b
(+ (car R) (car N))
(+ (cdr R) (cdr N)) ) ) ) ) )
R ) )
(redef - @
(let R (next)
(ifn (args)
(- R)
(while (args)
(let N (next)
(setq R
(if2 (atom R) (atom N)
(- R N) # c - c
(cons (- R (car N)) (cdr N)) # c - a
(cons (- (car R) N) (cdr R)) # a - c
(cons # a - b
(- (car R) (car N))
(+ (cdr R) (cdr N)) ) ) ) ) )
R ) ) )
(redef * @
(let R (next)
(while (args)
(let N (next)
(setq R
(if2 (atom R) (atom N)
(* R N) # c * c
(cons # c * a
(*/ R (car N) 1.0)
(mul2div2 (cdr N) R 1.0) )
(cons # a * c
(*/ (car R) N 1.0)
(mul2div2 (cdr R) N 1.0) )
(uncMul (*/ (car R) (car N) 1.0) R N) ) ) ) ) # a * b
R ) )
(redef / @
(let R (next)
(while (args)
(let N (next)
(setq R
(if2 (atom R) (atom N)
(/ R N) # c / c
(cons # c / a
(*/ R 1.0 (car N))
(mul2div2 (cdr N) R 1.0) )
(cons # a / c
(*/ (car R) 1.0 N)
(mul2div2 (cdr R) N 1.0) )
(uncMul (*/ (car R) 1.0 (car N)) R N) ) ) ) ) # a / b
R ) )
(redef ** (A C)
(if (atom A)
(** A C)
(let F (pow (car A) C)
(cons F
(mul2div2 (cdr A) (*/ F C (car A)) 1.0) ) ) ) )
# Utilities
(de mul2div2 (A B C)
(*/ A B B (* C C)) )
(de uncMul (F R N)
(cons F
(mul2div2
(+
(mul2div2 (cdr R) 1.0 (car R))
(mul2div2 (cdr N) 1.0 (car N)) )
F
1.0 ) ) )
# I/O conversion
(de unc (N U)
(if U
(cons N (*/ U U 1.0))
(pack
(round (car N) 10)
" ± "
(round (sqrt (* 1.0 (cdr N))) 8) ) ) )

12
Task/Numeric-error-propagation/PicoLisp/numeric-error-propagation-2.l Normal file
View file

@ -0,0 +1,12 @@
(de distance (X1 Y1 X2 Y2)
(**
(+ (** (- X1 X2) 2.0) (** (- Y1 Y2) 2.0))
0.5 ) )
(prinl "Distance: "
(unc
(distance
(unc 100. 1.1)
(unc 50. 1.2)
(unc 200. 2.2)
(unc 100. 2.3) ) ) )