Chemistry-Harmonia

 view release on metacpan or  search on metacpan

lib/Chemistry/Harmonia.pm  view on Meta::CPAN

package Chemistry::Harmonia;

use 5.008008;
use strict;
use warnings;

use Carp;
use Chemistry::File::Formula;
use Algorithm::Combinatorics qw( variations_with_repetition subsets );
use String::CRC::Cksum qw( cksum );
use Math::BigInt qw( blcm bgcd );
use Math::BigRat;
use Math::Assistant qw(:algebra);

use Data::Dumper;


require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
			parse_chem_mix
			prepare_mix
			oxidation_state
			redox_test
			class_cir_brutto
			good_formula
			brutto_formula
			stoichiometry
			ttc_reaction
			) ],
		    'redox' => [ qw(
			parse_chem_mix
			prepare_mix
			oxidation_state
			redox_test
			) ],
		    'equation' => [ qw(
			parse_chem_mix
			prepare_mix
			class_cir_brutto
			good_formula
			brutto_formula
			stoichiometry
			ttc_reaction
			) ],
);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw( );

our $VERSION = '0.118';

use base qw(Exporter);


# Returns array of "good" chemical formulas
sub good_formula{
    my $substance = shift || return;
    my $opts = shift;

    for( $substance ){
	my $m = '(?:1|!|\|)';	# mask

	# Replacement by iodine
	s/^(\W*)$m(\d*)$/$1I$2/;
	s/j/I/ig;

	s/\$/s/g; # for 'S' or 's'

	s/((?:^|[^BCGLNPRT])A)$m/$1l/ig;	# for 'Al'
	s/((?:^|[^ACT])L)$m/$1i/ig;	# for 'Li'

	# Is it 'o' or oxigen?
	1 while s/(?<=[CHNP])0(?![,.]\d)/\$/g; # temporarilly to replace --> '$'
	1 while s/(?<!\d)0(?![,.]\d)/o/g; # to replace --> 'o'

	s/(?<=[ACT])$m(?=\D|$)/l/ig;	# for Al, Cl, Tl
	s/(?<=[BLNS])$m(?=\D|$)/i/ig;	# for Bi, Li, Ni, Si (without Ti)

	s/Q/O/g; # for oxigen
	s/(?<=[AHMRS])q/g/ig;	# for Aq, Hq, Mq, Rq, Sq
    }

    my(@maU, @maUl);
    my %sa;	# Letters of possible atoms

    my $adb = &_atoms_db;

    # Possible atoms of substance
    for( my $i = 0; $i < @$adb; $i+=5 ){
	$_ = $adb->[$i];

	next if $substance !~ /$_/i;

	if( length > 1 ){
	    push @maUl, $_; # Double chem.symbol: 1th - CAPITAL, 2th - small

	}else{
	    push @maU, $_; # Unary chem.symbol
	}
	$sa{ uc $_ } = '' for split //; # String of CAPITAL letters
    }

    # All atom letters (CAPITAL) || return 0
    my $sas = join('', keys %sa) || return;

    my $mz = '(?<!1)0';		# mask for 'zero2oxi'

    for( $substance ){
	s/,/./g;
	s/[^0-9\$\.\*\(\)\[\]\{\}$sas]+//ig; # to clean bad symbols

	s/\.+$//;	# to clean points
	s/(?<!\d)\.+(?!\d)//g;	# the same

	# to clean sequences not unary symbols
	while( @maU && $sas =~ /([^@maU])/gx ){
	    my $ul = $1;
	    s/($ul)$ul+($ul)/$1$2/ig;
	}

	# remove bordering brackets
	our( $maskr, $maskf, $maskq );
	$maskr = qr/\((?:(?>[^\(\)]+)|(??{$maskr}))*\)/;
	$maskf = qr/{(?:(?>[^{}]+)|(??{$maskf}))*}/;
	$maskq = qr/\[(?:(?>[^\[\]]+)|(??{$maskq}))*\]/;

	s/^.|.$//g while /($maskr|$maskf|$maskq)/g && $_ eq $1;

	# to do small the last symbol of double
	s/([AEGLMR])(?=[^a-z]|$)/\l$1/g;

	# Double symbol similar unary with coefficient in the end
	if( /^@maUl\d+$/i && @maU && /^(?i:[@maU])\L[@maU]\d+$/ ){
	    my @cf = ( "\u$_", uc );

	    if( /$mz/ && exists( $opts->{'zero2oxi'} ) ){
		my @a = @cf;
		s/$mz/O/g for @a;
		return [ @cf, @a ];
	    }
	    return \@cf;
	}

	# Normalization of oxide-coated formulas (written through '*')
	if(/\*/){
	    my %k;
	    my $l = 1;
	    for my $i (split /\*/){
		if($i =~ /^(\d+)[a-zA-Z]/){	# Integer coefficient
		    $k{ $1 } = $1;

		}elsif($i =~ /^(\d*\.(\d+))/){ # Fractional coefficient
		    $k{ $1 } = $1;
		    $l *= 10 if length $2 >= length $l;

		}else{	# without coefficient (=1)
		    $k{ '' } = 1;
		}
	    }

	    if( $l > 1 ){
		$k{ $_ } *= $l for keys %k;
	    }
	    # by GCD reduce order of coefficients
	    my $gcd = bgcd(values %k);

	    if( $gcd > 1 ){
		$k{ $_ } /= $gcd for keys %k;
	    }

	    my $f;
	    for my $i (split /\*/){
		$i =~ s/^(\d*\.?\d*)([\w\(\)\[\]\{\}]+)$/$k{$1}>1?"{$2}".$k{$1}:"{$2}"/e;
		$f .= $i;
	    }
	    $_ = $f;
	}

	1 while s/[\(\{\[][\)\}\]]//g;	# clean empty brackets
    }

    my $cf = [''];
    for my $s (split /((?:\$|\d|\(|\)|\[|\]|\{|\})+)/,$substance){

	if( $s =~ /[$sas]/i ){ # Atom symbols
	    &_in_gf($s, \@maU, \@maUl, $cf);

	}elsif( $s =~ /\$/ ){ # Zero symbols: 'o' && 'O'
	    $s =~ s/^\$//;
	    &_add_zero( $cf, "O$s", "o$s" ); # add oxigen to { C H N P } -> { CO HO NO PO }
					 # add 'o' to { C H N P } -> { Co Ho No Po }

	}elsif($s =~ /$mz/ && exists( $opts->{'zero2oxi'} ) ){ # Zero symbols
	    my $z = $s;		# zero
	    $s =~ s/$mz/O/g;	# oxigen

	    &_add_zero( $cf, $s, $z );

	}else{ # Others
	    $_ .= $s for @$cf;
	}
    }

    $cf->[0] =~ /\w/ ? return $cf : return;

lib/Chemistry/Harmonia.pm  view on Meta::CPAN

	    push @in_cf, ucfirst lc;

	}elsif( length($saUl) == 0 ){ # Without double symbol
	    s/.?([$saU]+).?/$1/i; # unary symbol(s)
	    push @in_cf, uc;

	}else{	# 1th and 2th small letters - two alternative variants
	    if( /[\L$saU]{2}/ ){ # unary symbols
		push @in_cf, uc;
	    }
	    if( /\L$saUl/ ){ # double symbol
		push @in_cf, ucfirst;
	    }

	    @in_cf || return;

	    if( @in_cf == 2 ){

		my $n = $#{$cf};
		for( my $i = 0; $i <= $n; $i++ ){
		    $cf->[$i + $n + 1] = $cf->[$i].$in_cf[1];
		    $cf->[$i] .= $in_cf[0];
		}
		return 1;
	    }
	}

	$_ .= $in_cf[0] for @$cf;
	return 1;
    }

    # More 2 symbols

    for( $s ){
	my $m = join '|', $saUl, @i_maU;

	while( ! /^(?:$m)/i ){ s/^.// } # Clear head
	while( ! /(?:$m)$/i ){ s/.$// } # Clear tail

	# Search double and unary symbols
	my $z = '';
	while( /^((?:$m)+)/g ){ $z .= $1 } 

	if( length $z ){

	    $_ .= $z for @$cf;
	    return 1 if length($z) == length;	# The end

	    s/^$z//;
	    return &_in_gf($_, \@i_maU, \@i_maUl, $cf) if 3 > length;
	}
    }

    if( @w ){	# Search by fragments of anchor symbols 
	my $m = join '|', @w;

	for my $f (split /($m)/, $s){

	    &_in_gf($f, \@i_maU, \@i_maUl, $cf);

	    if( $#{$cf} ){ # For >1 formula
		# To leave the longest fragments
		for( my $i = $#$cf; $i > 0; $i-- ){
		    splice @$cf, $i, 1 if length( $cf->[$i] ) < length( $cf->[0] );
		}
	    }
	}
	return 1;
    }

    # Difficult fragment
    my $cf_copy = [ @$cf ];
    $#{$cf} = -1;	# Reset

_M_gf_1: # Letter by letter search
    for( my $i = 1; $i < length($s); $i++ ){

        my $cf_new = [ @$cf_copy ];

	for( $s =~ /^(\w{$i})(\w+)/ ){
	    &_in_gf($_, \@i_maU, \@i_maUl, $cf_new) || next _M_gf_1;
	}
	# To accumulate only unique, big fragments
	for my $k ( @$cf_new ){
	    scalar( grep length($_) > length($k) || $_ eq $k, @$cf ) || push @$cf, $k;
	}
    }
    return 1;
}


# Tactico-technical characteristics of chemical reaction.
# Return quantity hash (SAR):
#	's'ubstance
#	'a'toms
#	'r'ank
sub ttc_reaction{
    my $ce = shift || return;
    
    # Hash atom matrix and quantity of atoms
    my( $atoms_substance, $atoms ) = &_search_atoms_subs( $ce );

    my $rank = Rank( [ values %$atoms_substance ] ) || return;

    return { 's' => scalar( keys %$atoms_substance ),
	    'a' => $atoms,
	    'r' => $rank,
	    };
}

# Calculation common identifier for reaction:
#	Alphabetic CLASS
# and
#	Chemical Interger Reaction (CIR) identifier
# also
#	brutto (gross) formulas of substances
sub class_cir_brutto{
    my( $ce, $coef ) = @_;
    $ce || return;

    my( %elm, %bf, @cir );

    for my $c ( @$ce ){
	for my $s ( @$c ){

	    # stoichiometry coefficient
	    my $k = exists $coef->{$s} ? $coef->{$s} : 1; 

	    my %e = Chemistry::File::Formula->parse_formula( $s );

	    # for brutto
	    $bf{ $s } = join '', map( "$_$e{$_}", sort{ $a cmp $b } keys %e );

	    # for cir
	    push @cir, $k.$bf{ $s };

	    # For class
	    @elm{ keys %e } = ''; # reaction atoms
	}
    }

    # CLASS, CIR of reaction and hash: formula => brutto of substances
    return [ join( '', sort { $a cmp $b } keys %elm ),
	     ( cksum( join '+', sort { $a cmp $b } @cir ) )[0],
	     \%bf ];
}


# Transformation substance arrays to chemical mix (equation)
# $ce -- ref to array of substance arrays
# $opts ->{ }	 (facultative parameters)
#	->'substances' -- ref to array of real (required) substances
#	->'coefficients' -- ref to hash stoichiometry coefficients for substances
#	->'norma' -- chemical mix to brutto-normalize
sub prepare_mix{
    my( $ce, $opts ) = @_;

    # Check empty reactants & products
    croak('Bad equation!') if @$ce != 2 ||
	scalar( grep ! defined, @$ce ) ||
	scalar( grep { grep ! defined, @{$_} } @$ce );

    my $sign = 0;
    # Any coefficient isn't set --> to bypass
    if( exists( $opts->{'norma'} ) &&
	scalar( grep { 
		    grep ! exists( $opts->{'coefficients'}{$_} ), @{$_} 
		} @$ce ) == 0 ){ # All coefficients are set

	# Test stoichiometry coefficient sign  on initial (first) substances
	$sign = 1;
	for( @{ $ce->[0] } ){
	    $opts->{'coefficients'}{$_} || next; # Zero stoichiometry coefficient
	    $sign = -1 if $opts->{'coefficients'}{$_} < 0;
	    last;
	}
    }

    if( $sign != 0 ){ # chemical mix to brutto-normalize

	# if assume all coefficients positive '+'
	if( $opts->{'norma'} != 1 ){
	    $opts->{'coefficients'}{$_} *= -1 for @{ $ce->[1] };
	}

	my @cir; # for brutto-formula
	while( my($s, $c) = each %{ $opts->{'coefficients'} } ){
	    $c || next;
	    my $ip = $sign * $c > 0 ? 0 : 1;

	    my $ff = abs($c)." $s";

	    my %e = Chemistry::File::Formula->parse_formula( $ff );
	    $cir[$ip]{$ff} = join '', map( "$_$e{$_}", sort{ $a cmp $b} keys %e );
	}
	# Result
	$_ = join(' == ', map{ join ' + ',sort {$_->{$a} cmp $_->{$b}} keys %{$_} } @cir);

    }else{
	if( exists( $opts->{'substances'} ) && @{ $opts->{'substances'} } ){
	    # List of real substances is specified
	    my %bs;
	    @bs{ @{ $opts->{'substances'} } } = ();

	    $_ = join(' == ', map{ join ' + ', map{ 
		if( exists $bs{$_} ){
		    exists( $opts->{'coefficients'}{$_} ) ? abs( $opts->{'coefficients'}{$_} )." $_" : $_
		}else{
		    ( )
		}
	    } @{$_} } @$ce );

	}else{	# List isn't specified
	    $_ = join(' == ', map{ join ' + ', map{ 
	    exists( $opts->{'coefficients'}{$_} ) ? abs( $opts->{'coefficients'}{$_} )." $_" : $_ } @{$_} } @$ce );
	}
    }

    s/^\s*==|==\s*$//g;
    /\S\s*[=+]+\s*\S/ ? $_ : return;
}


# Расчёт (поиск) стехиометрических коэффициентов
# Возвращает :
#	решение в $cheq
#	undef --- нет решения
sub stoichiometry{
    my($mix, $opts) = @_;
    $opts->{'redox_pairs'} = 1 unless exists $opts->{'redox_pairs'};	# вкл. redox-уравниватель

    my @cheq; # возвращаемые уравнения

    &_in_search_stoich($mix, \@cheq, $opts ); # Рекурсивный поиск

    @cheq ? \@cheq : return undef;
}


# Рекурсивный поиск стехиометрических коэффициентов
sub _in_search_stoich{
    my($mix, $cheq, $opts) = @_;

    my %coef; # на случай заданных коэф. в $mix
    my $chem_eq = parse_chem_mix($mix, \%coef);

    croak('Bad equation!') if @$chem_eq != 2;

    # Хеш Атомной матрицы и кол-во атомов
    my ( $atoms_substance, $num_atoms ) = &_search_atoms_subs( $chem_eq );

    # Список Всех веществ и копия атомной матрицы (для проверки баланса в конце)
    my $All_substances = [ keys %$atoms_substance ];

lib/Chemistry/Harmonia.pm  view on Meta::CPAN


			    $vv{$v_p}{'yes'}++;
			    $vv{$v_p}{'os'}{$e} = 1; # Элементы меняющие свою OS

			    my $lcm = blcm($n_i, $n_p); # наименьший общий множитель кол-ва атомов

			    my($c, $z) = Math::BigRat->new("$os_i")->parts();
			    my $ee = $lcm * $c / $z;

			    ($c, $z) = Math::BigRat->new("$os_p")->parts();
			    $ee -= $lcm * $c / $z;
			    
			    # Принятые элек-ны, OS, число атомов и
			    # множители на MAX число атомов исх. и прод.
			    @{ $redox{$nm}{$e}{"$v_i->$v_p"} } = ( abs($ee),
							$os_i, $os_p,
							$n_i, $n_p,
							$lcm / $n_i, $lcm / $n_p );
			}
		    }
		}
	    }
	}

	# !!! Интуитивно исключаем из redox-списков не ОВР в-ва
	for my $nm ( 'oxidant','reducer' ){
	    for my $e ( keys %{ $redox{$nm} } ){ # Элементы

		# Redox-пары элемента
		next if keys %{ $redox{$nm}{$e} } < 2; # одна пара

		for my $i_k ( keys %{ $redox{$nm}{$e} } ){
		    for( split "->",$i_k ){
			next if $ve{$_} < 3; # кол-во Элементов в в-ве
			next if $vv{$_}{'yes'} > 1; # в-во встречается часто
			next if keys %{ $vv{$_}{'os'} } > 1; # OS меняет более 1 Элемента

			$del_rx{$_} = ''; # внести в список исключённых в-в
			%redox = ();	# очистить
			next _M_redox_2;
		    }
		}
	    }


	}
	return keys( %{ $redox{'oxidant'} } ) && keys( %{ $redox{'reducer'} } ) ? \%redox : undef; # не ОВР
    }
}


