Rosetta Code

Temperature conversion/REXX: Difference between revisions

Page Discussion

Temperature conversion/REXX (view source)

Revision as of 22:12, 3 August 2018

346 bytes added ,  5 years ago
→‎{{header|REXX}}: corrected some typos, added/changed comments and whitespace. split compound REXX statements, corrected for loss of output data if numbers exceeded 50 digits.
m (→‎{{header|REXX}}: changed/added comments and whitespace, changed indentations, elided need for FUZZY digits, moved some code into subroutines to make reading easier.)
(→‎{{header|REXX}}: corrected some typos, added/changed comments and whitespace. split compound REXX statements, corrected for loss of output data if numbers exceeded 50 digits.)
Line 2:
 
=={{header|REXX}}==
<lang rexx>♀/*REXX program converts tem4eraturestemperatures for fifty-sevenfifty─seven different temperature scales. */
 
call e /*let's see the precision we can use. */
numeric digits length(e) - 1 /*big digits for Planck & Daltons scale*/
/*subtract one for the decimal point.*/
parse arg tList /*get the specified temperature lists. */
Line 11:
 
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 '(' var x z '(' /*handle any comments (if there're any)*/
parse upper var z z ' TO ' ! . /*separate the TO option from number.*/
parse var z z 'NOT' not . , noS noE /*separate NOT option from number. */
 
/* *xxx ◄───don't show scales that end in xxx */
/* xxx* ◄─── " " " " begin with xxx */
if not\=='' then do
if left(not, 1) == '*' then noE= substr(not, 2)
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."
end
 
if !=='' then != "ALL" /*nothing specific, so choose "ALL". */
 
all= (!=='ALL') /*allows specification of the "TO" opt.*/
 
if z=='' then call serr 'no arguments were specified.'
 
Line 36 ⟶ 38:
if _\==0 then do
if _==1 then call serr 'illegal temperature:' z
n= left(z, _-1) /*obtain the number (hopefully). */
u= strip( substr(z, _)) ) /*obtain the temperature unit. */
end
else u= 'k' /*assume kelvin as per task requirement*/
 
if \datatype(n, 'N') then call serr "illegal number:" n
 
if \all then do /*there is a TO ααα temp. scale. */
call scaleName ! /*process the TO temp. abbreviation.*/
!=sn sn /*assign the full temperature name to !*/
end /*! now contains temp scale full name.*/
 
call scaleName u u /*allow alternate temp. scale spellings*/
call convert2Fahrenheit /*convert a temperature ──↓──► FarhrenheitFahrenheit.*/
 
say right(' ' x, 79, "─") /*show original value & scale (for sep)*/
 
call convert2specific /*convert FarhrenheitFahrenheit ──► specific temp.*/
end /*until tlist='' */ /*this is a biggish DO loop. */
 
 
Line 60 ⟶ 62:
 
 
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────$ subroutine────────────────────────────────────────*/
$: procedure; showDig=8 /*only show 8 significant decimal digs.*/
_= commas( format( arg(1), , showDig ) / 1 ) /*format# 8 digits past . and add comma*/
p=pos(., _) /*find position of the decimal point. */
/* [↓] align integers with FP numbers.*/
Line 68 ⟶ 70:
else _=_ || left('', 5 + showDig - length(_) + p) /*has " " */
 
return right(_, max(60, length(_) ) ) /*return the re-formattedre─formatted argument (#).*/
 
 
/*────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────CONVERT2FAHRENHEIT subroutine─────────────────────────────────────────────────*/
convert2Fahrenheit: /*convert N ──► °F temperatures. */
 
Line 86 ⟶ 88:
when sn=='CRUQUIUS' then F= n * 0.409266 - 405.992
when sn=='DALENCE' then F= n * 2.7 + 59
when sn=='DALTON' then F= 273.15 * pow(273.15 / 273.15, n / 100) * 1.8 - 459.67
when sn=='DANIELL' then F= n * 7.27194 + 55.9994
when sn=='DE LA HIRE' then F=(n - 3) / 0.549057
Line 140 ⟶ 142:
 
 
/*─────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────CONVERT2SPECIFIC subroutine────────────────────────────────────────────────*/
convert2specific: /*convert N ──► °F 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.*/
 
Line 158 ⟶ 160:
if ?('CRUQUIUS') then say $( ( F + 405.992 ) / 0.409266 ) "Cruquius"
if ?('DALENCE') then say $( ( F - 59 ) / 2.7 ) "Dalence"
 
