#! /usr/bin/perl -w ################################################################################ # schema2ground.pl - 06/20/2002 by aldeba # # Create a ground PDDL description from a PDDL operators schema # for a particular planning problem ################################################################################ use strict; ################################################################################ # function to load a LISP list from a file ################################################################################ sub loadListFile { my $resultList = ''; my $openParenthesis = 0; if( open( LISTFILE, $_[ 1 ] ) == 0 ) { die "$_[ 0 ]: error trying to open file $_[ 1 ]\n"; } while( ) { chop; $_ = lc( $_ ); # remove the commentary lines s/^;.*$//go; while( /^.+$/ ) { # remove spaces and tabs if( s/^[\s\t]*//o ) { if( $resultList ne '' ) { $resultList .= ' '; } } # add the number of open parenthesis if( /^(\()(.*)/o ) { $openParenthesis++; $resultList .= $1; $_ = $2; } # subtract the number of open parenthesis if( /^(\))(.*)/o ) { $openParenthesis--; if( $openParenthesis < 0 ) { die "$_[ 0 ]: file $_[ 1 ] does not contain a valid list\n"; } $resultList .= $1; $_ = $2; } # get the arguments from a list if( /^([^\(^\)^\s^\t]+)([\(\)\s\t]*.*)/o ) { $resultList .= $1; $_ = $2; } } } close( LISTFILE ); # check for the correct list sintax if( $openParenthesis != 0 ) { die "$_[ 0 ]: file $_[ 1 ] does not contain a valid list\n"; } $resultList; } ################################################################################ # function to check if a string represents a LISP list ################################################################################ sub isList { my $openParenthesis = 0; my $result = 0; $_ = $_[ 0 ]; # must begin with a parenthesis if( /^[\s\t]*\(/o ) { while( /^.+$/ ) { # remove spaces and tabs s/^[\s\t]*//o; # add the number of open parenthesis if( /^\((.*)/o ) { $openParenthesis++; $_ = $1; } # subtract the number of open parenthesis if( /^\)(.*)/o ) { $openParenthesis--; $_ = $1; } # get the arguments from the list if( /^[^\(^\)^\s^\t]+([\(\)\s\t]*.*)/o ) { $_ = $1; } } if( $openParenthesis == 0 ) { $result = 1; } } $result; } ################################################################################ # function to extract the arguments of a LISP list, returning it into a vector ################################################################################ sub listArguments { my $openParenthesis = 0; my @listArgument = (); my $argumentIndex = 0; $_ = $_[ 0 ]; while( /^.+$/ ) { # remove spaces and tabs s/^[\s\t]*//o; # add the number of open parenthesis if( /^\((.*)/o ) { $openParenthesis++; if( $openParenthesis == 2 ) { $listArgument[ ++$#listArgument ] = '( '; } elsif( $openParenthesis > 2 ) { $listArgument[ $#listArgument ] .= '( '; } $_ = $1; } # subtract the number of open parenthesis if( /^\)(.*)/o ) { $openParenthesis--; if( $openParenthesis == 0 ) { } elsif( $openParenthesis >= 1 ) { $listArgument[ $#listArgument ] .= ') '; } $_ = $1; } # get the arguments from a list if( /^([^\(^\)^\s^\t]+)([\(\)\s\t]*.*)/o ) { if( $openParenthesis == 1 ) { $listArgument[ ++$#listArgument ] = $1; } else { $listArgument[ $#listArgument ] .= $1 . ' '; } $_ = $2; } } @listArgument; } ################################################################################ # function to get predicates from a LISP list, returning it into a vector ################################################################################ sub getPredicates { my @listArgument = listArguments( $_[ 0 ] ); my @predicates = (); if( $#listArgument >= 0 ) { if( $listArgument[ 0 ] ne 'and' ) { $predicates[ $#predicates++ ] = '( ' . $listArgument[ 0 ] . ' )'; } else { for( my $i = 1; $i <= $#listArgument; $i++ ) { $predicates[ ++$#predicates ] = $listArgument[ $i ]; } } } @predicates; } ################################################################################ # function to return the predicate name from a LISP list ################################################################################ sub predicateName { my @listArgument = listArguments( $_[ 0 ] ); if( $listArgument[ 0 ] eq 'not' ) { @listArgument = listArguments( $listArgument[ 1 ] ); } $listArgument[ 0 ]; } ################################################################################ # function that return 1 if the predicate argument is negated, 0 otherwise ################################################################################ sub negatedPredicate { my @listArgument = listArguments( $_[ 0 ] ); if( $listArgument[ 0 ] eq 'not' ) { 1; } else { 0; } } ################################################################################ # function to return a transformation of a ground predicate in a proposition ################################################################################ sub groundPredicate2proposition { my @listArgument = listArguments( $_[ 0 ] ); my $proposition; if( $listArgument[ 0 ] eq 'not' ) { @listArgument = listArguments( $listArgument[ 1 ] ); $proposition = '~'; } $proposition .= $listArgument[ 0 ]; for( my $i = 1; $i <= $#listArgument; $i++ ) { $proposition .= '_' . $listArgument[ $i ]; } $proposition; } ################################################################################ # function to get variable names from a action, returning it into a vector ################################################################################ sub getVariableNames { my @listArgument = listArguments( $_[ 0 ] ); my @variableName; for( my $i = 0; $i <= $#listArgument; $i += 3 ) { $variableName[ ++$#variableName ] = $listArgument[ $i ]; } @variableName; } ################################################################################ # function to get variable types from a action, returning it into a vector ################################################################################ sub getVariableTypes { my @listArgument = listArguments( $_[ 0 ] ); my @variableType; for( my $i = 2; $i <= $#listArgument; $i += 3 ) { $variableType[ ++$#variableType ] = $listArgument[ $i ]; } @variableType; } ################################################################################ # main function ################################################################################ my $PDDL_OUTPUT = 1; my $STRIPS_OUTPUT = 2; my $thisProgram = 'schema2ground'; my $domainFileName = ''; my $problemFileName = ''; my $outputFormat = $PDDL_OUTPUT; my $noCWA = 0; my $verbose = 0; # command line arguments parsing foreach my $argument( @ARGV ) { if( $argument eq '--help' ) { print < 7 || ( $#ithDomainArgument + 1 ) % 2 != 0 ) { die "$thisProgram: wrong number of arguments in the action list\n"; } if( isList( $ithDomainArgument[ 1 ] ) != 0 ) { die "$thisProgram: second action list argument must be the action name\n"; } # store the action name $actionName[ ++$#actionName ] = $ithDomainArgument[ 1 ]; # parse the other action list arguments for( my $j = 2; $j <= $#ithDomainArgument; $j += 2 ) { if( isList( $ithDomainArgument[ $j + 1 ] ) == 0 ) { die "$thisProgram: argument following the action parameter $ithDomainArgument[ $j ] must be a list\n"; } if( $ithDomainArgument[ $j ] eq ':parameters' ) { my $auxiliar = $ithDomainArgument[ $j + 1 ]; $actionParameters{ $ithDomainArgument[ 1 ] } = $auxiliar; } elsif( $ithDomainArgument[ $j ] eq ':precondition' ) { my $auxiliar = '( '; my @listArgument = listArguments( $ithDomainArgument[ $j + 1 ] ); if( $listArgument[ 0 ] eq 'and' ) { for( my $i = 1; $i <= $#listArgument; $i++ ) { $auxiliar .= $listArgument[ $i ]; } } else { $auxiliar = '( ' . $ithDomainArgument[ $j + 1 ]; } $actionPrecondition{ $ithDomainArgument[ 1 ] } = $auxiliar . ')'; } elsif( $ithDomainArgument[ $j ] eq ':effect' ) { my $auxiliar = '( '; my @listArgument = listArguments( $ithDomainArgument[ $j + 1 ] ); if( $listArgument[ 0 ] eq 'and' ) { for( my $i = 1; $i <= $#listArgument; $i++ ) { $auxiliar .= $listArgument[ $i ]; } } else { $auxiliar = '( ' . $ithDomainArgument[ $j + 1 ]; } $actionEffect{ $ithDomainArgument[ 1 ] } = $auxiliar . ')'; } else { die "$thisProgram: unknown action parameter $ithDomainArgument[ $j ]\n"; } } } } # display the domain description after the PDDL parse if( $verbose == 1 ) { print STDERR "[debug] domain: $domainName\n"; if( $#typeName >= $[ ) { print STDERR "[debug] types: "; foreach my $typeName ( @typeName ) { print STDERR "$typeName "; } print STDERR "\n"; } if( $#predicateName >= $[ ) { print STDERR "[debug] predicates: "; foreach my $predicateName ( @predicateName ) { print STDERR "$predicateName "; } print STDERR "\n"; } foreach my $actionName ( @actionName ) { print STDERR "[debug] action: $actionName\n"; print STDERR " parameters: $actionParameters{ $actionName }\n"; print STDERR " precondition: $actionPrecondition{ $actionName }\n"; print STDERR " effect: $actionEffect{ $actionName }\n"; } } ################################################################################ # problem list parsing ################################################################################ my $problemName; my @objectName; my %objectType; my @initialState; my @goalState; # check if the problem list follows the structure below: # ( define ( problem problem-name ) ( :domain domain-name ) # ( :objects ... ) ( :init ( ... ) ) ( :goal ( ... ) ) ) my @problemArgument = listArguments( $problemList ); if( $#problemArgument < 5 ) { die "$thisProgram: wrong number of arguments in the problem list\n"; } if( $problemArgument[ 0 ] ne 'define' ) { die "$thisProgram: first problem list argument must be define\n"; } for( my $i = 1; $i <= $#problemArgument; $i++ ) { if( isList( $problemArgument[ $i ] ) == 0 ) { die "$thisProgram: $i th problem list argument must be a list\n"; } } # check if the first problem list follows the structure below: # ( problem problem-name ) my @firstProblemArgument = listArguments( $problemArgument[ 1 ] ); if( $#firstProblemArgument != 1 ) { die "$thisProgram: wrong number of arguments in the first problem list argument\n"; } if( $firstProblemArgument[ 0 ] ne 'problem' ) { die "$thisProgram: first problem list argument must be problem\n"; } # extract the domain name $problemName = $firstProblemArgument[ 1 ]; # check if the second problem list follows the structure below: # ( :domain domain-name ) my @secondProblemArgument = listArguments( $problemArgument[ 2 ] ); if( $#secondProblemArgument != 1 ) { die "$thisProgram: wrong number of arguments in the second problem list argument\n"; } if( $secondProblemArgument[ 0 ] ne ':domain' ) { die "$thisProgram: first domain list argument must be :domain\n"; } if( $secondProblemArgument[ 1 ] ne $domainName ) { die "$thisProgram: domain not the same as the problem domain\n"; } # check if the third problem list follows the structure below: # ( :objects ( ... ) ) my @thirdProblemArgument = listArguments( $problemArgument[ 3 ] ); if( $#thirdProblemArgument < 1 ) { die "$thisProgram: wrong number of arguments in the third problem list argument\n"; } if( $thirdProblemArgument[ 0 ] ne ':objects' ) { die "$thisProgram: first init list argument must be :objects\n"; } # extract the object names and types, if declared here for( my $i = 1; $i <= $#thirdProblemArgument; $i++ ) { if( $thirdProblemArgument[ $i ] ne '-' ) { $objectName[ ++$#objectName ] = $thirdProblemArgument[ $i ]; } else { $objectType{ $objectName[ $#objectName ] } = $thirdProblemArgument[ ++$i ]; } } # check if the fourth problem list follows the structure below: # ( :init ( ... ) ) my @fourthProblemArgument = listArguments( $problemArgument[ 4 ] ); if( $#fourthProblemArgument != 1 ) { die "$thisProgram: wrong number of arguments in the fourth problem list argument\n"; } if( $fourthProblemArgument[ 0 ] ne ':init' ) { die "$thisProgram: first init list argument must be :init\n"; } if( isList( $fourthProblemArgument[ 1 ] ) == 0 ) { die "$thisProgram: first initial state list argument must be a list\n"; } # extract the initial state @initialState = getPredicates( $fourthProblemArgument[ 1 ] ); # check if the fifth problem list follows the structure below: # ( :goal ( ... ) ) my @fifthProblemArgument = listArguments( $problemArgument[ 5 ] ); if( $#fifthProblemArgument != 1 ) { die "$thisProgram: wrong number of arguments in the fifth problem list argument\n"; } if( $fifthProblemArgument[ 0 ] ne ':goal' ) { die "$thisProgram: first goal list argument must be :goal\n"; } if( isList( $fifthProblemArgument[ 1 ] ) == 0 ) { die "$thisProgram: first goal state list argument must be a list\n"; } # extract the goal state @goalState = getPredicates( $fifthProblemArgument[ 1 ] ); # display the problem description after the PDDL parse if( $verbose == 1 ) { print STDERR "[debug] problem: $problemName\n"; print STDERR "[debug] objects: "; foreach my $object ( @objectName ) { print STDERR "$object - $objectType{ $object }; "; } print STDERR "\n"; print STDERR "[debug] init: @initialState\n"; print STDERR "[debug] goal: @goalState\n"; } ################################################################################ # validate the domain description ################################################################################ # types must be distinct strings # all predicates argument's must be of declared types # all parameter variables must be of declared types # all preconditions and effects variable's must be in the parameter list # all preconditions and effects predicates must be valid predicates # all equality conditions must have two variable name arguments ################################################################################ # validate the problem description ################################################################################ # objects must be distinct strings # all initial state predicates must be valid predicates # all initial state predicates must be ground # all initial state predicates argument's must be valid objects # all goal state predicates must be valid predicates # all goal state predicates argument's must be either a valid object # or a variable of declared type ################################################################################ # get the type associated with each object from the initial state ################################################################################ ################################################################################ # transform the schema in a ground representation ################################################################################ my %predicate2proposition; my %action2proposition; my %actionPropositionPrecondition; my %actionPropositionEffect; my $numPropositions = 0; my $numActionPropositions = 0; # store all initial state's predicates for( my $i = 0; $i <= $#initialState; $i++ ) { $predicate2proposition{ $initialState[ $i ] } = groundPredicate2proposition( $initialState[ $i ] ); } for( ;; ) { my @predicateProposition = keys %predicate2proposition; my @actionProposition = keys %action2proposition; if( $numPropositions == $#predicateProposition && $numActionPropositions == $#actionProposition ) { last; } $numPropositions = $#predicateProposition; $numActionPropositions = $#actionProposition; # try to instantiate each action foreach my $actionName ( @actionName ) { my @variableName = getVariableNames( $actionParameters{ $actionName } ); my @variableType = getVariableTypes( $actionParameters{ $actionName } ); my %variableAssignment; if( $verbose == 1 ) { print STDERR "[debug] try to instantiate $actionName\n"; } # initially, make all variables assigned to the first object for( my $i = 0; $i <= $#variableName; $i++ ) { foreach my $object ( @objectName ) { if( $objectType{ $object } eq $variableType[ $i ] ) { $variableAssignment{ $variableName[ $i ] } = $object; last; } } } for( ;; ) { if( $verbose == 1 ) { print STDERR "[debug] set of state predicates: "; foreach my $predicate ( keys %predicate2proposition ) { print STDERR "$predicate^ "; } print STDERR "\n"; print STDERR "[debug] variable instantiation: "; foreach my $variable ( @variableName ) { print STDERR "$variable/$variableAssignment{ $variable } "; } print STDERR "\n"; } # try to unify each precondition my @precondition = listArguments( $actionPrecondition{ $actionName } ); my $unified = 0; for( my $i = 0; $i <= $#precondition; $i++ ) { # check for equality conditions if( predicateName( $precondition[ $i ] ) eq '=' ) { if( $verbose == 1 ) { print STDERR "[debug] equality check: $precondition[ $i ]\n"; } my @preconditionArgument; if( negatedPredicate( $precondition[ $i ] ) == 0 ) { @preconditionArgument = listArguments( $precondition[ $i ] ); if( $variableAssignment{ $preconditionArgument[ 1 ] } ne $variableAssignment{ $preconditionArgument[ 2 ] } ) { $unified = 0; last; } } else { my @auxiliar = listArguments( $precondition[ $i ] ); @preconditionArgument = listArguments( $auxiliar[ 1 ] ); if( $variableAssignment{ $preconditionArgument[ 1 ] } eq $variableAssignment{ $preconditionArgument[ 2 ] } ) { $unified = 0; last; } } next; } # try to unify the precondition with all predicates foreach my $predicate ( keys %predicate2proposition ) { if( predicateName( $precondition[ $i ] ) eq predicateName( $predicate ) && negatedPredicate( $precondition[ $i ] ) == negatedPredicate( $predicate ) ) { my @preconditionArgument; my @predicateArgument; if( $verbose == 1 ) { print STDERR "[debug] possible unification: $precondition[ $i ]- $predicate\n"; } if( negatedPredicate( $precondition[ $i ] ) == 0 ) { @preconditionArgument = listArguments( $precondition[ $i ] ); } else { my @auxiliar = listArguments( $precondition[ $i ] ); @preconditionArgument = listArguments( $auxiliar[ 1 ] ); } if( negatedPredicate( $predicate ) == 0 ) { @predicateArgument = listArguments( $predicate ); } else { my @auxiliar = listArguments( $predicate ); @predicateArgument = listArguments( $auxiliar[ 1 ] ); } # check if the variable assignment is valid for the possible unification $unified = 1; for( my $j = 1; $j <= $#preconditionArgument; $j++ ) { if( $variableAssignment{ $preconditionArgument[ $j ] } ne $predicateArgument[ $j ] ) { $unified = 0; last; } } if( $unified == 1 ) { last; } } } if( $unified == 0 ) { last; } } if( $unified == 1 ) { my $parameters = ''; my $proposition = $actionName; foreach my $variable ( @variableName ) { $parameters .= $variableAssignment{ $variable } . ' '; $proposition .= '_' . $variableAssignment{ $variable }; } $action2proposition{ "( $actionName $parameters)" } = $proposition; if( $verbose == 1 ) { print STDERR "[debug] action instantiation: ( $actionName $parameters) = $proposition\n"; } # instantiate all precondition's predicates my @precondition = listArguments( $actionPrecondition{ $actionName } ); my $auxiliar = '( and '; for( my $i = 0; $i <= $#precondition; $i++ ) { if( predicateName( $precondition[ $i ] ) eq '=' ) { next; } my @preconditionArgument; if( negatedPredicate( $precondition[ $i ] ) == 0 ) { @preconditionArgument = listArguments( $precondition[ $i ] ); $auxiliar .= '( ' . $preconditionArgument[ 0 ]; } else { my @auxiliar = listArguments( $precondition[ $i ] ); @preconditionArgument = listArguments( $auxiliar[ 1 ] ); $auxiliar .= '( not ( ' . $preconditionArgument[ 0 ]; } for( my $j = 1; $j <= $#preconditionArgument; $j++ ) { if( $preconditionArgument[ $j ] =~ /^\?.*/ ) { $auxiliar .= '_' . $variableAssignment{ $preconditionArgument[ $j ] }; } else { $auxiliar .= '_' . $preconditionArgument[ $j ]; } } if( negatedPredicate( $precondition[ $i ] ) == 1 ) { $auxiliar .= ' )'; } $auxiliar .= ' ) '; } $actionPropositionPrecondition{ $proposition } = "$auxiliar)"; if( $verbose == 1 ) { print STDERR "[debug] precondition: $auxiliar)\n"; } # instantiate all effect's predicates my @effect = listArguments( $actionEffect{ $actionName } ); $auxiliar = '( and '; for( my $i = 0; $i <= $#effect; $i++ ) { my $effectPredicate; my $effectProposition; my @effectArgument; if( negatedPredicate( $effect[ $i ] ) == 0 ) { @effectArgument = listArguments( $effect[ $i ] ); $effectPredicate = '( ' . $effectArgument[ 0 ]; $effectProposition = '( ' . $effectArgument[ 0 ]; } else { my @auxiliar = listArguments( $effect[ $i ] ); @effectArgument = listArguments( $auxiliar[ 1 ] ); $effectPredicate = '( not ( ' . $effectArgument[ 0 ]; $effectProposition = '( not ( ' . $effectArgument[ 0 ]; } for( my $j = 1; $j <= $#effectArgument; $j++ ) { if( $effectArgument[ $j ] =~ /^\?.*/ ) { $effectPredicate .= ' ' . $variableAssignment{ $effectArgument[ $j ] }; $effectProposition .= '_' . $variableAssignment{ $effectArgument[ $j ] }; } else { $effectPredicate .= ' ' . $effectArgument[ $j ]; $effectProposition .= '_' . $effectArgument[ $j ]; } } if( negatedPredicate( $effect[ $i ] ) == 1 ) { $effectPredicate .= ' )'; $effectProposition .= ' )'; } $effectPredicate .= ' ) '; $effectProposition .= ' ) '; $predicate2proposition{ $effectPredicate } = groundPredicate2proposition( $effectPredicate ); $auxiliar .= $effectProposition; } $actionPropositionEffect{ $proposition } = "$auxiliar)"; if( $verbose == 1 ) { print STDERR "[debug] effect: $auxiliar)\n"; } } # try the next variable assignment my $carryOut = 1; # foreach my $variable ( @variableName ) { # if( $carryOut == 1 ) { # if( $variableAssignment{ $variable } ne $objectName[ $#objectName ] ) { # for( my $i = 0; $i < $#objectName; $i++ ) { # if( $variableAssignment{ $variable } eq $objectName[ $i ] ) { # $variableAssignment{ $variable } = $objectName[ $i + 1 ]; # # $carryOut = 0; # last; # } # } # } else { # $variableAssignment{ $variable } = $objectName[ 0 ]; # } # } # } for( my $i = 0; $i <= $#variableName; $i++ ) { if( $carryOut == 1 ) { my $firstObject = ''; my $currentObject = 0; my $nextObject; my $lastObject; # find for the first, current, next and last object corresponding to the same # type as the current variable assignment foreach my $object ( @objectName ) { if( $objectType{ $object } eq $variableType[ $i ] ) { if( $firstObject eq '' ) { $firstObject = $object; } if( $currentObject == 1 ) { $nextObject = $object; $currentObject = 0; } if( $variableAssignment{ $variableName[ $i ] } eq $object ) { $currentObject = 1; } $lastObject = $object; } } if( $variableAssignment{ $variableName[ $i ] } ne $lastObject ) { $variableAssignment{ $variableName[ $i ] } = $nextObject; $carryOut = 0; last; } else { $variableAssignment{ $variableName[ $i ] } = $firstObject; } } else { last; } } if( $carryOut == 1 ) { last; } } } } ################################################################################ # generate the domain description ################################################################################ if( $outputFormat == $PDDL_OUTPUT ) { } else { foreach my $action ( keys %action2proposition ) { print "$action2proposition{ $action }\n"; my @precondition = getPredicates( $actionPropositionPrecondition{ $action2proposition{ $action } } ); my @effect = getPredicates( $actionPropositionEffect{ $action2proposition{ $action } } ); for( my $i = 0; $i <= $#precondition; $i++ ) { if( negatedPredicate( $precondition[ $i ] ) ) { print '~'; } print predicateName( $precondition[ $i ] ); if( $i < $#precondition ) { print ';'; } } print "\n"; for( my $i = 0; $i <= $#effect; $i++ ) { if( negatedPredicate( $effect[ $i ] ) ) { print '~'; } print predicateName( $effect[ $i ] ); if( $i < $#effect ) { print ';'; } } print "\n"; } print "\n"; } ################################################################################ # generate the initial state description ################################################################################ if( $outputFormat == $PDDL_OUTPUT ) { } else { for( my $i = 0; $i <= $#initialState; $i++ ) { print groundPredicate2proposition( $initialState[ $i ] ); if( $i < $#initialState ) { print ';'; } } # if there´s no closed world assumption, generate a complete description if( 1 == $noCWA ) { foreach my $predicate ( keys %predicate2proposition ) { if( 0 == negatedPredicate( $predicate ) ) { my $existInIS = 0; for( my $i = 0; $i <= $#initialState; $i++ ) { if( groundPredicate2proposition( $initialState[ $i ] ) eq $predicate2proposition{ $predicate } ) { $existInIS = 1; } } if( 0 == $existInIS ) { print ";~$predicate2proposition{ $predicate }"; } } } } print "\n"; } ################################################################################ # generate the goal state description ################################################################################ if( $outputFormat == $PDDL_OUTPUT ) { } else { for( my $i = 0; $i <= $#goalState; $i++ ) { print groundPredicate2proposition( $goalState[ $i ] ); if( $i < $#goalState ) { print ';'; } } print "\n"; }