1package Math::Units; 2 3# Copyright 1997, 1998 Ken Fox 4 5# This program is free software; you can redistribute it and/or modify 6# it under the terms of either: 7# 8# a) the GNU General Public License as published by the Free 9# Software Foundation; either version 1, or (at your option) any 10# later version, or 11# 12# b) the "Artistic License," the text of which is distributed with 13# Perl 5. If you need a copy of this license, please write to 14# me at <fox@vulpes.com> and I will be happy to send one. 15# 16# This program is distributed in the hope that it will be useful, 17# but WITHOUT ANY WARRANTY; without even the implied warranty of 18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either 19# the GNU General Public License or the Artistic License for more 20# details. 21 22=head1 NAME 23 24Math::Units - Unit conversion 25 26=head1 SYNOPSIS 27 28use Math::Units qw(convert); 29 30my $out_value = convert($in_value, 'in unit', 'out unit'); 31 32=head1 DESCRIPTION 33 34The Math::Units module converts a numeric value in one unit of measurement 35to some other unit. The units must be compatible, i.e. length can not be 36converted to volume. If a conversion can not be made an exception is thrown. 37 38A combination chaining and reduction algorithm is used to perform the most 39direct unit conversion possible. Units may be written in several different 40styles. An abbreviation table is used to convert from common long-form unit 41names to the (more or less) standard abbreviations that the units module uses 42internally. All multiplicative unit conversions are cached so that future 43conversions can be performed very quickly. 44 45Too many units, prefixes and abbreviations are supported to list here. See 46the source code for a complete listing. 47 48=head1 TODO 49 50I beleive this module has great potential, if you have any ideas or patches feel free to submit them to rt.cpan.org. 51 52'units' program test like 'gunits' 53 54other tests 55 56POD about what units/abbr/etc can be used with the function 57 58general cleanup 59 60Mr. Fox's original TODO: 61 621. There should be a set of routines for adding new unit formulas, 63 reductions and conversions. 64 652. Some conversions can be automatically generated from a reduction. (This 66 has to be done carefully because conversions are bi-directional while 67 reductions *must* be consistently uni-directional.) 68 693. It would be nice to simplify the default conversions using the 70 yet-to-be-written solution to #2. 71 724. There are many units (several in the GNU unit program for example) that 73 aren't defined here. Since I was (un)fortunately born in the U.S., I 74 have a(n) (in)correct belief of what the standard units are. Please let 75 me know if I've messed anything up! 76 77=head1 EXAMPLES 78 79print "5 mm == ", convert(5, 'mm', 'in'), " inches\n"; 80print "72 degrees Farenheit == ", convert(72, 'F', 'C'), " degrees Celsius\n"; 81print "1 gallon == ", convert(1, 'gallon', 'cm^3'), " cubic centimeters\n"; 82print "4500 rpm == ", convert(4500, 'rpm', 'Hz'), " Hertz\n"; 83 84=cut 85 86use strict; 87use vars qw($VERSION @ISA @EXPORT_OK); 88 89$VERSION = 1.3; 90 91require Exporter; 92@ISA = qw(Exporter); 93@EXPORT_OK = qw(convert print_conversion); 94 95use Carp; 96 97# Prefixes are used to alter the magnitude of a unit. They 98# can *not* be chained together to form compound prefixes. 99# (For special cases of compound prefixes, you can enter an 100# abbreviation that rewrites the compound prefix to a single 101# prefix of the right magnitude.) 102 103my %prefixes = ( 104 'T' => 1e12, 105 'G' => 1e9, 106 'M' => 1e6, 107 'k' => 1000, 108 'h' => 100, 109 'da' => 10, 110 'd' => .1, 111 'c' => .01, 112 'm' => .001, 113 '�' => 1e-6, 114 'n' => 1e-9, 115 'dn' => 1e-10, 116 'p' => 1e-12, 117 'f' => 1e-15 118); 119 120# Formulas and reductions are carefully chosen expressions that 121# define a unit in terms of other units (and constants). The 122# unit conversion algorithm always applies a formula definition, 123# but only uses a reduction as a last ditch effort to make the 124# conversion. The reason for this is that reductions can lead 125# to very long chains of unit conversions. However, in most 126# conversions a single factor can be used which will skip the 127# entire reduction process (and improve accuracy besides). 128# 129# Always express a unit in terms of more fundamental units. 130# Loops are not detected and will cause the conversion algorithm 131# to hang. (Adding units is intended to be easy, but not 132# trivial.) 133# 134# See below for conversion examples. 135 136my %formulas = ( 137 'are' => '100 m^2', # as in hectare 138 'l' => 'm^3/1000', # liter 139 'tonne' => '1000 kg', # metric ton 140 'N' => 'kg m/s^2', # newton 141 'dyn' => 'cm gram/s^2', 142 'Pa' => 'N/m^2', # pascal 143 'bar' => '1e5 Pa', 144 'barye' => 'dyne/cm^2', 145 'kine' => 'cm/s', 146 'bole' => 'g kine', 147 'pond' => 'gram gee', 148 'glug' => 'pond s^2/cm', 149 'J' => 'N m', # joule 150 'W' => 'J/s', # watt 151 'gee' => '9.80665 m/s^2', # Earth gravity 152 'atm' => '101325 Pa', # Earth atmosphere 153 'Hg' => '13.5951 pond/cm^3', # mercury (used in: inches Hg) 154 'water' => 'pond/cm^3', # water (used in: inches water) 155 'mach' => '331.46 m/s', # speed of sound 156 'coulomb' => 'A s', 157 'V' => 'W/A', # volt 158 'ohm' => 'V/A', 159 'siemens' => 'A/V', 160 'farad' => 'coulomb/V', 161 'Wb' => 'V s', # weber 162 'henry' => 'Wb/A', 163 'tesla' => 'Wb/m^2', 164 'Hz' => 'cycle/s', # hertz 165 166 'lbf' => 'lb gee', # pounds of force 167 'tonf' => 'ton gee', # tons of force 168 169 'duty' => 'ft lbf', 170 'celo' => 'ft/s^2', 171 'jerk' => 'ft/s^3', 172 173 'slug' => 'lbf s^2/ft', 174 'reyn' => 'psi sec', # viscosity 175 176 'psi' => 'lbf/in^2', # pounds per square inch 177 'tsi' => 'tonf/in^2', # tons per square inch 178 179 'ouncedal' => 'oz ft/s^2', # force which accelerates an ounce at 1 ft/s^2 180 'poundal' => 'lb ft/s^2', # same thing for a pound 181 'tondal' => 'ton ft/s^2', # and for a ton 182 183 'hp' => '550 ft lbf/s', # horse power 184 'nauticalmile' => '1852 m', 185 'mil' => '.001 in' 186); 187 188# The base units are: 189# 190# m .............. meter (length) meter^2 (area) meter^3 (volume) 191# g .............. gram (mass) 192# s .............. second (time) 193# deg ............ degree (angular measure) 194# A .............. ampere (current) 195# C .............. degrees Celsius (temperature) 196# Cd ............. Celsius degrees (temperature change) 197 198my %reductions = ( 199 'in' => '0.0254 m', # inches 200 'pnt' => 'in/72', # PostScript points 201 'ft' => '12 in', # feet 202 'yd' => '3 ft', # yards 203 'mi' => '5280 ft', # miles 204 'kip' => '1000 lbf', # kilo pounds 205 206 'barrel' => '42 gal', # barrels 207 'gal' => '231 in^3', # gallons 208 'qt' => 'gal/4', # quarts 209 'pt' => 'qt/2', # pints 210 'gill' => 'pt/4', # gills 211 'floz' => 'pt/16', # fluid ounces 212 213 'Fd' => '1.8 Cd', # Farenheit degrees (change) 214 'Kd' => 'Cd', # Kelvins (change) 215 216 'min' => '60 s', # minutes 217 'hr' => '60 min', # hours 218 'day' => '24 hr', # days 219 'wk' => '7 day', # weeks 220 221 'lb' => '453.59237 g', # pounds 222 'oz' => 'lb/16', # ounces 223 'dr' => 'oz/16', # drams 224 'gr' => 'lb/7000', # grains 225 'ton' => '2000 lb', # tons 226 227 'cycle' => '360 deg', # complete revolution = 1 cycle 228 'rad' => '180 deg/3.14159265358979323846', # radians 229 'grad' => '9 deg/10', # gradians 230 231 'troypound' => '5760 gr', # troy pound 232 'troyounce' => 'troypound/12', # troy ounce 233 'pennyweight' => 'troyounce/20', # penny weight 234 235 'carat' => '0.2 gm' # carat 236); 237 238# Abbreviations are simple text conversions that convert a pattern 239# expression (i.e. a Perl regular expression) into a different form. 240# Usually these convert from the long, spelled out form of a unit 241# to the unit's abbreviated form. Plural forms are also eliminated. 242# A few small bows to standard spoken units are also available. 243# 244# Examples: 245# 246# meters => m 247# kilometers => k-meters => k-m 248# grams/cc => grams/cm^3 => g/cm^3 249# meters per second => m/s 250# cubic inches => cu-in 251# feet squared => ft^2 252# hectares => h-are 253# 254# Abbreviation substitutions are applied IN THE GIVEN ORDER to the unit 255# until no more abbreviations match. As in the formula and 256# reduction expressions, be careful to avoid rewriting loops. Also, 257# be aware that longer abbreviations should appear first to avoid 258# the possibility of an unintended rewrite. 259 260my @abbreviations = ( 261 '\bper\b' => '\/', 262 '\bsq(uare)?\s+' => 'sq,', 263 '\bcu(bic)?\s+' => 'cu,', 264 '\s+squared\b' => '^2', 265 '\s+cubed\b' => '^3', 266 267 '\bmicrons?\b' => '�,m', 268 269 '\bdecinano-?' => 'dn,', 270 '\btera-?' => 'T,', 271 '\bgiga-?' => 'G,', 272 '\bmega-?' => 'M,', 273 '\bkilo-?' => 'k,', 274 '\bhecto-?' => 'h,', 275 '\bdeka-?' => 'da,', 276 '\bdeca-?' => 'da,', 277 '\bdeci-?' => 'd,', 278 '\bcenti-?' => 'c,', 279 '\bmilli-?' => 'm,', 280 '\bmicro-?' => '�,', 281 '\bnano-?' => 'n,', 282 '\bpico-?' => 'p,', 283 '\bfemto-?' => 'f,', 284 285 '\bdn-' => 'dn,', 286 '\bT-' => 'T,', 287 '\bG-' => 'G,', 288 '\bM-' => 'M,', 289 '\bk-' => 'k,', 290 '\bh-' => 'h,', 291 '\bda-' => 'da,', 292 '\bda-' => 'da,', 293 '\bd-' => 'd,', 294 '\bc-' => 'c,', 295 '\bm-' => 'm,', 296 '\b�-' => '�,', 297 '\bn-' => 'n,', 298 '\bp-' => 'p,', 299 '\bf-' => 'f,', 300 301 '\b[Rr][Pp][Mm]\b' => 'cycle\/min', 302 '\bhz\b' => 'Hz', 303 304 '\b[Cc]elsius\b' => 'C', 305 '\b[Ff]arenheit\b' => 'F', 306 '\b[Kk]elvins?\b' => 'K', 307 '\bdegs?\s+C\b' => 'C', 308 '\bdegs?\s+F\b' => 'F', 309 '\bC\s+change\b' => 'Cd', 310 '\bF\s+change\b' => 'Fd', 311 '\bK\s+change\b' => 'Kd', 312 313 '\bdegs\b' => 'deg', 314 '\bdegrees?\b' => 'deg', 315 '\brads\b' => 'rad', 316 '\bradians?\b' => 'rad', 317 '\bgrads\b' => 'grad', 318 '\bgradians?\b' => 'grad', 319 320 '\bangstroms?\b' => 'dn,m', 321 '\bcc\b' => 'cm^3', 322 '\bhectares?\b' => 'h,are', 323 '\bmils?\b' => 'm,in', 324 'amperes?\b' => 'A', 325 'amps?\b' => 'A', 326 'days\b' => 'day', 327 'drams?\b' => 'dr', 328 'dynes?\b' => 'dyn', 329 'feet\b' => 'ft', 330 'foot\b' => 'ft', 331 'gallons?\b' => 'gal', 332 'gm\b' => 'g', 333 'grams?\b' => 'g', 334 'grains?\b' => 'gr', 335 'hours?\b' => 'hr', 336 'inch(es)?\b' => 'in', 337 'joules?\b' => 'J', 338 'lbs\b' => 'lb', 339 'lbm\b' => 'lb', 340 'liters?\b' => 'l', 341 'meters?\b' => 'm', 342 'miles?\b' => 'mi', 343 'minutes?\b' => 'min', 344 'newtons?\b' => 'N', 345 'ounces?\b' => 'oz', 346 'pascals?\b' => 'Pa', 347 'pints?\b' => 'pt', 348 'points?\b' => 'pnt', 349 'pounds?\b' => 'lb', 350 'quarts?\b' => 'qt', 351 'seconds?\b' => 's', 352 'secs?\b' => 's', 353 'watts?\b' => 'W', 354 'weeks?\b' => 'wk', 355 'yards?\b' => 'yd' 356); 357 358# The conversion table *must* define unit conversion in terms 359# of the base units, not in terms of units with prefixes. This 360# table will be used to generate the initial conversion factors 361# used in simple unit to unit conversion. Inverse factors will 362# be automatically generated where possible. As new unit 363# conversion paths are discovered, the combined conversion 364# factors will be added to the table. No conversion factors 365# should be entered for units that are defined in the formula 366# table. (Many or all of the reductions will be redundantly 367# defined in the conversions table. The reductions table uses 368# a more general format which makes automatic conversion a 369# bit tricky.) 370# 371# The entire purpose of the conversion table is to allow a 372# more direct unit conversion path. The reduction algorithm 373# will always find a conversion (if one exists) but it may 374# use many more multiplies than if the conversion table is 375# used directly. 376# 377# Here is an example contrasting the two approaches. Given 378# the following base facts: 379# 380# reductions: in -> m, ft -> in, yd -> ft 381# conversions: in <-> m, ft <-> in, yd <-> ft 382# 383# convert feet to yards: 384# 385# by reduction: ft -> in -> m <- in <- ft <- yd 386# by conversion: ft -> yd 387# 388# This demonstrates that fewer intermediate multiplies are 389# performed in the direct conversion approach over the reduction 390# approach. However, the following problem can not be easily 391# solved in the direct conversion approach: 392# 393# convert square meters to inch * feet: 394# 395# by reduction: m^2 -> area <- m m <- m feet <- inch feet 396# by conversion: m^2 -> no match! 397# 398# Conversion can't solve this problem unless it first breaks up 399# square meters into meter * meter. Simple in this case, but very 400# hard to generalize. 401# 402# In summary, the direct conversion system uses fewer intermediate 403# conversions for better accuracy (and possibly performance but 404# that isn't really an issue). The reduction system is more 405# general in that it can solve conversion problems that the direct 406# conversion system can't. 407# 408# Examples: 409# 410# m -> in is solved by m -> in 411# in -> m is solved by in -> m (inverses are automatically generated) 412# qt -> ft^3 is solved by qt -> gal -> in^3 -> ft^3 413# l -> ft^3 is solved by l -> m^3 -> in^3 -> ft^3 414# K -> F is solved by K -> C -> F 415 416my %conversions = ( 417 'in,m' => 0.0254, 418 'in,pnt' => 72, 419 'ft,in' => 12, 420 'yd,ft' => 3, 421 'mi,ft' => 5280, 422 423 'barrel,gal' => 42, 424 'gal,in^3' => 231, 425 'gal,qt' => 4, 426 'qt,pt' => 2, 427 'pt,floz' => 16, 428 'pt,gill' => 4, 429 430 'C,F' => sub { $_[0] * 1.8 + 32 }, 431 'F,C' => sub { ( $_[0] - 32 ) / 1.8 }, 432 'K,C' => sub { $_[0] - 273.15 }, 433 'C,K' => sub { $_[0] + 273.15 }, 434 435 'Cd,Fd' => 1.8, 436 'Kd,Cd' => 1, 437 438 'wk,day' => 7, 439 'day,hr' => 24, 440 'hr,min' => 60, 441 'min,s' => 60, 442 443 'dollar,cent' => 100, 444 445 'lb,g' => 453.59237, 446 'lb,oz' => 16, 447 'lb,gr' => 7000, 448 'oz,dr' => 16, 449 'ton,lb' => 2000, 450 451 'cycle,deg' => 360, 452 'rad,deg' => 180 / 3.14159265358979323846, 453 'grad,deg' => 9 / 10, 454 455 'troypound,gr' => 5760, 456 'troypound,troyounce' => 12, 457 'troyounce,pennyweight' => 20, 458 459 'carat,gm' => .2 460); 461 462my $factors_computed = 0; # have the base conversion factors been computed? 463my %factor = (); # conversion factors for base units 464my %conversion_history = (); # history of conversion factors for raw unit strings 465 466sub register_factor { 467 my ( $u1, $u2, $f ) = @_; 468 469 $factor{$u1}{$u2} = $f; 470 $factor{$u2}{$u1} = 1 / $f if ( ref($f) ne "CODE" ); 471} 472 473sub print_unit($\%) { 474 my ( $prefix, $u_group ) = @_; 475 my ( $num_str, $den_str, $u, $dim ); 476 477 $num_str = ""; 478 $den_str = ""; 479 480 while ( ( $u, $dim ) = each %{$u_group} ) { 481 if ( $u eq "1" ) { $prefix *= $dim } 482 elsif ( $dim > 1 ) { $num_str .= "$u^$dim " } 483 elsif ( $dim == 1 ) { $num_str .= "$u " } 484 elsif ( $dim == -1 ) { $den_str .= "$u " } 485 elsif ( $dim < -1 ) { $den_str .= join( "", $u, "^", -$dim, " " ) } 486 } 487 488 $num_str .= "$prefix " if ( $prefix != 1 ); 489 490 chop $num_str; 491 chop $den_str; 492 493 $num_str = "1" if ( !$num_str ); 494 495 print $num_str; 496 print "/", $den_str if ($den_str); 497 print "\n"; 498} 499 500my $current_prefix; 501my %current_group; 502 503sub merge_simple_unit { 504 my ( $prefix, $u, $dim ) = @_; 505 506 if ( $dim > 1 ) { $current_prefix *= $prefix**$dim } 507 if ( $dim == 1 ) { $current_prefix *= $prefix } 508 elsif ( $dim == -1 ) { $current_prefix /= $prefix } 509 elsif ( $dim < -1 ) { $current_prefix /= $prefix**-$dim } 510 511 if ( $u ne "1" ) { 512 if ( defined( $current_group{$u} ) ) { $current_group{$u} += $dim } 513 else { $current_group{$u} = $dim } 514 515 delete $current_group{$u} if ( $current_group{$u} == 0 ); 516 } 517} 518 519sub reduce_simple_unit { 520 my ( $u, $dim, $apply_reductions ) = @_; 521 my ($p); 522 523 if ( defined( $formulas{$u} ) ) { 524 reduce_unit( $formulas{$u}, $dim, $apply_reductions ); 525 return; 526 } 527 528 if ( $apply_reductions && defined( $reductions{$u} ) ) { 529 reduce_unit( $reductions{$u}, $dim, $apply_reductions ); 530 return; 531 } 532 elsif ( defined( $factor{$u} ) ) { 533 merge_simple_unit( 1, $u, $dim ); 534 return; 535 } 536 537 foreach $p ( keys %prefixes ) { 538 if ( $u =~ /^$p,?(.+)/ ) { 539 if ( defined( $formulas{$1} ) ) { 540 merge_simple_unit( $prefixes{$p}, "1", $dim ); 541 reduce_unit( $formulas{$1}, $dim, $apply_reductions ); 542 return; 543 } 544 if ( $apply_reductions && defined( $reductions{$1} ) ) { 545 merge_simple_unit( $prefixes{$p}, "1", $dim ); 546 reduce_unit( $reductions{$1}, $dim, $apply_reductions ); 547 return; 548 } 549 elsif ( defined( $factor{$1} ) ) { 550 merge_simple_unit( $prefixes{$p}, $1, $dim ); 551 return; 552 } 553 } 554 } 555 556 Carp::croak "unknown unit '$u' used"; 557} 558 559sub reduce_unit { 560 my ( $u_group, $dim, $apply_reductions ) = @_; 561 my ($u); 562 563 foreach $u ( keys %{$u_group} ) { 564 if ( $u eq "1" ) { 565 merge_simple_unit( $u_group->{$u}, $u, $dim ); 566 } 567 else { 568 reduce_simple_unit( $u, $dim * $u_group->{$u}, $apply_reductions ); 569 } 570 } 571} 572 573sub canonicalize_unit_list (\@$$) { 574 my ( $units, $u_group, $denomenator ) = @_; 575 my ( $u, $dim ); 576 577 foreach $u ( @{$units} ) { 578 next if ( !$u ); 579 580 if ( $u =~ s/\^(.+)$// ) { # unit of higher dimension, e.g. "cm^3" 581 $dim = $1; 582 } 583 elsif ( $u =~ /^sq,(.+)/ ) { # square unit, e.g. "sq-in" 584 $u = $1; 585 $dim = 2; 586 } 587 elsif ( $u =~ /^cu,(.+)/ ) { # cubic unit, e.g. "cu-in" 588 $u = $1; 589 $dim = 3; 590 } 591 else { 592 $dim = 1; 593 } 594 595 $dim = -$dim if ($denomenator); 596 597 if ( $u =~ /^-?\d+(?:\.\d+)?(?:e-?\d+)?$/ ) { 598 if ( $dim == 1 ) { $dim = $u } 599 elsif ( $dim == -1 ) { $dim = 1 / $u } 600 else { $dim = $u**$dim } 601 $u = "1"; 602 } 603 604 if ( defined( $u_group->{$u} ) ) { 605 if ( $u eq "1" ) { $u_group->{$u} *= $dim } 606 else { $u_group->{$u} += $dim } 607 } 608 else { 609 $u_group->{$u} = $dim; 610 } 611 } 612} 613 614sub canonicalize_unit_string ($$) { 615 my ( $units, $u_group ) = @_; 616 my ( $num, $den, $u, @units ); 617 618 substitute_abbreviations( \$units ); 619 $units =~ tr [*][ ]; 620 $units =~ s/\s*\^\s*/\^/g; 621 $units =~ s/-\s*(\D)/ $1/g; 622 623 if ( $units =~ m|^([^/]*)/(.*)| ) { 624 $num = $1; 625 $den = $2; 626 $den =~ tr [/][ ]; 627 } 628 else { 629 $num = $units; 630 $den = ""; 631 } 632 633 @units = split( /\s+/, $num ); 634 if ( scalar @units ) { 635 canonicalize_unit_list( @units, $u_group, 0 ); 636 } 637 638 @units = split( /\s+/, $den ); 639 if ( scalar @units ) { 640 canonicalize_unit_list( @units, $u_group, 1 ); 641 } 642 643 $u_group; 644} 645 646sub reduce_toplevel_unit ($\%) { 647 my ( $units, $u_group ) = @_; 648 649 canonicalize_unit_string( $units, $u_group ); 650 651 $current_prefix = 1; 652 %current_group = (); 653 654 reduce_unit( $u_group, 1, 0 ); 655 656 %{$u_group} = %current_group; 657 658 $current_prefix; 659} 660 661sub finish_reducing_toplevel_unit (\%) { 662 my ($u_group) = @_; 663 664 $current_prefix = 1; 665 %current_group = (); 666 667 reduce_unit( $u_group, 1, 1 ); 668 669 %{$u_group} = %current_group; 670 671 $current_prefix; 672} 673 674sub get_factor { 675 my ( $u1, $u2 ) = @_; 676 677 ( $u1 eq $u2 ) ? 1 : $factor{$u1}{$u2}; 678} 679 680my $combined_f; 681my $combined_f_useless; 682 683sub attempt_direct_conversion { 684 my ( $value, $u1, $u1_dim, $u2, $u2_dim ) = @_; 685 my ($f); 686 687 if ( $u1_dim != $u2_dim ) { 688 $u1 = "$u1^$u1_dim" if ( $u1_dim != 1 ); 689 $u2 = "$u2^$u2_dim" if ( $u2_dim != 1 ); 690 $u1_dim = 1; 691 } 692 693 if ( $u1_dim < 0 ) { 694 $u1_dim = -$u1_dim; 695 $f = get_factor( $u2, $u1 ); 696 } 697 else { 698 $f = get_factor( $u1, $u2 ); 699 } 700 701 if ( defined($f) ) { 702 if ( ref($f) eq "CODE" ) { 703 $value = &$f( $value, $u1_dim ); 704 $combined_f_useless = 1; 705 } 706 elsif ( $f != 1 ) { 707 $f = $f**$u1_dim if ( $u1_dim > 1 ); # $u1_dim is non-negative 708 $value *= $f; 709 $combined_f *= $f; 710 } 711 712 return $value; 713 } 714 715 undef; 716} 717 718my %tmp_u_history; 719my @tmp_u_path; 720my @tmp_dim_path; 721 722my $tmp_value; 723my $tmp_uX; 724my $tmp_uX_dim; 725 726sub apply_factor_chain { 727 my $chained_f = 1.0; 728 my $chained_f_useless = 0; 729 730 push @tmp_u_path, $tmp_uX; 731 my $final = scalar(@tmp_u_path) - 1; 732 my $original_value = $tmp_value; 733 734 my ( $i, $f, $dim ); 735 736 for ( $i = 0; $i < $final; ++$i ) { 737 $dim = $tmp_dim_path[$i]; 738 739 $f = get_factor( $tmp_u_path[$i], $tmp_u_path[ $i + 1 ] ); 740 741 if ( defined($f) ) { 742 if ( ref($f) eq "CODE" ) { 743 if ( $dim < 0 ) { 744 $dim = -$dim; 745 $f = get_factor( $tmp_u_path[ $i + 1 ], $tmp_u_path[$i] ); 746 } 747 $tmp_value = &$f( $tmp_value, $dim ); 748 $chained_f_useless = 1; 749 } 750 elsif ( $f != 1 ) { 751 $f = $f**$dim if ( $dim != 1 ); # $dim can be either negative or positive 752 $tmp_value *= $f; 753 $chained_f *= $f; 754 } 755 } 756 } 757 758 if ($chained_f_useless) { 759 $combined_f_useless = 1; 760 } 761 else { 762 my $u1 = $tmp_u_path[0]; 763 if ( exists( $factor{$u1} ) && exists( $factor{$tmp_uX} ) ) { 764 my $u1_dim = $tmp_dim_path[0]; 765 766 $u1 = "$u1^$u1_dim" if ( $u1_dim != 1 ); 767 $tmp_uX = "$tmp_uX^$tmp_uX_dim" if ( $tmp_uX_dim != 1 ); 768 769 register_factor( $u1, $tmp_uX, $chained_f ); 770 $combined_f *= $chained_f; 771 } 772 } 773 774 die "OK\n"; 775} 776 777sub breadth_first_factor_search { 778 my ( $level, $u, $dim ) = @_; 779 my $attempts = 0; 780 781 SEARCH: 782 { 783 $tmp_u_history{$u} = 1; 784 785 ++$attempts; 786 787 push @tmp_u_path, $u; 788 push @tmp_dim_path, $dim; 789 790 if ( $level == 0 ) { 791 if ( $dim == $tmp_uX_dim && defined( $factor{$u}{$tmp_uX} ) ) { 792 apply_factor_chain(); 793 } 794 } 795 else { 796 my $child; 797 foreach $child ( keys %{ $factor{$u} } ) { 798 if ( !defined( $tmp_u_history{$child} ) ) { 799 breadth_first_factor_search( $level - 1, $child, $dim ); 800 } 801 } 802 } 803 804 if ( $attempts < 2 ) { 805 if ( $dim == 1 ) { 806 if ( $u =~ /^([^^]+)\^(.+)/ ) { 807 $u = $1; 808 $dim = $2; 809 810 redo SEARCH if ( !defined( $tmp_u_history{$u} ) ); 811 } 812 } 813 else { 814 $u = "$u^$dim"; 815 $dim = 1; 816 817 redo SEARCH if ( !defined( $tmp_u_history{$u} ) ); 818 } 819 } 820 } 821 822 while ( $attempts-- > 0 ) { 823 pop @tmp_u_path; 824 pop @tmp_dim_path; 825 } 826} 827 828sub attempt_indirect_conversion { 829 my ( $input_value, $u1, $u1_dim, $uX, $uX_dim ) = @_; 830 831 $tmp_value = $input_value; 832 $tmp_uX = $uX; 833 $tmp_uX_dim = $uX_dim; 834 835 eval { 836 my $level; 837 for ( $level = 0; $level < 4; ++$level ) { 838 %tmp_u_history = (); 839 @tmp_u_path = (); 840 @tmp_dim_path = (); 841 842 breadth_first_factor_search( $level, $u1, $u1_dim ); 843 } 844 }; 845 846 return undef if ( $@ ne "OK\n" ); 847 848 return $tmp_value; 849} 850 851sub perform_unit_conversion ($\%\%) { 852 my ( $value, $u1_group, $u2_group ) = @_; 853 my ( $u1, $u1_dim ); 854 my ( $u2, $u2_dim ); 855 my ($new_value); 856 857 DIRECT_UNIT_CONVERSION: 858 foreach $u1 ( keys %{$u1_group} ) { 859 $u1_dim = $u1_group->{$u1}; 860 861 foreach $u2 ( keys %{$u2_group} ) { 862 $u2_dim = $u2_group->{$u2}; 863 864 $new_value = attempt_direct_conversion( $value, $u1, $u1_dim, $u2, $u2_dim ); 865 866 if ( defined($new_value) ) { 867 $value = $new_value; 868 delete $u1_group->{$u1}; 869 delete $u2_group->{$u2}; 870 next DIRECT_UNIT_CONVERSION; 871 } 872 } 873 } 874 875 INDIRECT_UNIT_CONVERSION: 876 foreach $u1 ( keys %{$u1_group} ) { 877 $u1_dim = $u1_group->{$u1}; 878 879 foreach $u2 ( keys %{$u2_group} ) { 880 $u2_dim = $u2_group->{$u2}; 881 882 $new_value = attempt_indirect_conversion( $value, $u1, $u1_dim, $u2, $u2_dim ); 883 884 if ( defined($new_value) ) { 885 $value = $new_value; 886 delete $u1_group->{$u1}; 887 delete $u2_group->{$u2}; 888 next INDIRECT_UNIT_CONVERSION; 889 } 890 } 891 } 892 893 if ( scalar keys %{$u1_group} || scalar keys %{$u2_group} ) { 894 $tmp_value = $value; 895 die "REDUCE\n"; 896 } 897 898 $value; 899} 900 901sub compute_base_factors { 902 903 # register all of the direct unit-to-unit conversion factors 904 905 my ( $pair, $f, $u1, $u2 ); 906 while ( ( $pair, $f ) = each %conversions ) { 907 ( $u1, $u2 ) = split( /,/, $pair ); 908 register_factor( $u1, $u2, $f ); 909 } 910 911 # build a fast pattern substitution function by eval'ing a 912 # subroutine generated by concatenating all the abbreviation 913 # substitution commands together. 914 915 my $code = "sub substitute_abbreviations { my(\$units) = \@_; SUBST: {\n"; 916 my ( $pattern, $subst ); 917 918 my $i = 0; 919 while ( $i < scalar @abbreviations ) { 920 $pattern = $abbreviations[ $i++ ]; 921 $subst = $abbreviations[ $i++ ]; 922 923 $code .= " redo SUBST if (\$\$units =~ s/$pattern/$subst/g);\n"; 924 } 925 926 $code .= "} }"; 927 928 eval $code; 929 930 # simplify all the formulas and reductions up front so that 931 # multiple rewrite passes aren't required during unit expansion 932 933 foreach $u1 ( keys %formulas ) { 934 $formulas{$u1} = canonicalize_unit_string( $formulas{$u1}, {} ); 935 } 936 937 foreach $u1 ( keys %reductions ) { 938 $reductions{$u1} = canonicalize_unit_string( $reductions{$u1}, {} ); 939 } 940 941 # mark this function completed because it only runs once 942 943 $factors_computed = 1; 944} 945 946sub print_conversion { 947 my ( $value, $u1, $u2 ) = @_; 948 my $my_result = Convert( $value, $u1, $u2 ); 949 950 print "$value $u1 == $my_result $u2\n"; 951 $my_result; 952} 953 954sub convert { 955 my ( $value, $u1, $u2 ) = @_; 956 my ( %u1_group, %u2_group ); 957 my ( $u1_prefix, $u2_prefix ); 958 my ($f); 959 960 return ($value) if ( $u1 eq $u2 ); 961 if ( defined( $f = $conversion_history{$u1}{$u2} ) ) { 962 return ( $value * $f ); 963 } 964 965 if ( !$factors_computed ) { 966 compute_base_factors(); 967 } 968 969 $u1_prefix = reduce_toplevel_unit( $u1, %u1_group ); 970 $u2_prefix = reduce_toplevel_unit( $u2, %u2_group ); 971 972 $combined_f = $u1_prefix / $u2_prefix; 973 $combined_f_useless = 0; 974 $value *= $combined_f; 975 976 eval { $value = perform_unit_conversion( $value, %u1_group, %u2_group ); }; 977 978 if ($@) { 979 if ( $@ eq "REDUCE\n" ) { 980 $u1_prefix = finish_reducing_toplevel_unit(%u1_group); 981 $u2_prefix = finish_reducing_toplevel_unit(%u2_group); 982 983 $f = $u1_prefix / $u2_prefix; 984 985 if ( !$combined_f_useless ) { 986 $combined_f *= $f; 987 } 988 989 $value = $tmp_value * $f; 990 991 eval { $value = perform_unit_conversion( $value, %u1_group, %u2_group ); }; 992 993 if ($@) { 994 if ( $@ eq "REDUCE\n" ) { 995 Carp::croak "conversion of unit '$u1' to '$u2' failed (incompatible units?)"; 996 } 997 else { 998 Carp::croak $@; 999 } 1000 } 1001 } 1002 else { 1003 Carp::croak "impossible! $@"; 1004 } 1005 } 1006 1007 if ( !$combined_f_useless ) { 1008 $conversion_history{$u1}{$u2} = $combined_f; 1009 } 1010 1011 $value; 1012} 1013 10141; 1015