Temperature conversion/REXX: Difference between revisions

Content added Content deleted
m (→‎{{header|REXX}}: changed extra digits and optimized the sqrt function, added a comment.)
(→‎{{header|REXX}}: changed/added comments and whitespace, changed indentations, split compound lines.)
Line 2: Line 2:


=={{header|REXX}}==
=={{header|REXX}}==
<lang rexx>/*REXX program converts temperatures for a large number of temperature scales.*/
<lang rexx>♀/*REXX program converts temperatures for a large number of temperature scales. */


call e /*let's see the precision we can use. */
call e /*let's see the precision we can use. */
numeric digits length(e) /*big digits for Planck & Daltons scale*/
numeric digits length(e) - 1 /*big digits for Planck & Daltons scale*/
parse arg tList /*get the specified temperature lists. */
parse arg tList /*get the specified temperature lists. */


do until tList='' /*process the list of temperatures. */
do until tList='' /*process the list of temperatures. */
parse var tList x ',' tList /*temperatures are separated by commas.*/
parse var tList x ',' tList /*temperatures are separated by commas.*/
x=translate(x,'((',"[{") /*support other grouping symbols. */
x=translate(x,'((',"[{") /*support other grouping symbols. */
x=space(x); parse var x z '(' /*handle any comments (if there're any)*/
x=space(x) /*elide any and all superfluous blanks.*/
parse upper var z z ' TO ' ! . /*separate the TO option from number.*/
parse var x z '(' /*handle any comments (if there're any)*/
parse var z z 'NOT' not . , noS noE /*separate NOT option from number. */
parse upper var z z ' TO ' ! . /*separate the TO option from number.*/
/* *xxx ◄───don't show scales that end in xxx */
parse var z z 'NOT' not . , noS noE /*separate NOT option from number. */
if not\=='' then do /* xxx* ◄─── " " " " begin with xxx */
/* *xxx ◄───don't show scales that end in xxx */
if left(not,1)=='*' then noE=substr(not,2)
/* xxx* ◄─── " " " " begin with xxx */
⚫
if not\=='' then do egin with xxx */
⚫
if right(not,1)=='*' then noS=left(not,length(not)-1)
if left(not, 1)=='*' then noE=substr(not, 2)
⚫
if right(not, 1)=='*' then noS=left(not, length(not)-1)
noL=length(noE || noS)
noL=length(noE || noS)
if noL==0 then call serr "illegal NOT keyword, no leading or trailing * specified."
if noL==0 then call serr "illegal NOT keyword, no leading or trailing * specified."
end
end


if !=='' then !='ALL'; all=!=='ALL' /*allow specification of the "TO" opt.*/
if !=='' then !='ALL'
⚫
all= (!=='ALL') /*allows specification of the "TO" opt.*/
if z=='' then call serr 'no arguments were specified.'
if z=='' then call serr 'no arguments were specified.'


_=verify(z, '+-.0123456789') /*a list of valid number thingys. */
_=verify(z, '+-.0123456789') /*a list of valid number thingys. */
n=z
n=z


if _\==0 then do
if _\==0 then do
if _==1 then call serr 'illegal temperature:' z
if _==1 then call serr 'illegal temperature:' z
n=left(z, _-1) /*pick off the number (hopefully). */
n=left(z, _-1) /*pick off the number (hopefully). */
u=strip(substr(z, _)) /*pick off the temperature unit. */
u=strip(substr(z, _)) /*pick off the temperature unit. */
end
end
else u='k' /*assume kelvin as per task requirement*/
else u='k' /*assume kelvin as per task requirement*/


if \datatype(n,'N') then call serr 'illegal number:' n
if \datatype(n,'N') then call serr 'illegal number:' n


if \all then do /*there is a TO ααα temp. scale. */
if \all then do /*there is a TO ααα temp. scale. */
call scaleName ! /*process the TO temp. abbreviation.*/
call scaleName ! /*process the TO temp. abbreviation.*/
!=sn /*assign the full temperature name to !*/
!=sn /*assign the full temperature name to !*/
end /*! now contains temp scale full name.*/
end /*! now contains temp scale full name.*/


call scaleName u /*allow alternate temp. scale spellings*/
call scaleName u /*allow alternate temp. scale spellings*/


select /*convert ──► °F temperatures. */
select /*convert N ──► °F temperatures. */
when sn=='AMONTON' then F= n * 8.37209 - 399.163
when sn=='AMONTON' then F= n * 8.37209 - 399.163
when sn=='BARNSDORF' then F= n * 6.85714 + 6.85714
when sn=='BARNSDORF' then F= n * 6.85714 + 6.85714
Line 105: Line 108:
end /*select*/
end /*select*/


