Algorithms

Note: Subroutines are not underlined due to limitations of Markdown.

Searching Players

' Finds players that match a given search query.
BEGIN SearchPlayers(Players, QueryString)
    Let NumResults = 0
    Let Query = Split(QueryString, " ")
    FOR i = 1 TO Length of Players
        Let Ranking = PlayerMatches(Players(i), Query)
        IF Ranking > 0 THEN
            NumResults = NumResults + 1
            Results(NumResults) = Players(i)
            Rankings(NumResults) = Ranking
        END IF
    NEXT i

    InplaceSort(Results, Rankings)

    RETURN Results
END SearchPlayers

' Checks if a player fits a query, returning a ranking [0, 1].
BEGIN PlayerMatches(Player, Query)
    Let TotalCloseness = WordRelevance(Player.FirstName, Query)
                       + WordRelevance(Player.LastName, Query)
                       + WordRelevance(Player.Username, Query)
    RETURN TotalCloseness / 3
END PlayerMatches

' Relevance of the query word list to the document word, [0, 1].
BEGIN WordRelevance(DocumentWord, Query)
    Let Best = 0
    FOR i = 1 TO Length of Query
        Let QueryWord = Query(i)

        IF Length of QueryWord <= Length of DocumentWord THEN
            Let MatchLen = FuzzyMatch(DocumentWord, QueryWord)
            IF MatchLen > Best THEN
                Best = MatchLen
            END IF
        END IF
    NEXT i

    RETURN Best / (Length of DocumentWord)
END WordRelevance

' Returns the number of characters [0, Length of Query] that were matched.
BEGIN FuzzyMatch(Text, Query)
    Let TextPos = 1

    FOR QueryPos = 1 TO Length of Query
        WHILE TextPos <= Length of Text AND Text(TextPos) <> Query(QueryPos)
            TextPos = TextPos + 1
        END WHILE

        IF TextPos > Length of Text THEN
            RETURN QueryPos - 1 ' Abort, no more text to match!
        END IF

        TextPos = TextPos + 1 ' We can't reuse the same character.
    NEXT QueryPos

    RETURN Length of Query ' The whole query was matched!
END FuzzyMatch

' Split a string by a delimiter, returning an array of words.
BEGIN Split(String, Delimiter)
    Let NumWords = 0
    Let Partial = ""

    FOR i = 0 TO Length of String
        IF String(i) = Delimiter THEN
            IF Length of Partial > 0 THEN
                NumWords = NumWords + 1
                Words(NumWords) = Partial
                Partial = ""
            END IF
        ELSE
            Partial = Partial + String(i)
        END IF
    NEXT i

    ' The last word might not have a delimiter after it.
    IF Length of Partial > 0 THEN
        NumWords = NumWords + 1
        Words(NumWords) = Partial
    END IF

    RETURN Words
END Split

' Does an inplace selection sort of the items in `List` using `Keys` for ordering.
' Both arrays are passed by reference.
BEGIN InplaceSort(List, Keys)
    FOR i = 1 TO Length of List
        Let Best = i
        FOR j = i + 1 TO Length of List
            IF Keys(j) > Keys(Best) THEN
                Best = j
            END IF
        NEXT i

        Swap(List, i, Best)
        Swap(Keys, i, Best)
    NEXT i
END InplaceSort

' Swaps the items of a list at the given indices.
' List is passed by reference.
BEGIN Swap(List, i, j)
    Let Scratch = List(i)
    List(i) = List(j)
    List(j) = Scratch
END Swap

Payments

DIM RECORD Payment
  Label as String
  Debtors as Debtor()
  Recurrence as Recurrence
  Frequency as UInt64
  Cost as UInt64 ' Cost in cents.
  PaymentTime as UInt64 ' Payment time, taking units from Recurrence.
END RECORD

DIM RECORD Debtor
  FirstName as String
  LastName as String
  ID as UInt64
  DateAdded as DateTime ' Used only for internal bookkeeping.
  Payments as DateTime()
END RECORD