if ?('DALTON') then if k>a then say $(100*ln(k/273.15)/ln(373.15/273.15) ) "Dalton"
else say right$("-infinity ",) 60 ) "Dalton"
 
if ?('DANIELL') then say $( ( F - 55.9994 ) / 7.27194 ) "Daniell"
if ?('DE LA HIRE') then say $( F * 0.549057 + 3 ) "De la Hire"
Line 197 ⟶ 201:
if ?('RICHTER') then say $( ( F + 7.45205) * 73/160 ) "Richter"
if ?('RINALDINI') then say $( ( F - 32 ) / 15 ) "Rinaldini"
if ?('ROMER') then say $( ( F - 32 ) * 74/2427 + 7.5 ) "Romer"
if ?('ROSENTHAL') then say $( ( F + 453.581 ) * 86/45 ) "Rosenthal"
if ?('ROYAL SOCIETY') then say $( F * -69/50 + 122.82 ) "Royal Society of London"
Line 210 ⟶ 214:
 
 
/*──────────────────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────SCALENAME subroutine───────────────-────────────────────────────*/
scaleName: parse arg y /*abbreviations ──► temp. short name.*/
yU= translate(y, '-eE', "_éÉ") /*translate some accented characters. */
upper yU /*uppercase version of temperature unit*/
 
Line 218 ⟶ 222:
if left(yU, 6)=='DEGREE' then yU=substr(yU, 7) /* " " " " "degree" ? */
 
yU= strip(yU) /*elide all leading & trailing blanks. */
_= length(yU) /*obtain the length of the yU value. */
 
if right(yU,1)=='S' & _>1 then yU=left(yU, _-1) /*remove any trailing plural(s). */
Line 400 ⟶ 404:
 
 
/*──────────────────────────────────one─liner subroutines───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
?: 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▼
commas:procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-4; do j=e to b by -3; _=insert(",",_,j); end /*j*/; return _▼
e: e = 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427427466391932; return e▼
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..()▼
ln..: do while ig & xx>1.5 | \ig & xx<.5;_=e;do k=-1;iz=xx*_**-is;if k>=0 & (ig & iz<1 | \ig & iz>.5) then leave;_=_*_;izz=iz;end;xx=izz; ii=ii+is*2**k; end; x=x*e**-ii-1; z=0;_=-1;p=z;do k=1; _=-_*x; z=z+_/k; if z=p then leave;p=z; end; return z+ii▼
pow: procedure; parse arg x,y; if y=0 then return 1; if x=0 then return 0; if isInt(y) then return x**y; if isInt(1/y) then return root(x,1/y,f); return pow.()▼
pow.: if abs(y//1)=.5 then return sqrt(x)**sign(y)*x**(y%1); return exp(y*ln(x))▼
root: procedure; parse arg x 1 ox,y 1 oy; if x=0 | y=1 then return x; if isInt(y) then return rooti(x,y); _=sqrt(x); if y<0 then _=1/_; return _▼
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▼
/*────────────────────────────────────────────────────────────────────────────────────────────*/
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6
numeric digits; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g *.5'e'_ % 2
do j=0 while h>9; m.j=h; h= h%2 + 1; end /*j*/
do k=j+5 to 0 by -1; numeric digits m.k; g= (g+x/g)*.5; end /*k*/
return g/1
 
</lang>
 
/*──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
▲?: 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
▲commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-4; do j=e to b by -3; _=insert(",",_,j); end /*j*/; return _
▲e: e = 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427427466391932; return e
▲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..()
▲ln..: do while ig & xx>1.5 | \ig & xx<.5;_=e;do k=-1;iz=xx*_**-is;if k>=0 & (ig & iz<1 | \ig & iz>.5) then leave;_=_*_;izz=iz;end;xx=izz; ii=ii+is*2**k; end; x=x*e**-ii-1; z=0;_=-1;p=z;do k=1; _=-_*x; z=z+_/k; if z=p then leave;p=z; end; return z+ii
▲pow: procedure; parse arg x,y; if y=0 then return 1; if x=0 then return 0; if isInt(y) then return x**y; if isInt(1/y) then return root(x,1/y,f); return pow.()
▲pow.: if abs(y//1)=.5 then return sqrt(x)**sign(y)*x**(y%1); return exp(y*ln(x))
▲root: procedure; parse arg x 1 ox,y 1 oy; if x=0 | y=1 then return x; if isInt(y) then return rooti(x,y); _=sqrt(x); if y<0 then _=1/_; return _
▲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; say; exit 13</lang>
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/251904"