strawman pair proposal

cpairs.fsx

// pairs II
// for a lightweight IDE with F# syntax awareness and REPL try https://code.visualstudio.com

/// generate all possible pairings given a list of candidatesf
let rec genPossiblePairs list =
    match list with
    | [] -> []
    | me::rest -> [for otherPerson in rest -> me, otherPerson] @ genPossiblePairs rest

genPossiblePairs [1..3]
let congaPeople = ["adam"; "bailey"; "corey"; "jordan"; "josh";"kendric";"kevin";"mark";"ryan"]
genPossiblePairs congaPeople

let r = System.Random()

/// shuffle a list randomly
let shuffle cards = cards |> List.map (fun card -> r.Next(),card) |> List.sort |> List.map snd
congaPeople |> shuffle
genPossiblePairs congaPeople |> shuffle

/// deal proposed pairs from a list of all possible pairings
let rec dealPairs possiblePairs =
    let nothingInCommon us them = fst them <> fst us && fst them <> snd us && snd them <> fst us && snd them <> snd us
    match possiblePairs with
    | [] -> []
    | us::rest ->
        let listWithoutMeOrMyBuddy = rest |> List.filter (fun them -> nothingInCommon us them)
        us :: dealPairs listWithoutMeOrMyBuddy

[1..6] |> genPossiblePairs |> dealPairs
[1..6] |> genPossiblePairs |> shuffle |> dealPairs
congaPeople |> genPossiblePairs |> shuffle |> dealPairs    //here  

// done  story
//   x   day 1 simple no history even pairs
//   x   day 1 odd man out
//   x   exclusions - teamate out of rotation today
//   x   day 2 exclude prior pairs
//   x   transpile to javascript (fable) https://fable-compiler.github.io
//   x   preferences: avoid novice-novice pairing in early days of sprint
//   x   latter days: if I've paired with everybody and solo'd, I prefer any repeat pair to another solo (rank hands)
//   x   pin pair(s) ("we like that") and re-pick
//       pin pairs and story .. reroll  3-Feb.
//       "who have I paired with" he asked 3-Feb.  (that diagram!)
//       simple swaps, e.g. "swap gp / sw"
//       whole thing as a command line and history of picks in a file
//       generate strawpoll.me for pair picking time fast iteration
//       way to say "I'm a story lead" and don't pair up two leads?
//       query: when X last pair with Y?
//       as slack bot so anybody could run 
//       express a preference to stay on a story
//       "that who-paired-with-whom chart is hard to read" ... better presentation ? Generated from this history to a URL 
//       --or-- expose repl over a socket ... that updates... like /deal   /accept /decline  /pin ... /pref ...   uService... agents.. hm.. azure function endpoint..
//       maybe order that final proposed team list by the goodness of the pairs
//       spot preferences, e.g. (pref GP (EF BK JZ))  // "pair me with masonites today, please""
//       print in cannonical order so I can find my name


// meet the team

type Person = VG|BK|JZ|BM|EF|GP|ZP|AW|DB|SW|Solo
let allPeople = [VG;BK;JZ;BM;EF;GP;ZP;AW;DB;SW]

//let people = allPeople
let people = congaPeople


// naive pairing for an even team -- odd man out, if any, is silently omitted
people |> genPossiblePairs |> shuffle |> dealPairs

let contains (a,b) c = a=c || b=c
/// find the soloists
let findSoloists people pairs =
    let isUnpaired person pairs =
        let possiblyUnpaired = pairs |> Seq.tryFind (fun somePair -> contains somePair person)
        match possiblyUnpaired with Some _ -> false | None -> true
    people |> List.filter (fun person -> isUnpaired person pairs)

/// simple deal the people: no history no exclusions    //here
let deal people  =             
    let pairs = people |> shuffle |> genPossiblePairs |> shuffle |> dealPairs
    let soloists = findSoloists people pairs |> List.map (fun solo -> solo,solo)
    pairs@soloists

deal people
deal [1..3]

let subset exclusions everybody = everybody |> List.filter (fun somebody -> exclusions |> Seq.contains somebody |> not)
let dealExcluding everybody exclusions =  everybody |> subset exclusions |> shuffle |> deal
dealExcluding [1..8] [8]
dealExcluding people ["adam"]   //here

/// filter out the excluded pairs from the list of all possible pairs
let excludePairs excludedPairs everybody =
    let swap (a,b) = (b,a)
    let contains list item = List.contains item list || List.contains (swap item) list
    everybody |> List.filter (fun somebody -> contains excludedPairs somebody |> not)  

[1..10] |> genPossiblePairs |> excludePairs [1,2] |> dealPairs

/// propose pairs excluding specific  people (somebody OOO) and pairs (already paired in this sprint)
let dealExcludingPeoplePairs people excludedPeople excludedPairs  =
    let peopleAvailable = subset excludedPeople people
    let pairs = peopleAvailable |> shuffle |> genPossiblePairs |>shuffle |> excludePairs excludedPairs |> dealPairs
    let soloists = findSoloists peopleAvailable pairs |> List.map (fun solo -> solo,solo)
    pairs@soloists
dealExcludingPeoplePairs [1..10] [10;9] [1,2]
dealExcludingPeoplePairs [1..6] [5] []



let flatten listOfLists = List.fold (@) [] listOfLists

List.concat [ [1..3]; [5..10]; [22;33]]
module explore =

    flatten [ [1..3];[5..10];[22;33] ]
    people |> genPossiblePairs |> shuffle |> dealPairs
    [1..3] |> genPossiblePairs |> dealPairs |> findSoloists [1..3]

let soloToMeMe (a,b) = if b=Solo then a,a else a,b

