25 Horses Problem

bplus
Global Moderator

b = b + ...

Posts: 840

25 Horses Problem Sept 10, 2023 3:56:59 GMT Aaditya Parashar likes this

Quote

Post by bplus on Sept 10, 2023 3:56:59 GMT

Find the fastest 3 racing at most 5 at a time but no stop watch.

Google interview question is what is minimum number of races you need to get the 1, 2, and 3 place horse?

Here is good presentation of problem and solution:
www.google.com/search?client=opera&q=25+Horse+problem&sourceid=opera&ie=UTF-8&oe=UTF-8#fpstate=ive&ip=1&vld=cid:4e94e9f1,vid:i-xqRDwpilM,st:0

Now try and code it! LOL

Here is what I came up with:

_Title "25 Horses" ' b+ 2022-09-06 revisit 2023-09-09

' Good Intro to problem here:
' https://www.google.com/search?client=opera&q=25+Horse+problem&sourceid=opera&ie=UTF-8&oe=UTF-8#fpstate=ive&ip=1&vld=cid:4e94e9f1,vid:i-xqRDwpilM,st:0

' Of 25 horses which are top 3 runners?
' You can race up to 5 horses at a time but only learn their ranking 1st, 2nd, 3rd...
' What is the minimum number of races of 5 horses at a time?

' Answ = 7 but figure out why and then code it!

' debug or cheat by seeing the actual rates of each horse with race results
Debug = 1

Randomize Timer
Type horse
    As Integer ID, rate, race, place
    ' ID is the horse number 1 to 25 before shuffling
    ' rate is number 1 to 25 rankings of horses to check with final answer found by code
    ' race helps track the group the horse was in in first 5 races
    ' place 2 or 3 if horse came in 2nd or 3rd in first 5 races
End Type

