All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > Logic
Dysfunctional Crossing (Posted on 2005-09-26) Difficulty: 3 of 5
There are 8 people that need to cross a river. The water is too deep and fast to walk or swim across, and the only transportation device available is a raft. The raft can only be operated by adults, cannot float across the river on its own, and can carry at most two people.

The 8 people are a juvenile delinquent, her jailer, and a dysfunctional family of six: mother, father, two sons, and two daughters. To be clear, the only adults are the jailer, the mother, and the father.

Unfortunately some people fight with each other:

  • The juvenile delinquent will fight with anybody if her jailer is not present.
  • The father fights with either daughter if the mother is not present to mediate.
  • The mother fights with either son if the father is not present to mediate.
  • How can these 8 people cross the river without any fights? How many trips on the raft did it take?

    For a fun way to test out your theories, click here and then click on the blue circle.

    See The Solution Submitted by nikki    
    Rating: 4.1538 (13 votes)

    Comments: ( Back to comment list | You must be logged in to post comments.)
    Solution Finally--a computer solution | Comment 7 of 30 |

    After having gone off on a wrong track of trying to go through all possibilities recursively, I switched to using a transition matrix among the 256 conceivable states of the system.

    Its final output (after a lot of debugging stuff) is:

    9 Jj                       DFJMSdjs
    8 DJ J       Jj            DFMSds
    7 Md Jj      DJj           FMSds
    6 Jj M       DMd           FJSjs
    5 DM D       DJdj          FMSs
    4 FM M       DJMdj         FSs
    3 Fs F       DFJMdj        Ss
    2 JS jJ      DFJMdjs       S
    1 Jj J       DFJMSds       j

    Where the sequence is from bottom to top, so follow the numbers.  Each row represents a round trip except for row 9 at the top, so this is indeed 2*8+1=17 rides across the river. F and M are the father and mother; J is the jailer and j is the j.d.; S and D are the elder son and daughter and s and d are the younger son and daughter.

    The columns are the sequence number, the travelers for the outgoing trip and then the trip back, and the resulting sets of people still on the first side and then the second side.

     

    DECLARE FUNCTION btcompat# (s$)
    DECLARE SUB getRec (s$, row#, col#)
    DECLARE SUB putRec (s$, row#, col#)
    DECLARE FUNCTION compat# (s$)
    DECLARE FUNCTION number# (s$)
    DEFDBL A-Z
    CLS
    DIM SHARED template$
    template$ = "DFJMSdjs"  ' Dgtr1,Father,Jailer,Mother,Son1,Dgtr2,JD,Son2
    DIM side1$(256), side2$(256)

    OPEN "dyscros2.bin" FOR BINARY AS #2
    ' at 4 bytes per cell, a 256x256 matrix takes up 262,144 bytes
    ' first and second  = boat rider(s)'s letter(s)
    ' third and fourth  = return boat rider(s)'s letter(s)

    s4$ = "    "
    FOR i = 0 TO 255
     FOR j = 0 TO 255
      PUT #2, , s4$
     NEXT
    NEXT

    FOR n = 0 TO 255
      s1$ = template$: s2$ = ""
      i = n: p = 8
      DO
        r = i MOD 2: i = i \ 2
        IF r = 0 THEN
          MID$(s1$, p, 1) = " "
          s2$ = MID$(template$, p, 1) + s2$
        END IF
        p = p - 1
      LOOP UNTIL p = 0
      DO
       ix = INSTR(s1$, " ")
       IF ix THEN s1$ = LEFT$(s1$, ix - 1) + MID$(s1$, ix + 1)
      LOOP UNTIL ix = 0
      side1$(n) = s1$: side2$(n) = s2$
     ' PRINT n; TAB(15); s1$; TAB(30); s2$
     ' IF n MOD 40 = 0 THEN DO: LOOP UNTIL INKEY$ > ""
    NEXT


    'build transition matrix
    FOR start = 0 TO 255
      s1$ = side1$(start): s2$ = side2$(start)
      IF compat(s1$) AND compat(s2$) THEN
       FOR i = 1 TO LEN(s1$)
        bt$ = MID$(s1$, i, 1) + " "
        newS2$ = RTRIM$(s2$ + bt$)
        newS1$ = LEFT$(s1$, i - 1) + MID$(s1$, i + 1)
        IF btcompat(bt$) AND compat(newS2$) AND compat(newS1$) THEN
          newNum = number(newS1$)
          getRec chk$, start, newNum
          IF chk$ < "A" THEN
            putRec bt$, start, newNum
          END IF
          ' figure return trip
          FOR k = 1 TO LEN(newS2$)
           bt2$ = MID$(newS2$, k, 1) + " "
           newerS1$ = RTRIM$(newS1$ + bt2$)
           newerS2$ = LEFT$(newS2$, k - 1) + MID$(newS2$, k + 1)
           IF compat(newerS1$) AND compat(newerS2$) THEN
            newerNum = number(newerS1$)
            getRec chk$, start, newerNum
            IF MID$(chk$, 3, 2) < "A" THEN
              putRec bt$ + bt2$, start, newerNum
            END IF
           END IF
           FOR l = k + 1 TO LEN(newS2$)
             MID$(bt2$, 2, 1) = MID$(newS2$, l, 1)
             newerS1$ = RTRIM$(newS1$ + bt2$)
             ix = INSTR(newerS2$, RIGHT$(bt2$, 1))
             newestS2$ = LEFT$(newerS2$, ix - 1) + MID$(newerS2$, ix + 1)
             IF compat(newerS1$) AND compat(newestS2$) AND btcompat(bt2$) THEN
               newerNum = number(newerS1$)
               getRec chk$, start, newerNum
               IF MID$(chk$, 3, 2) < "A" THEN
                 putRec bt$ + bt2$, start, newerNum
               END IF
             END IF
           NEXT l
          NEXT k
        END IF
        FOR j = i + 1 TO LEN(s1$)
          MID$(bt$, 2, 1) = MID$(s1$, j, 1)
          newS2$ = RTRIM$(s2$ + bt$)
          ix = INSTR(newS1$, RIGHT$(bt$, 1))
          newerS1$ = LEFT$(newS1$, ix - 1) + MID$(newS1$, ix + 1)
          IF compat(newerS1$) AND compat(newerS2$) AND btcompat(bt$) THEN
            newerNum = number(newerS1$)
            getRec chk$, start, newerNum
            IF MID$(chk$, 1, 2) < "A" THEN
              putRec bt$, start, newerNum
            END IF
        
            ' figure return trip
            FOR k = 1 TO LEN(newS2$)
             bt2$ = MID$(newS2$, k, 1) + " "
             newestS1$ = RTRIM$(newerS1$ + bt2$)
             newerS2$ = LEFT$(newS2$, k - 1) + MID$(newS2$, k + 1)
             IF compat(newestS1$) AND compat(newerS2$) AND btcompat(bt$) THEN
              newerNum = number(newestS1$)
              getRec chk$, start, newerNum
              IF MID$(chk$, 3, 2) < "A" THEN
                putRec bt$ + bt2$, start, newerNum
              END IF
             END IF
             FOR l = k + 1 TO LEN(newS2$)
               MID$(bt2$, 2, 1) = MID$(newS2$, l, 1)
               newestS1$ = RTRIM$(newerS1$ + bt2$)
               ix = INSTR(newerS2$, RIGHT$(bt2$, 1))
               newestS2$ = LEFT$(newerS2$, ix - 1) + MID$(newerS2$, ix + 1)
               IF compat(newerS1$) AND compat(newestS2$) AND btcompat(bt2$) THEN
                 newestNum = number(newestS1$)
                 getRec chk$, start, newestNum
                 IF MID$(chk$, 3, 2) < "A" THEN
                   putRec bt$ + bt2$, start, newestNum
                 END IF
               END IF
             NEXT l
            NEXT k
          END IF
        NEXT
       NEXT i
       FOR i = 1 TO LEN(s$) - 1
         FOR j = i + 1 TO LEN(s$)
         NEXT
       NEXT
      END IF
    NEXT

    REM

    DIM h$(30, 256)

    genr = 1
    FOR i = 0 TO 255
     getRec s$, 255, i
     IF LTRIM$(s$) > "" THEN
      h$(1, i) = CHR$(255) + s$
      PRINT i; s$; side2$(i)
     END IF
    NEXT

    DO
     genr = genr + 1
     flag = 0
     FOR dest = 0 TO 255
      ps$ = h$(genr - 1, dest)
      IF LTRIM$(MID$(ps$, 2, 1)) = "" OR LTRIM$(MID$(ps$, 4, 1)) = "" AND dest <> 0 THEN
        FOR src = 0 TO 255
         getRec s$, src, dest
         IF LTRIM$(s$) > "" AND dest = 0 OR LTRIM$(MID$(s$, 3)) > "" THEN
          backw = 1
          DO
            ps$ = h$(genr - backw, src)
            IF LTRIM$(MID$(ps$, 4, 1)) = "" THEN EXIT DO
            IF LTRIM$(MID$(ps$, 4, 1)) <> "-" THEN EXIT DO
            backw = backw + 1
          LOOP
          IF LTRIM$(MID$(ps$, 4, 1)) > "" THEN
            h$(genr, dest) = CHR$(src) + s$
            PRINT genr; src; side1$(src); ","; side2$(src); ";"; dest; side1$(dest); ","; side2$(dest); ";"; s$
            flag = 1
            EXIT FOR
          END IF
         END IF
        NEXT
      ELSE
        h$(genr, dest) = CHR$(dest) + "----"
      END IF
     NEXT
    LOOP UNTIL flag = 0 OR genr > 12
    PRINT genr

    prv = 0
    FOR i = genr TO 1 STEP -1
     PRINT i; MID$(h$(i, prv), 2, 2); " "; MID$(h$(i, prv), 4, 2), side1$(prv), side2$(prv)
     prv = ASC(h$(i, prv))
    NEXT

    CLOSE
    END

    FUNCTION btcompat (s$)
      c = 1
      IF LEN(RTRIM$(s$)) > 1 THEN
        IF INSTR(s$, "j") > 0 AND INSTR(s$, "J") = 0 THEN c = 0
        IF INSTR(s$, "F") > 0 AND INSTR(LCASE$(s$), "d") > 0 AND INSTR(s$, "M") = 0 THEN c = 0
        IF INSTR(s$, "M") > 0 AND INSTR(LCASE$(s$), "s") > 0 AND INSTR(s$, "F") = 0 THEN c = 0
      END IF
      IF INSTR(s$, "F") = 0 AND INSTR(s$, "M") = 0 AND INSTR(s$, "J") = 0 THEN c = 0
      btcompat = c

    END FUNCTION

    FUNCTION compat (s$)
      c = 1
      IF LEN(RTRIM$(s$)) > 1 THEN
        IF INSTR(s$, "j") > 0 AND INSTR(s$, "J") = 0 THEN c = 0
        IF INSTR(s$, "F") > 0 AND INSTR(LCASE$(s$), "d") > 0 AND INSTR(s$, "M") = 0 THEN c = 0
        IF INSTR(s$, "M") > 0 AND INSTR(LCASE$(s$), "s") > 0 AND INSTR(s$, "F") = 0 THEN c = 0
      END IF

      compat = c
    END FUNCTION

    SUB getRec (s$, row, col)
     p = row * 256 * 4 + col * 4 + 1
     s$ = SPACE$(4)
     GET #2, p, s$
    END SUB

    FUNCTION number (s$)
     pow = 1
     FOR p = 8 TO 1 STEP -1
      IF INSTR(s$, MID$(template$, p, 1)) THEN n = n + pow
      pow = pow * 2
     NEXT
     number = n
    END FUNCTION

    SUB putRec (s$, row, col)
     p = row * 1024 + col * 4 + 1 ' 1024=256*4
     s1$ = LEFT$(s$ + SPACE$(4), 4)
     PUT #2, p, s1$
    END SUB

     


      Posted by Charlie on 2005-09-28 02:24:47
    Please log in:
    Login:
    Password:
    Remember me:
    Sign up! | Forgot password


    Search:
    Search body:
    Forums (0)
    Newest Problems
    Random Problem
    FAQ | About This Site
    Site Statistics
    New Comments (8)
    Unsolved Problems
    Top Rated Problems
    This month's top
    Most Commented On

    Chatterbox:
    Copyright © 2002 - 2024 by Animus Pactum Consulting. All rights reserved. Privacy Information