DIM ENUM Recurrence
  OneShot ' Does not recur.
  Daily
  Monthly
  Yearly
END ENUM

' Drives the payment tracking interface.
BEGIN PaymentsMain
  ' Globals are usually bad, but they can really simplify process descriptions!
  ' Pass this around manually in the implementation, rather than using a global.
  Global Payments = LoadPayments()

  Display Payments
  Start UI Loop
END PaymentsMain

' Creates a new payment and persists it.
' Triggered by the user clicking on a 'New' or 'Add' button.
BEGIN CreatePayment()
  Get Label ' Use a good ol' text field.
  Get Frequency ' Use standard numeric input.
  Get PaymentTime ' Use a numeric input.
  Get Recurrence ' Use dropdown menu, possibly with "Recurring" checkbox.
  Get PaymentTime ' Use a numeric input.
  Get Cost ' Use currency input box.

  Let NewPayment = Payment from
    Label, Frequency, Recurrence, Cost, PaymentTime
  Payments(Length of Payments + 1) = NewPayment
  PersistPayments(Payments)
END CreatePayment

' Triggered when the user tries removing a payment.
BEGIN RemovePayment(Index)
  RemoveAtIndex(Payments, Index)
  PersistPayments(Payments)
END RemovePayment

BEGIN AddDebtor(Payment, ID, FirstName, LastName)
  Let DateAdded = Now()
  Let NewDebtor = Debtor from FirstName, LastName, ID, DateAdded
  Payment.Debtors(Length of Payment.Debtors + 1) = NewDebtor
  PersistPayments(Payments)
END AddDebtor

BEGIN RemoveDebtor(Payment, Index)
  RemoveAtIndex(Payment.Debtors, Index)
  PersistPayments(Payments)
END RemoveDebtor

' Triggered when the user selects a payment.
BEGIN SelectPayment(Index)
  Let Payment = Payments(Index)

  Display FormatRecurrence(Payment.Recurrence, Payment.Frequency)
  Display FormatCost(Payment.Cost)
  FOR i = 1 TO Length of Payment.Debtors
    DisplayDebtor(Payment, i)
  NEXT i
END SelectPayment

BEGIN DisplayDebtor(Payment, Index)
  Let Debtor = Payment.Debtors(Index)
  Display Debtor.FirstName
  Display Debtor.LastName
  Display QuantityOwed(Payment, Index)
  Display DueDate(Payment, Index)
END DisplayDebtor

' Triggered when the user wants to pay off some debt.
BEGIN PayDebt(Debtor, Quantity)
  Let Date = Now() ' Get the current date and time.

  FOR i = 1 TO Quantity
    Debtor.Payments(Length of Debtor.Payments + 1) = Date
  NEXT i

  PersistPayments(Payments)
END PayDebt

' Formats recurrence data into a human-readable string.
BEGIN FormatRecurrence(RecurrenceType, Frequency)
  Let Result = "UNREACHABLE"

  IF RecurrenceType = Recurrence.OneShot THEN
    Result = "One-Time Payment"
  ELSE IF Frequency = 1 THEN
    CASEWHERE RecurrenceType is
      RecurrenceType.Daily   : Result = "Daily"
      RecurrenceType.Monthly : Result = "Monthly"
      RecurrenceType.Yearly  : Result = "Yearly"
    ENDCASE
  ELSE
    Result = "Every " + Frequency + " "

    CASEWHERE RecurrenceType is
      RecurrenceType.Daily   : Result = Result + " Days"
      RecurrenceType.Monthly : Result = Result + " Months"
      RecurrenceType.Yearly  : Result = Result + " Years"
    ENDCASE
  END IF

  Return Result
END FormatRecurrence

BEGIN QuantityOwed(Payment, Index)
  Let Debtor = Payment.Debtors(i)
  Let Periods = PeriodsSince(
    Payment.Recurrence, Payment.Frequency,
    Debtor.DateAdded, Now())
  RETURN Max(Periods - (Length of Debtor.Payments) + 1, 0)