sub _search_atoms_subs{
    my $chem_eq = shift;

    my %tmp_subs;	# Atoms of substance
    my %atoms;		# Atom hash

    for my $i ( @$chem_eq ){
	for my $s ( @$i ){
	    # Atoms of substance
	    my %f = eval{ Chemistry::File::Formula->parse_formula( $s ) } or
croak("'$s' is not substance!");

	    for( keys %f ){
		$tmp_subs{$s}{$_} = $f{$_};
		$atoms{$_}++; # Atom balance
	    }
	}
    }

    while( my($k,$v) = each %atoms){
	croak("No balance of '$k' atom!") if $v == 1;
    }

    # Atom (stoichiometry) matrix vectors (quantity of atoms for each substance)
    my %atoms_substance;
    for my $subs (keys %tmp_subs){
	$atoms_substance{$subs} = [ map { $tmp_subs{$subs}{$_} || 0 } keys %atoms ];
    }

    return( \%atoms_substance, scalar(keys %atoms) );
}

# Transform classic into brutto (gross) formula
sub brutto_formula{
    my $s = shift;

    my %e = eval{ Chemistry::File::Formula->parse_formula( $s ) } or
croak("'$s' is not substance!");

    return( join( '', map{ "$_$e{$_}" } sort { $a cmp $b } keys %e ) );
}

