Author Topic: Wordiff - Rosetta Code  (Read 3860 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Wordiff - Rosetta Code
« on: September 03, 2021, 12:33:54 am »
ref: http://rosettacode.org/wiki/Wordiff

I think I have the game roughed out now and will go for the "Optional Stretch Goals" with the scores array tomorrow. Kind'a fun to play :)

Code: QB64: [Select]
  1. _Title "Wordiff - Rosetta Code" 'b+ 2021-09-02 ref: http://rosettacode.org/wiki/Wordiff
  2. Const nWords = 24819 ' precounted for  unixdict.txt word list
  3. Dim Shared words$(1 To nWords), used$(1 To 1000), nUsed, players$(1 To 100), scores(1 To 100), nPlayers, nextPlayer
  4.  
  5. LoadWords
  6. getPlayers
  7. nextPlayer = 1
  8.  
  9. newRound:
  10. lastWord$ = StartWord$
  11. Print "Start word is "; lastWord$
  12. bad = 0
  13.     Print players$(nextPlayer);
  14.     Input ", please enter your try "; try$
  15.     For i = 1 To nUsed
  16.         If try$ = used$(i) Then Print "I'm sorry, " + players$(nextPlayer) + ", " + try$ + " was already used.": bad = -1
  17.     Next
  18.     If bad = 0 Then
  19.         If wordFound%(try$) Then
  20.             If Len(try$) = Len(lastWord$) - 1 Then
  21.                 If oneLess%(lastWord$, try$) Then Print "Good" Else Print try$ + " doesn't work.": bad = -1
  22.             ElseIf Len(try$) = Len(lastWord$) Then
  23.                 If oneChange%(lastWord$, try$) Then Print "Good" Else Print try$ + " doesn't work.": bad = -1
  24.             ElseIf Len(try$) = Len(lastWord$) + 1 Then
  25.                 If oneMore%(lastWord$, try$) Then Print "Good" Else Print try$ + " doesn't work.": bad = -1
  26.             Else
  27.                 Print "I'm sorry, " + players$(nextPlayer) + ", " + try$ + " was not the correct length.": bad = -1
  28.             End If
  29.         Else
  30.             Print "I'm sorry, " + players$(nextPlayer) + ", " + try$ + " was not found in dictionary.": bad = -1
  31.         End If
  32.     End If
  33.     If bad = 0 Then
  34.         nUsed = nUsed + 1
  35.         used$(nUsed) = try$
  36.         lastWord$ = try$
  37.     End If
  38.     nextPlayer = nextPlayer + 1
  39.     If nextPlayer > nPlayers Then nextPlayer = 1
  40. GoTo newRound
  41.  
  42. Sub LoadWords
  43.     Dim wd$, i As Integer, m As Integer, ok As _Bit
  44.     Open "unixdict.txt" For Input As #1
  45.     While EOF(1) = 0
  46.         Input #1, wd$
  47.         If Len(wd$) > 2 Then
  48.             ok = -1
  49.             For m = 1 To Len(wd$)
  50.                 If Asc(wd$, m) < 97 Or Asc(wd$, m) > 122 Then ok = 0: Exit For
  51.             Next
  52.             If ok Then i = i + 1: words$(i) = wd$
  53.         End If
  54.     Wend
  55.     Close #1
  56.  
  57. Sub getPlayers
  58.     nPlayers = 0
  59.     Do
  60.         Input "Enter a player name or nothing to finish list "; player$
  61.         If player$ <> "" Then nPlayers = nPlayers + 1: players$(nPlayers) = player$
  62.     Loop Until player$ = ""
  63.     If nPlayers = 0 Then Print "No players, goodbye!"
  64.  
  65. Function StartWord$
  66.     Do
  67.         StartWord$ = words$(Int(Rnd * nWords) + 1)
  68.         If Len(StartWord$) > 2 And Len(StartWord$) < 5 Then
  69.             OK = -1
  70.             For i = 1 To nUsed ' let us at least not start with a word used in last game
  71.                 If used$(i) = StartWord$ Then OK = 0
  72.             Next
  73.         End If
  74.         If OK Then Erase used$: nUsed = 1: used$(1) = StartWord$
  75.     Loop Until OK
  76.  
  77. Function wordFound% (word$) ' is the word 3 or more letters in dictionary
  78.     If Len(word$) > 2 Then
  79.         lo = 1: hi = nWords
  80.         Do While wordFound% = 0
  81.             test = Int((hi + lo) / 2)
  82.             If words$(test) = word$ Then
  83.                 wordFound% = -1: Exit Function
  84.             ElseIf words$(test) < word$ Then
  85.                 lo = test + 1
  86.             Else
  87.                 hi = test - 1
  88.             End If
  89.             If hi < lo Then Exit Function
  90.         Loop
  91.     End If
  92.  
  93. Function oneLess% (last$, test$) ' is word one letter less than last word
  94.     If Len(test$) = Len(last$) - 1 Then
  95.         lastfind = 1
  96.         For i = 1 To Len(test$)
  97.             find = InStr(lastfind, last$, Mid$(test$, i, 1))
  98.             If find = 0 Then Exit Function Else lastfind = find + 1
  99.         Next
  100.         oneLess% = -1
  101.     End If
  102.  
  103. Function oneMore% (last$, test$) ' is word one letter more than last word
  104.     If Len(test$) = Len(last$) + 1 Then
  105.         lastfind = 1
  106.         For i = 1 To Len(last$)
  107.             find = InStr(lastfind, test$, Mid$(lasst$, i, 1))
  108.             If find = 0 Then Exit Function Else lastfind = find + 1
  109.         Next
  110.         oneMore% = -1
  111.     End If
  112.  
  113. Function oneChange% (last$, test$)
  114.     If Len(test$) = Len(last$) Then
  115.         For i = 1 To Len(last$)
  116.             If Mid$(last$, i, 1) <> Mid$(test$, i, 1) Then strike = strike + 1
  117.         Next
  118.         If strike = 1 Then oneChange% = -1
  119.     End If
  120.  
  121.  

Attached is dictionary used at RC (doesn't have "has")
* unixdict.txt (Filesize: 201.57 KB, Downloads: 1352)
« Last Edit: September 03, 2021, 12:37:35 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Wordiff - Rosetta Code
« Reply #1 on: September 03, 2021, 11:42:29 am »
Dang, how is that working with a typo?

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Wordiff - Rosetta Code
« Reply #2 on: September 03, 2021, 11:52:35 am »
It was letting all words the right length to pass.

Code: QB64: [Select]
  1. 'test oneMore%
  2.     Input "Testing oneMore%, enter last word, test word "; last$, test$
  3.     If oneMore%(last$, test$) Then Print "One more" Else Print "NOT one more"
  4. Loop Until last$ = ""
  5.  
  6. Function oneMore% (last$, test$) ' is word one letter more than last word
  7.     If Len(test$) = Len(last$) + 1 Then
  8.         lastfind = 1
  9.         For i = 1 To Len(last$)
  10.             find = InStr(lastfind, test$, Mid$(last$, i, 1)) ' typo fix 2021-09-03
  11.             If find = 0 Then Exit Function Else lastfind = find + 1
  12.         Next
  13.         oneMore% = -1
  14.     End If
  15.  
« Last Edit: September 03, 2021, 11:53:52 am by bplus »

Marked as best answer by bplus on September 03, 2021, 09:49:21 am

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Wordiff - Rosetta Code
« Reply #3 on: September 03, 2021, 01:42:45 pm »
Reworked the checking code and added computer finds when a player misses that could have been played off last correct wordiff:

Code: QB64: [Select]
  1. _Title "Wordiff - Rosetta Code" 'b+ 2021-09-02 ref: http://rosettacode.org/wiki/Wordiff
  2. Const nWords = 24819 ' precounted for  unixdict.txt word list
  3. Dim Shared words$(1 To nWords), used$(1 To 1000), nUsed, players$(1 To 100), nPlayers, nextPlayer
  4. Q$(0) = "Good!": Q$(1) = "used already.": Q$(2) = "not in dictionary.": Q$(3) = "bad minus letter."
  5. Q$(4) = "bad letter change.": Q$(5) = "bad add letter.": Q$(6) = "bad length."
  6. LoadWords
  7. getPlayers
  8. nextPlayer = 1
  9. newRound:
  10. lastWord$ = StartWord$
  11. Print: Print "Start word is "; lastWord$
  12.     Print players$(nextPlayer);
  13.     Input ", please enter your try "; try$
  14.     badtry = bad%(lastWord$, try$)
  15.     Print try$ + " is " + Q$(badtry)
  16.     If badtry = 0 Then
  17.         nUsed = nUsed + 1
  18.         used$(nUsed) = try$
  19.         lastWord$ = try$
  20.     End If
  21.     nextPlayer = nextPlayer + 1
  22.     If nextPlayer > nPlayers Then nextPlayer = 1
  23. Loop Until badtry
  24. Print "Wordiffs found for " + lastWord$ + " are:"
  25. finds lastWord$
  26. GoTo newRound
  27.  
  28. Sub LoadWords
  29.     Dim wd$, i As Integer, m As Integer, ok As _Bit
  30.     Open "unixdict.txt" For Input As #1
  31.     While EOF(1) = 0
  32.         Input #1, wd$
  33.         If Len(wd$) > 2 Then
  34.             ok = -1
  35.             For m = 1 To Len(wd$)
  36.                 If Asc(wd$, m) < 97 Or Asc(wd$, m) > 122 Then ok = 0: Exit For
  37.             Next
  38.             If ok Then i = i + 1: words$(i) = wd$
  39.         End If
  40.     Wend
  41.     Close #1
  42.  
  43. Sub getPlayers
  44.     nPlayers = 0
  45.     Do
  46.         Input "Enter a player name or nothing to finish list "; player$
  47.         If player$ <> "" Then nPlayers = nPlayers + 1: players$(nPlayers) = player$
  48.     Loop Until player$ = ""
  49.     If nPlayers = 0 Then Print "No players, goodbye!": End
  50.  
  51. Function StartWord$
  52.     Do
  53.         StartWord$ = words$(Int(Rnd * nWords) + 1)
  54.         If Len(StartWord$) > 2 And Len(StartWord$) < 5 Then
  55.             OK = -1
  56.             For i = 1 To nUsed ' let us at least not start with a word used in last game
  57.                 If used$(i) = StartWord$ Then OK = 0
  58.             Next
  59.         End If
  60.         If OK Then Erase used$: nUsed = 1: used$(1) = StartWord$
  61.     Loop Until OK
  62.  
  63. Function wordFound% (word$) ' is the word 3 or more letters in dictionary
  64.     If Len(word$) > 2 Then
  65.         lo = 1: hi = nWords
  66.         Do While wordFound% = 0
  67.             test = Int((hi + lo) / 2)
  68.             If words$(test) = word$ Then
  69.                 wordFound% = -1: Exit Function
  70.             ElseIf words$(test) < word$ Then
  71.                 lo = test + 1
  72.             Else
  73.                 hi = test - 1
  74.             End If
  75.             If hi < lo Then Exit Function
  76.         Loop
  77.     End If
  78.  
  79. Function oneLess% (last$, test$) ' is word one letter less than last word
  80.     If Len(test$) = Len(last$) - 1 Then
  81.         lastfind = 1
  82.         For i = 1 To Len(test$)
  83.             find = InStr(lastfind, last$, Mid$(test$, i, 1))
  84.             If find = 0 Then Exit Function Else lastfind = find + 1
  85.         Next
  86.         oneLess% = -1
  87.     End If
  88.  
  89. Function oneMore% (last$, test$) ' is word one letter more than last word
  90.     If Len(test$) = Len(last$) + 1 Then
  91.         lastfind = 1
  92.         For i = 1 To Len(last$)
  93.             find = InStr(lastfind, test$, Mid$(last$, i, 1)) ' typo fix 2021-09-03
  94.             If find = 0 Then Exit Function Else lastfind = find + 1
  95.         Next
  96.         oneMore% = -1
  97.     End If
  98.  
  99. Function oneChange% (last$, test$)
  100.     If Len(test$) = Len(last$) Then
  101.         For i = 1 To Len(last$)
  102.             If Mid$(last$, i, 1) <> Mid$(test$, i, 1) Then strike = strike + 1
  103.         Next
  104.         If strike = 1 Then oneChange% = -1
  105.     End If
  106.  
  107. Function bad% (last$, test$)
  108.     For i = 1 To nUsed
  109.         If test$ = used$(i) Then bad% = 1: Exit Function
  110.     Next
  111.     If wordFound%(test$) = 0 Then bad% = 2: Exit Function
  112.     If Len(test$) = Len(last$) - 1 Then
  113.         If oneLess%(last$, test$) = 0 Then bad% = 3
  114.     ElseIf Len(test$) = Len(last$) Then
  115.         If oneChange%(last$, test$) = 0 Then bad% = 4
  116.     ElseIf Len(test$) = Len(last$) + 1 Then
  117.         If oneMore%(last$, test$) = 0 Then bad% = 5
  118.     Else
  119.         bad% = 6
  120.     End If
  121.  
  122. Sub finds (last$) ' find all words that would have worked
  123.     For i = 1 To nWords
  124.         test$ = words$(i)
  125.         For j = 1 To nUsed
  126.             If test$ = used$(j) Then GoTo skip '_continue didn't work
  127.         Next
  128.         If oneLess%(last$, test$) Then Print test$; " ";
  129.         If oneChange%(last$, test$) Then Print test$; " ";
  130.         If oneMore%(last$, test$) Then Print test$; " ";
  131.         skip:
  132.     Next
  133.     Print
  134.  

Time keeping seems boring and unfair for scoring as words get longer and more difficult, so I took out scores array. Much more interesting to show what could have been played IMHO.

See first post for dictionary file or use your own.
« Last Edit: September 03, 2021, 01:49:17 pm by bplus »