4 people like it.

Wimbledon special!

Tennis scoring system (at the game level). Includes some pattern-matching examples including 'when' guards.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
open Microsoft.FSharp.Reflection

type Score = | Love | Fifteen | Thirty | Forty | Deuce | Advantage | Disadvantage | Win | Lose

type Player = {name : string; score : Score}

/// Returns the name of a union case as a string
let GetUnionCaseName(x:'a) = 
    match FSharpValue.GetUnionFields(x, typeof<'a>) with
    | case, _ -> case.Name  

/// Formats a single score - eg. Score.Fifteen -> "Fifteen"
let formatScore =
    function
        | Win -> "Game"
        | Lose -> "Loses"
        | other -> GetUnionCaseName other
    
/// Formats the scores for an array of two players
let formatScores (players : array<Player>) =
    match players with
    | [|p1; _|] when p1.score = Deuce -> formatScore p1.score
    | [|p1; _|] when p1.score = Advantage -> formatScore p1.score + " "  + p1.name
    | [|_; p2|] when p2.score = Advantage -> formatScore p2.score + " "  + p2.name
    | [|p1; _|] when p1.score = Win -> formatScore p1.score + " " + p1.name
    | [|_; p2|] when p2.score = Win -> formatScore p2.score + " " + p2.name
    | [|p1; p2|] when p1.score = p2.score -> formatScore p1.score + " All"
    | [|p1; p2|] -> formatScore p1.score + " " + formatScore p2.score
    | _ -> failwith "Impossible combination"

/// Maps a current score into a new score
let nextScore (winnerScore, loserScore) =
    let score =
        match (winnerScore, loserScore) with
        | (Love, any) -> (Fifteen, any)
        | (Fifteen, any) -> (Thirty, any)
        | (Thirty, any) when any < Forty -> (Forty, any)
        | (Thirty, any) when any = Forty -> (Deuce, Deuce)
        | (Forty, any) when any < Forty -> (Win, Lose)
        | (Forty, any) when any = Forty -> (Advantage, Disadvantage)
        | (Deuce, Deuce) -> (Advantage, Disadvantage)
        | (Disadvantage, Advantage) -> (Deuce, Deuce)
        | (Advantage, Disadvantage) -> (Win, Lose)
        | _ -> failwith ("Impossible combination: " + formatScore winnerScore + "/" + formatScore loserScore)
    [|fst(score); snd(score)|]

/// Returns a new 2-element player array on the assumption that player.[winnerIndex] has won a point
let winPoint (players : array<Player>, winnerIndex : int) =
    let loserIndex = (winnerIndex + 1) % 2
    let winner, loser = players.[winnerIndex], players.[loserIndex]
    let newScores = nextScore (winner.score, loser.score)
    // Using winner/loserIndex in this way ensures the resulting scores end up in the right slots:
    [|{players.[0] with score=newScores.[winnerIndex]}; {players.[1] with score=newScores.[loserIndex]}|]

/// Takes an array of players and array of winner indexes and summarises the progress of points
let play players runOfPlay =
    runOfPlay
    |> Array.fold (fun score winnerIndex -> 
                        let newScore = winPoint(score, winnerIndex)
                        printfn "%s" (formatScores newScore)
                        newScore) players 
  
// Test:

let players = [|{name="Sharapova"; score=Love}; {name="Kvitova"; score=Love}|]

let walkover = [|0;0;0;0|]
play players walkover |> ignore
   
let notTooHard = [|0;0;1;1;0;1;1;1|]
play players notTooHard |> ignore

let hardFought = [|0;1;0;1;0;1;1;0;1;0;1;0;0;0|]
play players hardFought |> ignore
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Reflection
type Score =
  | Love
  | Fifteen
  | Thirty
  | Forty
  | Deuce
  | Advantage
  | Disadvantage
  | Win
  | Lose

Full name: Script.Score
union case Score.Love: Score
union case Score.Fifteen: Score
union case Score.Thirty: Score
union case Score.Forty: Score
union case Score.Deuce: Score
union case Score.Advantage: Score
union case Score.Disadvantage: Score
union case Score.Win: Score
union case Score.Lose: Score
type Player =
  {name: string;
   score: Score;}

Full name: Script.Player
Player.name: string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
Player.score: Score
val GetUnionCaseName : x:'a -> string

Full name: Script.GetUnionCaseName


 Returns the name of a union case as a string
val x : 'a
type FSharpValue =
  static member GetExceptionFields : exn:obj * ?bindingFlags:BindingFlags -> obj []
  static member GetRecordField : record:obj * info:PropertyInfo -> obj
  static member GetRecordFields : record:obj * ?bindingFlags:BindingFlags -> obj []
  static member GetTupleField : tuple:obj * index:int -> obj
  static member GetTupleFields : tuple:obj -> obj []
  static member GetUnionFields : value:obj * unionType:Type * ?bindingFlags:BindingFlags -> UnionCaseInfo * obj []
  static member MakeFunction : functionType:Type * implementation:(obj -> obj) -> obj
  static member MakeRecord : recordType:Type * values:obj [] * ?bindingFlags:BindingFlags -> obj
  static member MakeTuple : tupleElements:obj [] * tupleType:Type -> obj
  static member MakeUnion : unionCase:UnionCaseInfo * args:obj [] * ?bindingFlags:BindingFlags -> obj
  ...

Full name: Microsoft.FSharp.Reflection.FSharpValue
static member FSharpValue.GetUnionFields : value:obj * unionType:System.Type * ?allowAccessToPrivateRepresentation:bool -> UnionCaseInfo * obj []
static member FSharpValue.GetUnionFields : value:obj * unionType:System.Type * ?bindingFlags:System.Reflection.BindingFlags -> UnionCaseInfo * obj []
val typeof<'T> : System.Type

Full name: Microsoft.FSharp.Core.Operators.typeof
val case : UnionCaseInfo
property UnionCaseInfo.Name: string
val formatScore : _arg1:Score -> string

Full name: Script.formatScore


 Formats a single score - eg. Score.Fifteen -> "Fifteen"
val other : Score
val formatScores : players:Player array -> string

Full name: Script.formatScores


 Formats the scores for an array of two players
val players : Player array
type 'T array = 'T []

Full name: Microsoft.FSharp.Core.array<_>
val p1 : Player
val p2 : Player
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val nextScore : winnerScore:Score * loserScore:Score -> Score []

Full name: Script.nextScore


 Maps a current score into a new score
val winnerScore : Score
val loserScore : Score
val score : Score * Score
val any : Score
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val winPoint : players:Player array * winnerIndex:int -> Player []

Full name: Script.winPoint


 Returns a new 2-element player array on the assumption that player.[winnerIndex] has won a point
val winnerIndex : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val loserIndex : int
val winner : Player
val loser : Player
val newScores : Score []
val play : players:Player array -> runOfPlay:int [] -> Player array

Full name: Script.play


 Takes an array of players and array of winner indexes and summarises the progress of points
val runOfPlay : int []
module Array

from Microsoft.FSharp.Collections
val fold : folder:('State -> 'T -> 'State) -> state:'State -> array:'T [] -> 'State

Full name: Microsoft.FSharp.Collections.Array.fold
val score : Player array
val newScore : Player []
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val players : Player []

Full name: Script.players
val walkover : int []

Full name: Script.walkover
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
val notTooHard : int []

Full name: Script.notTooHard
val hardFought : int []

Full name: Script.hardFought
Raw view Test code New version

More information

Link:http://fssnip.net/66
Posted:12 years ago
Author:Kit Eason
Tags: tennis , reflection , match , when