00050 .PR POINT .PR
00100 .COMMENT SISTERS, COUSINS AND AUNTS - MODEL SOLUTION .COMMENT
00120 ( .MODE .PERSON = .STRUCT(.STRING NAME, .BOOL SEX, .INT COUNT, .BITS UP
00130 , .REF .PERSON PA, MA, NEXTHASH)
00140 ; .REF .PERSON NOBODY = .NIL
00150 ; .INT HASHSIZE = 43
00152 ; .INT BITSWIDTH = (MAXINT=32767!16!32)
00160 ; .LOC [0:HASHSIZE-1] .REF .PERSON HASHTABLE
00170 # PERSONS HASHING TO THE SAME HASHTABLE ELEMENT WILL BE CHAINED
00180 USING THE 'NEXTHASH' FIELD #
00190 ; .FOR I .FROM 0 .TO HASHSIZE-1
00200 .DO HASHTABLE[I] := NOBODY .OD
00210 ; .BOOL MALE = .TRUE, FEMALE = .FALSE, CHECK = .TRUE, NOCHECK = .FALSE
00220 ; .PROC HASHIN = (.STRING NAME, .BOOL SEX, CHECK).REF .PERSON:
00230 # RETURNS EXISTING .REF .PERSON FROM HASHTABLE (CHECKING EXISTING SEX IF 'CHECK'),
00240 OR CREATES A NEW ONE AS REQUIRED.
00250 AN EMPTY 'NAME' RETURNS 'NOBODY' #
00260 .IF NAME=""
00270 .THEN NOBODY
00280 .ELSE .LOC .INT HASHNO := 0
00290 ; .FOR I .TO .UPB NAME
00300 .DO HASHNO +:= .ABS NAME[I] .OD
00310 ; .LOC .REF .REF .PERSON PTR := HASHTABLE[HASHNO .MOD HASHSIZE]
00320 # NOTE USE OF THE "3 REF TRICK" #
00330 ; .WHILE (PTR .IS NOBODY ! .FALSE ! NAME .OF PTR /= NAME)
00340 .DO PTR := NEXTHASH .OF PTR .OD
00350 ; .IF PTR .IS NOBODY
00360 .THEN .REF .REF .PERSON (PTR) := .HEAP .PERSON :=
00370 ( NAME, SEX, 0, .SKIP, NOBODY, NOBODY, NOBODY)
00380 .ELIF SEX .OF PTR = SEX .OR .NOT CHECK
00390 .THEN PTR
00400 .ELSE PRINT((NAME, " SEEMS TO HAVE CHANGED SEX", NEWLINE))
00410 ; NOBODY
00420 .FI
00430 .FI
00440 ; .BEGIN # INPUT OF FAMILIES #
00450 .LOC .STRING FATHER, MOTHER, CHILD
00460 ; .LOC .REF .PERSON PA, MA, INFANT
00470 ; .LOC .CHAR SD # TO HOLD "S" FOR SON, OR "D" FOR DAUGHTER #
00480 ; .LOC .BOOL SEX # .TRUE FOR MALE #
00482 ; CLOSE(STANDIN)
00484 ; OPEN(STANDIN, "sisters", STAND IN CHANNEL)
00490 ; ON PAGE END(STAND IN, (.REF .FILE F).BOOL: (NEWPAGE(F); .GOTO RELATIONSHIP))
00500 ; MAKE TERM(STAND IN, ",;.")
00510 ; RESTART:
00520 ( .PROC COMPLAIN = (.STRING MESSAGE).VOID:
00530 # IGNORES REMAINDER OF CURRENT LINE, AND RESTARTS INPUT LOOP #
00540 ( PRINT((MESSAGE, NEWLINE))
00550 ; READ(NEWLINE)
00560 ; .GOTO RESTART
00570 )
00580 ; .PROC EXPECT = (.CHAR E).VOID:
00590 # ABSORBS NEXT CHARACTER, COMPLAINING IF IT IS NOT AS EXPECTED #
00600 ( .LOC .CHAR C
00610 ; READ(C)
00620 ; .IF C/=E
00630 .THEN COMPLAIN(C+" FOUND INSTEAD OF "+E)
00640 .FI
00650 )
00660 ; READ(FATHER); EXPECT(",")
00670 ; PA := HASHIN(FATHER, MALE, CHECK)
00680 ; READ(MOTHER); EXPECT(";")
00690 ; MA := HASHIN(MOTHER, FEMALE, CHECK)
00700 # IF FATHER(MOTHER) IS NOT SPECIFIED, 'NOBODY' GETS ASSIGNED TO PA(MA) #
00710 ; .IF (PA .IS NOBODY) .AND (MA .IS NOBODY)
00720 .THEN COMPLAIN("BOTH PARENTS MISSING")
00730 .FI
00740 ; .WHILE READ(SD)
00750 ; SEX := (SD="S" ! MALE !: SD="D" ! FEMALE ! COMPLAIN(SD+" FOUND INSTEAD OF S OR D"); .SKIP)
00760 ; EXPECT("=")
00770 ; READ(CHILD)
00780 ; INFANT := HASHIN(CHILD, SEX, CHECK)
00790 ; .IF INFANT .ISNT NOBODY
00800 .THEN .IF PA .OF INFANT .ISNT NOBODY
00810 .THEN COMPLAIN(CHILD+" ALREADY HAS A FATHER")
00820 .ELSE PA .OF INFANT := PA
00830 .FI
00840 ; .IF MA .OF INFANT .ISNT NOBODY
00850 .THEN COMPLAIN(CHILD+" ALREADY HAS A MOTHER")
00860 .ELSE MA .OF INFANT := MA
00870 .FI
00880 .ELSE COMPLAIN("CHILD'S NAME NOT GIVEN")
00890 .FI
00900 ; READ(SD)
00910 ; SD/="."
00920 .DO .SKIP .OD
00930 ; READ(NEWLINE)
00940 ; .GOTO RESTART
00950 )
00960 .END # INPUT OF FAMILIES #
00970 ; RELATIONSHIP:
00980 .BEGIN # CHECKING OF RELATIONSHIPS #
00990 .LOC .STRING FIRST, SECOND
01000 ; .LOC .REF .PERSON THIS, THAT
01010 ; .MODE .CHAIN = .STRUCT(.INT UP, DOWN, .REF .CHAIN NEXT)
01020 ; .REF .CHAIN NOCHAIN = .NIL
01030 ; .LOC .REF .CHAIN START CHAIN
01040 ; .PROC INSERT CHAIN = (.INT UP, DOWN).VOID:
01050 ( .LOC .REF .CHAIN PTR := START CHAIN
01060 ; .WHILE (PTR :/=: NOCHAIN ! UP .OF PTR /= UP .OR DOWN .OF PTR /= DOWN ! .FALSE)
01070 .DO PTR := NEXT .OF PTR .OD
01080 ; .IF PTR :=: NOCHAIN .THEN START CHAIN := .HEAP .CHAIN := (UP, DOWN, START CHAIN) .FI
01090 )
01100 ; .PROC RELATIONS = (.INT UP, DOWN).VOID:
01110 # PRINTS THE RELATIONSHIP BETWEEN 'THIS' AND 'THAT', ACCORDING TO
01120 'UP' AND 'DOWN' #
01130 PRINT((NAME .OF THIS
01140 , ( .PROC GREATS = (.INT N).STRING: N*"GREAT-"
01150 ; " IS THE " +
01160 .CASE UP+1
01170 .IN .CASE DOWN+1
01180 .IN "SAME AS "
01190 , (SEX .OF THIS ! "FATHER" ! "MOTHER") + " OF "
01200 .OUT GREATS(DOWN-UP-2) + "GRAND" + (SEX .OF THIS ! "FATHER" ! "MOTHER") + " OF "
01210 .ESAC
01220 , .CASE DOWN+1
01230 .IN (SEX .OF THIS ! "SON" ! "DAUGHTER") + " OF "
01240 , (SEX .OF THIS ! "BROTHER" ! "SISTER") + " OF "
01250 .OUT GREATS(DOWN-UP-1) + (SEX .OF THIS ! "UNCLE" ! "AUNT") + " OF "
01260 .ESAC
01270 .OUT .CASE DOWN+1
01280 .IN GREATS(UP-DOWN-2) + "GRAND" + (SEX .OF THIS ! "SON" ! "DAUGHTER") + " OF "
01290 , GREATS(UP-DOWN-1) + (SEX .OF THIS ! "NEPHEW" ! "NIECE") + " OF "
01300 .OUT .INT COUS = (UP<DOWN ! UP ! DOWN)-1
01310 ; .INT REM = .ABS(UP-DOWN)
01320 ; WHOLE(COUS, 0) + (COUS ! "ST", "ND", "RD" ! "TH") + " COUSIN "
01330 + (REM/=0 ! WHOLE(REM, 0) + " TIMES REMOVED " ! "") + "OF "
01340 .ESAC
01350 .ESAC
01360 )
01370 , NAME .OF THAT, NEWLINE
01380 ))
01390 ; .LOC .INT COUNT := 1 # USED TO MARK .PERSONS WHICH HAVE BEEN SCANNED #
01400 ; .PROC MARK = (.REF .PERSON P, .BITS UP).VOID:
01410 # MARK ALL ANCESTORS OF 'P' WITH 'COUNT'.
01420 'UP' IS NUMBER OF GENERATIONS FROM START #
01430 .IF P .ISNT NOBODY
01440 .THEN .IF COUNT .OF P = COUNT
01442 .THEN UP .OF P := UP .OF P .OR UP
01450 .ELSE COUNT .OF P := COUNT
01460 ; UP .OF P := UP
01462 .FI
01470 ; MARK(PA .OF P, UP .SHR 1)
01480 ; MARK(MA .OF P, UP .SHR 1)
01500 .FI
01510 ; .PROC SEARCH = (.REF .PERSON P, .INT DOWN, .BOOL FIRSTIME).BOOL:
01520 # SEARCHES ALL ANCESTORS OF 'P' FOR MARKED ANCESTOR.
01530 'DOWN' IS NUMBER OF GENERATIONS FROM START.
01540 RETURNS .FALSE IF NO RELATION FOUND #
01550 .IF P .ISNT NOBODY
01560 .THEN .IF COUNT .OF P = COUNT
01562 .THEN .BITS UP = UP .OF P
01564 ; .FOR I .TO BITSWIDTH-1
01565 .DO .IF I .ELEM UP
01566 .THEN .IF FIRSTIME
01567 .THEN INSERT CHAIN(I-1, DOWN)
01568 .ELSE INSERT CHAIN(DOWN, I-1)
01569 .FI
01570 .FI
01571 .OD
01572 ; .TRUE
01573 .ELSE SEARCH(PA .OF P, DOWN+1, FIRSTIME)
01580 .OR SEARCH(MA .OF P, DOWN+1, FIRSTIME)
01590 .FI
01600 .ELSE .FALSE
01610 .FI
01620 ; ON LOGICAL FILE END(STANDIN, (.REF .FILE F).BOOL: .GOTO STOP)
01630 ; MAKE TERM(STANDIN, ",;.")
01640 ; RESTART:
01650 ( .PROC COMPLAIN = (.STRING MESSAGE).VOID:
01660 ( PRINT((MESSAGE, NEWLINE))
01670 ; READ(NEWLINE)
01680 ; .GOTO RESTART
01690 )
01700 ; .PROC EXPECT = (.CHAR E).VOID:
01710 ( .LOC .CHAR C
01720 ; READ(C)
01730 ; .IF C/=E .THEN COMPLAIN(C+" FOUND INSTEAD OF "+E) .FI
01740 )
01750 ; READ(FIRST); EXPECT(",")
01760 ; THIS := HASHIN(FIRST, .SKIP, NOCHECK)
01770 ; READ(SECOND); EXPECT(".")
01780 ; THAT := HASHIN(SECOND, .SKIP, NOCHECK)
01790 ; .IF (THIS .IS NOBODY) .OR (THAT .IS NOBODY) .THEN COMPLAIN("TWO NAMES NOT GIVEN") .FI
01800 ; MARK(THIS, 2R1 .SHL (BITSWIDTH-1))
01810 ; START CHAIN := NOCHAIN
01820 ; .IF SEARCH(THAT, 0, .TRUE)
01822 .THEN COUNT +:= 1
01823 ; MARK(THAT, 2R1 .SHL (BITSWIDTH-1))
01824 ; SEARCH(THIS, 0, .FALSE)
01830 ; .LOC .REF .CHAIN PTR := START CHAIN
01840 ; .WHILE PTR :/=: NOCHAIN
01850 .DO RELATIONS(UP .OF PTR, DOWN .OF PTR)
01860 ; PTR := NEXT .OF PTR
01870 .OD
01880 .ELSE PRINT((NAME .OF THIS, " IS NOT RELATED TO ", NAME .OF THAT, NEWLINE))
01890 .FI
01900 ; COUNT +:= 1
01910 ; READ(NEWLINE)
01920 ; .GOTO RESTART
01930 )
01940 .END # CHECKING OF RELATIONSHIPS #
01950 )