Unification (QBASIC)

From LiteratePrograms

Unification is normally handled using a pointer based structure representing a list. This program takes a slightly different approach and implements it using string-based lists instead.

Description

Before defining the main unification function we have to specify a couple of auxiliary functions to handle the "lists". Firstly we need the isList function. It checks a string to report whether it can be interpreted as a list or not. The criterion is very simple: does it start and end with parentheses ? Although a more complex (and accurate) test involving counting balanced parentheses could be specified, it's not really necessary for our purposes at the moment. If it became necessary the following function could be upgraded.

<<isList function>>=
FUNCTION isList% (aText AS STRING)
   LET isList% = (LEFT$(aText, 1) = "(" AND RIGHT$(aText, 1) = ")")
END FUNCTION

Secondly we need a function to allow us to split a list into its first item and the remainder. Of course the first item may itself be a list and so here we do need to count balanced parentheses to make sure that we split the string at the right point. And that's what the WHILE/WEND loop within the following function is for. Other than that we have to ensure that the function will not get trapped in the loop if the list is malformed.

<<SplitText function>>=
SUB SplitText (aFirst AS STRING, aRest AS STRING)
   DIM B AS INTEGER
   DIM J AS INTEGER
   DIM L AS INTEGER
   DIM Q AS INTEGER
   SELECT CASE ASC(LEFT$(aRest, 1))
   CASE 40  ' (
      LET B = 1
      LET J = 2
      LET L = LEN(aRest)
      WHILE J <= L AND B > 0
         LET Q = ASC(MID$(aRest, J, 1))
         LET B = B - (Q = 40) + (Q = 41)  '( or )
         LET J = J + 1
      WEND
   CASE ELSE
      LET J = INSTR(aRest + " ", " ")
   END SELECT
   LET aFirst = LEFT$(aRest, J - 1)
   LET aRest = LTRIM$(MID$(aRest, J))
END SUB

Luckily there's no need for a list "CONSing" function. BASIC's string concatenation operator will suffice. However there is a need for a replacement function. In fact we need a specialised one which, given a list of replacements to make as its first argument, will then go ahead and make them on its second and third arguments.

<<Substitute function>>=
SUB Substitute (aRepList AS STRING, aExpr1 AS STRING, aExpr2 AS STRING)
   DIM J AS INTEGER
   DIM L AS INTEGER
   DIM dList AS STRING
   DIM dItem AS STRING
   DIM dFrom AS STRING
   DIM dTo AS STRING
   LET dList = LTRIM$(aRepList)
   WHILE LEN(dList) > 0
      SplitText dItem, dList
      LET dItem = MID$(dItem, 2, LEN(dItem) - 2)
      SplitText dFrom, dItem
      SplitText dTo, dItem
      LET L = LEN(dFrom)
      LET J = INSTR(aExpr1, dFrom)
      WHILE J <> 0
         LET aExpr1 = LEFT$(aExpr1, J - 1) + dTo + MID$(aExpr1, J + L)
         LET J = INSTR(J + 1, aExpr1, dFrom)
      WEND
      LET J = INSTR(aExpr2, dFrom)
      WHILE J <> 0
         LET aExpr2 = LEFT$(aExpr2, J - 1) + dTo + MID$(aExpr2, J + L)
         LET J = INSTR(J + 1, aExpr2, dFrom)
      WEND
   WEND
END SUB

Now we've got the parts we need to define our Unification function. This takes the form of a divide-and-conquer algorithm which addresses five separate types of expression, dealing with four of them directly and calling itself recursively to deal with the fifth.

The first three cases are straightforward. In the first case the function has been given two identical arguments, so the result is successful unification. The second and third cases are mirror images. In each of them the function has been given a variable in one argument and some expression in the other. This leads to successful unification provided that the variable does not appear within the expression. If it doesn't then unification can be achieved by associating the variable with the expression. Otherwise unification is impossible.

The fourth case isn't quite so straightforward. It deals with the situation where both expressions are lists. In that case it is necessary to go through the two lists element by element, unifying corresponding elements. Note that unifying two elements may involve associating a variable with an expression and if that's so the variable has to be substituted wherever else it appears in the two lists. If it proves impossible to unify any two elements then it is impossible to unify the two lists.

Lastly the fifth case handles everything else. Since everything else is impossible to unify, this case just reports failure.

