#!/usr/bin/perl -w
##################################################################
#
# Funktionsparser
#
# Autoren: Stephan Hoehrmann, Xenia Rendtel
#
# VERSION 2
# Letzte Aenderung: 20.07.2009
#
# Dieser Parser ersetzt eine Funktion in umgekehrter polnischer Notation.
# dazu wird ein Baum nach dem folgenden Prinzip erstellt:
# Zunaechst wird die Zeichenkette  mit der Funktion tokenizer in
# ihre Einzelteile zerlegt.
# Dabei wird unterschieden, ob es sich um einen Term, einen Operator,
# eine Funktion, eine oeffnende oder schliessende Klammer oder eine Variable handelt.
# Dann wird diese neu gewonnene Liste mit dem
# folgenden Algorithmus in einen Baum verwandelt:
#
# 0. Solange Liste nicht leer, suche von Position 0 aufsteigend
#    durch die Liste mit folgenden Kriterien:
# 1. ( Liste ) wird zu einem Ausdruck der Form Liste ohne Klammern,
#    auf die der Algorithmus erneut angewendet wird. goto 0.
# 2. Term|Variable ^ Term|Variable wird zu einem Term mit dem Inhalt
#    (Term|Variable ^ Term|Variable)
# 3. Term|Variable mal|geteilt Term|Variable wird zu einem Term
#    mit dem Inhalt (Term|Variable mal|geteilt Term|Variable). goto 0
# 4. Funktion Term|Variable wird zu einem Term
#    mit dem Inhalt (Funktion Term|Variable). goto 0
# 5. Term|Variable plus|minus Term|Variable wird zu einem Term
#    mit dem Inhalt (Term|Variable plus|minus Term|Variable). goto 0
# 6. plus|minus Variable wird zu einem Term
#    mit dem Inhalt (0 plus|minus Variable). goto 0
# 7. Fertig!
# Es wird dabei Schritt fuer Schritt ein Baum mit aufgebaut.
##################################################################
use strict;
use warnings;
use Data::Dumper;
use Math::Trig;
use Math::Complex;
use POSIX qw /floor ceil/;

my @funktionpolnisch;

### Wichtige Funktionen:

sub abrunden {
    my ( $wert, $schritt ) = @_;
    return $schritt * floor( $wert / $schritt );
}

sub aufrunden {
    my ( $wert, $schritt ) = @_;
    return $schritt * ceil( $wert / $schritt );
}

sub fakultaet {
    my ($n) = shift;

    if ( ( $n == 1 ) || ( $n == 0 ) ) {
	return 1;
    }
    elsif ( $n < 0 ) {
	return "Fehler";
    }
    else {
	return $n * fakultaet( $n - 1 );
    }
}

sub round {
    my ($zahl) = shift;
    return int( $zahl + 0.5 );
}

