Temperature conversion/REXX: Difference between revisions
m (→{{header|REXX}}: elide errant vertical tab (VT) left over from DOS pipe command when using a wide DOS window.) |
m (→{{header|REXX}}: changed/added comments and whitespace, changed indentations, elided need for FUZZY digits, moved some code into subroutines to make reading easier.) |
||
Line 2: | Line 2: | ||
=={{header|REXX}}== |
=={{header|REXX}}== |
||
<lang rexx>/*REXX program converts |
<lang rexx>/*REXX program converts tem4eratures for fifty-seven different 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) - 1 /*big digits for Planck & Daltons scale*/ |
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. */ |
parse arg tList /*get the specified temperature lists. */ |
||
do until tList='' /*process the list of temperatures. */ |
do until tList='' /*process the list of temperatures. */ |
||
Line 18: | Line 20: | ||
/* *xxx ◄───don't show scales that end in xxx */ |
/* *xxx ◄───don't show scales that end in xxx */ |
||
/* xxx* ◄─── " " " " begin with xxx */ |
/* xxx* ◄─── " " " " begin with xxx */ |
||
if not\=='' then do |
if not\=='' then do |
||
if left(not, 1)=='*' then noE=substr(not, 2) |
if left(not, 1)=='*' then noE=substr(not, 2) |
||
if right(not, 1)=='*' then noS=left(not, length(not)-1) |
if right(not, 1)=='*' then noS=left(not, length(not)-1) |
||
Line 25: | Line 27: | ||
end |
end |
||
if !=='' then != |
if !=='' then !="ALL" /*nothing specific, so choose "ALL". */ |
||
all= (!=='ALL') /*allows specification of the "TO" opt.*/ |
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.' |
||
Line 34: | Line 36: | ||
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) /* |
n=left(z, _-1) /*obtain the number (hopefully). */ |
||
u=strip(substr(z, _)) /* |
u=strip(substr(z, _)) /*obtain 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 |
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. */ |
||
Line 47: | Line 49: | ||
call scaleName u /*allow alternate temp. scale spellings*/ |
call scaleName u /*allow alternate temp. scale spellings*/ |
||
call convert2Fahrenheit /*convert a temperature ──↓ Farhrenheit*/ |
|||
say right(' ' x, 79, "─") /*show original value & scale (for sep)*/ |
|||
select |
|||
call convert2specific /*convert Farhrenheit ──► specific temp*/ |
|||
end /*until tlist='' */ /*this is a biggish DO loop. */ |
|||
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 " " */ |
|||
return right(_,60) /*return the re-formatted argument (#).*/ |
|||
/*──────────────────────────────────CONVERT2FAHRENHEIT subroutine─────────────────────────────────────────────────*/ |
|||
convert2Fahrenheit: /*convert N ──► °F temperatures. */ |
|||
/* [↓] 57 different temperature scales*/ |
|||
select |
|||
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 |
||
when sn=='BEAUMUIR' then F= n * 2.22951 + 32 |
when sn=='BEAUMUIR' then F= n * 2.22951 + 32 |
||
when sn=='BENART' then F= n * 1.43391 + 31.2831 |
when sn=='BENART' then F= n * 1.43391 + 31.2831 |
||
when sn=='BERGEN' then F=(n + 23.8667) |
when sn=='BERGEN' then F=(n + 23.8667) * 15/14 |
||
when sn=='BRISSEN' then F= n * 32/15 + 32 |
when sn=='BRISSEN' then F= n * 32/15 + 32 |
||
when sn=='CELSIUS' then F= n * 9/5 + 32 /*a single C is taken as Celsius.*/ |
when sn=='CELSIUS' then F= n * 9/5 + 32 /*a single C is taken as Celsius.*/ |
||
Line 60: | Line 86: | ||
when sn=='CRUQUIUS' then F= n * 0.409266 - 405.992 |
when sn=='CRUQUIUS' then F= n * 0.409266 - 405.992 |
||
when sn=='DALENCE' then F= n * 2.7 + 59 |
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=='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=='DANIELL' then F= n * 7.27194 + 55.9994 |
||
when sn=='DE LA HIRE' then F=(n - 3) |
when sn=='DE LA HIRE' then F=(n - 3) / 0.549057 |
||
when sn=='DE LA VILLE' then F=(n + 6.48011) |
when sn=='DE LA VILLE' then F=(n + 6.48011) / 0.985568 |
||
when sn=='DELISLE' then F=212 - n * 6/5 |
when sn=='DELISLE' then F=212 - n * 6/5 |
||
when sn=='DELISLE OLD' then F=212 - n * 1.58590197 |
when sn=='DELISLE OLD' then F=212 - n * 1.58590197 |
||
when sn=='DE LUC' then F=(n + 14) |
when sn=='DE LUC' then F=(n + 14) * 16/7 |
||
when sn=='DE LYON' then F=(n + 17.5) |
when sn=='DE LYON' then F=(n + 17.5) * 64/35 |
||
when sn=='DE REVILLAS' then F=212 - n * 97/80 |
when sn=='DE REVILLAS' then F=212 - n * 97/80 |
||
when sn=='DERHAM' then F= n / 0.38444386 - 188.578 |
when sn=='DERHAM' then F= n / 0.38444386 - 188.578 |
||
when sn=='DERHAM OLD' then F= n * 3 + 4.5 |
when sn=='DERHAM OLD' then F= n * 3 + 4.5 |
||
when sn=='DE SUEDE' then F=(n + 17.6666) |
when sn=='DE SUEDE' then F=(n + 17.6666) * 150/83 |
||
when sn=='DE VILLENEUVE' then F=(n + 23.7037) |
when sn=='DE VILLENEUVE' then F=(n + 23.7037) / 0.740741 |
||
when sn=='DU CREST' then F=(n + 37.9202) |
when sn=='DU CREST' then F=(n + 37.9202) / 0.650656 |
||
when sn=='EDINBURGH' then F= n * 4.6546 - 6.40048 |
when sn=='EDINBURGH' then F= n * 4.6546 - 6.40048 |
||
when sn=='ELECTRON VOLTS' then F= n * 20888.1 - 459.67 |
when sn=='ELECTRON VOLTS' then F= n * 20888.1 - 459.67 |
||
when sn=='FAHRENHEIT' then F= n |
when sn=='FAHRENHEIT' then F= n |
||
when sn=='FAHRENHEIT OLD' then F= n * 20/11 - 89.2727 |
when sn=='FAHRENHEIT OLD' then F= n * 20/11 - 89.2727 |
||
when sn=='FLORENTINE LARGE' then F=(n + 7.42857) |
when sn=='FLORENTINE LARGE' then F=(n + 7.42857) / 0.857143 |
||
when sn=='FLORENTINE MAGNUM' then F=(n + 73.9736 ) |
when sn=='FLORENTINE MAGNUM' then F=(n + 73.9736 ) / 1.50659 |
||
when sn=='FLORENTINE SMALL' then F=(n - 1.38571) |
when sn=='FLORENTINE SMALL' then F=(n - 1.38571) / 0.378571 |
||
when sn=='FOWLER' then F= n * 0.640321 + 53.7709 |
when sn=='FOWLER' then F= n * 0.640321 + 53.7709 |
||
when sn=='FRICK' then F= n * 200/251 + 58.5339 |
when sn=='FRICK' then F= n * 200/251 + 58.5339 |
||
Line 93: | Line 119: | ||
when sn=='NEWTON' then F= n * 60/11 + 32 |
when sn=='NEWTON' then F= n * 60/11 + 32 |
||
when sn=='OERTEL' then F= n + n - 32 |
when sn=='OERTEL' then F= n + n - 32 |
||
when sn=='PLANCK' then F= n * 1.416833e32 |
when sn=='PLANCK' then F= n * 1.416833e32 * 9/5 - 459.67 |
||
when sn=='RANKINE' then F= n - 459.67 /*a single R is taken as Rankine.*/ |
when sn=='RANKINE' then F= n - 459.67 /*a single R is taken as Rankine.*/ |
||
when sn=='REAUMUR' then F= n * 9/4 + 32 |
when sn=='REAUMUR' then F= n * 9/4 + 32 |
||
Line 100: | Line 126: | ||
when sn=='ROMER' then F=(n - 7.5) * 27/4 + 32 |
when sn=='ROMER' then F=(n - 7.5) * 27/4 + 32 |
||
when sn=='ROSENTHAL' then F= n * 45/86 - 453.581 |
when sn=='ROSENTHAL' then F= n * 45/86 - 453.581 |
||
when sn=='ROYAL SOCIETY' then F=(n -122.82) |
when sn=='ROYAL SOCIETY' then F=(n -122.82) * -50/69 |
||
when sn=='SAGREDO' then F= n * 0.3798 - 5.98 |
when sn=='SAGREDO' then F= n * 0.3798 - 5.98 |
||
when sn=='SAINT-PATRICE' then F= n * 2.62123 + 115.879 |
when sn=='SAINT-PATRICE' then F= n * 2.62123 + 115.879 |
||
Line 110: | Line 136: | ||
end /*select*/ |
end /*select*/ |
||
K = (F + 459.67) * 5/9 /*compute temperature to 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.*/ |
|||
say right(' ' x, 79, "─") /*show original value and scale, sep. */ |
|||
return |
|||
if ?('AMONTON') then say $( ( F + 399.163 ) / 8.37209 ) 'Amonton' |
|||
if ?('BARNSDORF') then say $( ( F - 6.85715) / 6.85715 ) 'Barnsdorf' |
|||
if ?('BEAUMUIR') then say $( ( F - 32 ) / 2.22951 ) 'Beaumuir' |
|||
if ?('BENART') then say $( ( F - 31.2831 ) / 1.43391 ) 'Benart' |
|||
if ?('BERGEN') then say $( ( F * 14/15 ) - 23.8667 ) 'Bergen' |
|||
if ?('BRISSON') then say $( ( F - 32 ) * 15/32 ) 'Brisson' |
|||
if ?('CELSIUS') then say $( ( F - 32 ) * 5/9 ) 'Celsius' |
|||
if ?('CIMENTO') then say $( ( F + 4.54135) / 2.70677 ) 'Cimento' |
|||
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' |
|||
if ?('DE LA VILLE') then say $( F * 0.985568 - 6.48011 ) 'De la Ville' |
|||
if ?('DELISLE') then say $( ( 212 - F ) * 5/6 ) 'Delisle' |
|||
if ?('DELISLE OLD') then say $( ( 212 - F ) / 1.58590197 ) 'Delisle OLD' |
|||
if ?('DE LUC') then say $( F * 7/16 - 14 ) 'De Luc' |
|||
if ?('DE LYON') then say $( F * 35/64 - 17.5 ) 'De Lyon' |
|||
if ?('DE REVILLAS') then say $( ( 212 - F ) * 80/97 ) 'De Revillas' |
|||
if ?('DERHAM') then say $( F * 0.38444386 + 72.4978 ) 'Derham' |
|||
if ?('DERHAM OLD') then say $( ( F - 4.5 ) / 3 ) 'Derham OLD' |
|||
if ?('DE VILLENEUVE') then say $( F * 0.740741 - 23.7037 ) 'De Villeneuve' |
|||
if ?('DE SUEDE') then say $( F * 83/150 - 17.6666 ) 'De Suede' |
|||
if ?('DU CREST') then say $( F * 0.650656 - 37.9202 ) 'Du Crest' |
|||
if ?('EDINBURGH') then say $( ( F + 6.40048) / 4.6546 ) 'Edinburgh' |
|||
if ?('ELECTRON VOLTS') then say $( eV ) 'electron volt's(eV) |
|||
if ?('FAHRENHEIT') then say $( F ) 'Fahrenheit' |
|||
if ?('FAHRENHEIT OLD') then say $( F * 20/11 - 89.2727 ) 'Fahrenheit OLD' |
|||
if ?('FLORENTINE LARGE') then say $( F * 0.857143 - 7.42857 ) 'Florentine large' |
|||
if ?('FLORENTINE MAGNUM') then say $( F * 1.50659 - 73.9736 ) 'Florentine Magnum' |
|||
if ?('FLORENTINE SMALL') then say $( F * 0.378571 + 1.38571 ) 'Florentine small' |
|||
if ?('FOWLER') then say $( ( F - 53.7709 ) / 0.640321 ) 'Fowler' |
|||
if ?('FRICK') then say $( ( F - 58.5338 ) * 251/200 ) 'Frick' |
|||
if ?('GAS MARK') then say $( ( F - 250 ) * 0.04 ) 'gas mark' |
|||
if ?('GOUBERT') then say $( ( F + 32 ) * 0.5 ) 'Goubert' |
|||
if ?('HALES') then say $( ( F - 32 ) / 1.2 ) 'Hales' |
|||
if ?('HANOW') then say $( ( F + 10.6672 ) / 1.06668 ) 'Hanow' |
|||
if ?('HAUKSBEE') then say $( ( F - 88.16 ) * 25/18 ) 'Hauksbee' |
|||
if ?('JACOBS-HOLBORN') then say $( ( F + 53.4366 ) * 71/18 ) 'Jacobs-Holborn' |
|||
if ?('KELVIN') then say $( k ) 'kelvin's(k) |
|||
if ?('LEIDEN') then say $( F / 1.8 + 235.222 ) 'Leiden' |
|||
if ?('NEWTON') then say $( ( F - 32 ) * 11/60 ) 'Newton' |
|||
if ?('OERTEL') then say $( ( F + 32 ) * 0.5 ) 'Oertel' |
|||
if ?('PLANCK') then say $( ( F + 459.67 ) * 5/9 / 1.416833e32 ) 'Planck' |
|||
if ?('RANKINE') then say $( F + 459.67 ) 'Rankine' |
|||
if ?('REAUMUR') then say $( ( F - 32 ) * 4/9 ) 'Reaumur' |
|||
if ?('RICHTER') then say $( ( F + 7.45205) * 73/160 ) 'Richter' |
|||
if ?('RINALDINI') then say $( ( F - 32 ) / 15 ) 'Rinaldini' |
|||
if ?('ROMER') then say $( ( F - 32 ) * 7/24 + 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' |
|||
if ?('SAGREDO') then say $( ( F + 5.98 ) / 0.3798 ) 'Segredo' |
|||
if ?('SAINT-PATRICE') then say $( ( F - 115.879 ) / 2.62123 ) 'Saint-Patrice' |
|||
if ?('STUFE') then say $( ( F - 257 ) / 45 ) 'Stufe' |
|||
if ?('SULZER') then say $( ( F - 33.2334 ) / 1.14595 ) 'Sulzer' |
|||
if ?('THERMOSTAT') then say $( ( F - 32 ) / 54 ) 'Thermostat' |
|||
if ?('WEDGWOOD') then say $( ( F - 516.2 ) / 44.7429295 ) 'Wedgwood' |
|||
end /*until tlist ···*/ |
|||
exit /*stick a fork in it, we're all done. */ |
|||
/*──────────────────────────────────CONVERT2SPECIFIC subroutine────────────────────────────────────────────────*/ |
|||
convert2specific: /*convert N ──► °F temperatures. */ |
|||
K = (F + 459.67) * 5/9 /*compute temperature in kelvin scale. */ |
|||
/*──────────────────────────────────$ subroutine────────────────────────────────────────*/ |
|||
a = (1e || (-digits()%2) - digits()%20) /*minimum number for Dalton temperature*/ |
|||
$: procedure; showDig=8 /*only show 8 significant decimal digs.*/ |
|||
eV= (F + 459.67) / 20888.1 /*compute the number of electron volts.*/ |
|||
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 (#).*/ |
|||
if ?('AMONTON') then say $( ( F + 399.163 ) / 8.37209 ) "Amonton" |
|||
if ?('BARNSDORF') then say $( ( F - 6.85715) / 6.85715 ) "Barnsdorf" |
|||
if ?('BEAUMUIR') then say $( ( F - 32 ) / 2.22951 ) "Beaumuir" |
|||
if ?('BENART') then say $( ( F - 31.2831 ) / 1.43391 ) "Benart" |
|||
if ?('BERGEN') then say $( ( F * 14/15 ) - 23.8667 ) "Bergen" |
|||
if ?('BRISSON') then say $( ( F - 32 ) * 15/32 ) "Brisson" |
|||
if ?('CELSIUS') then say $( ( F - 32 ) * 5/9 ) "Celsius" |
|||
if ?('CIMENTO') then say $( ( F + 4.54135) / 2.70677 ) "Cimento" |
|||
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" |
|||
if ?('DE LA VILLE') then say $( F * 0.985568 - 6.48011 ) "De la Ville" |
|||
if ?('DELISLE') then say $( ( 212 - F ) * 5/6 ) "Delisle" |
|||
if ?('DELISLE OLD') then say $( ( 212 - F ) / 1.58590197 ) "Delisle OLD" |
|||
if ?('DE LUC') then say $( F * 7/16 - 14 ) "De Luc" |
|||
if ?('DE LYON') then say $( F * 35/64 - 17.5 ) "De Lyon" |
|||
if ?('DE REVILLAS') then say $( ( 212 - F ) * 80/97 ) "De Revillas" |
|||
if ?('DERHAM') then say $( F * 0.38444386 + 72.4978 ) "Derham" |
|||
if ?('DERHAM OLD') then say $( ( F - 4.5 ) / 3 ) "Derham OLD" |
|||
if ?('DE VILLENEUVE') then say $( F * 0.740741 - 23.7037 ) "De Villeneuve" |
|||
if ?('DE SUEDE') then say $( F * 83/150 - 17.6666 ) "De Suede" |
|||
if ?('DU CREST') then say $( F * 0.650656 - 37.9202 ) "Du Crest" |
|||
if ?('EDINBURGH') then say $( ( F + 6.40048) / 4.6546 ) "Edinburgh" |
|||
if ?('ELECTRON VOLTS') then say $( eV ) "electron volt"s(eV) |
|||
if ?('FAHRENHEIT') then say $( F ) "Fahrenheit" |
|||
if ?('FAHRENHEIT OLD') then say $( F * 20/11 - 89.2727 ) "Fahrenheit OLD" |
|||
if ?('FLORENTINE LARGE') then say $( F * 0.857143 - 7.42857 ) "Florentine large" |
|||
if ?('FLORENTINE MAGNUM') then say $( F * 1.50659 - 73.9736 ) "Florentine Magnum" |
|||
if ?('FLORENTINE SMALL') then say $( F * 0.378571 + 1.38571 ) "Florentine small" |
|||
if ?('FOWLER') then say $( ( F - 53.7709 ) / 0.640321 ) "Fowler" |
|||
if ?('FRICK') then say $( ( F - 58.5338 ) * 251/200 ) "Frick" |
|||
if ?('GAS MARK') then say $( ( F - 250 ) * 0.04 ) "gas mark" |
|||
if ?('GOUBERT') then say $( ( F + 32 ) * 0.5 ) "Goubert" |
|||
if ?('HALES') then say $( ( F - 32 ) / 1.2 ) "Hales" |
|||
if ?('HANOW') then say $( ( F + 10.6672 ) / 1.06668 ) "Hanow" |
|||
if ?('HAUKSBEE') then say $( ( F - 88.16 ) * 25/18 ) "Hauksbee" |
|||
if ?('JACOBS-HOLBORN') then say $( ( F + 53.4366 ) * 71/18 ) "Jacobs-Holborn" |
|||
if ?('KELVIN') then say $( k ) "kelvin"s(k) |
|||
if ?('LEIDEN') then say $( F / 1.8 + 235.222 ) "Leiden" |
|||
if ?('NEWTON') then say $( ( F - 32 ) * 11/60 ) "Newton" |
|||
if ?('OERTEL') then say $( ( F + 32 ) * 0.5 ) "Oertel" |
|||
if ?('PLANCK') then say $( ( F + 459.67 ) * 5/9 / 1.416833e32 ) "Planck" |
|||
if ?('RANKINE') then say $( F + 459.67 ) "Rankine" |
|||
if ?('REAUMUR') then say $( ( F - 32 ) * 4/9 ) "Reaumur" |
|||
if ?('RICHTER') then say $( ( F + 7.45205) * 73/160 ) "Richter" |
|||
if ?('RINALDINI') then say $( ( F - 32 ) / 15 ) "Rinaldini" |
|||
if ?('ROMER') then say $( ( F - 32 ) * 7/24 + 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" |
|||
if ?('SAGREDO') then say $( ( F + 5.98 ) / 0.3798 ) "Segredo" |
|||
if ?('SAINT-PATRICE') then say $( ( F - 115.879 ) / 2.62123 ) "Saint-Patrice" |
|||
if ?('STUFE') then say $( ( F - 257 ) / 45 ) "Stufe" |
|||
if ?('SULZER') then say $( ( F - 33.2334 ) / 1.14595 ) "Sulzer" |
|||
if ?('THERMOSTAT') then say $( ( F - 32 ) / 54 ) "Thermostat" |
|||
if ?('WEDGWOOD') then say $( ( F - 516.2 ) / 44.7429295 ) "Wedgwood" |
|||
return |
|||
/*──────────────────────────────────SCALENAME subroutine────────────────────────────────*/ |
|||
/*──────────────────────────────────SCALENAME subroutine───────────────-────────────────────────────*/ |
|||
scaleName: parse arg y /*abbreviations ──► temp. short name.*/ |
scaleName: parse arg y /*abbreviations ──► temp. short name.*/ |
||
yU=translate(y,'-eE',"_éÉ") |
yU=translate(y, '-eE', "_éÉ") /*translate some accented characters. */ |
||
upper yU /*uppercase version of temperature unit*/ |
upper yU /*uppercase version of temperature unit*/ |
||
if left(yU,7)=='DEGREES' |
if left(yU, 7)=='DEGREES' then yU=substr(yU, 8) /*is this a redundant "degrees" ? */ |
||
if left(yU,6)=='DEGREE' |
if left(yU, 6)=='DEGREE' then yU=substr(yU, 7) /* " " " " "degree" ? */ |
||
yU=strip(yU) /*elide all leading & trailing blanks. */ |
yU=strip(yU) /*elide all leading & trailing blanks. */ |
||
_=length(yU) /*obtain the length of the yU value. */ |
_=length(yU) /*obtain the length of the yU value. */ |
||
if right(yU,1)=='S' & _>1 then yU=left(yU,_-1) |
if right(yU,1)=='S' & _>1 then yU=left(yU, _-1) /*remove any trailing plural(s). */ |
||
select /*abbreviations ──► shortname. |
select /*change abbreviations ──► shortname.*/ |
||
when abbrev('AMONTON' , yU) then sn= |
when abbrev('AMONTON' , yU) then sn= "AMONTON" |
||
when abbrev('BARNDORF' , yU,2) |, |
when abbrev('BARNDORF' , yU,2) |, |
||
abbrev('BARNSDORF' , yU,2) then sn= |
abbrev('BARNSDORF' , yU,2) then sn= "BARNSDORF" |
||
when abbrev('BEAUMIUR' , yU,3) |, |
when abbrev('BEAUMIUR' , yU,3) |, |
||
abbrev('BEAUMUIR' , yU,3) then sn= |
abbrev('BEAUMUIR' , yU,3) then sn= "BEAUMUIR" |
||
when abbrev('BENERT' , yU,3) |, |
when abbrev('BENERT' , yU,3) |, |
||
abbrev('BENART' , yU,3) then sn= |
abbrev('BENART' , yU,3) then sn= "BENART" |
||
when abbrev('BRISSEN' , yU,3) |, |
when abbrev('BRISSEN' , yU,3) |, |
||
abbrev('BRISSON' , yU,3) then sn= |
abbrev('BRISSON' , yU,3) then sn= "BRISSEN" |
||
when abbrev('BURGEN' , yU,3) |, |
when abbrev('BURGEN' , yU,3) |, |
||
abbrev('BURGAN' , yU,3) |, |
abbrev('BURGAN' , yU,3) |, |
||
abbrev('BERGAN' , yU,3) |, |
abbrev('BERGAN' , yU,3) |, |
||
abbrev('BERGEN' , yU,3) then sn= |
abbrev('BERGEN' , yU,3) then sn= "BERGEN" |
||
when abbrev('CENTIGRADE' , yU) |, |
when abbrev('CENTIGRADE' , yU) |, |
||
abbrev('CENTRIGRADE' , yU) |, /* 50% misspelled.*/ |
abbrev('CENTRIGRADE' , yU) |, /* 50% misspelled.*/ |
||
Line 229: | Line 251: | ||
abbrev('CELISU' , yU) |, /* 1% misspelled.*/ |
abbrev('CELISU' , yU) |, /* 1% misspelled.*/ |
||
abbrev('CELSU' , yU) |, /* 1% misspelled.*/ |
abbrev('CELSU' , yU) |, /* 1% misspelled.*/ |
||
abbrev('CELSIU' , yU) then sn= |
abbrev('CELSIU' , yU) then sn= "CELSIUS" |
||
when abbrev('CIMANTO' , yU,2) |, |
when abbrev('CIMANTO' , yU,2) |, |
||
abbrev('CIMENTO' , yU,2) then sn= |
abbrev('CIMENTO' , yU,2) then sn= "CIMENTO" |
||
when abbrev('CRUQUIOU' , yU,2) |, |
when abbrev('CRUQUIOU' , yU,2) |, |
||
abbrev('CRUQUIO' , yU,2) |, |
abbrev('CRUQUIO' , yU,2) |, |
||
abbrev('CRUQUIU' , yU,2) then sn= |
abbrev('CRUQUIU' , yU,2) then sn= "CRUQUIU" |
||
when abbrev('DALANCE' , yU,4) |, |
when abbrev('DALANCE' , yU,4) |, |
||
abbrev('DALENCE' , yU,4) then sn= |
abbrev('DALENCE' , yU,4) then sn= "DALENCE" |
||
when abbrev('DANELLE' , yU,3) |, |
when abbrev('DANELLE' , yU,3) |, |
||
abbrev('DANEAL' , yU,3) |, |
abbrev('DANEAL' , yU,3) |, |
||
Line 244: | Line 266: | ||
abbrev('DANYAL' , yU,3) |, |
abbrev('DANYAL' , yU,3) |, |
||
abbrev('DANYEL' , yU,3) |, |
abbrev('DANYEL' , yU,3) |, |
||
abbrev('DANIELL' , yU,3) then sn= |
abbrev('DANIELL' , yU,3) then sn= "DANIELL" |
||
when abbrev('DALTON' , yU,3) then sn= |
when abbrev('DALTON' , yU,3) then sn= "DALTON" |
||
when abbrev('DELAHIRE' , yU,7) |, |
when abbrev('DELAHIRE' , yU,7) |, |
||
abbrev('LAHIRE' , yU,4) |, |
abbrev('LAHIRE' , yU,4) |, |
||
abbrev('HIRE' , yU,2) |, |
abbrev('HIRE' , yU,2) |, |
||
abbrev('DE-LA-HIRE' , yU,7) then sn= |
abbrev('DE-LA-HIRE' , yU,7) then sn= "DE LA HIRE" |
||
when abbrev('DELAVILLE' , yU,7) |, |
when abbrev('DELAVILLE' , yU,7) |, |
||
abbrev('LAVILLE' , yU,3) |, |
abbrev('LAVILLE' , yU,3) |, |
||
abbrev('VILLE' , yU,1) |, |
abbrev('VILLE' , yU,1) |, |
||
abbrev('VILLA' , yU,1) |, |
abbrev('VILLA' , yU,1) |, |
||
abbrev('DE-LA-VILLE' , yU,7) then sn= |
abbrev('DE-LA-VILLE' , yU,7) then sn= "DE LA VILLE" |
||
when abbrev('DELISLE' , yU,3) then sn= |
when abbrev('DELISLE' , yU,3) then sn= "DELISLE" |
||
when abbrev('DELISLE-OLD' , yU,8) |, |
when abbrev('DELISLE-OLD' , yU,8) |, |
||
abbrev('OLDDELISLE' , yU,6) |, |
abbrev('OLDDELISLE' , yU,6) |, |
||
abbrev('DELISLEOLD' , yU,8) then sn= |
abbrev('DELISLEOLD' , yU,8) then sn= "DELISLE OLD" |
||
when abbrev('DELUC' , yU,4) |, |
when abbrev('DELUC' , yU,4) |, |
||
abbrev('LUC' , yU,2) |, |
abbrev('LUC' , yU,2) |, |
||
abbrev('DE-LUC' , yU,5) then sn= |
abbrev('DE-LUC' , yU,5) then sn= "DE LUC" |
||
when abbrev('DELYON' , yU,4) |, |
when abbrev('DELYON' , yU,4) |, |
||
abbrev('LYON' , yU,2) |, |
abbrev('LYON' , yU,2) |, |
||
abbrev('DE-LYON' , yU,5) then sn= |
abbrev('DE-LYON' , yU,5) then sn= "DE LYON" |
||
when abbrev('DEREVILLA' , yU,3) |, |
when abbrev('DEREVILLA' , yU,3) |, |
||
abbrev('DEREVILA' , yU,3) |, |
abbrev('DEREVILA' , yU,3) |, |
||
abbrev('REVILLA' , yU,3) |, |
abbrev('REVILLA' , yU,3) |, |
||
abbrev('DE-REVILLA' , yU,4) |, |
abbrev('DE-REVILLA' , yU,4) |, |
||
abbrev('DE-REVILLA' , yU,5) then sn= |
abbrev('DE-REVILLA' , yU,5) then sn= "DE REVILLAS" |
||
when abbrev('DEVILLENEUVE' , yU,3) |, |
when abbrev('DEVILLENEUVE' , yU,3) |, |
||
abbrev('DE-VILLENEUVE' , yU,4) then sn= |
abbrev('DE-VILLENEUVE' , yU,4) then sn= "DE VILLENEUVE" |
||
when abbrev('DURHAM' , yU,3) |, |
when abbrev('DURHAM' , yU,3) |, |
||
abbrev('DERHAM' , yU,4) then sn= |
abbrev('DERHAM' , yU,4) then sn= "DERHAM" |
||
when abbrev('OLDDURHAM' , yU,5) |, |
when abbrev('OLDDURHAM' , yU,5) |, |
||
abbrev('OLDDERHAM' , yU,6) |, |
abbrev('OLDDERHAM' , yU,6) |, |
||
abbrev('DERHAM-OLD' , yU,4) |, |
abbrev('DERHAM-OLD' , yU,4) |, |
||
abbrev('DERHAMOLD' , yU,4) then sn= |
abbrev('DERHAMOLD' , yU,4) then sn= "DERHAM OLD" |
||
when abbrev('DE-SUEDE' , yU,4) |, |
when abbrev('DE-SUEDE' , yU,4) |, |
||
abbrev('DESUEDE' , yU,4) then sn= |
abbrev('DESUEDE' , yU,4) then sn= "DE SUEDE" |
||
when abbrev('DU-CREST' , yU,2) |, |
when abbrev('DU-CREST' , yU,2) |, |
||
abbrev('DUCREST' , yU,2) then sn= |
abbrev('DUCREST' , yU,2) then sn= "DU CREST" |
||
when abbrev('EDENBURGH' , yU,2) |, |
when abbrev('EDENBURGH' , yU,2) |, |
||
abbrev('EDINBURGH' , yU,2) then sn= |
abbrev('EDINBURGH' , yU,2) then sn= "EDINBURGH" |
||
when abbrev('EVOLT' , yU,2) |, |
when abbrev('EVOLT' , yU,2) |, |
||
abbrev('ELECTRONVOLT' , yU,2) then sn= |
abbrev('ELECTRONVOLT' , yU,2) then sn= "ELECTRON VOLTS" |
||
when abbrev('FARENHEIT' , yU) |, /* 39% misspelled.*/ |
when abbrev('FARENHEIT' , yU) |, /* 39% misspelled.*/ |
||
abbrev('FARENHEIGHT' , yU) |, /* 15% misspelled.*/ |
abbrev('FARENHEIGHT' , yU) |, /* 15% misspelled.*/ |
||
Line 301: | Line 323: | ||
abbrev('FARINHEIT' , yU) |, /* 1% misspelled.*/ |
abbrev('FARINHEIT' , yU) |, /* 1% misspelled.*/ |
||
abbrev('FARANHITE' , yU) |, /* 1% misspelled.*/ |
abbrev('FARANHITE' , yU) |, /* 1% misspelled.*/ |
||
abbrev('FAHRENHEIT' , yU) then sn= |
abbrev('FAHRENHEIT' , yU) then sn= "FAHRENHEIT" |
||
when abbrev('OLDFAHRENHEIT' , yU,4) |, |
when abbrev('OLDFAHRENHEIT' , yU,4) |, |
||
abbrev('FAHRENHEIT-OLD' , yU,13) |, |
abbrev('FAHRENHEIT-OLD' , yU,13) |, |
||
abbrev('FAHRENHEITOLD' , yU,13) then sn= |
abbrev('FAHRENHEITOLD' , yU,13) then sn= "FARHENHEIT OLD" |
||
when abbrev('FLORENTINE-LARGE' , yU,12) |, |
when abbrev('FLORENTINE-LARGE' , yU,12) |, |
||
abbrev('LARGE-FLORENTINE' , yU,7) |, |
abbrev('LARGE-FLORENTINE' , yU,7) |, |
||
abbrev('LARGEFLORENTINE' , yU,6) |, |
abbrev('LARGEFLORENTINE' , yU,6) |, |
||
abbrev('FLORENTINELARGE' , yU,12) then sn= |
abbrev('FLORENTINELARGE' , yU,12) then sn= "FLORENTINE LARGE" |
||
when abbrev('FLORENTINE-MAGNUM' , yU,2) |, |
when abbrev('FLORENTINE-MAGNUM' , yU,2) |, |
||
abbrev('MAGNUM-FLORENTINE' , yU,3) |, |
abbrev('MAGNUM-FLORENTINE' , yU,3) |, |
||
abbrev('MAGNUMFLORENTINE' , yU,3) |, |
abbrev('MAGNUMFLORENTINE' , yU,3) |, |
||
abbrev('FLORENTINEMAGNUM' , yU,2) then sn= |
abbrev('FLORENTINEMAGNUM' , yU,2) then sn= "FLORENTINE MAGNUM" |
||
when abbrev('FLORENTINE-SMALL' , yU,13) |, |
when abbrev('FLORENTINE-SMALL' , yU,13) |, |
||
abbrev('SMALL-FLORENTINE' , yU,7) |, |
abbrev('SMALL-FLORENTINE' , yU,7) |, |
||
abbrev('SMALLFLORENTINE' , yU,6) |, |
abbrev('SMALLFLORENTINE' , yU,6) |, |
||
abbrev('FLORENTINESMALL' , yU,13) then sn= |
abbrev('FLORENTINESMALL' , yU,13) then sn= "FLORENTINE SMALL" |
||
when abbrev('FOULER' , yU,2) |, |
when abbrev('FOULER' , yU,2) |, |
||
abbrev('FOWLOR' , yU,2) |, |
abbrev('FOWLOR' , yU,2) |, |
||
abbrev('FOWLER' , yU,2) then sn= |
abbrev('FOWLER' , yU,2) then sn= "FOWLER" |
||
when abbrev('FRICK' , yU,2) then sn= |
when abbrev('FRICK' , yU,2) then sn= "FRICK" |
||
when abbrev('GAS-MARK' , yU,2) |, |
when abbrev('GAS-MARK' , yU,2) |, |
||
abbrev('GASMARK' , yU,2) then sn= |
abbrev('GASMARK' , yU,2) then sn= "GAS MARK" |
||
when abbrev('GOUBERT' , yU,2) then sn= |
when abbrev('GOUBERT' , yU,2) then sn= "GOUBERT" |
||
when abbrev('HAIL' , yU,3) |, |
when abbrev('HAIL' , yU,3) |, |
||
abbrev('HALE' , yU,3) then sn= |
abbrev('HALE' , yU,3) then sn= "HALES" |
||
when abbrev('HANOW' , yU,3) then sn= |
when abbrev('HANOW' , yU,3) then sn= "HANOW" |
||
when abbrev('HUCKSBEE' , yU,3) |, |
when abbrev('HUCKSBEE' , yU,3) |, |
||
abbrev('HAWKSBEE' , yU,3) |, |
abbrev('HAWKSBEE' , yU,3) |, |
||
abbrev('HAUKSBEE' , yU,3) then sn= |
abbrev('HAUKSBEE' , yU,3) then sn= "HAUKSBEE" |
||
when abbrev('JACOBSHOLBORN' , yU,2) |, |
when abbrev('JACOBSHOLBORN' , yU,2) |, |
||
abbrev('JACOBS-HOLBORN' , yU,2) then sn= |
abbrev('JACOBS-HOLBORN' , yU,2) then sn= "JACOBS-HOLBORN" |
||
when abbrev('KALVIN' , yU) |, /* 27% misspelled.*/ |
when abbrev('KALVIN' , yU) |, /* 27% misspelled.*/ |
||
abbrev('KERLIN' , yU) |, /* 18% misspelled.*/ |
abbrev('KERLIN' , yU) |, /* 18% misspelled.*/ |
||
abbrev('KEVEN' , yU) |, /* 9% misspelled.*/ |
abbrev('KEVEN' , yU) |, /* 9% misspelled.*/ |
||
abbrev('KELVIN' , yU) then sn= |
abbrev('KELVIN' , yU) then sn= "KELVIN" |
||
when abbrev('LAYDEN' , yU) |, |
when abbrev('LAYDEN' , yU) |, |
||
abbrev('LEIDEN' , yU) then sn= |
abbrev('LEIDEN' , yU) then sn= "LEIDEN" |
||
when abbrev('NEUTON' , yU) |, /*100% misspelled.*/ |
when abbrev('NEUTON' , yU) |, /*100% misspelled.*/ |
||
abbrev('NEWTON' , yU) then sn= |
abbrev('NEWTON' , yU) then sn= "NEWTON" |
||
when abbrev('ORTEL' , yU) |, |
when abbrev('ORTEL' , yU) |, |
||
abbrev('OERTEL' , yU) then sn= |
abbrev('OERTEL' , yU) then sn= "OERTEL" |
||
when abbrev('PLACK' , yU) |, /*100% misspelled.*/ |
when abbrev('PLACK' , yU) |, /*100% misspelled.*/ |
||
abbrev('PLANC' , yU) |, /* misspelled.*/ |
abbrev('PLANC' , yU) |, /* misspelled.*/ |
||
abbrev('PLANK' , yU) |, /* misspelled.*/ |
abbrev('PLANK' , yU) |, /* misspelled.*/ |
||
abbrev('PLANCK' , yU) then sn= |
abbrev('PLANCK' , yU) then sn= "PLANCK" |
||
when abbrev('RANKINE' , yU, 1) then sn= |
when abbrev('RANKINE' , yU, 1) then sn= "RANKINE" |
||
when abbrev('REAUMUR' , yU, 2) then sn= |
when abbrev('REAUMUR' , yU, 2) then sn= "REAUMUR" |
||
when abbrev('RICKTER' , yU, 3) |, |
when abbrev('RICKTER' , yU, 3) |, |
||
abbrev('RICHTER' , yU, 3) then sn= |
abbrev('RICHTER' , yU, 3) then sn= "RICHTER" |
||
when abbrev('RINALDINI' , yU, 3) then sn= |
when abbrev('RINALDINI' , yU, 3) then sn= "RINALDINI" |
||
when abbrev('ROEMER' , yU, 3) |, |
when abbrev('ROEMER' , yU, 3) |, |
||
abbrev('ROMER' , yU, 3) then sn= |
abbrev('ROMER' , yU, 3) then sn= "ROMER" |
||
when abbrev('ROSANTHAL' , yU, 3) |, |
when abbrev('ROSANTHAL' , yU, 3) |, |
||
abbrev('ROSENTHAL' , yU, 3) then sn= |
abbrev('ROSENTHAL' , yU, 3) then sn= "ROSENTHAL" |
||
when abbrev('RSOL' , yU, 2) |, |
when abbrev('RSOL' , yU, 2) |, |
||
abbrev('RSL' , yU, 2) |, |
abbrev('RSL' , yU, 2) |, |
||
abbrev('ROYALSOCIETYOFLONDON' , yU, 3) |, |
abbrev('ROYALSOCIETYOFLONDON' , yU, 3) |, |
||
abbrev('ROYAL-SOCIETY-OF-LONDON' , yU, 3) then sn= |
abbrev('ROYAL-SOCIETY-OF-LONDON' , yU, 3) then sn= "ROYAL SOCIETY" |
||
when abbrev('SAGREDO' , yU, 3) then sn= |
when abbrev('SAGREDO' , yU, 3) then sn= "SAGREDO" |
||
when abbrev('ST.-PATRICE' , yU, 3) |, |
when abbrev('ST.-PATRICE' , yU, 3) |, |
||
abbrev('ST.PATRICE' , yU, 3) |, |
abbrev('ST.PATRICE' , yU, 3) |, |
||
abbrev('SAINTPATRICE' , yU, 3) |, |
abbrev('SAINTPATRICE' , yU, 3) |, |
||
abbrev('SAINT-PATRICE' , yU, 3) then sn= |
abbrev('SAINT-PATRICE' , yU, 3) then sn= "SAINT-PATRICE" |
||
when abbrev('STUFFE' , yU, 3) |, |
when abbrev('STUFFE' , yU, 3) |, |
||
abbrev('STUFE' , yU, 3) then sn= |
abbrev('STUFE' , yU, 3) then sn= "STUFE" |
||
when abbrev('SULTZER' , yU, 2) |, |
when abbrev('SULTZER' , yU, 2) |, |
||
abbrev('SULZER' , yU, 2) then sn= |
abbrev('SULZER' , yU, 2) then sn= "SULZER" |
||
when abbrev('WEDGEWOOD' , yU) |, |
when abbrev('WEDGEWOOD' , yU) |, |
||
abbrev('WEDGWOOD' , yU) then sn= |
abbrev('WEDGWOOD' , yU) then sn= "WEDGWOOD" |
||
otherwise call serr 'illegal temperature scale:' y |
otherwise call serr 'illegal temperature scale:' y |
||
end /*select*/ |
end /*select*/ |
||
return |
return |
||
Line 378: | Line 401: | ||
/*──────────────────────────────────one─liner subroutines───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ |
/*──────────────────────────────────one─liner subroutines───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ |
||
?: parse arg y; if not\=='' then do; if noS\== |
?: 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( |
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..() |
||
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 |
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: 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)) |
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,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 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: |
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.*/ |
s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/ |
||
serr: say; say '***error |
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 |
|||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6; |
|||
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ |
|||
numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2 |
|||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ |
|||
return g/1 |
|||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ |
|||
</lang> |
Revision as of 19:52, 9 April 2016
This is the unabridged version of the REXX program to solve the Rosetta Code task of Temperature conversion.
REXX
<lang rexx>/*REXX program converts tem4eratures for fifty-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. */
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 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.'
_=verify(z, '+-.0123456789') /*a list of valid number thingys. */ n=z
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 /*assign the full temperature name to !*/ end /*! now contains temp scale full name.*/
call scaleName u /*allow alternate temp. scale spellings*/ call convert2Fahrenheit /*convert a temperature ──↓ Farhrenheit*/
say right(' ' x, 79, "─") /*show original value & scale (for sep)*/
call convert2specific /*convert Farhrenheit ──► specific temp*/ end /*until tlist= */ /*this is a biggish DO loop. */
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 " " */
return right(_,60) /*return the re-formatted argument (#).*/
/*──────────────────────────────────CONVERT2FAHRENHEIT subroutine─────────────────────────────────────────────────*/
convert2Fahrenheit: /*convert N ──► °F temperatures. */
/* [↓] 57 different temperature scales*/ select when sn=='AMONTON' then F= n * 8.37209 - 399.163 when sn=='BARNSDORF' then F= n * 6.85714 + 6.85714 when sn=='BEAUMUIR' then F= n * 2.22951 + 32 when sn=='BENART' then F= n * 1.43391 + 31.2831 when sn=='BERGEN' then F=(n + 23.8667) * 15/14 when sn=='BRISSEN' then F= n * 32/15 + 32 when sn=='CELSIUS' then F= n * 9/5 + 32 /*a single C is taken as Celsius.*/ when sn=='CIMENTO' then F= n * 2.70677 - 4.54135 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 when sn=='DE LA VILLE' then F=(n + 6.48011) / 0.985568 when sn=='DELISLE' then F=212 - n * 6/5 when sn=='DELISLE OLD' then F=212 - n * 1.58590197 when sn=='DE LUC' then F=(n + 14) * 16/7 when sn=='DE LYON' then F=(n + 17.5) * 64/35 when sn=='DE REVILLAS' then F=212 - n * 97/80 when sn=='DERHAM' then F= n / 0.38444386 - 188.578 when sn=='DERHAM OLD' then F= n * 3 + 4.5 when sn=='DE SUEDE' then F=(n + 17.6666) * 150/83 when sn=='DE VILLENEUVE' then F=(n + 23.7037) / 0.740741 when sn=='DU CREST' then F=(n + 37.9202) / 0.650656 when sn=='EDINBURGH' then F= n * 4.6546 - 6.40048 when sn=='ELECTRON VOLTS' then F= n * 20888.1 - 459.67 when sn=='FAHRENHEIT' then F= n when sn=='FAHRENHEIT OLD' then F= n * 20/11 - 89.2727 when sn=='FLORENTINE LARGE' then F=(n + 7.42857) / 0.857143 when sn=='FLORENTINE MAGNUM' then F=(n + 73.9736 ) / 1.50659 when sn=='FLORENTINE SMALL' then F=(n - 1.38571) / 0.378571 when sn=='FOWLER' then F= n * 0.640321 + 53.7709 when sn=='FRICK' then F= n * 200/251 + 58.5339 when sn=='GASMARK' then F= n * 25 + 250 when sn=='GOUBERT' then F= n * 2 + 32 when sn=='HALES' then F= n * 1.2 + 32 when sn=='HANOW' then F= n * 1.06668 - 10.6672 when sn=='HAUKSBEE' then F= n * 18/25 + 88.16 when sn=='JACOBS-HOLBORN' then F= n * 18/71 - 53.4366 when sn=='KELVIN' then F= n * 9/5 - 459.67 when sn=='LEIDEN' then F= n * 1.8 - 423.4 when sn=='NEWTON' then F= n * 60/11 + 32 when sn=='OERTEL' then F= n + n - 32 when sn=='PLANCK' then F= n * 1.416833e32 * 9/5 - 459.67 when sn=='RANKINE' then F= n - 459.67 /*a single R is taken as Rankine.*/ when sn=='REAUMUR' then F= n * 9/4 + 32 when sn=='RICHTER' then F= n * 160/73 - 7.45205 when sn=='RINALDINI' then F= n * 15 + 32 when sn=='ROMER' then F=(n - 7.5) * 27/4 + 32 when sn=='ROSENTHAL' then F= n * 45/86 - 453.581 when sn=='ROYAL SOCIETY' then F=(n -122.82) * -50/69 when sn=='SAGREDO' then F= n * 0.3798 - 5.98 when sn=='SAINT-PATRICE' then F= n * 2.62123 + 115.879 when sn=='STUFE' then F= n * 45 + 257 when sn=='SULZER' then F= n * 1.14595 + 33.2334 when sn=='THERMOSTAT' then F= n * 54 + 32 when sn=='WEDGWOOD' then F= n * 44.7429295 + 516.2 otherwise call serr 'invalid temperature scale: ' u end /*select*/
return
/*──────────────────────────────────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.*/
if ?('AMONTON') then say $( ( F + 399.163 ) / 8.37209 ) "Amonton"
if ?('BARNSDORF') then say $( ( F - 6.85715) / 6.85715 ) "Barnsdorf"
if ?('BEAUMUIR') then say $( ( F - 32 ) / 2.22951 ) "Beaumuir"
if ?('BENART') then say $( ( F - 31.2831 ) / 1.43391 ) "Benart"
if ?('BERGEN') then say $( ( F * 14/15 ) - 23.8667 ) "Bergen"
if ?('BRISSON') then say $( ( F - 32 ) * 15/32 ) "Brisson"
if ?('CELSIUS') then say $( ( F - 32 ) * 5/9 ) "Celsius"
if ?('CIMENTO') then say $( ( F + 4.54135) / 2.70677 ) "Cimento"
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" if ?('DE LA VILLE') then say $( F * 0.985568 - 6.48011 ) "De la Ville" if ?('DELISLE') then say $( ( 212 - F ) * 5/6 ) "Delisle" if ?('DELISLE OLD') then say $( ( 212 - F ) / 1.58590197 ) "Delisle OLD" if ?('DE LUC') then say $( F * 7/16 - 14 ) "De Luc" if ?('DE LYON') then say $( F * 35/64 - 17.5 ) "De Lyon" if ?('DE REVILLAS') then say $( ( 212 - F ) * 80/97 ) "De Revillas" if ?('DERHAM') then say $( F * 0.38444386 + 72.4978 ) "Derham" if ?('DERHAM OLD') then say $( ( F - 4.5 ) / 3 ) "Derham OLD" if ?('DE VILLENEUVE') then say $( F * 0.740741 - 23.7037 ) "De Villeneuve" if ?('DE SUEDE') then say $( F * 83/150 - 17.6666 ) "De Suede" if ?('DU CREST') then say $( F * 0.650656 - 37.9202 ) "Du Crest" if ?('EDINBURGH') then say $( ( F + 6.40048) / 4.6546 ) "Edinburgh" if ?('ELECTRON VOLTS') then say $( eV ) "electron volt"s(eV) if ?('FAHRENHEIT') then say $( F ) "Fahrenheit" if ?('FAHRENHEIT OLD') then say $( F * 20/11 - 89.2727 ) "Fahrenheit OLD" if ?('FLORENTINE LARGE') then say $( F * 0.857143 - 7.42857 ) "Florentine large" if ?('FLORENTINE MAGNUM') then say $( F * 1.50659 - 73.9736 ) "Florentine Magnum" if ?('FLORENTINE SMALL') then say $( F * 0.378571 + 1.38571 ) "Florentine small" if ?('FOWLER') then say $( ( F - 53.7709 ) / 0.640321 ) "Fowler" if ?('FRICK') then say $( ( F - 58.5338 ) * 251/200 ) "Frick" if ?('GAS MARK') then say $( ( F - 250 ) * 0.04 ) "gas mark" if ?('GOUBERT') then say $( ( F + 32 ) * 0.5 ) "Goubert" if ?('HALES') then say $( ( F - 32 ) / 1.2 ) "Hales" if ?('HANOW') then say $( ( F + 10.6672 ) / 1.06668 ) "Hanow" if ?('HAUKSBEE') then say $( ( F - 88.16 ) * 25/18 ) "Hauksbee" if ?('JACOBS-HOLBORN') then say $( ( F + 53.4366 ) * 71/18 ) "Jacobs-Holborn" if ?('KELVIN') then say $( k ) "kelvin"s(k) if ?('LEIDEN') then say $( F / 1.8 + 235.222 ) "Leiden" if ?('NEWTON') then say $( ( F - 32 ) * 11/60 ) "Newton" if ?('OERTEL') then say $( ( F + 32 ) * 0.5 ) "Oertel" if ?('PLANCK') then say $( ( F + 459.67 ) * 5/9 / 1.416833e32 ) "Planck" if ?('RANKINE') then say $( F + 459.67 ) "Rankine" if ?('REAUMUR') then say $( ( F - 32 ) * 4/9 ) "Reaumur" if ?('RICHTER') then say $( ( F + 7.45205) * 73/160 ) "Richter" if ?('RINALDINI') then say $( ( F - 32 ) / 15 ) "Rinaldini" if ?('ROMER') then say $( ( F - 32 ) * 7/24 + 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" if ?('SAGREDO') then say $( ( F + 5.98 ) / 0.3798 ) "Segredo" if ?('SAINT-PATRICE') then say $( ( F - 115.879 ) / 2.62123 ) "Saint-Patrice" if ?('STUFE') then say $( ( F - 257 ) / 45 ) "Stufe" if ?('SULZER') then say $( ( F - 33.2334 ) / 1.14595 ) "Sulzer" if ?('THERMOSTAT') then say $( ( F - 32 ) / 54 ) "Thermostat" if ?('WEDGWOOD') then say $( ( F - 516.2 ) / 44.7429295 ) "Wedgwood"
return
/*──────────────────────────────────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) /*is this a redundant "degrees" ? */ 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). */
select /*change abbreviations ──► shortname.*/ when abbrev('AMONTON' , yU) then sn= "AMONTON" when abbrev('BARNDORF' , yU,2) |, abbrev('BARNSDORF' , yU,2) then sn= "BARNSDORF" when abbrev('BEAUMIUR' , yU,3) |, abbrev('BEAUMUIR' , yU,3) then sn= "BEAUMUIR" when abbrev('BENERT' , yU,3) |, abbrev('BENART' , yU,3) then sn= "BENART" when abbrev('BRISSEN' , yU,3) |, abbrev('BRISSON' , yU,3) then sn= "BRISSEN" when abbrev('BURGEN' , yU,3) |, abbrev('BURGAN' , yU,3) |, abbrev('BERGAN' , yU,3) |, abbrev('BERGEN' , yU,3) then sn= "BERGEN" when abbrev('CENTIGRADE' , yU) |, abbrev('CENTRIGRADE' , yU) |, /* 50% misspelled.*/ abbrev('CETIGRADE' , yU) |, /* 50% misspelled.*/ abbrev('CENTINGRADE' , yU) |, abbrev('CENTESIMAL' , yU) |, abbrev('CELCIU' , yU) |, /* 82% misspelled.*/ abbrev('CELCIOU' , yU) |, /* 4% misspelled.*/ abbrev('CELCUI' , yU) |, /* 4% misspelled.*/ abbrev('CELSUI' , yU) |, /* 2% misspelled.*/ abbrev('CELCEU' , yU) |, /* 2% misspelled.*/ abbrev('CELCU' , yU) |, /* 2% misspelled.*/ abbrev('CELISU' , yU) |, /* 1% misspelled.*/ abbrev('CELSU' , yU) |, /* 1% misspelled.*/ abbrev('CELSIU' , yU) then sn= "CELSIUS" when abbrev('CIMANTO' , yU,2) |, abbrev('CIMENTO' , yU,2) then sn= "CIMENTO" when abbrev('CRUQUIOU' , yU,2) |, abbrev('CRUQUIO' , yU,2) |, abbrev('CRUQUIU' , yU,2) then sn= "CRUQUIU" when abbrev('DALANCE' , yU,4) |, abbrev('DALENCE' , yU,4) then sn= "DALENCE" when abbrev('DANELLE' , yU,3) |, abbrev('DANEAL' , yU,3) |, abbrev('DANIAL' , yU,3) |, abbrev('DANIELE' , yU,3) |, abbrev('DANNEL' , yU,3) |, abbrev('DANYAL' , yU,3) |, abbrev('DANYEL' , yU,3) |, abbrev('DANIELL' , yU,3) then sn= "DANIELL" when abbrev('DALTON' , yU,3) then sn= "DALTON" when abbrev('DELAHIRE' , yU,7) |, abbrev('LAHIRE' , yU,4) |, abbrev('HIRE' , yU,2) |, abbrev('DE-LA-HIRE' , yU,7) then sn= "DE LA HIRE" when abbrev('DELAVILLE' , yU,7) |, abbrev('LAVILLE' , yU,3) |, abbrev('VILLE' , yU,1) |, abbrev('VILLA' , yU,1) |, abbrev('DE-LA-VILLE' , yU,7) then sn= "DE LA VILLE" when abbrev('DELISLE' , yU,3) then sn= "DELISLE" when abbrev('DELISLE-OLD' , yU,8) |, abbrev('OLDDELISLE' , yU,6) |, abbrev('DELISLEOLD' , yU,8) then sn= "DELISLE OLD" when abbrev('DELUC' , yU,4) |, abbrev('LUC' , yU,2) |, abbrev('DE-LUC' , yU,5) then sn= "DE LUC" when abbrev('DELYON' , yU,4) |, abbrev('LYON' , yU,2) |, abbrev('DE-LYON' , yU,5) then sn= "DE LYON" when abbrev('DEREVILLA' , yU,3) |, abbrev('DEREVILA' , yU,3) |, abbrev('REVILLA' , yU,3) |, abbrev('DE-REVILLA' , yU,4) |, abbrev('DE-REVILLA' , yU,5) then sn= "DE REVILLAS" when abbrev('DEVILLENEUVE' , yU,3) |, abbrev('DE-VILLENEUVE' , yU,4) then sn= "DE VILLENEUVE" when abbrev('DURHAM' , yU,3) |, abbrev('DERHAM' , yU,4) then sn= "DERHAM" when abbrev('OLDDURHAM' , yU,5) |, abbrev('OLDDERHAM' , yU,6) |, abbrev('DERHAM-OLD' , yU,4) |, abbrev('DERHAMOLD' , yU,4) then sn= "DERHAM OLD" when abbrev('DE-SUEDE' , yU,4) |, abbrev('DESUEDE' , yU,4) then sn= "DE SUEDE" when abbrev('DU-CREST' , yU,2) |, abbrev('DUCREST' , yU,2) then sn= "DU CREST" when abbrev('EDENBURGH' , yU,2) |, abbrev('EDINBURGH' , yU,2) then sn= "EDINBURGH" when abbrev('EVOLT' , yU,2) |, abbrev('ELECTRONVOLT' , yU,2) then sn= "ELECTRON VOLTS" when abbrev('FARENHEIT' , yU) |, /* 39% misspelled.*/ abbrev('FARENHEIGHT' , yU) |, /* 15% misspelled.*/ abbrev('FARENHITE' , yU) |, /* 6% misspelled.*/ abbrev('FARENHIET' , yU) |, /* 3% misspelled.*/ abbrev('FARHENHEIT' , yU) |, /* 3% misspelled.*/ abbrev('FARINHEIGHT' , yU) |, /* 2% misspelled.*/ abbrev('FARENHIGHT' , yU) |, /* 2% misspelled.*/ abbrev('FAHRENHIET' , yU) |, /* 2% misspelled.*/ abbrev('FERENHEIGHT' , yU) |, /* 2% misspelled.*/ abbrev('FEHRENHEIT' , yU) |, /* 2% misspelled.*/ abbrev('FERENHEIT' , yU) |, /* 2% misspelled.*/ abbrev('FERINHEIGHT' , yU) |, /* 1% misspelled.*/ abbrev('FARIENHEIT' , yU) |, /* 1% misspelled.*/ abbrev('FARINHEIT' , yU) |, /* 1% misspelled.*/ abbrev('FARANHITE' , yU) |, /* 1% misspelled.*/ abbrev('FAHRENHEIT' , yU) then sn= "FAHRENHEIT" when abbrev('OLDFAHRENHEIT' , yU,4) |, abbrev('FAHRENHEIT-OLD' , yU,13) |, abbrev('FAHRENHEITOLD' , yU,13) then sn= "FARHENHEIT OLD" when abbrev('FLORENTINE-LARGE' , yU,12) |, abbrev('LARGE-FLORENTINE' , yU,7) |, abbrev('LARGEFLORENTINE' , yU,6) |, abbrev('FLORENTINELARGE' , yU,12) then sn= "FLORENTINE LARGE" when abbrev('FLORENTINE-MAGNUM' , yU,2) |, abbrev('MAGNUM-FLORENTINE' , yU,3) |, abbrev('MAGNUMFLORENTINE' , yU,3) |, abbrev('FLORENTINEMAGNUM' , yU,2) then sn= "FLORENTINE MAGNUM" when abbrev('FLORENTINE-SMALL' , yU,13) |, abbrev('SMALL-FLORENTINE' , yU,7) |, abbrev('SMALLFLORENTINE' , yU,6) |, abbrev('FLORENTINESMALL' , yU,13) then sn= "FLORENTINE SMALL" when abbrev('FOULER' , yU,2) |, abbrev('FOWLOR' , yU,2) |, abbrev('FOWLER' , yU,2) then sn= "FOWLER" when abbrev('FRICK' , yU,2) then sn= "FRICK" when abbrev('GAS-MARK' , yU,2) |, abbrev('GASMARK' , yU,2) then sn= "GAS MARK" when abbrev('GOUBERT' , yU,2) then sn= "GOUBERT" when abbrev('HAIL' , yU,3) |, abbrev('HALE' , yU,3) then sn= "HALES" when abbrev('HANOW' , yU,3) then sn= "HANOW" when abbrev('HUCKSBEE' , yU,3) |, abbrev('HAWKSBEE' , yU,3) |, abbrev('HAUKSBEE' , yU,3) then sn= "HAUKSBEE" when abbrev('JACOBSHOLBORN' , yU,2) |, abbrev('JACOBS-HOLBORN' , yU,2) then sn= "JACOBS-HOLBORN" when abbrev('KALVIN' , yU) |, /* 27% misspelled.*/ abbrev('KERLIN' , yU) |, /* 18% misspelled.*/ abbrev('KEVEN' , yU) |, /* 9% misspelled.*/ abbrev('KELVIN' , yU) then sn= "KELVIN" when abbrev('LAYDEN' , yU) |, abbrev('LEIDEN' , yU) then sn= "LEIDEN" when abbrev('NEUTON' , yU) |, /*100% misspelled.*/ abbrev('NEWTON' , yU) then sn= "NEWTON" when abbrev('ORTEL' , yU) |, abbrev('OERTEL' , yU) then sn= "OERTEL" when abbrev('PLACK' , yU) |, /*100% misspelled.*/ abbrev('PLANC' , yU) |, /* misspelled.*/ abbrev('PLANK' , yU) |, /* misspelled.*/ abbrev('PLANCK' , yU) then sn= "PLANCK" when abbrev('RANKINE' , yU, 1) then sn= "RANKINE" when abbrev('REAUMUR' , yU, 2) then sn= "REAUMUR" when abbrev('RICKTER' , yU, 3) |, abbrev('RICHTER' , yU, 3) then sn= "RICHTER" when abbrev('RINALDINI' , yU, 3) then sn= "RINALDINI" when abbrev('ROEMER' , yU, 3) |, abbrev('ROMER' , yU, 3) then sn= "ROMER" when abbrev('ROSANTHAL' , yU, 3) |, abbrev('ROSENTHAL' , yU, 3) then sn= "ROSENTHAL" when abbrev('RSOL' , yU, 2) |, abbrev('RSL' , yU, 2) |, abbrev('ROYALSOCIETYOFLONDON' , yU, 3) |, abbrev('ROYAL-SOCIETY-OF-LONDON' , yU, 3) then sn= "ROYAL SOCIETY" when abbrev('SAGREDO' , yU, 3) then sn= "SAGREDO" when abbrev('ST.-PATRICE' , yU, 3) |, abbrev('ST.PATRICE' , yU, 3) |, abbrev('SAINTPATRICE' , yU, 3) |, abbrev('SAINT-PATRICE' , yU, 3) then sn= "SAINT-PATRICE" when abbrev('STUFFE' , yU, 3) |, abbrev('STUFE' , yU, 3) then sn= "STUFE" when abbrev('SULTZER' , yU, 2) |, abbrev('SULZER' , yU, 2) then sn= "SULZER" when abbrev('WEDGEWOOD' , yU) |, abbrev('WEDGWOOD' , yU) then sn= "WEDGWOOD"
otherwise call serr 'illegal temperature scale:' y end /*select*/
return
/*──────────────────────────────────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>