/usr/share/axiom-20170501/src/algebra/NUMFMT.spad is in axiom-source 20170501-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | )abbrev package NUMFMT NumberFormats
++ SMW March 88
++ Description:
++ NumberFormats provides function to format and read arabic and
++ roman numbers, to convert numbers to strings and to read
++ floating-point numbers.
NumberFormats() : SIG == CODE where
PI ==> PositiveInteger
I ==> Integer
C ==> Character
F ==> Float
S ==> String
V ==> PrimitiveArray
SIG ==> with
FormatArabic : PI -> S
++ FormatArabic(n) forms an Arabic numeral
++ string from an integer n.
ScanArabic : S -> PI
++ ScanArabic(s) forms an integer from an Arabic numeral string s.
FormatRoman : PI -> S
++ FormatRoman(n) forms a Roman numeral string from an integer n.
ScanRoman : S -> PI
++ ScanRoman(s) forms an integer from a Roman numeral string s.
ScanFloatIgnoreSpaces : S -> F
++ ScanFloatIgnoreSpaces(s) forms a floating point number from
++ the string s ignoring any spaces. Error is generated if the
++ string is not recognised as a floating point number.
ScanFloatIgnoreSpacesIfCan : S -> Union(F, "failed")
++ ScanFloatIgnoreSpacesIfCan(s) tries to form a floating point
++ number from the string s ignoring any spaces.
CODE ==> add
import SExpression
import Symbol
replaceD: C -> C
replaced: C -> C
contract: S -> S
check: S ->Boolean
replaceD c ==
if c = char "D" then char "E" else c
replaced c ==
if c = char "d" then char "E" else c
contract s ==
s:= map(replaceD,s)
s:= map(replaced,s)
ls:List S := split(s,char " ")$String
s:= concat ls
check s ==
NUMBERP(READ_-FROM_-STRING(s)$Lisp)$Lisp and
-- if there is an "E" then there must be a "."
-- this is not caught by code above
-- also if the exponent is v.big the above returns false
not (any?((c1:C):Boolean +-> c1=char "E",s)
and not any?((c2:C):Boolean +-> c2=char ".",s) )
sexfloat:SExpression:=convert(coerce("Float")@Symbol)$SExpression
ScanFloatIgnoreSpaces s ==
s := contract s
not check s => error "Non-numeric value"
sex := interpret(ncParseFromString(s)$Lisp)$Lisp
sCheck := car(car(sex))
if (sCheck=sexfloat) = true then
f := (cdr cdr sex) pretend Float
else
if integer?(cdr sex) = true then
f := (cdr sex) pretend Integer
f::F
else
error "Non-numeric value"
ScanFloatIgnoreSpacesIfCan s ==
s := contract s
not check s => "failed"
sex := interpret(ncParseFromString(s)$Lisp)$Lisp
sCheck := car(car(sex))
if (sCheck=sexfloat) = true then
f := (cdr cdr sex) pretend Float
else
if integer?(cdr sex) = true then
f := (cdr sex) pretend Integer
f::F
else
"failed"
units:V S :=
construct ["","I","II","III","IV","V","VI","VII","VIII","IX"]
tens :V S :=
construct ["","X","XX","XXX","XL","L","LX","LXX","LXXX","XC"]
hunds:V S :=
construct ["","C","CC","CCC","CD","D","DC","DCC","DCCC","CM"]
umin := minIndex units
tmin := minIndex tens
hmin := minIndex hunds
romval:V I := new(256, -1)
romval ord char(" ")$C := 0
romval ord char("I")$C := 1
romval ord char("V")$C := 5
romval ord char("X")$C := 10
romval ord char("L")$C := 50
romval ord char("C")$C := 100
romval ord char("D")$C := 500
romval ord char("M")$C := 1000
thou:C := char "M"
plen:C := char "("
pren:C := char ")"
ichar:C := char "I"
FormatArabic n == PRINC_-TO_-STRING(n)$Lisp
ScanArabic s == PARSE_-INTEGER(s)$Lisp
FormatRoman pn ==
n := pn::Integer
-- Units
d := (n rem 10) + umin
n := n quo 10
s := units.d
zero? n => s
-- Tens
d := (n rem 10) + tmin
n := n quo 10
s := concat(tens.d, s)
zero? n => s
-- Hundreds
d := (n rem 10) + hmin
n := n quo 10
s := concat(hunds.d, s)
zero? n => s
-- Thousands
d := n rem 10
n := n quo 10
s := concat(new(d::NonNegativeInteger, thou), s)
zero? n => s
-- Ten thousand and higher
for i in 2.. while not zero? n repeat
-- Coefficient of 10**(i+2)
d := n rem 10
n := n quo 10
zero? d => "iterate"
m0:String := concat(new(i,plen),concat("I",new(i,pren)))
mm := concat([m0 for j in 1..d]$List(String))
-- strictly speaking the blank is gratuitous
if #s > 0 then s := concat(" ", s)
s := concat(mm, s)
s
-- ScanRoman
--
-- The Algorithm:
-- Read number from right to left. When the current
-- numeral is lower in magnitude than the previous maximum
-- then subtract otherwise add.
-- Shift left and repeat until done.
ScanRoman s ==
s := upperCase s
tot: I := 0
Max: I := 0
i: I := maxIndex s
while i >= minIndex s repeat
-- Read a single roman digit
c := s.i; i := i-1
n := romval ord c
-- (I)=1000, ((I))=10000, (((I)))=100000, etc
if n < 0 then
c ^= pren =>
error ["Improper character in Roman numeral: ",c]
nprens: PI := 1
while c = pren and i >= minIndex s repeat
c := s.i; i := i-1
if c = pren then nprens := nprens+1
c ^= ichar =>
error "Improper Roman numeral: (x)"
for k in 1..nprens while i >= minIndex s repeat
c := s.i; i := i-1
c ^= plen =>
error "Improper Roman numeral: unbalanced ')'"
n := 10**(nprens + 2)
if n < Max then
tot := tot - n
else
tot := tot + n
Max := n
tot < 0 => error ["Improper Roman numeral: ", tot]
tot::PI
|