<<Unify function>>=
SUB Unify (aThisList AS STRING, aThatList AS STRING, aEnv AS STRING)
   CONST FAIL = "F"
   DIM J AS INTEGER
   DIM L AS INTEGER
   DIM dSubst AS STRING
   DIM dResult AS STRING
   DIM dThisElem AS STRING
   DIM dThatElem AS STRING
   IF aThisList = aThatList THEN 'is already unified
      LET aEnv = ""
   ELSEIF LEFT$(aThisList, 1) = "$" THEN 'is a Variable
      IF INSTR(aThatList, aThisList) > 0 THEN
         LET aEnv = FAIL
      ELSE
         LET aEnv = "(" + aThisList + " " + aThatList + ")"
      END IF
   ELSEIF LEFT$(aThatList, 1) = "$" THEN 'is a Variable
      IF INSTR(aThisList, aThatList) > 0 THEN
         LET aEnv = FAIL
      ELSE
         LET aEnv = "(" + aThatList + " " + aThisList + ")"
      END IF
   ELSEIF isList(aThisList) AND isList(aThatList) THEN
      LET aThisList = MID$(aThisList, 2, LEN(aThisList) - 2)
      LET aThatList = MID$(aThatList, 2, LEN(aThatList) - 2)
      LET dSubst = ""
      WHILE aThisList <> aThatList AND LEN(aThisList) * LEN(aThatList) <> 0
         SplitText dThisElem, aThisList
         SplitText dThatElem, aThatList
         Unify dThisElem, dThatElem, dResult
         IF dResult = FAIL THEN
            LET aEnv = dResult
            EXIT SUB
         ELSEIF dResult > "" THEN
            LET dSubst = dSubst + dResult
            Substitute dResult, aThisList, aThatList
         END IF
      WEND
      IF aThisList = aThatList THEN
         LET aEnv = dSubst
      ELSE
         LET aEnv = FAIL
      END IF
   ELSE
      LET aEnv = FAIL
   END IF
END SUB

Since this is a fairly complex function it needs a comprehensive unit test. So here is a test harness with a goodly number of test cases.

<<test harness>>=
DECLARE SUB Unify (aThisList AS STRING, aThatList AS STRING, aEnv AS STRING)
DECLARE FUNCTION isList% (aText AS STRING)
DECLARE SUB Substitute (aRepList AS STRING, aExpr1 AS STRING, aExpr2 AS STRING)
DECLARE SUB SplitText (aFirst AS STRING, aRest AS STRING)
DEFINT A-Z
CONST FAIL = "F"
CONST Tries = 100
CLS
LET dStartTime! = TIMER
FOR Q = 1 TO Tries
   RESTORE
   READ X$, A$, B$
   WHILE LEN(X$) > 0
      LET X = VAL(X$)
      LET C$ = A$
      LET D$ = B$
      LET E$ = ""
      Unify C$, D$, E$
      LET C$ = A$
      LET D$ = B$
      IF E$ <> FAIL THEN
         Substitute E$, C$, D$
      END IF
      PRINT "Original:     ", A$, B$
      PRINT "Substitutions:", E$
      PRINT "Final:        ", C$;
      IF C$ <> D$ THEN PRINT " not unified with "; D$ ELSE PRINT
      PRINT
      READ X$, A$, B$
   WEND
NEXT
PRINT "Took"; (TIMER - dStartTime!) / (X * Tries) * 1000000!; "microseconds per unification"
SYSTEM
DATA 1,"(R a b)","(R a b)"
DATA 2,"(R a b)","(E a b)"
DATA 3,"(R $a $b)","(R ($c $d) $d)"
DATA 4,"(R $a $b)","(E ($c $d) $d)"
DATA 5,"(R $a $b)","(R ($c $d) d)"
DATA 6,"(R $a $b)","(R ($b $d) d)"
DATA 7,"(R $a $c)","(R ($b $c) $b)"
DATA 8,"(R $a (b c))","(R ($b $c) $b)"
DATA 9,"(R $a (d e))","(R ($b $c) $b)"
DATA 10,"(R $a b)","(R ($c $d) $d)"
DATA 11,"(R a b)","(R $x b)"
DATA 11,"(Q (P $X $Y) (P $Y $X))","(Q $Z $Z)"
DATA 12,"(P $X $Y)","(P $Y $X)"
DATA 13,"(P $X $Y a)","(P $Y $X $X)"
DATA 14,"(CAR ($X $Y) $X)","(CAR (1 2) $R)"
DATA 15,"(CDR ($X $Y) ($Y))","(CDR (1 2) $R)"
DATA 16,"(CONS ($X $Y) ($X $Y))","(CONS (1 2) $R)"
DATA 17,"(A (G $X $Y))","(A (G ($Y 1) ($X 2)))"
DATA 18,"(Man Fred)","(Man Fred)"
DATA 19,"(f $x (t $x) $z)","(f a $y (h $w $y))"
DATA "","",""

<<unify.bas>>=
test harness
isList function
SplitText function
Substitute function
Unify function

Download code