204 lines
9.7 KiB
Groff
204 lines
9.7 KiB
Groff
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 )
|