# Die Funktion tokenizer erstellt aus einem String eine
# Liste mit den einzelnen Rechenoperationen des Strings
sub tokenizer {
    my ($text) = @_;
    my ( $token, $vorzeichen );
    my @listevontokens;
    $vorzeichen = 1;
    $text =~ s/ //g;
    $text = lc($text);
    while ( $text ne "" ) {
	if (   ( $text =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)/ )
	       && ( $vorzeichen == 1 ) )
	{

	    # Zahlen mit Vorzeichen
	    $token      = $1;
	    $vorzeichen = 0;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "Term",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	elsif (( $text =~ /^([0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)/ )
	       && ( $vorzeichen == 0 ) )
	{

	    # Zahlen ohne Vorzeichen
	    $token      = $1;
	    $vorzeichen = 0;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "Term",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}

	elsif ( $text =~ /^(\^)/ ) {

	    # Hochzeichen
	    $token      = $1;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "hoch",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}

	elsif ( $text =~ /^([-])/ ) {

	    # Operatoren
	    $token      = $1;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "minus",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	elsif ( $text =~ /^([+])/ ) {

	    # Operatoren
	    $token      = $1;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "plus",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	elsif ( $text =~ /^([*])/ ) {

	    # Operatoren
	    $token      = $1;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "mal",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	elsif ( $text =~ /^([:\/])/ ) {

	    # Operatoren
	    $token      = $1;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "geteilt",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	elsif ( $text =~
		/^(sin|cos|tan|acos|asin|log|ln|ceiling|floor|truncate|round|sqrt|abs|fact|exp)/
	    )
	{

	    # Funktionen
	    $token      = $1;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "Funktion",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	elsif ( $text =~ /^(\()/ ) {

	    # oeffnende Klammer
	    $token      = $1;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "(",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	elsif ( $text =~ /^(\))/ ) {

	    # schliessende Klammer
	    $token      = $1;
	    $vorzeichen = 0;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => ")",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}

	elsif ( $text =~ /^([a-z][0-9a-z]*)/ ) {

	    # Variable
	    $token      = $1;
	    $vorzeichen = 0;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "Term",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}
	else {

	    # Rest
	    $token      = $text;
	    $vorzeichen = 1;
	    push @listevontokens,
	    {
		'Inhalt' => $token,
		'Typ'    => "Rest",
		'Baum'   => {
		    'knoten' => $token,
		    'links'  => undef,
		    'rechts' => undef
		}
	    };
	}

	#print "Token " . $token . "\n";
	$text = substr $text, length $token;
    }
    return @listevontokens;
}

# Ein vollstaendig geklammerter Ausdruck wird ausgegeben.
sub ausgabeliste {
    my (@liste) = @_;
    my $listenlaenge = scalar @liste;
    my $i;
    printf("'");
    for ( $i = 0 ; $i < $listenlaenge ; $i++ ) {
	printf( "%s", $liste[$i]{'Inhalt'} );
	printf("  ") if ( $i < $listenlaenge - 1 );
    }
    print "'\n ";

}

# Der eigentliche Algorithmus
sub regelwerk {
    my (@liste) = @_;
    my ( @klammerterm, $i, $j, $gefunden, $klammerauf, $klammerzu,
	 $klammertiefe );

    do {
	$gefunden = 0;
	if ( !$gefunden ) {

	    $klammerzu = $klammerauf = $klammertiefe = 0;

# Klammern:
# Wenn eine oeffnende Klammer gefunden wurde, dann wird der Zaehler klammertiefe erhoeht,
# bei einer schliessenden Klammer erniedrigt.
# Bei korrekter Klammerung ist der Zaehler am Ende 0
# und es wird die regelwerk-Funktion auf den Inhalt der Klammer angewendet.

	    for ( $i = 0 ; $i < scalar @liste ; $i++ ) {

		if ( $liste[$i]{'Typ'} eq "(" ) {
		    if ( ( $klammertiefe == 0 ) ) {
			$klammerauf = $i;
		    }
		    $klammertiefe++;
		}
		if ( $liste[$i]{'Typ'} eq ")" ) {
		    $klammertiefe--;
		    if ( $klammertiefe == 0 ) {
			$klammerzu = $i;
		    }
		}

	    }
	    ## Fehler wenn klammertiefe != 0 muss noch bearbeitet werden

	    if ( $klammerauf != $klammerzu ) {

		@klammerterm = ();
		for ( $j = $klammerauf + 1 ; $j <= $klammerzu - 1 ; $j++ ) {
		    push @klammerterm,
		    {
			'Inhalt' => $liste[$j]{'Inhalt'},
			'Typ'    => $liste[$j]{'Typ'},
			'Baum'   => {
			    'knoten' => $liste[$j]{'Baum'}{'knoten'},
			    'links'  => undef,
			    'rechts' => undef
			}
		    };
		}

		splice( @liste, $klammerauf, $klammerzu - $klammerauf + 1,
			regelwerk(@klammerterm) );
		$gefunden = 1;

	    }

	}
	if ( !$gefunden ) {

	    # Potenzieren
	    for ( $i = 0 ; $i < scalar @liste - 2 ; $i++ ) {

		if (   ( $liste[$i]{'Typ'} eq "Term" )
		       && ( $liste[ $i + 1 ]{'Typ'} eq "hoch" )
		       && ( $liste[ $i + 2 ]{'Typ'} eq "Term" )
		       && ( !$gefunden ) )
		{

		    splice(
			@liste, $i, 3,
			{
			    'Inhalt' => "("
				. $liste[$i]{'Inhalt'}
			    . $liste[ $i + 1 ]{'Inhalt'}
			    . $liste[ $i + 2 ]{'Inhalt'} . ")",
			    'Typ'  => "Term",
			    'Baum' => {
				'knoten' => $liste[ $i + 1 ]{'Baum'}{'knoten'},
				'links'  => $liste[$i]{'Baum'},
				'rechts' => $liste[ $i + 2 ]{'Baum'}
			    }
			}
			);
		    $gefunden = 1;
		}
	    }
	}
	if ( !$gefunden ) {

	    # Multiplikation und Division
	    for ( $i = 0 ; $i < scalar @liste - 2 ; $i++ ) {
		if (
		    ( $liste[$i]{'Typ'} eq "Term" )
		    && (   ( $liste[ $i + 1 ]{'Typ'} eq "mal" )
			   || ( $liste[ $i + 1 ]{'Typ'} eq "geteilt" ) )
		    && ( $liste[ $i + 2 ]{'Typ'} eq "Term" )
		    && ( !$gefunden )
		    )
		{
		    splice(
			@liste, $i, 3,
			{
			    'Inhalt' => "("
				. $liste[$i]{'Inhalt'}
			    . $liste[ $i + 1 ]{'Inhalt'}
			    . $liste[ $i + 2 ]{'Inhalt'} . ")",
			    'Typ'  => "Term",
			    'Baum' => {
				'knoten' => $liste[ $i + 1 ]{'Baum'}{'knoten'},
				'links'  => $liste[$i]{'Baum'},
				'rechts' => $liste[ $i + 2 ]{'Baum'}
			    }
			}
			);
		    $gefunden = 1;
		}
	    }
	}
	if ( !$gefunden ) {

	    # Funktion
	    for ( $i = 0 ; $i < scalar @liste - 1 ; $i++ ) {
		if (   ( $liste[$i]{'Typ'} eq "Funktion" )
		       && ( $liste[ $i + 1 ]{'Typ'} eq "Term" )
		       && ( !$gefunden ) )
		{
		    if ( $liste[$i]{'Inhalt'} eq "exp" ) {
			splice(
			    @liste, $i, 2,
			    {
				'Inhalt' => "("
				    . exp(1) . "\^"
				    . $liste[ $i + 1 ]{'Inhalt'} . ")",
				    'Typ'  => "Term",
				    'Baum' => {
					'knoten' => "^",
					'links'  => {
					    'knoten' => exp(1),
					    'links'  => undef,
					    'rechts' => undef
					},
						'rechts' => $liste[ $i + 1 ]{'Baum'}
				}
			    }
			    );
		    }
		    else {
			splice(
			    @liste, $i, 2,
			    {
				'Inhalt' => "("
				    . $liste[$i]{'Inhalt'}
				. $liste[ $i + 1 ]{'Inhalt'} . ")",
				'Typ'  => "Term",
				'Baum' => {
				    'knoten' => $liste[$i]{'Baum'}{'knoten'},
				    'links'  => $liste[ $i + 1 ]{'Baum'},
				    'rechts' => undef
				}
			    }
			    );
		    }
		    $gefunden = 1;
		}
	    }
	}
	if ( !$gefunden ) {

	    # Addition und Subtraktion
	    for ( $i = 0 ; $i < scalar @liste - 2 ; $i++ ) {
		if (
		    ( $liste[$i]{'Typ'} eq "Term" )
		    && (   ( $liste[ $i + 1 ]{'Typ'} eq "plus" )
			   || ( $liste[ $i + 1 ]{'Typ'} eq "minus" ) )
		    && ( $liste[ $i + 2 ]{'Typ'} eq "Term" )
		    && ( !$gefunden )
		    )
		{
		    splice(
			@liste, $i, 3,
			{
			    'Inhalt' => "("
				. $liste[$i]{'Inhalt'}
			    . $liste[ $i + 1 ]{'Inhalt'}
			    . $liste[ $i + 2 ]{'Inhalt'} . ")",
			    'Typ'  => "Term",
			    'Baum' => {
				'knoten' => $liste[ $i + 1 ]{'Baum'}{'knoten'},
				'links'  => $liste[$i]{'Baum'},
				'rechts' => $liste[ $i + 2 ]{'Baum'}
			    }
			}
			);
		    $gefunden = 1;
		}
	    }
	}
	if ( !$gefunden ) {

	    # Term mit Vorzeichen
	    for ( $i = 0 ; $i < scalar @liste - 1 ; $i++ ) {
		if (
		    (
		     ( $liste[$i]{'Typ'} eq "plus" )
		     || ( $liste[$i]{'Typ'} eq "minus" )
		    )
		    && ( $liste[ $i + 1 ]{'Typ'} eq "Term" )
		    )
		{
		    splice(
			@liste, $i, 2,
			{
			    'Inhalt' => "(0"
				. $liste[$i]{'Inhalt'}
			    . $liste[ $i + 1 ]{'Inhalt'} . ")",
			    'Typ'  => "Term",
			    'Baum' => {
				'knoten' => $liste[$i]{'Baum'}{'knoten'},
				'links'  => {
				    'knoten' => 0,
				    'links'  => undef,
				    'rechts' => undef
				},
					'rechts' => $liste[ $i + 1 ]{'Baum'}
			    }
			}
			);
		    $gefunden = 1;
		}
	    }
	}

    } while ($gefunden);

    ausgabeliste(@liste);
    return @liste;
}

# polnische Notation wird ausgegeben.
sub polnisch {
    my $ref = shift;

    # suche links (rekursiv)
    if ( defined( $$ref{'links'} ) ) {
	polnisch( $$ref{'links'} );
    }

    # suche rechts (rekursiv)
    if ( defined( $$ref{'rechts'} ) ) {
	polnisch( $$ref{'rechts'} );
    }

    # Ausgabe des Knotens
    print " $$ref{'knoten'}";
}

sub rechenbaum_ausrechnen {
    my $baum      = shift;
    my $variablen = shift;

    print $$baum{'knoten'} . "\n";
    if ( $$baum{'knoten'} eq "*" ) {
	return rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) *
	    rechenbaum_ausrechnen( $$baum{'rechts'}, $variablen );
    }
    elsif ( $$baum{'knoten'} eq ":" ) {
	return rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) /
	    rechenbaum_ausrechnen( $$baum{'rechts'}, $variablen );
    }

    elsif ( $$baum{'knoten'} eq "/" ) {
	return rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) /
	    rechenbaum_ausrechnen( $$baum{'rechts'}, $variablen );
    }
    elsif ( $$baum{'knoten'} eq "+" ) {
	return rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) +
	    rechenbaum_ausrechnen( $$baum{'rechts'}, $variablen );
    }
    elsif ( $$baum{'knoten'} eq "^" ) {
	return rechenbaum_ausrechnen( $$baum{'links'}, $variablen )
	    **rechenbaum_ausrechnen( $$baum{'rechts'}, $variablen );
    }

    elsif ( $$baum{'knoten'} eq "-" ) {
	return rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) -
	    rechenbaum_ausrechnen( $$baum{'rechts'}, $variablen );
    }
    elsif ( defined $$variablen{ $$baum{'knoten'} } ) {
	return $$variablen{ $$baum{'knoten'} };
    }
    elsif ( $$baum{'knoten'} eq "sin" ) {
	return sin( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }
    elsif ( $$baum{'knoten'} eq "cos" ) {
	return cos( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }
    elsif ( $$baum{'knoten'} eq "tan" ) {
	return tan( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }
    elsif ( $$baum{'knoten'} eq "asin" ) {
	return arcsin( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }
    elsif ( $$baum{'knoten'} eq "acos" ) {
	return acos( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }
    elsif ( $$baum{'knoten'} eq "log" ) {
	return log( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }
    elsif ( $$baum{'knoten'} eq "ceiling" ) {
	return aufrunden( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ),
			  1 );
    }
    elsif ( $$baum{'knoten'} eq "floor" ) {
	return abrunden( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ),
			 1 );
    }
    elsif ( $$baum{'knoten'} eq "truncate" ) {
	if ( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) < 0 ) {
	    return aufrunden(
		rechenbaum_ausrechnen( $$baum{'links'}, $variablen ), 1 );
	}
	else {
	    return abrunden(
		rechenbaum_ausrechnen( $$baum{'links'}, $variablen ), 1 );
	}

    }
    elsif ( $$baum{'knoten'} eq "round" ) {
	return round( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }

    elsif ( $$baum{'knoten'} eq "sqrt" ) {
	return sqrt( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }

    elsif ( $$baum{'knoten'} eq "abs" ) {
	return abs( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }

    elsif ( $$baum{'knoten'} eq "fact" ) {
	return fakultaet(
	    rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }

    elsif ( $$baum{'knoten'} eq "exp" ) {
	return exp( rechenbaum_ausrechnen( $$baum{'links'}, $variablen ) );
    }

    else {    # ACHTUNG: Keine Fehlerbehandlung!!!
	return $$baum{'knoten'};
    }

}

sub funktionsausgabe {
    my $funktionsausdruck = shift;
    my @ergebnis = regelwerk( tokenizer($funktionsausdruck) );

    if ( scalar @ergebnis != 1 ) {
	printf("Fehler \n");
	ausgabeliste(@ergebnis);
    }
    else {
	polnisch( $ergebnis[0]{'Baum'} );
	print "\n";
    }
}

my @ergebnis = regelwerk( tokenizer("(x-2)*(x+2)") );
print rechenbaum_ausrechnen(
    $ergebnis[0]{'Baum'},
    {
	'x'  => 2,
	'y'  => 2,
	'pi' => pi()
    }
    )
    . "\n";

funktionsausgabe("(x-2)*(x+2)");