Task: Word wheel




Go: package main

import (
    "bytes"
    "fmt"
    "io/ioutil"
    "log"
    "sort"
    "strings"
)

func main() {
    b, err := ioutil.ReadFile("unixdict.txt")
    if err != nil {
        log.Fatal("Error reading file")
    }
    letters := "deegklnow"
    wordsAll := bytes.Split(b, []byte{'\n'})
    
    var words [][]byte
    for _, word := range wordsAll {
        word = bytes.TrimSpace(word)
        le := len(word)
        if le > 2 && le < 10 {
            words = append(words, word)
        }
    }
    var found []string
    for _, word := range words {
        le := len(word)
        if bytes.IndexByte(word, 'k') >= 0 {
            lets := letters
            ok := true
            for i := 0; i < le; i++ {
                c := word[i]
                ix := sort.Search(len(lets), func(i int) bool { return lets[i] >= c })
                if ix < len(lets) && lets[ix] == c {
                    lets = lets[0:ix] + lets[ix+1:]
                } else {
                    ok = false
                    break
                }
            }
            if ok {
                found = append(found, string(word))
            }
        }
    }
    fmt.Println("The following", len(found), "words are the solutions to the puzzle:")
    fmt.Println(strings.Join(found, "\n"))

    
    mostFound := 0
    var mostWords9 []string
    var mostLetters []byte
    
    var words9 [][]byte
    for _, word := range words {
        if len(word) == 9 {
            words9 = append(words9, word)
        }
    }
    
    for _, word9 := range words9 {
        letterBytes := make([]byte, len(word9))
        copy(letterBytes, word9)
        sort.Slice(letterBytes, func(i, j int) bool { return letterBytes[i] < letterBytes[j] })
        
        distinctBytes := []byte{letterBytes[0]}
        for _, b := range letterBytes[1:] {
            if b != distinctBytes[len(distinctBytes)-1] {
                distinctBytes = append(distinctBytes, b)
            }
        }
        distinctLetters := string(distinctBytes)
        for _, letter := range distinctLetters {
            found := 0
            letterByte := byte(letter)
            for _, word := range words {
                le := len(word)
                if bytes.IndexByte(word, letterByte) >= 0 {
                    lets := string(letterBytes)
                    ok := true
                    for i := 0; i < le; i++ {
                        c := word[i]
                        ix := sort.Search(len(lets), func(i int) bool { return lets[i] >= c })
                        if ix < len(lets) && lets[ix] == c {
                            lets = lets[0:ix] + lets[ix+1:]
                        } else {
                            ok = false
                            break
                        }
                    }
                    if ok {
                        found = found + 1
                    }
                }
            }
            if found > mostFound {
                mostFound = found
                mostWords9 = []string{string(word9)}
                mostLetters = []byte{letterByte}
            } else if found == mostFound {
                mostWords9 = append(mostWords9, string(word9))
                mostLetters = append(mostLetters, letterByte)
            }
        }
    }
    fmt.Println("\nMost words found =", mostFound)
    fmt.Println("Nine letter words producing this total:")
    for i := 0; i < len(mostWords9); i++ {
        fmt.Println(mostWords9[i], "with central letter", string(mostLetters[i]))
    }
}





VB: Const wheel="ndeokgelw"

Sub print(s): 
  On Error Resume Next
  WScript.stdout.WriteLine (s)  
  If  err= &h80070006& Then WScript.Echo " Please run this script with CScript": WScript.quit
End Sub 

Dim oDic
Set oDic = WScript.CreateObject("scripting.dictionary")
Dim cnt(127)
Dim fso
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Set ff=fso.OpenTextFile("unixdict.txt")
i=0
print "reading words of 3 or more letters"
While Not ff.AtEndOfStream
  x=LCase(ff.ReadLine) 
  If Len(x)>=3 Then 
    If  Not odic.exists(x) Then oDic.Add x,0
  End If  
Wend  
print "remaining words: "& oDic.Count & vbcrlf
ff.Close
Set ff=Nothing
Set fso=Nothing

Set re=New RegExp
print "removing words with chars not in the wheel" 
re.pattern="[^"& wheel &"]"
For Each w In oDic.Keys
  If  re.test(w) Then oDic.remove(w) 
Next
print "remaining words: "& oDic.Count & vbcrlf

print "ensuring the mandatory letter "& Mid(wheel,5,1) & " is present"
re.Pattern=Mid(wheel,5,1)
For Each w In oDic.Keys
  If  Not re.test(w) Then oDic.remove(w) 
Next
print "remaining words: "& oDic.Count & vbcrlf

print "checking number of chars"

Dim nDic
Set nDic = WScript.CreateObject("scripting.dictionary")
For i=1 To Len(wheel)
  x=Mid(wheel,i,1)
  If nDic.Exists(x) Then
    a=nDic(x)
    nDic(x)=Array(a(0)+1,0)
  Else
    nDic.add x,Array(1,0)
  End If  
Next

For Each w In oDic.Keys
  For Each c In nDic.Keys
    ndic(c)=Array(nDic(c)(0),0)
  Next
  For ii = 1 To len(w)
    c=Mid(w,ii,1) 
    a=nDic(c)
    If (a(0)=a(1)) Then  
      oDic.Remove(w):Exit For
    End If
    nDic(c)=Array(a(0),a(1)+1)
  Next
Next

print "Remaining words "& oDic.count
For Each w In oDic.Keys 
  print w  
Next