K = (F + 459.67) * 5/9 /*compute temperature to kelvin scale. */
K = (F + 459.67) * 5/9 /*compute temperature to kelvin scale. */
a =(1e || (-digits()%2)-digits()%20) /*minimum number for Dalton temperature*/
a =(1e || (-digits()%2)-digits()%20) /*minimum number for Dalton temperature*/
eV=(F + 459.67) / 20888.1 /*compute the number of electron volts.*/
eV=(F + 459.67) / 20888.1 /*compute the number of electron volts.*/
say right(' ' x, 79, "─") /*show original value and scale, sep. */
say right(' ' x, 79, "─") /*show original value and scale, sep. */


if ?('AMONTON') then say $( ( F + 399.163 ) / 8.37209 ) 'Amonton'
if ?('AMONTON') then say $( ( F + 399.163 ) / 8.37209 ) 'Amonton'
Line 170: Line 173:
end /*until tlist ···*/
end /*until tlist ···*/


exit /*stick a fork in it, we're all done. */
exit /*stick a fork in it, we're all done. */


⚫
/*──────────────────────────────────$ 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.*/
⚫
if p==0 then _=_ || left('',5+showDig+1) /*no decimal point. */
⚫
else _=_ || left('',5+showDig-length(_)+p) /*has " " */


⚫
/*──────────────────────────────────$ subroutine────────────────────────────────────────*/
⚫
return right(_,60) /*return the re-formatted argument (#).*/
⚫
$: 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.*/
⚫
if p==0 then _=_ || left('', 5+showDig+1) /*no decimal point. */
⚫
else _=_ || left('', 5+showDig-length(_)+p) /*has " " */


⚫
return right(_,60) /*return the re-formatted argument (#).*/
⚫
/*──────────────────────────────────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*/


⚫
if left(yU,7)=='DEGREES' then yU=substr(yU,8) /*redundant "degrees"? */
⚫
if left(yU,6)=='DEGREE' then yU=substr(yU,7) /* " "degree" ? */


⚫
/*──────────────────────────────────SCALENAME subroutine────────────────────────────────*/
⚫
yU=strip(yU) /*elide blanks at ends.*/
_=length(yU) /*obtain the yU length.*/
scaleName: parse arg y /*abbreviations ──► temp. short name.*/
⚫
yU=translate(y,'-eE',"_éÉ") /*translate some accented characters. */
⚫
upper yU /*uppercase version of temperature unit*/


if right(yU,1)=='S' & _>1 then yU=left(yU,_-1) /*elide trailing plural*/
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" ? */


select /*abbreviations ──► shortname. */
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). */

⚫
select /*abbreviations ──► shortname. */
when abbrev('AMONTON' , yU) then sn='AMONTON'
when abbrev('AMONTON' , yU) then sn='AMONTON'
when abbrev('BARNDORF' , yU,2) |,
when abbrev('BARNDORF' , yU,2) |,
Line 368: Line 373:


return
return



/*──────────────────────────────────one─liner subroutines───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────one─liner subroutines───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
Line 373: Line 379:
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 _
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
e: e = 2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427427466391932; return e
isInt: return datatype(arg(1), 'W') /*is the argument a whole number (integer)?*/
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
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: procedure; parse arg x; call e; ig=x>1.5; is=1-2*(ig\==1); ii=0; xx=x; return ln..()
Line 381: Line 387:
root: procedure; parse arg x,y; if x=0 | y=1 then return x; if isInt(y) then return rooti(x,y); _=sqrt(x); if y<0 then _=1/_; return _
root: procedure; parse arg x,y; 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: procedure; parse arg x,y; if x=0 | y=1 then return x; n=y<0; y=abs(y); numeric digits digits()+2; z=abs(x); g=(z+1)/y; m=y-1; numeric fuzz 2; do forever; _=(m*g**y+z)/y/g**m; if _=g then leave; g=_; end; _=g*sign(x); if n then _=1/_; return _
rooti: procedure; parse arg x,y; if x=0 | y=1 then return x; n=y<0; y=abs(y); numeric digits digits()+2; z=abs(x); g=(z+1)/y; m=y-1; numeric fuzz 2; do forever; _=(m*g**y+z)/y/g**m; if _=g then leave; g=_; end; _=g*sign(x); if n then _=1/_; return _
s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/
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
serr: say; say '***error!***'; say; say arg(1); say; exit 13



sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6;
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
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 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*/
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
numeric digits d; return (g/1)i /*make complex if X < 0.*/</lang>
return g/1</lang>
Retrieved from "https://rosettacode.org/wiki/Temperature_conversion/REXX"