# Decomposes the chemical equation to
# arrays of initial substances and products
sub parse_chem_mix{
    $_ = shift; # List of substances with delimiters (spaces, comma, + )
    my $coef = shift; # hash of coefficients

    my %cf;	# temp hash of coefficients

    s/^\s+//;
    s/\s+$//;

    my $m = qr/\s*[ ,;+]+\s*/;	# mask of delimeters

    # to unite the separeted numerals ( coefficient ? )
    1 while s/((?:$m|^)[1-9]+)$m([1-9]+(?:$m|$))/$1$2/g;

    # to unite the separeted substance & index
    s/([)}\]a-zA-Z1-9])\s+([1-9]+\s*[)}\]\-=+])/$1$2/g;

    # remove spaces around brackets
    s/([({\[])\s+/$1/g;
    s/\s+([)}\]])/$1/g;

    # The chemical equation is set:
			    # A + B --> C + D ||
			    # A, B, C, D
    my $chem_eq = /(.+?)\s*[=-]+>*\s*(.+)/ ?
	[ map [ split "$m" ], ($1,$2) ] :
	[ map [ split "$m" ], ( /(.+)$m(\S+)/ ) ];

    return unless @$chem_eq;

    for my $ip ( @$chem_eq ){

	my @ip_del; # For removal from an array of coefficients

	for(my $i=0; $i<=$#{ $ip }; $i++ ){
	    $_ = $ip->[$i];

	    if( /^(\d+)([({\[a-zA-Z].*)/ ){ # together coefficient and substance

		my ($c, $s) = ($1, $2); # coefficient, substance

		# zero coefficient
		if( $c =~ /^0$/ && ( $i==0 || ( $i>0 && $ip->[$i-1] =~ /\D/ ) ) ){ 
		    push @ip_del, $i; # remove substance

		}elsif( s/^0/O/ ){ # oxigen?
		    &_p_c_m( $_, $i, \%cf, $ip );

		}else{
		    $cf{$s} = $c;	# coefficient
		    $ip->[$i] = $s;	# substance
		}

lib/Chemistry/Harmonia.pm  view on Meta::CPAN

    # Lists of substances:
	# fist --- reactants or '=','-','>'
	# last --- products or '=','-','>'
    return $chem_eq;
}

sub _p_c_m{
    my( $s, $i, $cf, $ip ) = @_;

    if( exists $cf->{ $ip->[$i] } ){
	$cf->{$s} = $cf->{ $ip->[$i] };
	delete $cf->{ $ip->[$i] };
    }
    $ip->[$i] = $s; # replacement
}


# Calculation of oxidation state
sub oxidation_state{
    my $s = shift || return;

    our $mask;
    $mask = qr/{(?:(?>[^{}]+)|(??{$mask}))*}\d*/;
    my @species = $s =~ /$mask/g;

    # One substance
    return &_in_os($s) if @species < 2 || $s ne join('',@species);

    my $r;	# Result:
	# HASH{element}{num}[0 .. n-1] - Element amount on everyone 1..n atom
	# HASH{element}{OS}[0 .. n-1][ .. ] - Oxidation States of Element (OSE) arrays 1..n atom 

    # Mix of substances
    for( @species ){

	# remove bordering brackets 
	s/^\{//;
	s/\}(\d*)$//;
	# save possible coefficient
	my $d = $1;
    
	my $p = &_in_os($_) || return;

	for my $e ( keys %$p ){
	    push @{ $r->{$e}{'OS'} }, @{ $p->{$e}{'OS'} };

	    if( $d ){
		$_ *= $d for @{ $p->{$e}{'num'} }
	    }
	    push @{ $r->{$e}{'num'} }, @{ $p->{$e}{'num'} };
	}
    }

    $r;
}

sub _in_os{
    my $chem_sub = shift;

    # prepare atomic composition of substance
    my %nf = eval{ Chemistry::File::Formula->parse_formula( $chem_sub ) };
    return unless keys %nf;

    # Count of "pure" atoms each element of substance
    $_ = $chem_sub;
    s/\d+//g;	# remove digits
    my %num = Chemistry::File::Formula->parse_formula( $_ );

    # Ions: { element }{ length }{ ion-pattern }[ [ array OSE ] ]
    my $ions = &_read_ions( $chem_sub );

    # Read Pauling electronegativity and OSE:
	# atom electronegativity, oxidation state, intermetallic compound
    my( $atom_el_neg, $atom_OS, $intermet ) = &_read_atoms( \%nf );
    return if keys( %$atom_el_neg ) != keys( %nf );

    my $prop;	# Result:

    # Substance is intermetallic compound or Simple substance (one element)
    if( $intermet || keys %nf == 1 ){

	while( my( $e, $n ) = each %nf ){
	    # Total quantity of atoms for element
	    $prop->{ $e }{ 'num' }[ 0 ] = $n;

	    # By default in the list of OSE only 0th charge
	    $prop->{ $e }{ 'OS' }[ 0 ] = [ 0 ];
	}

	return $prop ;
    }

    # Sort atoms in decreasing order of electronegativity:
    # 1th --- the most electronegative
    my @neg = sort { $atom_el_neg->{$b} <=> $atom_el_neg->{$a} } keys %{ $atom_el_neg };

    my %bOS;	# by default OSE basic list

    # Basic OSE list of atoms on decrease of electronegativities
    for(my $i = 0; $i <= $#neg; $i++){

	my $e = $neg[$i];	# element

	# Electronegative 1th is identical with next elements
	if( ( $i < $#neg &&
	     $atom_el_neg->{ $neg[0] } == $atom_el_neg->{ $neg[$i+1] } ) ||
	     $i == 1 ){

	    # '-' and '+' OSE, without 0
	    $bOS{ $e } = [ grep $_, @{ $atom_OS->{$e} } ];

	}elsif( $i == 0 ) { # 1th (most electronegative) -> only '-' OSE
		$bOS{ $e } = [ grep $_ < 0, @{ $atom_OS->{$e} } ];

	}else{	# Others -> only '+' OSE
	    $bOS{ $e } = [ grep $_ > 0, @{ $atom_OS->{$e} } ];
	}

	# Inert elements
	$bOS{ $e } = [ @{ $atom_OS->{$e} } ] if $e=~/He|Ne|Ar|Kr|Xe|Rn/;

	# mask for search ions
	my $m = length($e)==1 ? "$e\\d+|$e(?![a-gik-pr-u])" : "$e\\d*";

	for(my $j = 0; $j < $num{$e}; $j++){

	    # Number of various atoms for element in substance
	    if( $num{$e} == 1 ){ # One atom of element in substance
	        push @{ $prop->{$e}{'num'} }, $nf{$e};

	    }else{
		my $count = 0;
		$_ = $chem_sub;

		# Search ion-group. Remove all atoms of element, except current
		s{ ($m) }{ $1 if $count++ == $j }gex;

		my %f = Chemistry::File::Formula->parse_formula( $_ );
		push @{ $prop->{ $e }{'num'} }, $f{ $e };
	    }
	}
    }

    # Two pass: 1st -- ion recognition, 0th -- without ions (possible)
    for my $yni (1, 0){
	my $no_ion = 1;		# no ions

	my $balance_A = 0;	# for Electronic balance
	my $max_n_OS = 0;	# Number of OSE in maximum list
	my @atoms;		# Varied atoms of elements
	my %osin;		# lists of OSE ions

	for(my $i = 0; $i <= $#neg; $i++){

	    my $e = $neg[$i];	# element

	    # mask for search ions
	    my $m = length($e)==1 ? "$e\\d+|$e(?![a-gik-pr-u])" : "$e\\d*";

_SO_M1:		# Number of various atoms for element in substance
	    for(my $j = 0; $j < $num{$e}; $j++){

		$_ = $chem_sub;

		my $count = 0;
		# Search ion-group. Remove all atoms of element, except current
		s{ ($m) }{ $1 if $count++ == $j }gex;

		if( $yni ){
		    # Sort by decrease length of ion-group
		    for my $l (sort {$b <=> $a} keys %{ $ions->{$e} } ) {

			for my $mg ( keys %{ $ions->{$e}{$l} } ){
			    next unless /$mg/; # Ion-group isn't found

			    $no_ion = 0; # yes ions

			    # Ion-group is found. Save list of OSE
			    # for j-th atom of element
			    if( @{ $ions->{$e}{$l}{$mg} } == 1 ){ # One list OSE ion 

				push @{ $prop->{$e}{'OS'} }, $ions->{$e}{$l}{$mg}[0];

				# Calculation total and mean OSE
				my $os;
				$os += $_ for @{ $prop->{$e}{'OS'}[$j] };
			
				# sum OSE * number of atoms / number of OSE
				$balance_A += $os * $prop->{$e}{'num'}[$j] / @{ $prop->{$e}{'OS'}[$j] };

			    }else{ # Many OSE ion lists
				# Add in array varied OSE for j-th atom of element
				push @atoms, "$e:$j";
				$osin{"$e:$j"} = $ions->{$e}{$l}{$mg};

				# Define from a basic list of OSE
				push @{ $prop->{$e}{'OS'} }, [ -999 ];

lib/Chemistry/Harmonia.pm  view on Meta::CPAN

#	$intermet

sub _read_atoms{
    my $atoms = shift;

    my %atom_el_neg;	# atom electronegativity
    my %atom_OS;	# oxidation state
    my $intermet = 1;	# for intermetallic compound

    my $adb = &_atoms_db;

    for( my $i = 0; $i < @$adb; $i+=5 ){
	$_ = $adb->[$i];
	next if !exists $atoms->{ $_ };

	$atom_el_neg{ $_ } = $adb->[$i+2];
	$intermet = 0 unless $adb->[$i+3];	# Not intermetallic compound
	$atom_OS{ $_ } = $adb->[$i+4];
    }

    \%atom_el_neg, \%atom_OS, $intermet;
}

# Read necessary ion-group
# input:
#	$Chemistry_substance
# return:
#	$ions
sub _read_ions {
    my $chem_sub = shift;
    my %ions;

    my $idb = &_ions_db;

    # Construct pattern
    for( my $j = 0; $j < @$idb; $j+=2 ){
	my $frm = $idb->[$j];
	my $os = $idb->[$j+1];

	my %a = split /_|=/,$os; # Parse to element end OSE

	if($os =~ /~/){ # Macro-substitutions

	    my %ek;
	    my $max_n_ek = 0; # max number of element-pattern in macro-substitutions

	    while( my($e, $v) = each %a ){

		if($e =~ /(\w+~)(.*)/){
		    $ek{$1}[0] = [ split ',',$2 ]; # elements
		    $ek{$1}[1] = $v; # OSE for group

		    my $n_ek = $#{ $ek{$1}[0] }; # number of element-substitutions
		    $max_n_ek = $n_ek if $n_ek > $max_n_ek; # max list
		}
	    }

	    my $iter = variations_with_repetition( [ (0..$max_n_ek) ], scalar( keys %ek ) );
ELEMENT_MACRO_1:
	    while (my $p = $iter->next) {
		my $m = $frm; # macro-formula (mask)
		my $i = 0;
		for my $em (sort keys %ek){
		    my $e = $ek{ $em }[0][ $p->[$i++] ];	# element
		    next ELEMENT_MACRO_1 unless defined $e; # pattern have ended

		    $m =~ s/$em/$e/g; # Construct ion mask
		}

		next unless $chem_sub =~ /($m)/; # Ions in substance aren't present

		my $l = length($1); # Length of ion mask

		$i = 0;
		for my $em (sort keys %ek){
		    my $e = $ek{ $em }[0][ $p->[$i++] ]; # element

		    for my $z ( split /!/, $ek{ $em }[1] ){
			# list OSE
			push @{ $ions{ $e }{ $l }{ $m } }, [ split /;/,$z ];
		    }
		}

		while(my ($e, $v) = each %a ){
		    next if $e =~ /~/;

		    # list OSE
		    for my $z ( split /!/, $v ){
			push @{ $ions{ $e }{ $l }{ $m } }, [ split /;/,$z ];
		    }
		}
	    }

	}else{
	    next unless $chem_sub =~ /($frm)/; # no ions in substance

	    my $l = length($1); # Length of the found group

	    while(my ($e, $v) = each %a ){
		# list OSE
		for my $z ( split /!/, $v ){
		    push @{ $ions{ $e }{ $l }{ $frm } }, [ split /;/,$z ];
		}
	    }
	}
    }

    \%ions;
}


# Pauling scale (adapted).
# Atomic weights from NIST.
# Attention!
#	order of OSE is important (last are exotic OSE)
sub _atoms_db{
		return [
'Ac',	227,		110,	1,	[0, 3],
'Ag',	107.8682,	193,	1,	[0, 1, 2, 3, 5],
'Al',	26.9815386,	161,	1,	[-3, 0, 3, 1, 2],
'Am',	243,		113,	1,	[0, 2, 3, 4, 5, 6],

lib/Chemistry/Harmonia.pm  view on Meta::CPAN

# carbonyls
'^a~\d*\(CO\)\d*$',	'a~V,W,Cr,Ir,Mn,Fe,Co,Ni,Mo,Tc,Re,Ru,Rh,Os=0_C=2_O=-2',
# alkaline metals and others
'^a~2O2',	'a~H,Li,Na,K,Rb,Cs,Fr,Hg=1_O=-1',	# peroxides
'^(?:a~O2|a~2O4)',	'a~Li,Na,K,Rb,Cs,Fr=1_O=-1;0',	# superoxides
'^a~O3',	'a~Li,Na,K,Rb,Cs,Fr=1_O=-1;0;0',	# ozonide
# alkaline-earth metals and others
'^a~O2',	'a~Mg,Ca,Sr,Ba,Ra,Zn,Cd,Hg,Cu=2_O=-1',	# peroxides
'^(?:a~\(O2\)2|a~O4)',		'a~Mg,Ca,Sr,Ba,Ra=2_O=-1;0',	# superoxides
'^(?:a~\(O3\)2|a~O6)',		'a~Mg,Ca,Sr,Ba,Ra=2_O=-1;0;0',	# ozonide
# all peroxides
'.\(O2\)',	'O=-1',
# dioxygenils, O2PtF6 ... (except O2F2)
'^(?:\(O2\)|O2)(?![F])',	'O=1;0',
# chromium peroxide
'^CrO5$',	'Cr=6_O=-2;-1;-1;-1;-1',
'^Cr2O8$',	'Cr=6_O=-2;-2;-2;-2;-1;-1;-1;-1',
# rhenium, iodine, chlorine peroxide
'^a~2O8$',	'a~Re,I,Cl=7_O=-2;-2;-2;-2;-2;-2;-1;-1',
# sulfur peroxide
'^SO4$',	'S=6_O=-2;-2;-1;-1',
'^S2O7$',	'S=6_O=-2;-2;-2;-2;-2;-1;-1',
# peroxymonosulfuric | persulfuric | Caro's acid
'.SO5',		'S=6_O=-2;-2;-2;-1;-1',
# per-carbonates (percarbonic acid)
'.C2O6',	'C=4_O=-2;-2;-2;-2;-1;-1',
# acid chlorine peroxide ?
'.ClO5',	'Cl=7_O=-2;-2;-2;-1;-1',
# dioxodifluorochlorate
'.ClO2F2',	'Cl=5_O=-2_F=-1',
# oxotetrafluorochlorate
'.ClOF4',	'Cl=5_O=-2_F=-1',
# oxofluorides
'.ClO3F2',	'Cl=7_O=-2_F=-1',
'.ClO2F4',	'Cl=7_O=-2_F=-1',
# platinum hexafluoride (strongest oxidizer)
'.PtF[6-9][\]\)]?$',	'Pt=5_F=-1',
# chlorine nitrides
'^(?:Cl3N|NCl3)$',	'Cl=1_N=-3',
'.(?:ClN|NCl)',		'Cl=1_N=-3',

'^Fe2P',	'P=5_Fe=-2;-3',
# exotic
'^FNO3$',	'F=1_N=5_O=-2',
	]
}


1;
__END__

=head1 NAME

Chemistry::Harmonia - Decision of simple and difficult chemical puzzles.

=head1 SYNOPSIS

  use Chemistry::Harmonia qw( :all );
  use Data::Dumper;

  for my $formula ('Fe3O4', '[Cr(CO(NH2)2)6]4[Cr(CN)6]3'){
    my $ose = oxidation_state( $formula );
    print Dumper $ose;
  }

Will print something like:

  $VAR1 = {
          'O' => {
                  'num' => [ 4 ],
                  'OS' => [ [ -2 ] ]
                 },
          'Fe' => {
                  'num' => [ 3 ],
                  'OS' => [ [ 2, 3, 3 ] ]
                 }
         };
  $VAR1 = {
          'H' => { 'num' => [ 96 ],
                   'OS' => [ [ 1 ] ]
                 },
          'O' => { 'num' => [ 24 ],
                   'OS' => [ [ -2 ] ]
                 },
          'N' => { 'num' => [ 48, 18 ],
                   'OS' => [ [ -3 ], [ -3 ] ]
                 },
          'C' => { 'num' => [ 24, 18 ],
                   'OS' => [ [ 4 ], [ 2 ] ]
                 },
          'Cr' => { 'num' => [ 4, 3 ],
                    'OS' => [ [ 3 ], [ 2 ] ]
                  }
        };


To balance the chemical mix (equations of reactions), i.e. for list of the substances (reactants and products)
find all the possible "chemical true" balanced equations of reactions and the stoichiometric coefficients
of substances:

  print Dumper stoichiometry( 'NaOH, HCl, KOH, LiOH, KCl, NaCl, LiCl H2O' );

Will print the result:

  $VAR1 = [
          '1 LiCl + 1 NaOH == 1 NaCl + 1 LiOH',
          '1 KCl + 1 NaOH == 1 NaCl + 1 KOH',
          '1 LiCl + 1 KOH == 1 KCl + 1 LiOH',
          '1 HCl + 1 LiOH == 1 LiCl + 1 H2O',
          '1 HCl + 1 NaOH == 1 NaCl + 1 H2O',
          '1 HCl + 1 KOH == 1 KCl + 1 H2O'
        ];

Or the chemical equation e.g.:

  my $chemical_equation = 'KMnO4 + H2O2 + H2SO4 --> K2SO4 + MnSO4 + H2O + O2';
  print Dumper stoichiometry( $chemical_equation );

Will print the results:

  $VAR1 = [
          '5 H2O2 + 3 H2SO4 + 2 KMnO4 == 8 H2O + 5 O2 + 1 K2SO4 + 2 MnSO4',

lib/Chemistry/Harmonia.pm  view on Meta::CPAN


Will print one result:

  $VAR1 = [
          '5 H2O2 + 3 H2SO4 + 2 KMnO4 == 8 H2O + 5 O2 + 1 K2SO4 + 2 MnSO4'
        ];

The example of the classic chemical equations with huge stoichiometric coefficients:

  for my $ce (
    '[Cr(CO(NH2)2)6]4[Cr(CN)6]3, KMnO4, H2SO4, K2Cr2O7, KNO3, CO2, K2SO4, MnSO4, H2O',
    'Na4[Fe(CN)6] NaMnO4 H2SO4 NaHSO4 Fe2(SO4)3 MnSO4 HNO3 CO2 H2O'
    ){
	print Dumper stoichiometry( $ce );
  }

Will print results:

  $VAR1 = [
          '1399 H2SO4 + 10 [Cr(CO(NH2)2)6]4[Cr(CN)6]3 + 1176 KMnO4 == 1879 H2O + 660 KNO3 + 35 K2Cr2O7 + 420 CO2 + 1176 MnSO4 + 223 K2SO4'
        ];
  $VAR1 = [
          '299 H2SO4 + 10 Na4[Fe(CN)6] + 122 NaMnO4 == 162 NaHSO4 + 188 H2O + 60 HNO3 + 60 CO2 + 122 MnSO4 + 5 Fe2(SO4)3'
        ];

And even e.g.:

  my $mix = 'H2 Ca(CN)2 NaAlF4 FeSO4 MgSiO3 KI H3PO4 PbCrO4 BrCl CF2Cl2 SO2 PbBr2 CrCl3 MgCO3 KAl(OH)4 Fe(SCN)3 PI3 NaSiO3 CaF2 H2O';
  print Dumper stoichiometry( $mix );

Will print result:

  $VAR1 = [
          '24 BrCl + 6 CF2Cl2 + 6 NaAlF4 + 119 H2 + 2 H3PO4 + 6 KI + 6 MgSiO3 + 18 Ca(CN)2 + 12 PbCrO4 + 12 FeSO4 + 24 SO2 == 
  12 PbBr2 + 12 CrCl3 + 18 CaF2 + 110 H2O + 6 KAl(OH)4 + 6 MgCO3 + 6 NaSiO3 + 2 PI3 + 12 Fe(SCN)3'
        ];
:)

Transformation of the chemical mix in reagent and product arrays:

  my $chemical_equation = 'KMnO4 + NH3 --> N2 + MnO2 + KOH + H2O';
  print Dumper parse_chem_mix( $chemical_equation );

Will print:

  $VAR1 = [
           ['KMnO4', 'NH3'],
           ['N2', 'MnO2', 'KOH','H2O']
          ];

Preparation of the chemical mix (equation) from reagent and product arrays:

  my $ce = [ [ 'K', 'O2'], [ 'K2O', 'Na2O2', 'K2O2', 'KO2' ] ];
  my $k = { 'K2O' => 1, 'Na2O2' => 0, 'K2O2' => 2, 'KO2' => 3 };
  print prepare_mix( $ce, { 'coefficients' => $k } ),"\n";

Will output:

  K + O2 == 1 K2O + 0 Na2O2 + 2 K2O2 + 3 KO2

'Synthesis' of the good :) chemical formula(s):

  my $abracadabra = 'ggg[crr(cog(nhz2)2)6]4[qcr(cn)5j]3qqq';
  print Dumper good_formula( $abracadabra );

Will output:

  $VAR1 = [
           '[Cr(CO(NH2)2)6]4[Cr(CN)5I]3',
           '[Cr(Co(NH2)2)6]4[Cr(CN)5I]3'
          ];

Calculation CLASS-CIR and brutto (gross) formulas of substances
for reaction. See example:

  my $mix = '2 KMnO4 + 5 H2O2 + 3 H2SO4 --> 1 K2SO4 + 2 MnSO4 + 8 H2O + 5 O2';
  my %cf;
  my $ce = parse_chem_mix( $mix, \%cf );
  print Dumper class_cir_brutto( $ce, \%cf );

Will output:

  $VAR1 = [
          'HKMnOS',
          1504979632,
          {
            'O2' => 'O2',
            'MnSO4' => 'Mn1O4S1',
            'KMnO4' => 'K1Mn1O4',
            'K2SO4' => 'K2O4S1',
            'H2SO4' => 'H2O4S1',
            'H2O2' => 'H2O2',
            'H2O' => 'H2O1'
          }
        ];

Transforms classic chemical formula of substance into the brutto formula:

 print brutto_formula( '[Cr(CO(NH2)2)6]4[Cr(CN)6]3' );

Will output:

  C42Cr7H96N66O24

TTC reaction. Proceeding example above:

  print Dumper ttc_reaction( $ce );

Will output:

  $VAR1 = {
          'r' => 5,
          'a' => 5,
          's' => 7
        };


=head1 DESCRIPTION

The module provides the necessary subroutines to solve some puzzles of the
general inorganic and physical chemistry. The methods implemented in this module,
are all oriented to known rules and laws of general and physical chemistry.

=head1 SUBROUTINES

Chemistry::Harmonia provides these subroutines:

    stoichiometry( $mix_of_substances [, \%facultative_parameters ] )
    oxidation_state( $formula_of_substance )
    parse_chem_mix( $mix_of_substances [, \%coefficients ] )
    good_formula( $abracadabra [, { 'zero2oxi' => 1 } ] )
    brutto_formula( $formula_of_substance )
    prepare_mix( \@reactants_and_products [, \%facultative_parameters ] )
    class_cir_brutto( \@reactants_and_products [, \%coefficients ] )
    ttc_reaction( \@reactants_and_products )


All of them are context-sensitive.


=head2 stoichiometry( $mix_of_substances [, \%facultative_parameters ] )

This subroutine balances the chemical mix (equations of reactions), i.e. for list of the substances (reactants and products)
or the reactions find ALL the possible "chemical true" balanced equations of reactions and the stoichiometric coefficients
of the substances. The results return as the ref to array of the balanced equations
or C<undef> is no solutions.

Using the algebraic method and unique redox-algorithm, C<stoichiometry> will make a atomic matrices for the equations of chemical reactions 
to solve the matrices and to find a fundamental set of stoichiometric coefficients for a random mixture of chemical compounds.
A special feature is ability of C<stoichiometry> to recognize oxidation-reduction reactions and to find chemical correct the 
stoichiometric coefficients.

This subroutine parses C<$mix_of_substances> (usually participants of the chemical reaction),
i.e. the list of reactants (initial substances) and products (substances formed in the chemical reaction).
For details, see please subroutine C<parse_chem_mix>.

The following can be C<%facultative_parameters>: C<'coefficients'> and C<'redox_pairs'>.

C<'coefficients'> - ref to hash stoichiometry coefficients for substances.
E.g.:

  my $ce = 'PbS + O3 = PbSO4 + O2';
  print Dumper stoichiometry( $ce );

Will print results:

  $VAR1 = [
          '4 O3 + 3 PbS == 3 PbSO4',
          '2 O3 == 3 O2',
          '2 O2 + 1 PbS == 1 PbSO4'
        ];

With specified some coefficients:

  my $k = { 'O3' => 4, 'O2' => 4 };
  print Dumper stoichiometry( $ce, { 'coefficients' => $k } );

Will print one result:

  $VAR1 = [
          '4 O3 + 1 PbS == 4 O2 + 1 PbSO4'
        ];

Ditto:

  print Dumper stoichiometry( 'PbS + 4 O3 = PbSO4 + 4 O2' );

Result:

  $VAR1 = [
          '4 O3 + 1 PbS == 4 O2 + 1 PbSO4'
        ];

Another argument of C<%facultative_parameters> is C<'redox_pairs'>.
If C<'redox_pairs'> is 0 then disable redox-algorithm.
By default, redox-algorithm is active.
Some e.g.:

  print Dumper stoichiometry( 'KMnO4 H2O2 H2SO4 K2SO4 MnSO4 H2O O2', { 'redox_pairs' => 0 } );

Will only 4 equations:

  $VAR1 = [
          '2 H2O + 3 H2SO4 + 2 KMnO4 == 5 H2O2 + 1 K2SO4 + 2 MnSO4',
          '6 H2SO4 + 4 KMnO4 == 6 H2O + 5 O2 + 2 K2SO4 + 4 MnSO4',
          '2 H2O2 == 2 H2O + 1 O2',
          '3 H2SO4 + 2 KMnO4 == 3 H2O2 + 1 O2 + 1 K2SO4 + 2 MnSO4'
        ];

For some mix of substabces solution is able to be very long, so you can use C<'redox_pairs'>.

The C<stoichiometry> protesting for over 24,600 unique inorganic reactions.
Yes, to me it was hard to make it.

Beware use very big C<$mix_of_substances>!


=head2 oxidation_state( $formula_of_substance )

This subroutine returns a hierarchical hash-reference of hash integer 
oxidation state (key 'OS') and hash with the number of atoms for 
each element (key 'num') for the inorganic C<$formula_of_substance>.

Always use the upper case for the first character in the element name
and the lower case for the second character from Periodic Table. Examples: Na,
Ag, Co, Ba, C, O, N, F, etc. Compare: Co - cobalt and CO - carbon monoxide.

For very difficult mysterious formula (usually organic) returns C<undef>.
It will be good if to set, for example, 'Pb3C2O7' and 'Pt2Cl6' as
'{PbCO3}2{PbO}' and '{PtCl2}{PtCl4}'.

If you doesn't know formulas of chemical elements and/or Periodic Table
use subroutine C<good_formula()>.
I insist to do it always anyway :)

Now C<oxidation_state()> is checked for over 6760 unique inorganic substances.


=head2 parse_chem_mix( $mix_of_substances [, \%coefficients ] )

A chemical equation consists of the chemical formulas of the reactants
and products. This subroutine parses C<$mix_of_substances> (usually chemical equation)
to list of the reactants (initial substances) and products
(substances formed in the chemical reaction).
It is the most simple and low-cost way to carry out reaction without
reactants :).

Separator of the reactants from products can be sequence '=', '-' 
together or without one or some '>'. For example: 
=, ==, =>, ==>, ==>>, -, --, ->, -->, ->>> etc.
Spaces round a separator are not essential.
If the separator is not set, last substance of a mix will be a product only.

Each individual substance's chemical formula is separated from others by a plus
sign ('+'), comma (','), semicolon (';') and/or space.
Valid examples:

  print Dumper parse_chem_mix( 'KNO3 + S ; K2SO4 , NO SO2' );

Will print:

  $VAR1 = [
            [ 'KNO3','S','K2SO4','NO' ],
            [ 'SO2' ]
        ];

If in C<$mix_of_substances> is stoichiometric coefficients they collect in ref to hash
C<\%coefficients>. Next example:

  my %coef;
  my $chem_eq = 'BaS + 2 H2O = Ba(OH)2 + 1 Ba(SH)2';

  my $out_ce = parse_chem_mix( $chem_eq, \%coef );
  print Dumper( $out_ce, \%coef );

Will print something like:

  $VAR1 = [  [ 'BaS', 'H2O'], [ 'Ba(OH)2', 'Ba(SH)2'] ];
  $VAR2 = { 
       'Ba(SH)2' => '1',
      'H2O' => '2'
   };

By zero (0) coefficients it is possible to eliminate substances from the mix.
Next example:

  my $chem_eq = '2Al O2 = Al2O3 0 CaO*Al2O3';

Will output like:

  $VAR1 = [ [ 'Al', 'O2' ], [  'Al2O3' ] ];
  $VAR2 = {  'Al' => '2' };

However:

  $chem_eq = '2Al O2  Al2O3 0 CaO*Al2O3';

Will output like:

  $VAR1 = [ [ 'Al', 'O2', 'Al2O3', 'O' ], [  'CaO*Al2O3' ] ];
  $VAR2 = {  'Al' => '2' };

As without a separator ('=' or others similar) the last substance will be a product.

If in C<$mix_of_substances> is zero (0) similar oxygen, they are replaced
oxygen. Certainly, oxygen is life. I love oxygen :)
Some more examples:

  $chem_eq = '2Al 02 Ca CaO*Al2O3';

Will output like:

  $VAR1 = [ [ 'Al', 'O2', 'Ca' ], [ 'CaO*Al2O3' ] ];
  $VAR2 = { 'Al' => '2' };

lib/Chemistry/Harmonia.pm  view on Meta::CPAN

Input:

  $chem_eq = '2Al 102 Ca CaO*Al2O3';

Output:

  $VAR1 = [ [ 'Al', 'Ca' ], [ 'CaO*Al2O3' ] ];
  $VAR2 = { 'Al' => '2', 'Ca' => '102' };

Input:

  $chem_eq = '2Al --> 0 0Al2O3 0';

Output:

  $VAR1 = [ [ 'Al' ], [ 'O' ] ];
  $VAR2 = { 'Al' => '2' };

Input:

  $chem_eq = 'Al O2 = 1 0Al2O3';

Output:

  $VAR1 = [ [ 'Al', 'O2' ], [  'OAl2O3' ] ];
  $VAR2 = { 'OAl2O3' => '1' };

The forced conversion of single zero to oxygen is set by
parameter C<'zero2oxi'>. It add in C<\%coefficients>. Next example:

  $coef{ 'zero2oxi' } = 1;
  $chem_eq = 'Al CaO = 0 Al2O3';

Output:

  $VAR1 = [ ['Al', 'CaO'], ['O', 'Al2O3'] ];

Without C<'zero2oxi'> output:

 $VAR1 = [ ['Al'], ['CaO'] ];

Actually the subroutine recognizes more many difficult situations.
Here some examples:

  '2Al 1 02 Ca Al2O3' to-> [ ['Al', 'O2', 'Ca'], ['Al2O3'] ], {'Al' => 2, 'O2' => 1}
  '2Al 102 Ca Al2O3'  to-> [ ['Al', 'Ca'], ['Al2O3'] ], {'Al' => 2, 'Ca' => 102}
  '2Al 1 02 4O2 = 1 0Al2O3' to-> [ ['Al', 'O2'], ['OAl2O3'] ], {'Al' => 2, 'O2' => 4, 'OAl2O3' => 1}
  '2Al = 00 Al2O3'  to-> [ ['Al'], ['O0', 'Al2O3'] ], {'Al' => 2}
  '2Al O 2 = Al2O3'  to-> [ ['Al', 'O2'], ['Al2O3'] ], {'Al' => 2}
  '2Al O = '  to-> [ ['Al', 'O'], ['='] ], {'Al' => 2}
  ' = 2Al O'  to-> [ ['=','Al'], ['O'] ], {'Al' => 2}
  '0Al = O2 Al2O3'  to-> [ ['O2'], ['Al2O3'] ]
  '2Al 1 2 3 4 Ca 5 6 Al2O3 7 8 9'  to-> [ ['Al', 'Ca'], ['Al2O3'] ], {'Al2O3' => 56, 'Al' => 2, 'Ca' => 1234}
  '2Al 1 2 3 4 Ca 5 6 Al2O3'  to-> [ ['Al', 'Ca'], ['Al2O3'] ], {'Al2O3' => 56, 'Al' => 2, 'Ca' => 1234}
  '2Al 1 2 3 4 Ca 5 6 = Al2O3'  to-> [ ['Al', 'Ca56'], ['Al2O3'] ], {'Al' => 2, 'Ca56' => 1234}
  '2Al 1 2 3 4 Ca 5 6 = Al2O3 CaO 9'  to-> [ ['Al', 'Ca56'], ['Al2O3', 'CaO'] ], {'Al' => 2, 'Ca56' => 1234}
  'Al O + 2 = Al2O3'  to-> [ ['Al', 'O'], ['Al2O3'] ], {'Al2O3' => 2}
  'Cr( OH )  3 + NaOH = Na3[ Cr( OH )  6  ]'  to-> [ ['Cr(OH)3', 'NaOH'], ['Na3[Cr(OH)6]'] ]


=head2 good_formula( $abracadabra [, { 'zero2oxi' => 1 } ] )

This subroutine parses C<$abracadabra> to array reference of "good" chemical
formula(s). The "good" formula it does NOT mean chemically correct.
The subroutine C<oxidation_state()> will help with a choice chemically
correct formula.

Algorithm basis is the robust sense and chemical experience.

  'Co'   to->  'Co'
  'Cc'   to->  'CC'
  'co'   to->  'CO', 'Co'
  'CO2'  to->  'CO2'
  'Co2'  to->  'Co2', 'CO2'
  'mo2'  to->  'Mo2'

The good formula(s) there are chemical elements, brackets ()[]{} and
digits only. C<good_formula()> love oxygen.
Fraction will be scaled in the integer.

Fragments A*B, xC*yD are transformed to {A}{B}, {C}x{D}y
(here A, B, C, D - groups of chemical elements, digits and brackets ()[]{};
x, y - digits only). Next examples:

  '0.3al2o3*1.5sio2'  to->  '{Al2O3}{SIO2}5', '{Al2O3}{SiO2}5'
  'al2(so4)3*10h20'   to->  '{Al2(SO4)3}{H20}10'
  '..,,..mg0,,,,.*si0...s..,..'  to->  '{MgO}{SIOS}', '{MgO}{SiOS}'

Superfluous brackets won't be:

  'Irj(){}[]'  to->  'IrI'
  '[{(na)}]'   to->  'Na'

However:

  '{[[([[CaO]])*((SiO2))]]}'  to->  '{([[CaO]])}{((SiO2))}'

If in C<$abracadabra> is zero (0) similar oxygen, they are replaced oxygen.
I love the oxygen is still :)
Next examples:

  '00O02'  to->  'OOOO2'
  'h02'    to->  'Ho2', 'HO2'

However:

  'h20'    to->  'H20'

The forced conversion of zero to oxygen is set by parameter C<'zero2oxi'>:

  my $chem_formulas = good_formula( 'h20', { 'zero2oxi' => 1 } );

Output C<@$chem_formulas>:

  'H20', 'H2O'

If mode of paranoiac is necessary, then transform C<$abracadabra>
to low case as:

    lc $abracadabra

Beware use very long C<$abracadabra>!


=head2 brutto_formula( $formula_of_substance )

This subroutine transforms classic chemical C<$formula_of_substance> into the brutto (bruta, gross) formula:

 print brutto_formula( '[Cr(CO(NH2)2)6]4[Cr(CN)6]3' );

Output:

  'C42Cr7H96N66O24'

In brutto formula every the chemical element identified through its chemical symbol.
The atom number of every present chemical element in the classic C<$formula_of_substance> indicated 
by the sequebatur number.


=head2 prepare_mix( \@reactants_and_products [, \%facultative_parameters ] )

This subroutine simple but useful. It forms the chemical mix (equation)
from ref to array of arrays C<\@reactants_and_products>,
i.e. is C<parse_chem_mix> antipode.

The following can be  C<\%facultative_parameters>:
C<'substances'> - ref to array of real (required) substances,
C<'coefficients'> - ref to hash stoichiometry coefficients for substances.
Full examples:

  my $ce = [ [ 'O2', 'K' ], [ 'K2O', 'Na2O2', 'K2O2', 'KO2' ] ];
  my $k = { 'K' => 2, 'K2O2' => 1, 'KO2' => 0 };

  my $mix = prepare_mix( $ce, { 'coefficients' => $k } );

Will output C<$mix>:

  O2 + 2 K == K2O + Na2O2 + 1 K2O2 + 0 KO2

For real substances:

  my $real = [ 'K', 'O2', 'K2O2', 'KO2' ];
  print prepare_mix( $ce, { 'coefficients' => $k, 'substances' => $real } );

Will print:

  O2 + 2 K == 1 K2O2 + 0 KO2


=head2 class_cir_brutto( \@reactants_and_products [, \%coefficients ] )

This subroutine calculates Unique Common Identifier of Reaction 
C<\@reactants_and_products> with stoichiometry C<\%coefficients>
and brutto (gross) formulas of substances, i.e ref to array:
0th - alphabetic CLASS, 1th - Chemical Integer Reaction Identifier (CIR),
2th - hash brutto substances.

  my $reaction = '1 H2O + 1 CO2 --> 1 H2CO3';
  my %cf;
  my $ce = parse_chem_mix( $reaction, \%cf );
  print Dumper class_cir_brutto( $ce, \%cf );

Will print

  $VAR1 = [
          'CHO',
          1334303561,
          {
            'H2CO3' => 'C1H2O3',
            'CO2' => 'C1O2',
            'H2O' => 'H2O1'
          }
        ];

CIR is a 32 bit CRC of normalized chemical equation,
generating the same CRC value as the POSIX GNU C<cksum> program.
The returned CIR will always be a non-negative integer
in the range 0..2^32-1, i.e. 0..4,294,967,295.

The nature is diversiform, but we search simple decisions :)

The C<class_cir_brutto()> protesting CLASS-CIR
for over 24,600 unique inorganic reactions.
Yes, to me it was hard to make it.


=head2 ttc_reaction( \@reactants_and_products )

This subroutine calculates Tactico-Technical characteristics (TTC)
of reaction C<\@reactants_and_products>, sorry military slang :),
i.e. quantity SAR: (s)ubstances, (a)toms and (r)ank of reaction.
Proceeding example above:

  print Dumper ttc_reaction( $ce );

Will output:

  $VAR1 = {
          'r' => 2,
          'a' => 3,
          's' => 3
        };


=head1 EXPORT

Chemistry::Harmonia exports nothing by default.
Each of the subroutines can be exported on demand, as in

  use Chemistry::Harmonia qw( oxidation_state );

the tag C<redox> exports the subroutines C<oxidation_state>, C<redox_test>,
C<parse_chem_mix> and C<prepare_mix>:

  use Chemistry::Harmonia qw( :redox );

the tag C<equation> exports the subroutines C<stoichiometry>,
C<good_formula>, C<brutto_formula>,
C<parse_chem_mix>, C<prepare_mix>, C<class_cir_brutto> and
C<ttc_reaction>:

  use Chemistry::Harmonia qw( :equation );

and the tag C<all> exports them all:

  use Chemistry::Harmonia qw( :all );


=head1 DEPENDENCIES

Chemistry::Harmonia is known to run under perl 5.8.8 on Linux.
The distribution uses L<Chemistry::File::Formula>,
L<Algorithm::Combinatorics>,
L<Math::BigInt>,
L<Math::BigRat>,
L<Math::Assistant>,
L<String::CRC::Cksum>,
L<Data::Dumper>
and L<Carp>.


=head1 SEE ALSO

Greenwood, Norman N.; Earnshaw, Alan. (1997), Chemistry of the Elements (2nd
ed.), Oxford: Butterworth-Heinemann

Irving Langmuir. The arrangement of electrons in atoms and molecules. J. Am.
Chem. Soc. 1919, 41, 868-934.

Alessandro N.Gorohovski. The theory and practice of stoichiometry of chemical reactions.
Transactions of Donetsk National Technical University, -2011, -pp.211-217
http://ea.donntu.edu.ua:8080/jspui/handle/123456789/3424

L<Chemistry::Elements>, L<Chemistry::Mol>, L<Chemistry::File> and
L<Chemistry::MolecularMass>.


=head1 AUTHOR

Alessandro Gorohovski, E<lt>angel@domashka.kiev.uaE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010-2013 by A. N. Gorohovski

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut



( run in 0.751 second using v1.01-cache-2.11-cpan-364913b4093 )