File contents

package MatLab2CellML;

#---------------------------------------------------------------------
sub Eqn2Cellml {
#Given an equation $line will convert that line into cellml
#requires kern2cellml

    #Initialise variables
    my $line = @_[0];
    my $var;
    my $Equation;
    my $k;
    my $out;
    my $go;
    my $kernal;
    my @kernals;
    my $i;
    my $kern;
    
 
    #Split equation into variable and equation
   ($var, $Equation) = split(/=/,$line);

   #celan
   $Equation =~ s/[;\n]//g;
   $var =~ s/\s//g;
   
   #Initialise equation 
   $out = "<math xmlns=\"http://www.w3.org/1998/Math/MathML\"> \n<apply id=\"$var\_Eqn\"><eq /> \n <ci> $var </ci> \n :spacer: \n </apply> \n </math> \n";
  
   #Initialis kernal count
   $k = 1;

   #unrap eqn into kernals
   $go = 1;
   while ($go == 1) {
    #remove brakets and put contents of braket into kernal i
     if ($Equation =~ /\([\w \_ \. \* \- \/ \+ \^ \s]*\)/) {
   
       #find first kernal and store in 1
       $Equation =~ s/(\([\w \* \_ \. \- \/ \+ \^ \s]*\))/\1/;
       #replace kernal with kernal and number as spacer
       $Equation =~ s/(\([\w \* \_ \. \- \/ \+ \^ \s]*\))/kernal$k/;
       #store kernal in one and strip it of its brackets
       $kernal = $1; 
       $kernal =~ s/[\(\)]//g;
     
       } else {
       #If no more brakets decompose remaining eqn
       $kernal = $Equation;
       $go = 0;
     };

     $k = $k +1;
     #convert the kernal to cellml
     $kernal = &MatLab2CellML::kern2Cellml($kernal);
     push(@kernals,$kernal);   
 
  };     
    
  $kern = pop(@kernals);
  $out =~ s/:spacer:/ $kern \n/;
  $i = $k-2;

  while ($kern = pop(@kernals)) {
    $out =~ s/<ci>\s*kernal$i\s*<\/ci>/$kern/;
    $i = $i -1;
 };
 $out =~ s/<ci>\s*([0-9]*[\.e]?[0-9]*[\.e]?[0-9]*[\.e]?[0-9]*)\s*<\/ci>\s*\n/<cn cellml:units=\"dimensionless\"> $1 <\/cn> \n/g;
 $out =~ s/\n\s*\n/\n/g;
 $out ="$out\n";
 return($out);

};