END QuantityOwed

BEGIN DueDate(Payment, Index)
  Let Debtor = Payment.Debtors(i)
  Let Due = Debtor.DateAdded + Payments.PaymentTime
  Let AlreadyPaid = Payment.Frequency * (Length of Debtor.Payments)
  CASEWHERE RecurrenceType is
    RecurrenceType.OneShot : Pass ' Do nothing.
    RecurrenceType.Daily   : Add AlreadyPaid Days to Due
    RecurrenceType.Monthly : Add AlreadyPaid Months to Due
    RecurrenceType.Yearly  : Add AlreadyPaid Years to Due
  ENDCASE
  RETURN Due
END DueDate

' Number of periods started between DateA and DateB.
BEGIN PeriodsSince(RecurrenceType, Frequency, DateA, DateB)
    Let Base = 0
    CASEWHERE RecurrenceType is
      RecurrenceType.OneShot : Base = 0
      RecurrenceType.Daily   : Base = DateB.Days - DateA.Days
      RecurrenceType.Monthly : Base = DateB.Months - DateA.Months
      RecurrenceType.Yearly  : Base = DateB.Years - DateA.Years
    ENDCASE
    RETURN Floor(Base / Frequency)
END PeriodsSince

BEGIN FormatCost(Cost)
  Let Dollars = Floor(Cost / 100)
  Let Cents = Cost MOD 100
  Let Result = "$" + Dollars + "."

  ' Pad out to two digits.
  IF Cents < 10 THEN
    Result = Result + "0"
  END IF

  Result = Result + Cents

  RETURN Result
END FormatCost

BEGIN LoadPayments()
  ' The exact location of PaymentsFile is left to the implementation.
  Open PaymentsFile for Reading

  Let i = 1
  WHILE NOT EOF(PaymentsFile)
    Read Payments(i) from Payments
    i = i + 1
  END WHILE

  Close PaymentsFile

  RETURN Payments
END LoadPayments

BEGIN PersistPayments(Payments)
  Open PaymentsFile for Writing

  FOR i = 1 TO Length of Payments
    Write PaymentsFile from Payments(i)
  NEXT i

  Close PaymentsFile
END PersistPayments

BEGIN RemoveAtIndex(List, Index)
  FOR i = Index + 1 TO Length of List
    List(i - 1) = List(i)
  NEXT i
  List(Length of List) = Nothing
END RemoveAtIndex

Match

DIM RECORD GameState
  Config    as GameConfig
  Paused    as Boolean
  Running   as Boolean
  Countdown as Integer
  IdleTimer as Integer
  Red       as Player
  Blue      as Player

  ManualEnd    as Winner
  GoldenWinner as Winner

  ' <= NumRounds = Normal
  ' NumRounds + 1 = Golden Point
  ' > NumRounds + 1 = Tie, Manual Intervention Required  
  Round as Integer
END RECORD

DIM RECORD GameConfig
  ' Round duration in milliseconds.
  RoundDuration as Integer
  ' Number of rounds.
  NumRounds as Integer
  ' Maximum delay between judges, in milliseconds.
  MaxDelay as Integer
  ' The number of judges that is required to register a point.
  MinAgreement as Integer
  ' Break duration in milliseconds.
  IdleTime as Integer
  ' Names of the players.
  RedName as String
  BlueName as String
END RECORD

DIM RECORD Player
  Points         as Integer
  Penalty        as Integer ' Counted in half-points.
  HeadJudgements as DateTime[4]
  BodyJudgements as DateTime[4]
END RECORD

DIM ENUM Winner
  Red
  Blue
  Tie
  Indeterminate
END ENUM

DIM ENUM PointKind
  BlueHead
  BlueBody
  RedHead
  RedBody
END ENUM

' List to facilitate enumerating the enum.
Global PointKinds = {
  PointKind.BlueHead,
  PointKind.BlueBody,
  PointKind.RedHead,
  PointKind.RedBody
}