let history' =   
    [  
        [(SW, EF); (BK, BM); (DB, JZ); (GP, ZP)]                   // d1 in 1
        [(EF, BM); (SW, GP); (ZP, DB); (BK, JZ)]                   // d2 in 1
        [DB,JZ; GP,SW; BM,ZP; BK,EF]                              // d3 in 2
        [BM,SW; BK,ZP; GP,DB; EF,Solo]                            // d4 in 2  - swap soloist
        [(BM, GP); (JZ, ZP); (DB, BK); (EF, SW)]                  // d5 
    ] |> List.map (fun day -> day |> List.map soloToMeMe)
let pretty (a,b) = if a=b then a,Solo else a,b

// let history =   //here
//     [  
//         [("josh", "ryan"); ("corey", "kevin"); ("adam", "jordan");("bailey", "kendric")]
//     ] 
let isN0be'du who = [AW;DB;SW] |> List.contains who     // discriminated union - compile time people
let isN0be's who = ["norm"] |> List.contains who         // arbitrary strings naming people

let isN0be = isN0be's

/// score the goodness of the pair, disfavoing soloists and somewhat n0be,n0be
let scorePair (a,b) =
    if a=b then 0
    else
        if isN0be a && isN0be b then 1 else 10

let scoreList candidates = candidates |> List.map (scorePair) |> List.reduce (+)

/// return who paired with whom on what day from history
let whoPairedWithWhom h = h |> List.mapi (fun i item -> [for pair in item -> pair,i+1]) |> flatten
//whoPairedWithWhom history

/// generate many solutions, score them, return the best
let dealBest people excludedPeople excludedPairs =
    let many = [1..100] |> List.map (fun _ -> dealExcludingPeoplePairs people excludedPeople excludedPairs)
    let ranked = many |> List.map (fun l -> (scoreList l),l)
    let best = ranked |> List.sortByDescending fst |> List.head |> snd
    best



let eqv (a,b) (c,d) = (a=c && b=d) || (a=d && b=c)

let hasSoloed me h = h |> List.contains (me,me)

let havePairedWith us h = h |> List.tryFind (fun p -> p eqv us)

let meFirst me (a,b) = if (b=me) then (b,a) else (a,b)

meFirst (AW) (AW,BK) = (AW,BK)
meFirst (AW) (BK,AW) = (AW,BK)
let myHistory me h = h |> List.filter (fun p -> fst p = me || snd p = me)
[1..4] |> genPossiblePairs |> myHistory 2  = [(1, 2); (2, 3); (2, 4)]
//myHistory ZP (flatten history)
//myHistory AW (flatten history)

module advancedScoringWithHistory =

    type PairGoodness<'a> = Master of 'a*'a | Apprentice of 'a*'a  | Solo of 'a | RepeatPair of 'a*'a | RepeatSolo of 'a

    /// classify pairs given a predicate for apprentice  and the history of pairing
    let classify isApprentice (a,b) h =
        if a=b then
            if (h |> List.contains (a,a)) then RepeatSolo a else Solo a
        else if (h |> List.contains (a,b)) || (h |> List.contains (b,a)) then RepeatPair (a,b)
        else if isApprentice a && isApprentice b then Apprentice(a,b)
        else Master (a,b)

    // let tests = [   
    //     classify isN0be (BK,EF) []  = Master (BK,EF)
    //     classify isN0be (AW,DB) []  = Apprentice (AW,DB)
    //     classify isN0be (AW,BK) []  = Master (AW,BK)
    //     classify isN0be (AW,AW) []  = Solo AW
    //     classify isN0be (BK,DB) [(BK,DB)] = RepeatPair (BK,DB)
    //     classify isN0be (BK,DB) [(DB,BK)] = RepeatPair (BK,DB)
    //     classify isN0be (AW,AW) [(AW,AW)] = RepeatSolo AW
    // ]

    /// goodness of this pair
    let benefit classification =
        match classification with
        | Master _ -> 10                // best
        | Apprentice _ -> 2
        | Solo _   -> 0
        | RepeatPair _ -> 0
        | RepeatSolo _ -> -5            // worst

    //people |> genPossiblePairs |> List.map (fun pair -> classify isN0be pair (flatten history)) |> List.sort
    let scorePairHistory (a,b) h = classify isN0be (a,b) h |> benefit
    //scorePairHistory (AW,BK) []
    let scoreTeamHistory proposedTeam h = proposedTeam |> List.map (fun pair -> scorePairHistory pair h) |> List.reduce (+)

    let dealBest people excludedPeople history =
        let many = [1..100] |> List.map (fun _ -> dealExcludingPeoplePairs people excludedPeople [] )
        let ranked = many |> List.map (fun l -> (scoreTeamHistory l history),l)
        let best = ranked |> List.sortByDescending fst |> List.head |> snd
        best
    //dealBest people [VG;ZP] (flatten history) // 




let pinAndDeal people excludedPeople pinned h =
    let x = advancedScoringWithHistory.dealBest people ([for a,b in pinned do yield a; yield b]@excludedPeople) h
    x @ pinned

//let x = pinAndDeal people [VG;AW] [ ] (flatten history) |> List.map pretty       //here 

let cHistory =   //here
    [  
        //[("josh", "mark"); ("jordan", "kevin"); ("adam", "corey"); ("kendric", "bailey"); ("ryan", "ryan")]
    ] 
// demo scenarios.  Day 1 no history; we have history; somebody out;  pinned pair.
let x = pinAndDeal congaPeople [] [] (flatten cHistory)                      //herec
printfn "strawman proposal %A" x   
//printfn """/poll "strawman proposal %A " "strongly agree":pear: "agree":banana: "disagree":lemon:"strongly disagree":tomato: "disagree:block":fist:  """ x

//let meFirstHistory who history = myHistory who (flatten history) |> List.map (fun us -> meFirst who us )
//meFirstHistory GP history'