Temperature conversion/REXX: Difference between revisions

m
added whitespace.
m (added the mention of another function in the REXX section header (concerning the Dalton temperature scale).)
m (added whitespace.)
 
(10 intermediate revisions by 2 users not shown)
Line 2:
 
 
Note that conversion from/to the   '''Dalton'''   temperature scale requires natural logarithms   ('''ln'''),   and the   '''pow'''   function.
 
=={{header|REXX}}==
<lang rexx>/*REXX program converts temperatures for fifty─seven different temperature scales. */
 
No commenting/explaining was affixed to the higher math functions because it would detract from the logic of the main program.
 
/*────────────────────────────────────────────────────────────────────────────────────────────────
 
<span style='font-family: "Linux Libertine",Georgia,Times,serif;font-size:150%;'>[[REXX]]</span><hr>
tt tt
tt tt
tttttt tttttt
tttttt eeeee mmmm mmm ppppp eeeee rr rrr aaaa tttttt uu uu rr rrr eeee
tt eeeeeee mmmmmmmmmm pppppp eeeeeee rrrrrrr aaaaa tt uu uu rrrrrrr eeeeeee
tt ee ee mm mm mm pp pp ee ee rrr rr aa tt uu uu rrr rr ee ee
tt eeeeeee mm mm mm pp pp eeeeeee rr aaaaaa tt uu uu rr eeeeeee
tt eeeeeee mm mm mm pppppp eeeeeee rr aaaaaaa tt uu uu rr eeeeeee
tt tt ee mm mm mm ppppp ee rr aa aa tt tt uu uu rr ee
ttttt eeeeee mm mm mm pp eeeeee rr aaaaaaa ttttt uuuuuuu rr eeeeee
ttt eeee mm mm mm pp eeee rr aaaaaaa ttt uuuu uu rr eeee
pp
 
────────────────────────────────────────────────────────────────────────────────────────────────*/
 
<lang rexx>/*REXX program converts temperatures for fifty─sevenfifty─eight different temperature scales. */
/*
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
 
tt tt
tt tt
tttttt tttttt
tttttt eeeeeeeee mmmmmmm mmmmm ppppp eeeeeeeee rr rrrrr aaaa tttttt uu uu rr rrrrr eeeeeee
tt eeeeeeeeeeeee mmmmmmmmmmmmmmmmmm pppppp eeeeeeeeeeeee rrrrrrrrrrrrr aaaaa tt uu uu rrrrrrrrrrrrr eeeeeeeeeeeee
tt ee ee mm mm mm pp pp ee ee rrr rr aa tt uu uu rrr rr ee ee
tt eeeeeeeeeeeee mm mm mm pp pp eeeeeeeeeeeee rr aaaaaa tt uu uu rr eeeeeeeeeeeee
tt eeeeeeeeeeeee mm mm mm pppppp eeeeeeeeeeeee rr aaaaaaa tt uu uu rr eeeeeeeeeeeee
tt tt ee mm mm mm ppppp ee rr aa aa tt tt uu uu rr ee
ttttt eeeeeeeeeee mm mm mm pp eeeeeeeeeee rr aaaaaaa ttttt uuuuuuuuuuuuu rr eeeeeeeeeee
ttt eeeeeee mm mm mm pp eeeeeee rr aaaaaaa ttt uuuuuuu uu rr eeeeeee
pp
pp
 
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
*/
 
 
call e /*let's see the precision we can use. */
numeric digits length(e) - 1 /*big digits for Planck & DaltonsDalton scale.*/
/*subtract one for the decimal point.*/
parse arg tList /*get the specified temperature lists. */
tList= space(tList) /*elide any and all superfluous blanks.*/
 
 
do until tList='' /*process the list of temperatures. */
parse var tList x ',' tList /*temperatures are separated by commas.*/
x= translate(x, '(((', "[{«") /*support other grouping symbols. */
x= space(x) /*elide any and all superfluous blanks.*/
parse var x z '(' /*handle any comments (if there're any)*/
parse upper var z z ' TO ' ! . /*separate the TO option from number.*/
parse upper var z z 'NOT' not . , noS noE /*separate NOT option from number. */
/*for the NOT keyword, see (below).*/
 
/* *xxx ◄───don't show scales that end in xxx */
/* xxx* ◄─── " " " " begin with xxx */
Line 47 ⟶ 53:
if right(not, 1) == '*' then noS= left(not, length(not) - 1)
noL= length(noE || noS)
if noL==0 then call serr "illegal NOT keyword, no leading or trailing * specified."
"illegal NOT keyword, no leading or trailing * specified."
end
 
Line 56 ⟶ 63:
if z=='' then call serr 'no arguments were specified.'
 
_= verify(z, '+-.0123456789') /*a list of valid numberdecimal digs & thingys. */
n= z /*obtain a "backup" copy of Z (number).*/
n=z
 
if _\==0 then do
Line 65 ⟶ 72:
end
else u= 'k' /*assume kelvin as per task requirement*/
/* ────── */
 
if \datatype(n, 'N') then call serr "illegal number:" n
 
Line 97 ⟶ 104:
 
/*────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
convert2Fahrenheit: /*convert N ──► °ºF temperatures. */
 
