Projecteuler - Problem 22 Names Scores

[korhan]

Using names.txt (right click and 'Save Link/Target As...'), a 46K text file containing over five-thousand first names, begin by sorting it into alphabetical order. Then working out the alphabetical value for each name, multiply this value by its alphabetical position in the list to obtain a name score.
For example, when the list is sorted into alphabetical order, COLIN, which is worth 3 + 15 + 12 + 9 + 14 = 53, is the 938th name in the list. So, COLIN would obtain a score of 938 × 53 = 49714.

I am trying to make my code more efficient and any help or suggestion is appreciated.

Option Explicit
Sub Test2()
    Dim StartTime As Double
    Dim MinutesElapsed As String


    'Remember time when macro starts
    StartTime = Timer
    
    ' Declare variables
    Dim names() As String, textline As String
    Dim chrName() As Byte
    Dim i As Integer, j As Integer, x As Integer, y As Integer, intLowBnd As Integer, intUppBnd As Integer
    Dim strTemp As String
    Dim totalScore As Long, currentScore As Long


    Open "path\Question 22 Data.txt" For Input As #1
    
    Do Until EOF(1)
        Line Input #1, textline
        names = Split(textline, """" & "," & """", , vbTextCompare)
        names(0) = Replace(names(0), Chr(34), "")
        names(UBound(names)) = Replace(names(UBound(names)), Chr(34), "")
    Loop
    Close #1
    
    intLowBnd = LBound(names)
    intUppBnd = UBound(names)
    
    ' Alphabetically sort the names array
    For x = intLowBnd To intUppBnd - 1
      For y = x To intUppBnd
        If names(y) < names(x) Then
          strTemp = names(x)
          names(x) = names(y)
          names(y) = strTemp
        End If
       Next y
    Next x


    ' Loop through the list and get the scores
    For i = intLowBnd To intUppBnd
        currentScore = 0
        chrName = StrConv(names(i), vbFromUnicode)
        For j = 0 To UBound(chrName)
            currentScore = currentScore + (chrName(j) - 64)
        Next j
        totalScore = totalScore + (currentScore * (i + 1))
    Next i
    
    Debug.Print totalScore
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
    Debug.Print "Whole process took: ", MinutesElapsed
End Sub

 

[Eric W]

Have you actually solved the problem and gotten the right answer? If so, then you can go to the discussion forum on Project Euler for problem 22 and see many people's methods of solving it, so you should get some good tips there.

I solved this problem using Excel/VBA, and a lot of it depends on what you consider "acceptable" for including in the timing. For example, if I remember right, I started out by pasting the text file into Excel, then starting my macro with timer. But if you feel you need to including the reading as part of your timed macro, then I'd suggest just letting Excel open the file instead of reading each line individually.

Then you can also use the Excel sort routine to sort the names. Then use something like:

Names = Range("A1:A5000").Value

to put them into an array. But again, if you think you need to sort the list yourself, you may want to switch to a different sort. You're using a bubble sort, which is pretty slow. Google "VBA quick sort" and you should find some code for that.

Hope there's something useful here for you!

 

[korhan]

Eric, thanks. This code takes around 3 seconds. People in the forum are talking about 30 ms. I have started from 10 seconds down to 3. Pretty good but you are right my sort algorithm is not good. Thanks for the suggestion. I will try to implement quick sort.

 

[korhan]

47 ms. That was simply amazing. Implemented quick sort and increased the resolution of the timer to see the milliseconds. Amazing.

 

[Eric W]

Nice! Roughly 60 times faster. Pretty good. One thing to keep in mind is that some languages or development platforms are just faster than others. I tried frequently to match some of the times people were posting, and finally concluded I'd never get that fast with VBA, even on my fast PC. But with a good algorithm, you can usually come pretty close.

 

[shg]

This ran in 22ms on my not-young laptop.

Sub x()
  Const sFile       As String = "C:\Users\shg\Downloads\0Miscellany\p022_names.txt"
  Dim asInp()       As String
  Dim iSco          As Long
  Dim iTot          As Long
  Dim i             As Long
  Dim j             As Long
  Dim f             As Single

  f = Timer
  asInp = Split(Replace(File2Str(sFile), """", ""), ",")
  QuickSortAsc asInp, 0, UBound(asInp)

  For i = 0 To UBound(asInp)
    iSco = 0
    For j = 1 To Len(asInp(i))
      iSco = iSco + Asc(Mid(asInp(i), j, 1))
    Next j
    iTot = iTot + (i + 1) * (iSco - 64 * Len(asInp(i)))
  Next i
  Debug.Print iTot

  Debug.Print Timer - f
End Sub

Function File2Str(sFile As String) As String
  Dim iFile         As Integer

  If Len(Dir(sFile)) Then
    iFile = FreeFile
    Open sFile For Binary Access Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=iFile]#iFile[/URL] 
    File2Str = Input(LOF(iFile), iFile)
    Close iFile
  End If
End Function

Sub QuickSortAsc(ByRef av As Variant, ByVal iBeg As Long, ByVal iEnd As Long)
  ' from [url]http://www.vba-programmer.com/Snippets/Code_VB/Quick_Sort_Single.html[/url]

  Dim iLo           As Long
  Dim iHi           As Long
  Dim vTmp          As Variant
  Dim vSep          As Variant

  iLo = iBeg
  iHi = iEnd
  vSep = av((iBeg + iEnd) / 2)

  Do
    Do While av(iLo) < vSep     ' ascending
      iLo = iLo + 1
    Loop

    Do While av(iHi) > vSep     ' ascending
      iHi = iHi - 1
    Loop

    If iLo <= iHi Then
      vTmp = av(iLo)
      av(iLo) = av(iHi)
      av(iHi) = vTmp
      iLo = iLo + 1
      iHi = iHi - 1
    End If
  Loop While iLo <= iHi

  If iBeg < iHi Then QuickSortAsc av, iBeg, iHi
  If iLo < iEnd Then QuickSortAsc av, iLo, iEnd
End Sub

 

[shg]

It appears it would be about 4x faster with an SSD vs a spinning drive.

 

[korhan]

It appears it would be about 4x faster with an SSD vs a spinning drive.

Should I buy an SSD and put my processing times in the projecteuler forums to prove that VBA is also as powerful or prove people wrong? VBA gets a lot of beating or looked down on by a lot people.

 

[shg]

It's an interpreted language, so it's slow. It is amply fast enough to be useful.

Modifying the code to take out the file read,

  sInp = File2Str(sFile)
  f = Timer
  
  asInp = Split(Replace(sInp, """", ""), ",")
  QuickSortAsc asInp, 0, UBound(asInp)
  ...

... it runs in about 4ms.

 

[korhan]

It's an interpreted language, so it's slow. It is amply fast enough to be useful.

Modifying the code to take out the file read,

  sInp = File2Str(sFile)
  f = Timer
  
  asInp = Split(Replace(sInp, """", ""), ",")
  QuickSortAsc asInp, 0, UBound(asInp)
  ...

... it runs in about 4ms.

Weird, file modification actually increased the processing time from 47 to 140 ms. Do you have SSD, is that why?