BEGIN RunGame(Config)
  Let Game = NewGame(Config)

  Let LastTime = Now()
  WHILE Game.Running
    Sleep for (1000 / 60) milliseconds. ' ~60 FPS.
    Let Time = Now()
    Let dt = Time - LastTime
    LastTime = Time

    ProcessInput(Game)

    ' Tick down the judges' trigger timers.
    For i = 1 TO 4
      Let Kind = PointKinds(i)
      Let Judgements = JudgementsForPointKind(Game, Kind)
      FOR j = 1 TO 4
        Judgements(j) = Max(Judgements(j) - dt, 0)
      NEXT j
    NEXT i

    IF GetWinner(Game) <> Winner.Indeterminate THEN
      CountDown(Game)
    END IF

    ' Sends the state to the UI thread for rendering.
    ' Implementation-dependent.
    CopyToUI(Game)
  END WHILE
END RunGame

BEGIN CountDown(Game)
  IF NOT Game.Paused THEN
    Game.Countdown = Max(Game.Countdown - dt, 0)

    IF Game.Countdown = 0 THEN
      Play "End of Round Buzzer"
      Game.IdleTimer = Game.Config.IdleTime
      Game.Countdown = Game.Config.RoundDuration
      Game.Paused = True
      Game.Round = Game.Round + 1
    END IF
  ELSE
    Game.IdleTimer = Max(Game.IdleTimer - dt, 0)
  END IF
END CountDown

BEGIN ProcessInput(Game)
  ' See the screen designs for the accepted inputs.
  ' The referee can also transparently change timers, points, and penalties.

  Get ShouldStop
  IF ShouldStop THEN
    Game.Running = False
    RETURN
  END IF

  Get ManualEnd
  IF ManualEnd <> Winner.Indeterminate THEN
    Game.ManualEnd = ManualEnd
    RETURN
  END IF

  Get TogglePause
  IF TogglePause THEN
    Game.Paused = NOT Game.Paused
  END IF

  Get ChangedRound
  IF ChangedRound > -1 THEN
      Game.Round = ChangedRound
      Game.GoldenWinner = Winner.Indeterminate
  END IF

  FOR i = 1 TO 4
    For j = 1 TO 4
      Let Kind = PointKinds(j)

      If Judge i Pressed Kind THEN
        Let Judgements = JudgementsForPointKind(Game, Kind)
        Judgements(i) = Game.Config.MaxDelay

        IF 4 - Game.Config.MinAgreement <= Count(Judgements, 0) THEN
          AwardPoints(Game, Kind)
          ZeroArray(Judgements)
        END IF
      END IF
    NEXT j
  NEXT i
END ProcessInput

BEGIN GetWinner(Game)
  ' Referee choice comes first.
  IF Game.ManualEnd <> Winner.Indeterminate THEN
    RETURN Game.ManualEnd
  END IF

  ' Golden point.
  IF Game.GoldenWinner <> Winner.Indeterminate THEN
    RETURN Game.GoldenWinner
  END IF

  ' Normal end (player with more points after all the rounds).
  IF Game.Round > Game.Config.NumRounds THEN
    Let RedPoints = Game.Red.Points - Floor(Game.Red.Penalty / 2)
    Let BluePoints = Game.Blue.Points - Floor(Game.Blue.Penalty / 2)
    IF BluePoints > RedPoints THEN
      RETURN Winner.Blue
    ELSE IF RedPoints > BluePoints THEN
      RETURN Winner.Red
    END IF
  END IF

  ' Finished golden point round and still a tie.
  IF Game.Round > Game.Config.NumRounds + 1 THEN
    RETURN Winner.Tie
  END IF

  RETURN Winner.Indeterminate
END GetWinner

' Returns by reference.
BEGIN JudgementsForPointKind(Game, Kind)
  CASEWHERE Kind is
    PointKind.BlueHead : RETURN Game.Blue.HeadJudgements
    PointKind.BlueBody : RETURN Game.Blue.BodyJudgements
    PointKind.RedHead : RETURN Game.Red.HeadJudgements
    PointKind.RedBody : RETURN Game.Red.BodyJudgements
  ENDCASE