$Console:Only
Do
    ReDim horses(1 To 25) As horse
    ReDim rate(1 To 25)
    ' here are our horses secret ratings
    For i = 1 To 25 ' load places 1 to 25
        rate(i) = i
    Next
    For i = 25 To 2 Step -1
        Swap rate(i), rate(Int(Rnd * i) + 1)
    Next
    For i = 1 To 25
        horses(i).ID = i
        horses(i).rate = rate(i)
        horses(i).place = 0
        'Print horses(i).ID, horses(i).rate
    Next

    ReDim race6(1 To 5) As horse ' setup to place winners in here
    r6 = 0

    For n = 1 To 5 ' first 5 races
        ReDim group(1 To 5) As horse
        Print: Print "Race:"; n
        For i = 1 To 5
            group(i).ID = horses((n - 1) * 5 + i).ID
            group(i).rate = horses((n - 1) * 5 + i).rate
            horses((n - 1) * 5 + i).race = n
            'Print group(i).ID, group(i).rate
        Next
        QuickSort 1, 5, group() ' this is our running of the race and group is sorted by .rate

        ' show results pretend you see actual rating 2 item listed
        place = 2
        For i = 1 To 5
            Print group(i).ID,
            If Debug Then Print group(i).rate Else Print
            If i = 1 Then ' setup race 6  with this winner
                r6 = r6 + 1
                race6(r6).ID = group(i).ID
                race6(r6).rate = group(i).rate
                race6(r6).race = 6
                ' Print: Print r6, race6(r6).ID, race6(r6).rate
            End If
            If i = 2 Or i = 3 Then ' record ones that also placed  2nd or 3rd
                For j = 1 To 25
                    If horses(j).ID = group(i).ID Then horses(j).place = place: place = place + 1
                Next
            End If
        Next
    Next
    Print: Print "Race: 6  Winners of First 5 Races"
    'For i = 1 To 5 ' check race6
    '    Print race6(i).ID, race6(i).rate
    'Next
    QuickSort 1, 5, race6()

    ' the 7th race
    '#1 is number 1 but 2nd, 3rd in it's first race could be actual 2, 3  = 2 horses for 7th
    '#2 has to go again compare along it's 2nd in it's first race  = 2 more horse for 7th
    '#3 doesn't have anyone else from it's first race   = 1 more horse for 7th

    ReDim race7(1 To 5) As horse ' setup to load for 7th race
    r7 = 0

    For i = 1 To 5 ' report results race 6
        Print race6(i).ID,
        If Debug Then Print race6(i).rate Else Print
        If i = 1 Then
            FirstHorse = race6(i).ID
            FirstRate = race6(i).rate
            For j = 1 To 25
                If horses(j).ID = race6(i).ID Then race = horses(j).race: Exit For
            Next
            For j = 1 To 25 ' find 2 also places in #1's first race
                If horses(j).race = race And horses(j).place > 0 Then
                    r7 = r7 + 1
                    race7(r7).ID = horses(j).ID
                    race7(r7).rate = horses(j).rate
                End If
            Next
        End If
        If i = 2 Then ' this horse runs again
            r7 = r7 + 1
            race7(r7).ID = race6(i).ID
            race7(r7).rate = race6(i).rate
            For j = 1 To 25
                If horses(j).ID = race6(i).ID Then race = horses(j).race: Exit For
            Next
            For j = 1 To 25 ' find 2 also places in #1's first race
                If horses(j).race = race And horses(j).place = 2 Then ' get the horse that came 2nd
                    r7 = r7 + 1
                    race7(r7).ID = horses(j).ID
                    race7(r7).rate = horses(j).rate
                End If
            Next
        End If
        If i = 3 Then '  this last horse runs in the 7th
            r7 = r7 + 1
            race7(r7).ID = race6(i).ID
            race7(r7).rate = race6(i).rate
        End If
    Next
    Print: Print "Race: 7 Top Winner Already found but run the next 2 in it's first race"
    Print "        and Run the 2nd and the 2nd in it's first race, 5th horse is 3rd in 6th."
    'For i = 1 To 5 ' check have 5 including 2 and 3
    '    Print race7(i).ID, race7(i).rate
    'Next
    QuickSort 1, 5, race7()
    For i = 1 To 5 ' check have 5 includin 2 and 3
        Print race7(i).ID,
        If Debug Then Print race7(i).rate Else Print
        If i = 1 Then SecondHorse = race7(i).ID: SecondRate = race7(i).rate
        If i = 2 Then ThirdHorse = race7(i).ID: ThirdRate = race7(i).rate
    Next
    Print
    Print " First Horse and rate ="; FirstHorse, FirstRate
    Print "Second Horse and rate ="; SecondHorse, SecondRate
    Print " Third Horse and rate ="; ThirdHorse, ThirdRate
    Sleep
    Cls
Loop Until _KeyDown(27)

Sub QuickSort (start As Long, finish As Long, array() As horse)
    Dim Hi As Long, Lo As Long, Middle As Single
    Hi = finish: Lo = start
    Middle = array((Lo + Hi) / 2).rate 'find middle of array
    Do
        Do While array(Lo).rate < Middle: Lo = Lo + 1: Loop
        Do While array(Hi).rate > Middle: Hi = Hi - 1: Loop
        If Lo <= Hi Then
            Swap array(Lo), array(Hi)
            Lo = Lo + 1: Hi = Hi - 1
        End If
    Loop Until Lo > Hi
    If Hi > start Then Call QuickSort(start, Hi, array())
    If Lo < finish Then Call QuickSort(Lo, finish, array())
End Sub

Cheers! to the stars of Basic where ever they shine!

marjagonzalves
New Member

Posts: 34

25 Horses Problem Sept 12, 2023 2:02:12 GMT

Quote

Post by marjagonzalves on Sept 12, 2023 2:02:12 GMT

There is a similar game in some Latin American countries. A few small wood horses going around a roulette. Only the one winding the roulette know who wins.

I stopped watching those "horse races" a few years ago because in plain down town city I saw somebody smoking my name while winding up that roulette.