sub kern2Cellml {
#Sub converts a kernal (ie a function that contains no brakets) into cellml


my ($kernal) =@_;
my $iexp;
my $temp;
my @ExpS;
my $ilog;
my @LogS;
my $iln;
my @LnS;
my $iE;
my @PowerS;
my $iD;
my @DivideS;
my @NegativeS;
my $iS;
my @TimesS;
my $iM;
my $iA;
my $PlusS;
my @MinusS;
my $iSS;
my $cellml;



    #replace minus sfunctions with & where they are minus signs
    if ($kernal =~ /^\-/) {
	   $kernal =~ s/^\-/\&/;
     };
     $kernal =~ s/([\-\*\/\(\^])\-/\1\&/g;   
   
     #decompose in order of operations
          
     $iexp = 1;
     while ($kernal =~ /expkernal/) {
     	   $kernal =~ s/exp(kernal\d+)/exp\1/;
	   $temp = "<apply><exp /> \n<ci> $1 </ci>\n <\/apply>\n";
	   push(@ExpS,$temp);
	   $kernal =~ s/exp(kernal\d+)/ExpOperator$iexp/;
	   $iexp = $iexp + 1; 
     };   
     $iexp = $iexp - 1;

    
     $ilog = 1;
     while ($kernal =~ /logkernal/) {
     	   $kernal =~ s/log(kernal\d+)/log\1/;
	   $temp = "<apply><log /> \n <ci> $1 </ci>\n <\/apply>\n";
	   push(@LogS,$temp);
	   $kernal =~ s/log(kernal\d+)/LogOperator$ilog/;
	   $ilog = $ilog + 1; 
     };   
     $ilog = $ilog - 1;


     $iln = 1;
     while ($kernal =~ /lnkernal/) {
     	   $kernal =~ s/ln(kernal\d+)/ln\1/;
	   $temp = "<apply><ln /> \n <ci> $1 </ci>\n <\/apply>\n";
	   push(@LnS,$temp);
	   $kernal =~ s/ln(kernal\d+)/LnOperator$iln/;
	   $iln = $iln + 1; my $tab ="  ";
     };   
     $iln= $iln - 1;

     $iE = 1;
     while ($kernal =~ /\^/) {
           $kernal =~ s/([\w \_ \.]*)(\^)([\w \_ \.]*)/\1\2\3/;
	   $temp = "<apply><power /> \n <ci> $1 </ci>\n<ci> $3 </ci>\n  <\/apply>\n";
	   push(@PowerS,$temp);
	   $kernal =~ s/$1\^$3/PowerOperator$iE/;
	   $iE = $iE + 1; 
     };   
     $iE = $iE - 1;
     
     $iD = 1; 
     while ($kernal =~ /\//) {
           $kernal =~ s/([\w \_ \.]*)(\/)([\w \_ \.]*)/\1\2\3/;
	   $temp = "<apply><divide /> \n <ci> $1 </ci>\n<ci> $3 </ci>\n  <\/apply>\n";
	   push(@DivideS,$temp);
	   $kernal =~ s/$1\/$3/DivideOperator$iD/;
	   $iD = $iD + 1; 
     };  
     $iD = $iD - 1;
     
    $iS = 1;
    while ($kernal =~ /\&/) {
           $kernal =~ s/\&([\w \_ \.]*)/\&\1/;
	   $temp = "<apply><minus /> \n <ci> $1 </ci>\n<\/apply>\n";
	   push(@NegativeS,$temp);
	   $kernal =~ s/\&([\w \_ \.]*)/NegativeSign$iS/;
	   $iS = $iS + 1;     
     };
     $iS = $iS - 1;
     
     $iM = 1; 
     while ($kernal =~ /([\w \_ \.]*)(\*)([\w \_ \.]*)/) {
           $kernal =~ s/([\w \_ \.]*)(\*)([\w \_ \.]*)/\1\2\3/;
	   $temp = "<apply><times /> \n <ci> $1 </ci>\n<ci> $3 </ci>\n  <\/apply>\n";
	   push(@TimesS,$temp);
	   $kernal =~ s/$1\*$3/TimesOperator$iM/;
	   $iM = $iM + 1; 
     };   
     $iM = $iM  -1; 
     
     $iA = 1; 
     while ($kernal =~ /\+/) {
           $kernal =~ s/([\w \_ \.]*)(\+)([\w \_ \.]*)/\1\2\3/;
	   $temp = "<apply><plus/> \n <ci> $1 </ci>\n<ci> $3 </ci>\n  <\/apply>\n";
	   push(@PlusS,$temp);
	   $kernal =~ s/$1\+$3/PlusOperator$iA/;
	   $iA = $iA + 1; 
     };  
     $iA = $iA - 1; 
     
     $iSS = 1;    
     while ($kernal =~ /\-/) {
           $kernal =~ s/([\w \_ \.]*)(\-)([\w \_ \.]*)/\1\2\3/;
	   $temp = "<apply><minus/> \n <ci> $1 </ci>\n <ci> $3 </ci>\n  <\/apply>\n";
	   push(@MinusS,$temp);
	   $kernal =~ s/$1\-$3/MinusOperator$iSS/;
	   $iSS = $iSS + 1; 
     };    
     $iSS = $iSS - 1;
      
     $kernal =~ s/^/<ci> /;
     $kernal =~ s/$/ <\/ci> \n/;
 
 
     #REbuild in Cellml order
     
     while ($cellml = pop(@MinusS)) {
     $kernal =~ s/<ci>\s*MinusOperator$iSS\s*<\/ci>\s*\n/$cellml/;
     $iSS = $iSS - 1;
     };
    
     while ($cellml = pop(@PlusS)) {
     $kernal =~ s/<ci>\s*PlusOperator$iA\s*<\/ci>\s*\n/$cellml/;
     $iA = $iA - 1;
     };    
      
     while ($cellml = pop(@TimesS)) {
     $kernal =~ s/<ci>\s*TimesOperator$iM\s*<\/ci>\s*\n/$cellml/;
     $iM = $iM - 1;
     };  
       
     while ($cellml = pop(@NegativeS)) {
     $kernal =~ s/<ci>\s*NegativeSign$iS\s*<\/ci>\s*\n/$cellml/;
     $iS = $iS - 1;
     };    
    
     while ($cellml = pop(@DivideS)) {
     $kernal =~ s/<ci>\s*DivideOperator$iD\s*<\/ci>\s*\n/$cellml/;
     $iD = $iD - 1;
     };
          
     while ($cellml = pop(@PowerS)) {
     $kernal =~ s/<ci>\s*PowerOperator$iE\s*<\/ci>\s*\n/$cellml/;
     $iE = $iE - 1;
     };
     
     while ($cellml = pop(@LnS)) {
     $kernal =~ s/<ci>\s*LnOperator$ilnp\s*<\/ci>\s*\n/$cellml/;
     $iln = $iln - 1;
     };
     
     while ($cellml = pop(@LogS)) {
     $kernal =~ s/<ci>\s*LogOperator$ilog\s*<\/ci>\s*\n/$cellml/;
     $ilog = $ilog - 1;
     };
     
     while ($cellml = pop(@ExpS)) {
     $kernal =~ s/<ci>\s*ExpOperator$iexp\s*<\/ci>\s*\n/$cellml/;
     $iexp = $iexp - 1;
     };
     
     #Search for numbers in eqautions and replace with cellml numbers
     $kernal =~ s/<ci>\s*([0-9]*[\.\e]?[0-9]*[\.\e]?[0-9]*[\.\e]?[0-9]*)\s*<\/ci>\s*\n/<cn cellml:units=\"dimensionless\"> $1 <\/cn> \n/g;
     return($kernal); 
};

1;
 
__END__