END JudgementsForPointKind

BEGIN AwardPoints(Game, Kind)
  CASEWHERE Kind is
    PointKind.BlueHead : Game.Blue.Points = Game.Blue.Points + 2
    PointKind.BlueBody : Game.Blue.Points = Game.Blue.Points + 1
    PointKind.RedHead : Game.Red.Points = Game.Red.Points + 2
    PointKind.RedBody : Game.Red.Points = Game.Red.Points + 1
  ENDCASE

  IF GoldenPointRound(Game) THEN
    Play "Golden Point Buzzer"
    Game.Paused = True
    IF Game.GoldenWinner = Winner.Indeterminate THEN
      CASEWHERE Kind is
        PointKind.BlueHead : Game.Winner = Winner.Blue
        PointKind.BlueBody : Game.Winner = Winner.Blue
        PointKind.RedHead : Game.Winner = Winner.Red
        PointKind.RedBody : Game.Winner = Winner.Red
      ENDCASE
    END IF
  END IF
END AwardPoints

BEGIN NewGame(Config)
  Let Paused = True
  Let Running = False
  Let Countdown = 0
  Let IdleTimer = 0
  Let Round = 1

  RETURN GameState from
    Config,
    Paused,
    Running,
    Countdown,
    IdleTimer,
    Round,
    Winner.Indeterminate,
    Winner.Indeterminate,
    NewPlayer(),
    NewPlayer()
END NewGame

BEGIN NewPlayer()
  RETURN Player from 0, 0, {0, 0, 0, 0}, {0, 0, 0, 0}
END NewPlayer

' Count occurrence of Element in Array.
BEGIN Count(Array, Element)
  Let n = 0

  FOR i = 1 TO Length of Array
    IF Array(i) = Element THEN
      n = n + 1
    END IF
  NExt i

  RETURN n
END Count

' Fill an array with zeroes.
BEGIN ZeroArray(Array)
  FOR i = 1 TO Length of Array
    Array(i) = 0
  NEXT i
END ZeroArray

BEGIN Max(a, b)
  IF b > a THEN
    RETURN a
  ELSE
    RETURN b
  END IF
END Max

Login

Note: This is heavily simplified - the implementation would need to communicate across servers, and wouldn't just use a single, synchronous function. As a result, it would also need to store some state, such as an ID and expiry encrypted by the server, in order to prove its authentication.

BEGIN Login(Username, Password)
  Get User with Username from Database
  IF User = Nothing THEN
    RETURN "Incorrect username or password."
  END IF

  ' Good algorithms include Scrypt, Bcrypt, Argon2 and PBKDF2-HMAC-SHA256.
  Let Hash = Encrypt(Password, User.Salt)
  IF Hash <> User.PasswordHash THEN
    RETURN "Incorrect username or password."
  END IF

  RETURN "Login successful!"
END Login

Tournament

' Ideally implemented using tagged unions.
BEGIN RECORD MatchNode
  ' If match:
  Red as MatchNode,
  Blue as MatchNode

  ' If player:
  Player as Player
END RECORD

BEGIN GenerateTournament(Players)
  ' No players means no matches.
  IF Length of Players = 0
    Return Players
  END IF

  Let Current = Empty Array
  Let Next = Empty Array
  FOR i = 1 TO Length of Players
    Current(i) = MatchNode from Nothing, Nothing, Players(i)
  NEXT i

  WHILE Length of Current <> 1
    Let Next = Empty Array
    IF Length of Current MOD 2 = 1 THEN
      Next(1) = Current(Length of Current)
      Delete Current(Length of Current)
    END IF

    FOR i = 1 TO (Length of Current) / 2
      Let Red = Current(i)
      Let Blue = Current((Length of Current) - i + 1)
      Next(Length of Next) = MatchNode from Red, Blue, Nothing
    NEXT i

    Current = Next
  END WHILE

  Return Current(1)
END GenerateTournament

results matching ""

    No results matching ""