My name is short for drug word, rather than variety of "Maria" or "Mareeah".

It's supposed to be "marja_gonzalves" with "n". Didn't let me put underscore too.

bplus
Global Moderator

b = b + ...

Posts: 840

25 Horses Problem Sept 12, 2023 21:34:22 GMT

Quote

Post by bplus on Sept 12, 2023 21:34:22 GMT

ah! speaking of horse races here is a cute little quickie:

Option _Explicit
Width 120
Randomize Timer
Const track = 100
Dim horses(1 To 6)
Dim loops(1 To 6)
Dim stillRunning, i

stillRunning = 1
While stillRunning = 1
    stillRunning = 0 ' clear flag
    For i = 1 To 6
        If horses(i) <= track Then
            loops(i) = loops(i) + 1
            stillRunning = 1 'set flag
            horses(i) = horses(i) + Rnd * .25
        End If
    Next
    Cls
    Print
    For i = 1 To 6
        Color i
        Print Tab(Int(horses(i))); horses(i)
        Print
    Next
    Color 15
    Locate 1, 1
    For i = 1 To 6
        Print Tab(100); "|"
        Print
    Next
    _Limit 60
Wend
Color 15
Print "And the results are in:"
For i = 1 To 6
    Color i
    Print i, loops(i)
Next

I think I will fix this up a bit by adding a sort to list the horses in order they came in using the sort routine in OP.

Cheers! to the stars of Basic where ever they shine!

bplus
Global Moderator

b = b + ...

Posts: 840

25 Horses Problem Sept 12, 2023 22:10:36 GMT

Quote

Post by bplus on Sept 12, 2023 22:10:36 GMT

Here is the update, Horse Race 3

Option _Explicit
_Title "Horse Race 3" ' b+ 2023-09-12
' fix so the the list of horse is shown in order they came in at

Const track = 100
Const nHorses = 10
Type horse
    As Single col, loops, colr
End Type

Width 120, nHorses * 3 + 4 ' screen 0 default 16 colors
Randomize Timer

Dim stillRunning, i
Dim horses(1 To nHorses) As horse
For i = 1 To nHorses 'load color/id number for after sort
    horses(i).colr = i
Next

stillRunning = 1
While stillRunning = 1
    stillRunning = 0 ' clear flag
    For i = 1 To nHorses
        If horses(i).col <= track Then
            horses(i).loops = horses(i).loops + 1
            stillRunning = 1 'set flag
            horses(i).col = horses(i).col + Rnd * .25
        End If
    Next
    Cls
    Print
    For i = 1 To nHorses
        Color i
        Print Tab(Int(horses(i).col)); horses(i).colr; horses(i).loops
        Print
    Next
    Color 15
    Locate 1, 1
    For i = 1 To nHorses
        Print Tab(100); "|"
        Print
    Next
    _Limit 60
Wend
Color 15
Print Tab(40); "And the results are in:"
QuickSort 1, nHorses, horses()
For i = 1 To nHorses
    Color horses(i).colr
    Print Tab(40); i, horses(i).colr; horses(i).loops
Next

Sub QuickSort (start As Long, finish As Long, array() As horse)
    Dim Hi As Long, Lo As Long, Middle As Single
    Hi = finish: Lo = start
    Middle = array((Lo + Hi) / 2).loops 'find middle of array
    Do
        Do While array(Lo).loops < Middle: Lo = Lo + 1: Loop
        Do While array(Hi).loops > Middle: Hi = Hi - 1: Loop
        If Lo <= Hi Then
            Swap array(Lo), array(Hi)
            Lo = Lo + 1: Hi = Hi - 1
        End If
    Loop Until Lo > Hi
    If Hi > start Then Call QuickSort(start, Hi, array())
    If Lo < finish Then Call QuickSort(Lo, finish, array())
End Sub

Cheers! to the stars of Basic where ever they shine!