/* [↓] 57 differentfifty-eight temperature scales.*/
select
when sn=='ABSOLUTE' then F= n * 9/5 - 459.67
when sn=='AMONTON' then F= n * 8.37209 - 399.163
when sn=='BARNSDORF' then F= n * 6.85714 + 6.85714
Line 160 ⟶ 168:
otherwise call serr 'invalid temperature scale: ' u
end /*select*/
 
 
return
Line 166 ⟶ 173:
 
/*─────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
convert2specific: /*convert NºF ──► °Fxxx temperatures. */
 
K = (F + 459.67) * 5/9 /*compute temperature in kelvin scale. */
a = (1e || (-digits() % 2) - digits() % 20) /*minimum number for Dalton temperature*/
eV = (F + 459.67) / 20888.1 /*compute the number of electron volts.*/
 
 
if ?('ABSOLUTE') then say $( k ) "Absolute"
if ?('AMONTON') then say $( ( F + 399.163 ) / 8.37209 ) "Amonton"
if ?('BARNSDORF') then say $( ( F - 6.85715) / 6.85715 ) "Barnsdorf"
Line 242 ⟶ 250:
upper yU /*uppercase version of temperature unit*/
 
if left(yU, 7)=='DEGREES' then yU=substr(yU, 8) /*is this a redundant "degrees" ? ? */
if left(yU, 6)=='DEGREE' then yU=substr(yU, 7) /* " " " " "degree" ? ? */
 
yU= strip(yU) /*elide all leading & trailing blanks. */
Line 252 ⟶ 260:
 
select /*change abbreviations ──► shortname.*/
when abbrev('ABSOLUTE' , yU, 1) then sn= "ABSOLUTE"
when abbrev('AMONTON' , yU) then sn= "AMONTON"
when abbrev('BARNDORF' , yU,2) |,
Line 278 ⟶ 287:
abbrev('CELISU' , yU) |, /* 1% misspelled.*/
abbrev('CELSU' , yU) |, /* 1% misspelled.*/
abbrev('HECTOGRADE' , yU) |,
abbrev('CELSIU' , yU) then sn= "CELSIUS"
when abbrev('CIMANTO' , yU,2) |,
Line 428 ⟶ 438:
 
/*──────────────────────────────────────────────────────────────────────────────────────*/
?: parse arg y 1 yu
d= digits()upper yu
if not\=='' then do
if noS\=="" then if left(yyu, noL)==noS then return 0
if noE\=='' then if right(yyu, noL)==noE then return 0
end
 
Line 456 ⟶ 467:
if x=0 then return 0 /*Argument is zero? Return 0.*/
/*This function work for zero.*/
d= digits() /*get # of dec. digs, current.*/
d= digits()
m.= 9 /*getset number" of decimal" digits " " at start.*/
h= d+6 /*add six6 for safetyrounding reasonsconcerns. */
numeric form /*ensure correctright form of #'s. exponentiation*/
numeric digits /*start with nine numeric digs*/
 
Line 465 ⟶ 476:
/*No exponent? Then add one. */
parse value format(x, 2, 1, , 0) 'E0' with g "E" _ .
/* [] halfhalve the exponent. */
g=g * .5'e'_ % 2 /*a first best guess for sqrt.,*/
/*which is 1/2 of the exponent*/
 
/* [↓] use min number of dec.*/
/* digs for early SQRTs. */
do j=0 while h>9
m.j= h /*calculate # of digits to use*/
h= h % 2 + 1 /*halving the exponent means */
end /*j*/ /* that it'll be doubled as */
/* the M. array will be */
 
/* processed backwards. [↓] */
do k=j+5 to 0 by -1 /*calculate higher precision. */
numeric digits m.k /*bump the decimal digits. */
Line 485 ⟶ 497:
?: parse arg y; if not\=='' then do; if noS\=="" then if left(y, noL)==noS then return 0; if noE\=='' then if right(y, noL)==noE then return 0; end; if all | y==! then return 1; return 0
e: e = 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427427466391932; return e /*112 useful decimal digits. */
isInt: return datatype(arg(1), 'W') /*is the argument a whole number (integer)? */
exp: procedure; parse arg x; ix=x%1; if abs(x-ix)>.5 then ix=ix+sign(x); x=x-ix; z=1; _=1; w=z; do j=1; _=_*x/j; z=(z+_)/1; if z==w then leave; w=z; end; if z\==0 then z= z * e()**ix; return z/1
ln: procedure; parse arg x; call e; ig=x>1.5; is=1-2*(ig\==1); ii=0; xx=x; return ln..()
Line 494 ⟶ 506:
rooti: x=abs(x); y=abs(y); a= digits() + 5; g=rootIg(); m= y-1; d=5; do until d==a; d=min(d+d, a); numeric digits d; o=0; do until o=g; o=g; g=format( (m*g**y+x) /y/g**m, , d-2); end; end; _= g * sign(ox); if oy<0 then _= 1/_; return _
rootIg: numeric form;parse value format(x,2,1,,0) 'E0' with ? 'E' _ .; return (? / y'E'_ % y) + (x>1)
s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/
serr: say; say '***error***'; say; say arg(1); say; exit 13</lang>
</lang>