Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
NIO 2003: Lingo (simple challenge)
#2
Words.dat and lingo.in should be in a .\lingo\ subdirectory.

I got done with part C before an hour, but here it's all combined into one program:

Code:
DECLARE SUB NoCommon ()
DECLARE SUB GetMask ()
DECLARE SUB Cull ()
DEFINT A-Z
DECLARE FUNCTION IsValid! ()

DIM SHARED Guess$, Target$, Mask$, Test$, NumGood

'File number constants
CONST Lingo = 1
CONST Valid = 2
CONST AOut = 3
CONST BOut = 4
CONST COut = 5
CONST Temp = 6
CLS

Mask$ = "+...."

OPEN ".\lingo\lingo.in" FOR INPUT AS #1
INPUT #1, Target$
CLOSE 1

PRINT "Largest group of words with no shared letters except the first:"
NoCommon
PRINT

Guess$ = LEFT$(Target$, 1) + "    "
PRINT "First Letter: ", Guess$

OPEN ".\lingo\words.dat" FOR INPUT AS #1
OPEN ".\lingo\valid.dat" FOR OUTPUT AS #2

DO
  LINE INPUT #1, Test$
  IF IsValid THEN
    PRINT #2, Test$
  END IF
LOOP UNTIL EOF(1)

CLOSE

PRINT "Guess:", "Result:", "Valid Entries Remaining:"

DO
  Cull

  OPEN ".\lingo\valid.dat" FOR INPUT AS Valid
  INPUT #Valid, Guess$
  CLOSE #Valid

  GetMask
  OPEN ".\lingo\1c.out" FOR APPEND AS #COut
  PRINT #COut, Guess$
  CLOSE

  PRINT Guess$, Mask$, NumGood
LOOP UNTIL Guess$ = Target$

SUB Cull

NumGood = 0

OPEN ".\lingo\valid.dat" FOR INPUT AS Valid
OPEN ".\lingo\temp" FOR OUTPUT AS Temp

DO
  INPUT #Valid, Test$
  IF IsValid AND (Test$ <> Guess$) THEN PRINT #Temp, Test$
LOOP UNTIL EOF(Valid)

CLOSE

OPEN ".\lingo\temp" FOR INPUT AS #Temp
OPEN ".\lingo\valid.dat" FOR OUTPUT AS #Valid

DO
  INPUT #Temp, s$
  PRINT #Valid, s$
  NumGood = NumGood + 1
LOOP UNTIL EOF(Temp)

'PRINT "Remaining: "; NumGood
OPEN ".\lingo\1b.out" FOR APPEND AS #BOut
PRINT #BOut, NumGood

CLOSE



END SUB

SUB GetMask

Mask$ = ""

FOR n = 1 TO 5
  s$ = MID$(Guess$, n, 1)
  a$ = "."
  IF INSTR(Target$, s$) THEN a$ = "/"
  IF MID$(Target$, n, 1) = s$ THEN a$ = "+"
  Mask$ = Mask$ + a$
NEXT

'Note: For challange, change 'APPEND' to 'OUTPUT'

OPEN ".\lingo\1a.out" FOR APPEND AS #AOut
PRINT #AOut, Mask$
CLOSE #AOut


END SUB

DEFSNG A-Z
SUB GetNext

OPEN "./lingo/valid.dat" FOR INPUT AS Valid
INPUT #Valid, Guess
PRINT Guess
CLOSE Valid


END SUB

FUNCTION IsValid

IsValid = 1

FOR n = 1 TO 5
  s$ = MID$(Mask$, n, 1)
  IF s$ = "+" THEN
    IF MID$(Test$, n, 1) <> MID$(Guess$, n, 1) THEN IsValid = 0
  END IF

  IF s$ = "/" THEN
    IF INSTR(Test$, MID$(Guess$, n, 1)) = 0 THEN IsValid = 0
    IF MID$(Guess$, n, 1) = MID$(Test$, n, 1) THEN IsValid = 0
  END IF

  IF s$ = "." THEN
    IF INSTR(Test$, MID$(Guess$, n, 1)) > 0 THEN IsValid = 0
  END IF

NEXT

END FUNCTION

DEFINT A-Z
SUB NoCommon
s$ = LEFT$(Target$, 1)
k$ = RIGHT$(Target$, 4)

OPEN ".\lingo\words.dat" FOR INPUT AS #1
OPEN ".\lingo\1d.out" FOR OUTPUT AS #2

DO
  LINE INPUT #1, a$
  IF LEFT$(a$, 1) = s$ THEN
    Bad = 0
    a$ = RIGHT$(a$, 4)

    FOR n = 1 TO LEN(k$)
      IF INSTR(a$, MID$(k$, n, 1)) THEN Bad = 1
    NEXT

    IF Bad = 0 THEN
      PRINT s$; a$
      PRINT #2, s$; a$
      k$ = k$ + a$
    END IF
  END IF
LOOP UNTIL EOF(1)

PRINT #2, "ready"
CLOSE


END SUB

The output files have more than one line because the program goes through the whole algorithm, but oh well, it's easy enough to change.


Would I get bonus points for writing it on a computer without a mouse?
Reply


Messages In This Thread
NIO 2003: Lingo (simple challenge) - by Neo - 11-23-2004, 07:02 PM
NIO 2003: Lingo (simple challenge) - by RST - 11-26-2004, 01:55 AM
NIO 2003: Lingo (simple challenge) - by Neo - 11-26-2004, 02:26 AM

Forum Jump:


Users browsing this thread: 1 Guest(s)