fixed bug

fixed bug

module c11Relat
// open util/relation

// TODO: don't have non-atomic actions in this model, just NA locations.

// Disable non-atomics entirely
fact {
  no NonAtomic
}

// Helper predicate: assert there are no transitive edges in a relation
pred is_core [ r : Action -> Action ] {
  all a,b,c: Action |
    (a -> b) + (b -> c) in ^r  implies  not (a -> c) in r
}

// Locations can be local or global
abstract sig Loc {}
sig Glob, Thr extends Loc {}

// Furthermore global locations can be atomic or nonatomic
sig Atomic, NonAtomic in Glob {}
fact {
  Atomic + NonAtomic = Glob
  disj [ Atomic, NonAtomic ]
}

sig Val {}
one sig Init in Val {} // Magic initialisation value

// Actions kinds corresponding to different memory actions
abstract sig Kind {}
one sig Read, ReadN, Write, RMW, AssmEq, FenceSC extends Kind {}

// Actions
abstract sig Action {}
sig Intern, Extern, Call, Ret extends Action {}

// Locations are associated with actions correctly
pred locWF[ dom : set Action,
            kind : Action -> Kind,
            gloc : Action -> Glob,
            lloc1, lloc2 : Intern -> Thr ] {
    kind in (dom - (Call + Ret)) -> one Kind
    no (Call + Ret).kind

    gloc in (dom - (Call + Ret)) -> lone Glob

    // local variables are only recorded for internal actions
    lloc1 in (dom & Intern) -> lone Thr
    lloc2 in (dom & Intern) -> lone Thr

    all a : dom | {
      // All reads, writes, RMW access global locations
      a in kind.(Read + ReadN + Write + RMW)  iff  one a.gloc

      // Reads and writes access zero or one local variables
      a in kind.(Read + Write) & Intern  implies  {
        one a.lloc1 and no a.lloc2
      }

      // Assume and RMW access two local variables
      a in kind.(AssmEq + RMW) & Intern  implies  {
        one a.lloc1 and one a.lloc2
      }

      // Fences and ReadN don't access local variables
      a in kind.(ReadN + FenceSC) & Intern implies {
        no a.lloc1 and no a.lloc2
      }
    }
}

// Values are associated with actions correctly
pred valWF[ dom : set Action,
            kind : Action -> Kind,
            wv, rv : Action -> Val ] {
    wv in (dom - (Call + Ret)) -> lone Val
    rv in (dom - (Call + Ret)) -> lone Val

    // Writes have a written value, reads have a read value, RMW have both
    all a : dom - (Call + Ret) | {
      kind[a] in Write iff {
        one a.wv
        no a.rv
      }
      kind[a] in (Read + ReadN) iff {
        one a.rv
        no a.wv
      }
      kind[a] in RMW iff {
        one a.rv
        one a.wv
      }
      // Implicitly, all other actions have no rv / wv
    }
}

// SB is acyclic
pred SBwf [ dom : set Action,
            kind : Action -> Kind,
            sb: Action -> Action ] {
  no iden & ^sb
}

// HB is acyclic
pred HBacyc [ dom : set Action, kind : Action -> Kind,
              loc : Action -> Loc, wv, rv : Action -> Val,
              hb, sb, mo, rf : Action -> Action ] {
  no iden & ^hb
}

// Find the last value written for a given local variable and action
fun lastval [ dom : set Action,
              kind : Action -> Kind,
              lloc : Action -> Loc,
              callmap : Thr -> Val,
              rv : Action -> Val,
              sb : Action -> Action,
              curr : Action,
              currloc : Loc ] : set Val {
  { v : Val |
    some r : dom & kind.Read | {
      r.rv = v
      r -> curr in ^sb
      r.lloc = currloc
      no r' : dom & kind.Read | {
        (r -> r') + (r' -> curr) in ^sb
        r'.lloc = currloc
      }
    }
  }
    +
  { v : Val | {
      v = (currloc).callmap
      (Call -> curr) in ^sb
      no r' : dom & kind.Read | {
        (Call -> r') + (r' -> curr) in ^sb
        r'.lloc = currloc
      }
    }
  }
}

// Write the value given at the call to the same local variable.
// TODO: handle internal RMW
pred RFwfLocal [ dom : set Action,
                kind : Action -> Kind,
                gloc : Action -> Loc,
                lloc1, lloc2 : Action -> Loc,
                callmap, retmap : Thr -> Val,
                wv, rv : Action -> Val,
                hb, sb, mo, rf : Action -> Action ] {
  callmap in Thr -> one Val
  retmap in Thr -> one Val

  // Assumes demand equality on local var values
  all a : dom & kind.AssmEq | {
    lastval[dom, kind, lloc1, callmap, rv, sb, a, a.lloc1] =
      lastval[dom, kind, lloc1, callmap, rv, sb, a, a.lloc2]
  }

  // Writes take the correct local var value
  all w : dom & kind.Write | {
    w.wv = lastval[dom, kind, lloc1, callmap, rv, sb, w, w.lloc1]
  }

  // The retmap takes the correct values.
  all t : Thr | {
    t.retmap = lastval[dom, kind, lloc1, callmap, rv, sb, Ret, t]
  }
}

// RF is well-formed
pred RFwf [ dom : set Action,
            kind : Action -> Kind,
            loc : Action -> Loc,
            wv, rv : Action -> Val,
            hb, sb, mo, rf : Action -> Action ] {
  // Read from at most one write
  rf in kind.(Write + RMW) lone -> kind.(Read + ReadN + RMW)

  // Irreflexive
  no iden & rf

  all r : dom & kind.(Read + ReadN + RMW) | {
    // Read from the same location written
    (rf.r).loc in r.loc

    // Value taken from origin write
    some rf.r implies r.rv = (rf.r).wv // and not r.rval in Init
    no rf.r implies r.rv in Init

    // Allow initialisation reads, but force actions to
    // read from an explicit write if any is hb-available
    // Note MO used here because r might be a RMW
    (some (hb + mo).r & (kind.(Write + RMW) <: loc).(r.loc) )
          implies (some rf.r)
    // TODO: Mark isn't completely convinced
  }
}

// Define hb by combining rf with hb over atomics
pred HBdef [ dom : set Action,
             kind : Action -> Kind,
             loc : Action -> Loc,
             wv, rv : Action -> Val,
             hb, sb, mo, rf : Action -> Action ] {
  // sw (sync-with) is rf projected to atomic locations
  let aact = dom & loc.Atomic,
      sw = rf & (aact -> aact) |

  // sc is mo projected to SC fences
  let fences = dom & (kind.FenceSC),
      sc = mo & (fences -> fences) |

  hb = ^(sw + sb + sc)
}

// Coherence order is respected
// Note: this version of the axiom also covers the AtomRMW rule.
pred CoWR [ dom : set Action, kind : Action -> Kind,
            loc : Action -> Loc, wv, rv : Action -> Val,
            hb, sb, mo, rf : Action -> Action ] {
  all r : dom & kind.(Read + ReadN + RMW), w1 : rf.r |
    not { (w1 -> r) in mo.(hb + mo) }
}

// Modification order is well-formed
pred MOwf [ dom : set Action, kind : Action -> Kind,
            loc : Action -> Loc, wv, rv : Action -> Val,
            hb, sb, mo, rf : Action -> Action ] {
  mo = ^mo     // transitive
  no iden & mo  // irreflexive
  mo in kind.(Write + RMW + FenceSC) -> kind.(Write + RMW + FenceSC)

  all disj w1, w2 : dom | {
    (w1 -> w2) in mo + ~mo iff {
      // per-location total on atomic read / RMWs
      ((w1.loc = w2.loc) and w1 + w2 in (loc.Atomic & kind.(Write + RMW)))
        or
      // total mo on SC fences
      (w1 + w2 in kind.FenceSC)
    }
  }
}

// HB and MO do not contradict one another
pred HBvsMO [ dom : set Action, kind : Action -> Kind,
              loc : Action -> Loc, wv, rv : Action -> Val,
              hb, sb, mo, rf : Action -> Action ] {
  no hb & ~mo
}

// // Stronger version of this axiom: rule out cycles, not loops
// pred HBMOacyc [ e : Execution ] {
//   no iden & ^(e.hb + e.mo)
// }

// Reads-from edges for NAs all follow hb
pred RFNonAtomic [ dom : set Action,
                   kind : Action -> Kind,
                   loc : Action -> Loc,
                   wv, rv : Action -> Val,
                   hb, sb, mo, rf : Action -> Action ] {
  let NA_reads = (dom <: loc).NonAtomic & kind.(Read + ReadN) |
     (rf :> NA_reads) in hb
}

// Combine the different predicates into execution validity
pred valid [ dom : set Action,
             kind : Action -> Kind,
             gloc : Action -> Glob,
             lloc1, lloc2: Action -> Thr,
             callmap, retmap : Thr -> Val,
             wv, rv : Action -> Val,
             hb, sb, mo, rf : Action -> Action ] {
  // Sanity conditions
  hb + sb + mo + rf in (dom -> dom)

  // Pre-execution structure
  locWF[dom, kind, gloc, lloc1, lloc2]
  valWF[dom, kind, wv, rv]
  SBwf[dom, kind, sb]

  // Local variable handling
  RFwfLocal[dom, kind, gloc, lloc1, lloc2, callmap, retmap, wv, rv, hb, sb, mo, rf]

  // Axioms
  HBacyc[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  RFwf[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  HBdef[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  CoWR[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  MOwf[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  HBvsMO[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  RFNonAtomic[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
}

// Test whether the execution is DRF
pred DRF [ dom : set Action,
           kind : Action -> Kind,
           loc : Action -> Loc,
           wv, rv : Action -> Val,
           hb, sb, mo, rf : Action -> Action ] {
  all l : NonAtomic |
  all disj w, a : (dom <: loc).l |
    (w in kind.Write)
    and
    (a in kind.(Write + Read + ReadN))
    implies
    (w -> a) in (hb + ~hb)
}

// The execution is sequential, i.e. sb is total
pred sequential [ dom : set Action, sb : Action -> Action ] {
  all disj a1, a2 : dom |   a1 -> a2 in ^sb + ^(~sb)
}

/*************************************************/
/* Tests                                         */
/*************************************************/

// run valid_run
//   { some dom : set Action, kind : Action -> Kind,
//                gloc, lloc : Action -> Loc,
//                callmap, retmap : Thr -> Val,
//                wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action | {
//      valid[dom, kind, gloc, lloc, callmap, retmap, wv, rv, ^hb, sb, mo, rf]
//      dom = Action
//      Loc = dom.(gloc + lloc)
//      is_core[hb]
//      is_core[sb]
//      no Call + Ret
//   }
// } for 6 but exactly 2 Thr, 0 Extern
//
//
// run seq_run
//   { some dom : set Action, kind : Action -> Kind,
//                gloc, lloc : Action -> Loc,
//                callmap, retmap : Thr -> Val,
//                wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action | {
//      valid[dom, kind, gloc, lloc, callmap, retmap, wv, rv, ^hb, sb, mo, rf]
//      dom = Action
//      Loc = dom.(gloc + lloc)
//      is_core[hb]
//      is_core[sb]
//      // check sequential
//      sequential[dom, sb]
//      no Call + Ret
//   }
// } for 6
//

// // Executions with no non-atomics are automatically DRF
// check atomic_DRF
//   { all dom : set Action, kind : Action -> Kind,
//                loc : Action -> Loc, wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action |
//     valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//        implies DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//   }
//   for 30
//   but 0 NonAtomic
//
// // Sequential executions are automatically DRF
// check seq_DRF
//   { all dom : set Action, kind : Action -> Kind,
//               loc : Action -> Loc, wv, rv : Action -> Val,
//               hb, sb, mo, rf : Action -> Action |
//     valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       and sequential[dom, sb]
//     implies DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//   }
//   for 10
//
// run litmus_SB
//   { some dom : set Action, kind : Action -> Kind,
//          loc : Action -> Loc, wv, rv : Action -> Val,
//          hb, sb, mo, rf : Action -> Action | {
//       valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       dom = Action
//       Loc = dom.loc
//       is_core[hb]
//       is_core[sb]
//       // litmus test
//       code_SB[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//     }
//   }
//   for 6
//   but 0 NonAtomic, 2 Val
//
// run litmus_IRIW
//   { some dom : set Action, kind : Action -> Kind,
//          loc : Action -> Loc, wv, rv : Action -> Val,
//          hb, sb, mo, rf : Action -> Action | {
//       valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       dom = Action
//       Loc = dom.loc
//       is_core[hb]
//       is_core[sb]
//       // litmus test
//       code_IRIW[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//     }
//   }
//   for 10
//   but 0 NonAtomic, 2 Val
//
// /*************************************************/
// /* Litmus test code                              */
// /*************************************************/
//
// // SB litmus test without initialisation
// pred code_SB [ dom : set Action, kind : Action -> Kind,
//                loc : Action -> Loc, wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action ] {
//   some disj wx, wy : kind.Write |
//   some disj rx, ry : kind.Read |  {
//     dom = (wx + wy + rx + ry)
//     (wx -> ry) + (wy -> rx) in sb // allow stronger sb
//     one wx.loc + rx.loc
//     one wy.loc + ry.loc
//     no wx.loc & wy.loc
//     no rf // read from initialisation
//   }
// }
//
// // Comment from JPW - alloy simplifies rel = ((a->b) + (c->d)...
// // Refactor this code?
//
// pred code_IRIW [ dom : set Action, kind : Action -> Kind,
//                  loc : Action -> Loc, wv, rv : Action -> Val,
//                  hb, sb, mo, rf : Action -> Action ] {
//   some disj wx, wy : kind.Write |
//   some disj r1x, r2x, r1y, r2y : kind.Read | {
//     dom = wx + wy + r1x + r2x + r1y + r2y
//     rf = ((wx -> r1x) + (wy -> r2y))
//     ((r1x -> r1y) + (r2y -> r2x)) in sb
//     one wx.loc + r1x.loc + r2x.loc
//     one wy.loc + r1y.loc + r2y.loc
//     no wx.loc & wy.loc
//   }
// }
//

module c11Relat
// open util/relation

// TODO: don't have non-atomic actions in this model, just NA locations.

// Disable non-atomics entirely
fact {
  no NonAtomic
}

// Helper predicate: assert there are no transitive edges in a relation
pred is_core [ r : Action -> Action ] {
  all a,b,c: Action |
    (a -> b) + (b -> c) in ^r  implies  not (a -> c) in r
}

// Locations can be local or global
abstract sig Loc {}
sig Glob, Thr extends Loc {}

// Furthermore global locations can be atomic or nonatomic
sig Atomic, NonAtomic in Glob {}
fact {
  Atomic + NonAtomic = Glob
  disj [ Atomic, NonAtomic ]
}

sig Val {}
one sig Init in Val {} // Magic initialisation value

// Actions kinds corresponding to different memory actions
abstract sig Kind {}
one sig Read, ReadN, Write, RMW, AssmEq, FenceSC extends Kind {}

// Actions
abstract sig Action {}
sig Intern, Extern, Call, Ret extends Action {}

// Locations are associated with actions correctly
pred locWF[ dom : set Action,
            kind : Action -> Kind,
            gloc : Action -> Glob,
            lloc1, lloc2 : Intern -> Thr ] {
    kind in (dom - (Call + Ret)) -> one Kind
    no (Call + Ret).kind

    gloc in (dom - (Call + Ret)) -> lone Glob

    // local variables are only recorded for internal actions
    lloc1 in (dom & Intern) -> lone Thr
    lloc2 in (dom & Intern) -> lone Thr

    all a : dom | {
      // All reads, writes, RMW access global locations
      a in kind.(Read + Write + RMW)  iff  one a.gloc

      // Reads and writes access zero or one local variables
      a in kind.(Read + Write) & Intern  implies  {
        one a.lloc1 and one a.lloc2
      }

      // Reads and writes access zero or one local variables
      a in kind.ReadN & Intern  implies  {
        one a.lloc1 and no a.lloc2
      }

      // Assume and RMW access two local variables
      a in kind.(AssmEq + RMW) & Intern  implies  {
        one a.lloc1 and one a.lloc2
      }

      // Fences don't access local variables
      a in kind.FenceSC & Intern implies {
        no a.lloc1 and no a.lloc2
      }
    }
}

// Values are associated with actions correctly
pred valWF[ dom : set Action,
            kind : Action -> Kind,
            wv, rv : Action -> Val ] {
    wv in (dom - (Call + Ret)) -> lone Val
    rv in (dom - (Call + Ret)) -> lone Val

    // Writes have a written value, reads have a read value, RMW have both
    all a : dom - (Call + Ret) | {
      kind[a] in Write iff {
        one a.wv
        no a.rv
      }
      kind[a] in (Read + ReadN) iff {
        one a.rv
        no a.wv
      }
      kind[a] in RMW iff {
        one a.rv
        one a.wv
      }
      // Implicitly, all other actions have no rv / wv
    }
}

// SB is acyclic
pred SBwf [ dom : set Action,
            kind : Action -> Kind,
            sb: Action -> Action ] {
  no iden & ^sb
}

// HB is acyclic
pred HBacyc [ dom : set Action, kind : Action -> Kind,
              loc : Action -> Loc, wv, rv : Action -> Val,
              hb, sb, mo, rf : Action -> Action ] {
  no iden & ^hb
}

// Find the last value written for a given local variable and action
fun lastval [ dom : set Action,
              kind : Action -> Kind,
              lloc : Action -> Loc,
              callmap : Thr -> Val,
              rv : Action -> Val,
              sb : Action -> Action,
              curr : Action,
              currloc : Loc ] : set Val {
  { v : Val |
    some r : dom & kind.Read | {
      r.rv = v
      r -> curr in ^sb
      r.lloc = currloc
      no r' : dom & kind.Read | {
        (r -> r') + (r' -> curr) in ^sb
        r'.lloc = currloc
      }
    }
  }
    +
  { v : Val | {
      v = (currloc).callmap
      (Call -> curr) in ^sb
      no r' : dom & kind.Read | {
        (Call -> r') + (r' -> curr) in ^sb
        r'.lloc = currloc
      }
    }
  }
}

// Write the value given at the call to the same local variable.
// TODO: handle internal RMW
pred RFwfLocal [ dom : set Action,
                kind : Action -> Kind,
                gloc : Action -> Loc,
                lloc1, lloc2 : Action -> Loc,
                callmap, retmap : Thr -> Val,
                wv, rv : Action -> Val,
                hb, sb, mo, rf : Action -> Action ] {
  callmap in Thr -> one Val
  retmap in Thr -> one Val

  // Assumes demand equality on local var values
  all a : dom & kind.AssmEq | {
    lastval[dom, kind, lloc1, callmap, rv, sb, a, a.lloc1] =
      lastval[dom, kind, lloc1, callmap, rv, sb, a, a.lloc2]
  }

  // Writes take the correct local var value
  all w : dom & kind.Write | {
    w.wv = lastval[dom, kind, lloc1, callmap, rv, sb, w, w.lloc1]
  }

  // The retmap takes the correct values.
  all t : Thr | {
    t.retmap = lastval[dom, kind, lloc1, callmap, rv, sb, Ret, t]
  }
}

// RF is well-formed
pred RFwf [ dom : set Action,
            kind : Action -> Kind,
            loc : Action -> Loc,
            wv, rv : Action -> Val,
            hb, sb, mo, rf : Action -> Action ] {
  // Read from at most one write
  rf in kind.(Write + RMW) lone -> kind.(Read + ReadN + RMW)

  // Irreflexive
  no iden & rf

  all r : dom & kind.(Read + ReadN + RMW) | {
    // Read from the same location written
    (rf.r).loc in r.loc

    // Value taken from origin write
    some rf.r implies r.rv = (rf.r).wv // and not r.rval in Init
    no rf.r implies r.rv in Init

    // Allow initialisation reads, but force actions to
    // read from an explicit write if any is hb-available
    // Note MO used here because r might be a RMW
    (some (hb + mo).r & (kind.(Write + RMW) <: loc).(r.loc) )
          implies (some rf.r)
    // TODO: Mark isn't completely convinced
  }
}

// Define hb by combining rf with hb over atomics
pred HBdef [ dom : set Action,
             kind : Action -> Kind,
             loc : Action -> Loc,
             wv, rv : Action -> Val,
             hb, sb, mo, rf : Action -> Action ] {
  // sw (sync-with) is rf projected to atomic locations
  let aact = dom & loc.Atomic,
      sw = rf & (aact -> aact) |

  // sc is mo projected to SC fences
  let fences = dom & (kind.FenceSC),
      sc = mo & (fences -> fences) |

  hb = ^(sw + sb + sc)
}

// Coherence order is respected
// Note: this version of the axiom also covers the AtomRMW rule.
pred CoWR [ dom : set Action, kind : Action -> Kind,
            loc : Action -> Loc, wv, rv : Action -> Val,
            hb, sb, mo, rf : Action -> Action ] {
  all r : dom & kind.(Read + ReadN + RMW), w1 : rf.r |
    not { (w1 -> r) in mo.(hb + mo) }
}

// Modification order is well-formed
pred MOwf [ dom : set Action, kind : Action -> Kind,
            loc : Action -> Loc, wv, rv : Action -> Val,
            hb, sb, mo, rf : Action -> Action ] {
  mo = ^mo     // transitive
  no iden & mo  // irreflexive
  mo in kind.(Write + RMW + FenceSC) -> kind.(Write + RMW + FenceSC)

  all disj w1, w2 : dom | {
    (w1 -> w2) in mo + ~mo iff {
      // per-location total on atomic read / RMWs
      ((w1.loc = w2.loc) and w1 + w2 in (loc.Atomic & kind.(Write + RMW)))
        or
      // total mo on SC fences
      (w1 + w2 in kind.FenceSC)
    }
  }
}

// HB and MO do not contradict one another
pred HBvsMO [ dom : set Action, kind : Action -> Kind,
              loc : Action -> Loc, wv, rv : Action -> Val,
              hb, sb, mo, rf : Action -> Action ] {
  no hb & ~mo
}

// // Stronger version of this axiom: rule out cycles, not loops
// pred HBMOacyc [ e : Execution ] {
//   no iden & ^(e.hb + e.mo)
// }

// Reads-from edges for NAs all follow hb
pred RFNonAtomic [ dom : set Action,
                   kind : Action -> Kind,
                   loc : Action -> Loc,
                   wv, rv : Action -> Val,
                   hb, sb, mo, rf : Action -> Action ] {
  let NA_reads = (dom <: loc).NonAtomic & kind.(Read + ReadN) |
     (rf :> NA_reads) in hb
}

// Combine the different predicates into execution validity
pred valid [ dom : set Action,
             kind : Action -> Kind,
             gloc : Action -> Glob,
             lloc1, lloc2: Action -> Thr,
             callmap, retmap : Thr -> Val,
             wv, rv : Action -> Val,
             hb, sb, mo, rf : Action -> Action ] {
  // Sanity conditions
  hb + sb + mo + rf in (dom -> dom)

  // Pre-execution structure
  locWF[dom, kind, gloc, lloc1, lloc2]
  valWF[dom, kind, wv, rv]
  SBwf[dom, kind, sb]

  // Local variable handling
  RFwfLocal[dom, kind, gloc, lloc1, lloc2, callmap, retmap, wv, rv, hb, sb, mo, rf]

  // Axioms
  HBacyc[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  RFwf[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  HBdef[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  CoWR[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  MOwf[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  HBvsMO[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
  RFNonAtomic[dom, kind, gloc, wv, rv, hb, sb, mo, rf]
}

// Test whether the execution is DRF
pred DRF [ dom : set Action,
           kind : Action -> Kind,
           loc : Action -> Loc,
           wv, rv : Action -> Val,
           hb, sb, mo, rf : Action -> Action ] {
  all l : NonAtomic |
  all disj w, a : (dom <: loc).l |
    (w in kind.Write)
    and
    (a in kind.(Write + Read + ReadN))
    implies
    (w -> a) in (hb + ~hb)
}

// The execution is sequential, i.e. sb is total
pred sequential [ dom : set Action, sb : Action -> Action ] {
  all disj a1, a2 : dom |   a1 -> a2 in ^sb + ^(~sb)
}

/*************************************************/
/* Tests                                         */
/*************************************************/

// run valid_run
//   { some dom : set Action, kind : Action -> Kind,
//                gloc, lloc : Action -> Loc,
//                callmap, retmap : Thr -> Val,
//                wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action | {
//      valid[dom, kind, gloc, lloc, callmap, retmap, wv, rv, ^hb, sb, mo, rf]
//      dom = Action
//      Loc = dom.(gloc + lloc)
//      is_core[hb]
//      is_core[sb]
//      no Call + Ret
//   }
// } for 6 but exactly 2 Thr, 0 Extern
//
//
// run seq_run
//   { some dom : set Action, kind : Action -> Kind,
//                gloc, lloc : Action -> Loc,
//                callmap, retmap : Thr -> Val,
//                wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action | {
//      valid[dom, kind, gloc, lloc, callmap, retmap, wv, rv, ^hb, sb, mo, rf]
//      dom = Action
//      Loc = dom.(gloc + lloc)
//      is_core[hb]
//      is_core[sb]
//      // check sequential
//      sequential[dom, sb]
//      no Call + Ret
//   }
// } for 6
//

// // Executions with no non-atomics are automatically DRF
// check atomic_DRF
//   { all dom : set Action, kind : Action -> Kind,
//                loc : Action -> Loc, wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action |
//     valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//        implies DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//   }
//   for 30
//   but 0 NonAtomic
//
// // Sequential executions are automatically DRF
// check seq_DRF
//   { all dom : set Action, kind : Action -> Kind,
//               loc : Action -> Loc, wv, rv : Action -> Val,
//               hb, sb, mo, rf : Action -> Action |
//     valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       and sequential[dom, sb]
//     implies DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//   }
//   for 10
//
// run litmus_SB
//   { some dom : set Action, kind : Action -> Kind,
//          loc : Action -> Loc, wv, rv : Action -> Val,
//          hb, sb, mo, rf : Action -> Action | {
//       valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       dom = Action
//       Loc = dom.loc
//       is_core[hb]
//       is_core[sb]
//       // litmus test
//       code_SB[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//     }
//   }
//   for 6
//   but 0 NonAtomic, 2 Val
//
// run litmus_IRIW
//   { some dom : set Action, kind : Action -> Kind,
//          loc : Action -> Loc, wv, rv : Action -> Val,
//          hb, sb, mo, rf : Action -> Action | {
//       valid[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       DRF[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//       dom = Action
//       Loc = dom.loc
//       is_core[hb]
//       is_core[sb]
//       // litmus test
//       code_IRIW[dom, kind, loc, wv, rv, ^hb, sb, mo, rf]
//     }
//   }
//   for 10
//   but 0 NonAtomic, 2 Val
//
// /*************************************************/
// /* Litmus test code                              */
// /*************************************************/
//
// // SB litmus test without initialisation
// pred code_SB [ dom : set Action, kind : Action -> Kind,
//                loc : Action -> Loc, wv, rv : Action -> Val,
//                hb, sb, mo, rf : Action -> Action ] {
//   some disj wx, wy : kind.Write |
//   some disj rx, ry : kind.Read |  {
//     dom = (wx + wy + rx + ry)
//     (wx -> ry) + (wy -> rx) in sb // allow stronger sb
//     one wx.loc + rx.loc
//     one wy.loc + ry.loc
//     no wx.loc & wy.loc
//     no rf // read from initialisation
//   }
// }
//
// // Comment from JPW - alloy simplifies rel = ((a->b) + (c->d)...
// // Refactor this code?
//
// pred code_IRIW [ dom : set Action, kind : Action -> Kind,
//                  loc : Action -> Loc, wv, rv : Action -> Val,
//                  hb, sb, mo, rf : Action -> Action ] {
//   some disj wx, wy : kind.Write |
//   some disj r1x, r2x, r1y, r2y : kind.Read | {
//     dom = wx + wy + r1x + r2x + r1y + r2y
//     rf = ((wx -> r1x) + (wy -> r2y))
//     ((r1x -> r1y) + (r2y -> r2x)) in sb
//     one wx.loc + r1x.loc + r2x.loc
//     one wy.loc + r1y.loc + r2y.loc
//     no wx.loc & wy.loc
//   }
// }
//


Incomplete - task : Extend unit tests for complete coverage - reinforced definition of surpluses and quota

-- (c) 2010-2011, Dermot Cochran, IT University of Copenhagen
-- http://www.kindsoftware.com/about/people/dc
-- http://www.itu.dk/people/dero

module Voting

open util/integer

-- An individual person standing for election
sig Candidate {
    votes: 			  set Ballot, 	-- First preference ballots assigned to this candidate
	transfers: 	      set Ballot,   -- Ballots received by transfer from another candidate
	surplus: 		  set Ballot, 	-- Ballots given to another candidate (on election or elimination)
	outcome: 		  Event
} {
	no b: Ballot | b in votes & transfers
	all b: Ballot | b in votes + transfers implies this in b.assignees
	surplus in votes + transfers
	Election.method = Plurality implies #surplus = 0 and #transfers = 0
}

-- A digital or paper artifact which accurately records the intentions of the voter
sig Ballot {
  assignees: 		set Candidate,  -- Candidates to which this ballot has been assigned
  preferences: 	seq Candidate  -- Ranking of candidates
} {
	assignees in preferences.elems
    not preferences.hasDups
	preferences.elems in Election.candidates
	preferences.first in assignees
	Election.method = Plurality implies #preferences = 1
    0 < #preferences
}

-- An election result
one sig Scenario {
   	losers: 				set Candidate,
   	winners: 			set Candidate,
	eliminated: 		set Candidate, 		-- Candidates excluded under STV rules
	threshold: 		Int, 						-- Minimum number of votes for a Loser or EarlyLoser
	quota: 				Int						-- Minimum number of votes for a STV Winner or QuotaWinner
}
{
 	winners + losers = Election.candidates
 	#winners = Election.seats
 	no c: Candidate | c in losers & winners
 	0 < #losers
 	all w: Candidate | all l: Candidate | l in losers and w in winners implies
		((#l.votes + #l.transfers <= #w.votes + #w.transfers) and (#l.votes <= #w.votes))
	0 <= threshold
	threshold <= quota
    Election.method = STV implies (threshold = 1 + quota.div[4])
	Election.method = Plurality implies #eliminated = 0
	eliminated in losers
	all c: Candidate | c in losers implies Election.method = Plurality
       or #c.votes + #c.transfers < quota
}

/*
	There are four winner-outcomes and six loser-outcomes:

	Winner: 						(W1) elected in the first round of counting either by quota or plurality,
	QuotaWinner: 				(W2) elected with transfers from another candidate (STV only),
	CompromiseWinner: 	(W3) elected on the last round of counting without quota (STV only),
	TiedWinner:					(W4) elected by tie breaker,
	TiedLoser:					(L1) loses only by tie breaker but reaches the threshold,
	Loser:			 				(L2) defeated on last round but reaches the minimum threshold of votes,
    TiedEarlyLoser:			(L3) reaches threshold but eliminated by tie breaker (STV only),
	EarlyLoser:					(L4) reaches threshold but is eliminated before last round (STV only),
	TiedSoreLoser:				(L5) loses only by tie breaker but does not reach threshold,
	SoreLoser: 					(L6) does not even reach the mimimum threshold of votes
*/
enum Event {Winner, QuotaWinner, CompromiseWinner, TiedWinner,
	TiedLoser, Loser, TiedEarlyLoser, EarlyLoser, TiedSoreLoser, SoreLoser}

enum Method {Plurality, STV}

-- An Election Constituency
one sig Election {
  candidates: 	set Candidate,
  seats: 				Int,
  method: 			Method,
  ballots:			Int -- number of ballots cast
}
{
 	0 < seats
 	seats < #candidates
 	all c: Candidate | c in candidates
    ballots = #Ballot
    Scenario.quota = 1 + ballots.div[seats+1]
}

-- Independent (or Fundamental) Axioms
fact threshold {
   Election.method = Plurality implies Scenario.threshold = Election.ballots.div[20]
}

fact surplus {
  all c: Candidate | c.outcome = Winner implies
     ((#c.surplus <= #c.votes - Scenario.quota) and (#transfers = 0))
}

fact surplusFromTransfers {
  all c: Candidate | c.outcome = QuotaWinner implies ((surplus in transfers) and
     (#c.surplus <= #c.transfers) and (#c.surplus <= (#c.votes + #c.transfers - Scenario.quota)))
}

fact integrity {
  all c: Candidate | all b: Ballot | b in c.votes implies c in b.assignees
}

fact pluralityEvents {
	all c: Candidate | Election.method = Plurality implies
		(c.outcome = Loser or c.outcome = SoreLoser or c.outcome = Winner or
		c.outcome = TiedWinner or c.outcome = TiedLoser)
}

fact winnerSTV {
	all c: Candidate | Election.method = STV implies (
		c.outcome = Winner iff Scenario.quota <= #c.votes)
}

fact transferWinner {
	all c: Candidate | c.outcome = QuotaWinner iff
		(not Scenario.quota <= #c.votes and Scenario.quota <= #c.votes + #c.transfers)
}

fact closeWinner {
	all c: Candidate | (c.outcome = CompromiseWinner or c.outcome = TiedWinner) iff
		(c in Scenario.winners and not Scenario.quota <= #c.votes + #c.transfers)
}

fact soreLoser {
	all c: Candidate | (c.outcome = SoreLoser or c.outcome = TiedSoreLoser) iff
		((#c.votes + #c.transfers < Scenario.threshold) and not c in Scenario.winners)
}

fact loser {
	all c: Candidate | (c.outcome = Loser or c.outcome = TiedLoser or c.outcome = TiedSoreLoser) iff
		c in Scenario.losers - Scenario.eliminated
}

fact earlyLoser {
	all c: Candidate | (c.outcome = EarlyLoser or c.outcome = TiedEarlyLoser) iff
		(c in Scenario.losers & Scenario.eliminated and not #c.votes + #c.transfers < Scenario.threshold)
}

fact winners {
	all c: Candidate | c in Scenario.winners iff
		(c.outcome = Winner or c.outcome = QuotaWinner or c.outcome = CompromiseWinner or
		c.outcome = TiedWinner)
}

fact losers {
	all c: Candidate | c in Scenario.losers iff
		(c.outcome = Loser or c.outcome = EarlyLoser or c.outcome = SoreLoser or
		c.outcome = TiedLoser or c.outcome = TiedEarlyLoser or c.outcome = TiedSoreLoser)
}

-- Non-Independent Axioms for Ballot Integrity
fact transfers {
	all c: Candidate | 0 < #c.transfers implies Election.method = STV
}

fact onlyWinnersAndQuotaWinnersHaveSurplus {
	all c: Candidate | 0 < #c.surplus implies
		c.outcome = Winner or c.outcome = QuotaWinner
}

fact winnersNeedNoTransfers {
		all c: Candidate | c.outcome = Winner implies 0 = #c.transfers
}

fact firstPreference {
	all b: Ballot | all c: Candidate | b.preferences.first = c iff b in c.votes
}

fact sizeOfSurplus {
	all c: Candidate | (c in Scenario.winners and Election.method = STV and 0 < #c.surplus) implies
		#c.surplus = #c.votes + #c.transfers - Scenario.quota
}

fact transferToNextPreference {
	all b: Ballot | all disj donor,receiver: Candidate |
		(donor + receiver in b.assignees and
		b in receiver.transfers and b in donor.surplus implies
		b.preferences.idxOf[donor] < b.preferences.idxOf[receiver] and
		receiver in b.preferences.rest.elems)
}

fact pluralityWinner {
	all disj a, b: Candidate | (Election.method = Plurality and Election.seats = 1) and
		a.outcome = Winner implies #b.votes <= #a.votes
}

fact transferToNextContinuingCandidate {
	all disj skipped, receiving: Candidate | all b: Ballot |
		b.preferences.idxOf[skipped] < b.preferences.idxOf[receiving] and
		receiving in b.assignees and (not skipped in b.assignees) implies
		(skipped in Scenario.eliminated or skipped.outcome = Winner or
		skipped.outcome = QuotaWinner)
}

// All ballots transfers are associated with the last candidate to receive the transfer
fact ownership {
	all disj c,d: Candidate | all b: Ballot | b in c.transfers implies c in b.assignees and
		(d not in b.assignees or b.preferences.idxOf[d] < b.preferences.idxOf[c])
}

// Lowest candidate is eliminated first
fact lowestElimination {
	all disj c,d: Candidate | c in Scenario.eliminated and d not in Scenario.eliminated implies
		#c.votes + #c.transfers <= #d.votes + #d.transfers
}

// All ties involve equality between at least one winner and at least one loser on either original votes or
// on transfers plus original votes
fact equalityOfTiedWinner {
   all w: Candidate | some l: Candidate | w.outcome = TiedWinner and
	 	(l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome = TiedEarlyLoser) implies
		(#l.votes = #w.votes) or (#l.votes + #l.transfers = #w.votes + #w.transfers)
}

fact equalityOfTiedLosers {
  all s: Candidate | some w: Candidate | w.outcome = TiedWinner and
       (s.outcome = SoreLoser or s.outcome = TiedLoser or s.outcome = TiedEarlyLoser) implies
       (#s.votes = #w.votes) or (#s.votes + #s.transfers = #w.votes + #w.transfers)
}

-- Scenario Validity Axioms
// When there is a tied sore loser then there are no non-sore losers
fact typeOfTiedLoser {
   no disj a,b: Candidate | a.outcome = TiedSoreLoser and
        (b.outcome = TiedLoser or b.outcome = TiedEarlyLoser or
         b.outcome=Loser or b.outcome=EarlyLoser)
}

fact tieBreaker {
	all w: Candidate | some l: Candidate | w.outcome = TiedWinner implies
		(l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome = TiedEarlyLoser)
}

fact validTieBreaker {
	all l: Candidate | some w: Candidate |
    (l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome = TiedEarlyLoser) implies
    w.outcome = TiedWinner and 0 < #w.votes + #w.transfers
}

// Compromise winner must have more votes than any tied winners
fact compromiseNotTied {
	all disj c,t: Candidate | (c.outcome = CompromiseWinner and t.outcome = TiedWinner) implies
		#t.votes + #t.transfers < #c.votes + #c.transfers
}

// Equal losers are tied
fact equalityofTiedWinnersAndLosers {
	all disj w,l: Candidate | w in Scenario.winners and l in Scenario.losers and
		#w.votes = #l.votes and #w.transfers = #l.transfers implies
			w.outcome = TiedWinner and 0 < #w.votes + #w.transfers and
			(l.outcome = TiedLoser or l.outcome = TiedEarlyLoser or l.outcome = TiedSoreLoser)
}

// Highest winner has a quota
fact highestWinners {
   all c: Candidate | Election.method = STV and c.outcome = Winner implies
		Scenario.quota <= #c.votes + #c.transfers
}

// Tied Winners and Tied Losers have an equal number of votes
fact equalTies {
	all disj a,b: Candidate | a.outcome = TiedWinner and b.outcome = TiedLoser implies
		#a.votes = #b.votes and #a.transfers = #b.transfers
}

// Winners have more votes than non-tied losers
fact winnersHaveVotes {
	all w,l: Candidate | w.outcome = Winner and
      (l.outcome = Loser or l.outcome = EarlyLoser or l.outcome = SoreLoser) implies
     ((#l.votes < #w.votes) or (#l.votes + #l.transfers < #w.votes + #w.transfers))
}

-- Basic Lemmas
assert honestCount {
	  all c: Candidate | all b: Ballot | b in c.votes + c.transfers implies c in b.assignees
}
check honestCount for 15 but 6 int

assert atLeastOneLoser {
	0 < #Scenario.losers
}
check atLeastOneLoser for 15 but 6 int

assert atLeastOneWinner {
	0 < #Scenario.winners
}
check atLeastOneWinner for 14 but 6 int

assert plurality {
	all c: Candidate | all b: Ballot | b in c.votes and
		Election.method = Plurality implies c in b.preferences.first
}
check plurality for 18 but 6 int

assert wellFormedTieBreaker {
	some w,l : Candidate | (w in Scenario.winners and l in Scenario.losers and
		#w.votes = #l.votes and #w.transfers = #l.transfers) implies
		w.outcome = TiedWinner and
		(l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome=TiedEarlyLoser)
}
check wellFormedTieBreaker for 18 but 6 int

assert validSurplus {
	all c: Candidate | 0 < #c.surplus implies (c.outcome = Winner or c.outcome = QuotaWinner or
		c in Scenario.eliminated)
}
check validSurplus for 16 but 6 int

-- Advanced Lemmas
// No lost votes during counting
assert accounting {
	all b: Ballot | some c: Candidate | b in c.votes and c in b.assignees
}
check accounting for 16 but 6 int

// Cannot have tie breaker with both tied sore loser and non-sore loser
assert tiedWinnerLoserTiedSoreLoser {
	no disj c,w,l: Candidate | c.outcome = TiedSoreLoser and
	   w.outcome = TiedWinner and (l.outcome = Loser or l.outcome = TiedLoser)
}
check tiedWinnerLoserTiedSoreLoser for 6 int

// Compromise winner must have at least one vote
assert validCompromise {
	all c: Candidate | c.outcome = CompromiseWinner implies 0 < #c.votes + #c.transfers
}
check validCompromise for 6 int

// Quota not more than the number of ballots cast
assert maxQuota {
  Scenario.quota < Election.ballots
}
check maxQuota for 7 int

-- Sample scenarios
pred TwoCandidatePlurality {
	Election.method = Plurality
	Election.seats = 1
	#Election.candidates = 2
}
run TwoCandidatePlurality for 10 but 1 Ballot, 6 int

pred PluralityTiedWinner {
	Election.method = Plurality
	Election.seats = 1
	some disj a,b: Candidate | a.outcome = TiedWinner and b.outcome = TiedLoser
}
run PluralityTiedWinner for 10 but 2 Ballot, 6 int

pred ThreeCandidatePlurality {
	Election.method = Plurality
	Election.seats = 1
	#Election.candidates = 3
}
run ThreeCandidatePlurality for 6 int

pred Plurality {
	Election.method = Plurality
	Election.seats = 1
	3 < #Election.candidates
}
run Plurality for 5 but 6 int

pred TenCandidatePluralityWithTwoSeats {
	Election.method = Plurality
	Election.seats = 2
	#Election.candidates = 10
}
run TenCandidatePluralityWithTwoSeats for 10 but 6 int

pred InstantRunoffVoting {
	Election.method = STV
	Election.seats = 1
	3 < #Election.candidates
}
run InstantRunoffVoting for 10 but 6 int

pred STV3 {
	Election.method = STV
	Election.seats = 3
}
run STV3 for 5 but 6 int

pred ThreeWinnersOneLoser {
    Election.method = STV
	some disj a,b,d: Candidate | a.outcome = Winner
   	  and b.outcome = QuotaWinner or b.outcome = CompromiseWinner
	  and d in Scenario.losers
}
run ThreeWinnersOneLoser for 6 but 6 int

pred LoserAndEarlyLoser {
	one d: Candidate | d.outcome = Loser
	one e: Candidate | e.outcome = EarlyLoser
}
run LoserAndEarlyLoser for 5 but 6 int

pred OneWinnerNineLosers {
	#Scenario.winners = 1
	#Scenario.losers = 9
}
run OneWinnerNineLosers for 16 but 6 int

pred ThreeWayTie {
	#Election.candidates = 3
    Election.method = Plurality
	some disj a,b,c: Candidate | a.outcome = TiedWinner and
		b.outcome = TiedLoser and
		c.outcome = TiedLoser
}
run ThreeWayTie for 5 but 6 int

pred FiveWayTie {
	some disj a,b,c,d,e: Candidate | a.outcome = TiedWinner and
	    b.outcome = TiedLoser and
		c.outcome = TiedLoser and d.outcome = TiedLoser and e.outcome = TiedWinner
}
run FiveWayTie for 7 but 6 int

pred ScenarioLWW {
	some disj a,b,c: Candidate | a.outcome = Loser and b.outcome = Winner and
		c.outcome = Winner
    #Election.candidates = 3
	Election.method = STV
    0 < #Ballot
}
run ScenarioLWW for 7 but 7 int

pred LongBallot {
	some b: Ballot | #b.preferences = 7
}
run LongBallot for 7 but 6 int

pred MultipleBallotsUnderSTV {
	Election.method = STV
	some disj a,b,c,d: Ballot | 1 < #a.preferences and 1 < #b.preferences
	and 0 < #c.preferences and 0 < #d.preferences and
        a.preferences.first = b.preferences.last
}
run MultipleBallotsUnderSTV for 10 but 6 int

pred WinnerLoserEarlyLoser {
	some a,b,c,d : Candidate | a.outcome = Winner and b.outcome = Loser and
		c.outcome = EarlyLoser and d.outcome = SoreLoser
	Election.method = STV
}
run WinnerLoserEarlyLoser for 7 but 6 int

pred TiedScenario {
  some disj a,b: Candidate | a.outcome = TiedLoser and b.outcome = TiedWinner
     Election.method = STV
     #Election.candidates = 2
     #Election.seats = 1
}
run TiedScenario for 7 but 6 int

pred NoTiesAndNoSoresScenarios {
  Election.method = STV
  #Election.candidates > 3
  #Ballot > 6
  no c: Candidate | c.outcome = TiedLoser or c.outcome = TiedWinner or
    c.outcome = TiedEarlyLoser or c.outcome = TiedSoreLoser or c.outcome = SoreLoser
}
run NoTiesAndNoSoresScenarios for 10 but 6 int

-- Unit Tests
pred UnitTest {
  some disj c0,c1: Candidate | c0.outcome = Winner and c1.outcome = Loser and
	Election.method = STV and #Election.candidates = 2 and #Election.seats = 1
}
run UnitTest for 10 but 6 int

pred LQQW {
	some disj a,b,c,d: Candidate | a.outcome = Loser and b.outcome = QuotaWinner and
		c.outcome = Winner and d.outcome = QuotaWinner
    #Election.candidates = 4
	Election.method = STV
    0 < #Ballot
}
run LQQW for 16 but 7 int

-- Version Control for changes to signatures and axioms, excluding lemmas and tests
one sig Version {
   year, month, day : Int
} {
  year = 11
  month = 01
  day = 13
  -- Dermot Cochran 2011-01-13
}

-- (c) 2010-2011, Dermot Cochran, IT University of Copenhagen
-- http://www.kindsoftware.com/about/people/dc
-- http://www.itu.dk/people/dero

module Voting

open util/integer

-- An individual person standing for election
sig Candidate {
    votes: 			  set Ballot, 	-- First preference ballots assigned to this candidate
	transfers: 	      set Ballot,   -- Ballots received by transfer from another candidate
	surplus: 		  set Ballot, 	-- Ballots given to another candidate (on election or elimination)
	outcome: 		  Event
} {
	no b: Ballot | b in votes & transfers
	all b: Ballot | b in votes + transfers implies this in b.assignees
	surplus in votes + transfers
    #surplus < #transfers implies surplus in transfers -- surpluses are taken first from transfers
	Election.method = Plurality implies #surplus = 0 and #transfers = 0
}

-- A digital or paper artifact which accurately records the intentions of the voter
sig Ballot {
  assignees: 		set Candidate,  -- Candidates to which this ballot has been assigned
  preferences: 	seq Candidate  -- Ranking of candidates
} {
	assignees in preferences.elems
    not preferences.hasDups
	preferences.elems in Election.candidates
	preferences.first in assignees
	Election.method = Plurality implies #preferences = 1
    0 < #preferences
}

-- An election result
one sig Scenario {
   	losers: 				set Candidate,
   	winners: 			set Candidate,
	eliminated: 		set Candidate, 		-- Candidates excluded under STV rules
	threshold: 		Int, 						-- Minimum number of votes for a Loser or EarlyLoser
	quota: 				Int						-- Minimum number of votes for a STV Winner or QuotaWinner
}
{
 	winners + losers = Election.candidates
 	#winners = Election.seats
 	no c: Candidate | c in losers & winners
 	0 < #losers
 	all w: Candidate | all l: Candidate | l in losers and w in winners implies
		#l.votes + #l.transfers <= #w.votes + #w.transfers
	0 <= threshold
	threshold <= quota
    Election.method = STV implies (threshold = 1 + quota.div[4])
	Election.method = Plurality implies #eliminated = 0
	eliminated in losers
	all c: Candidate | c in losers implies Election.method = Plurality
       or #c.votes + #c.transfers < quota
}

/*
	There are four winner-outcomes and six loser-outcomes:

	Winner: 						(W1) elected in the first round of counting either by quota or plurality,
	QuotaWinner: 				(W2) elected with transfers from another candidate (STV only),
	CompromiseWinner: 	(W3) elected on the last round of counting without quota (STV only),
	TiedWinner:					(W4) elected by tie breaker,
	TiedLoser:					(L1) loses only by tie breaker but reaches the threshold,
	Loser:			 				(L2) defeated on last round but reaches the minimum threshold of votes,
    TiedEarlyLoser:			(L3) reaches threshold but eliminated by tie breaker (STV only),
	EarlyLoser:					(L4) reaches threshold but is eliminated before last round (STV only),
	TiedSoreLoser:				(L5) loses only by tie breaker but does not reach threshold,
	SoreLoser: 					(L6) does not even reach the mimimum threshold of votes
*/
enum Event {Winner, QuotaWinner, CompromiseWinner, TiedWinner,
	TiedLoser, Loser, TiedEarlyLoser, EarlyLoser, TiedSoreLoser, SoreLoser}

enum Method {Plurality, STV}

-- An Election Constituency
one sig Election {
  candidates: 	set Candidate,
  seats: 				Int,
  method: 			Method,
  ballots:			Int -- number of ballots cast
}
{
 	0 < seats
 	seats < #candidates
 	all c: Candidate | c in candidates
    ballots = #Ballot
    Scenario.quota = 1 + ballots.div[seats+1]
}

-- Independent (or Fundamental) Axioms
fact threshold {
   Election.method = Plurality implies Scenario.threshold = Election.ballots.div[20]
}

fact integrity {
  all c: Candidate | all b: Ballot | b in c.votes implies c in b.assignees
}

fact pluralityEvents {
	all c: Candidate | Election.method = Plurality implies
		(c.outcome = Loser or c.outcome = SoreLoser or c.outcome = Winner or
		c.outcome = TiedWinner or c.outcome = TiedLoser)
}

fact winnerSTV {
	all c: Candidate | Election.method = STV implies (
		c.outcome = Winner iff Scenario.quota <= #c.votes)
}

fact transferWinner {
	all c: Candidate | c.outcome = QuotaWinner iff
		(not Scenario.quota <= #c.votes and Scenario.quota <= #c.votes + #c.transfers)
}

fact closeWinner {
	all c: Candidate | (c.outcome = CompromiseWinner or c.outcome = TiedWinner) iff
		(c in Scenario.winners and not Scenario.quota <= #c.votes + #c.transfers)
}

fact soreLoser {
	all c: Candidate | (c.outcome = SoreLoser or c.outcome = TiedSoreLoser) iff
		((#c.votes + #c.transfers < Scenario.threshold) and not c in Scenario.winners)
}

fact loser {
	all c: Candidate | (c.outcome = Loser or c.outcome = TiedLoser or c.outcome = TiedSoreLoser) iff
		c in Scenario.losers - Scenario.eliminated
}

fact earlyLoser {
	all c: Candidate | (c.outcome = EarlyLoser or c.outcome = TiedEarlyLoser) iff
		(c in Scenario.losers & Scenario.eliminated and not #c.votes + #c.transfers < Scenario.threshold)
}

fact winners {
	all c: Candidate | c in Scenario.winners iff
		(c.outcome = Winner or c.outcome = QuotaWinner or c.outcome = CompromiseWinner or
		c.outcome = TiedWinner)
}

fact losers {
	all c: Candidate | c in Scenario.losers iff
		(c.outcome = Loser or c.outcome = EarlyLoser or c.outcome = SoreLoser or
		c.outcome = TiedLoser or c.outcome = TiedEarlyLoser or c.outcome = TiedSoreLoser)
}

-- Non-Independent Axioms for Ballot Integrity
fact transfers {
	all c: Candidate | 0 < #c.transfers implies Election.method = STV
}

fact onlyWinnersAndQuotaWinnersHaveSurplus {
	all c: Candidate | 0 < #c.surplus implies
		c.outcome = Winner or c.outcome = QuotaWinner
}

fact winnersNeedNoTransfers {
		all c: Candidate | c.outcome = Winner implies 0 = #c.transfers
}

fact firstPreference {
	all b: Ballot | all c: Candidate | b.preferences.first = c iff b in c.votes
}

fact sizeOfSurplus {
	all c: Candidate | (c in Scenario.winners and Election.method = STV and 0 < #c.surplus) implies
		#c.surplus = #c.votes + #c.transfers - Scenario.quota
}

fact transferToNextPreference {
	all b: Ballot | all disj donor,receiver: Candidate |
		(donor + receiver in b.assignees and
		b in receiver.transfers and b in donor.surplus implies
		b.preferences.idxOf[donor] < b.preferences.idxOf[receiver] and
		receiver in b.preferences.rest.elems)
}

fact pluralityWinner {
	all disj a, b: Candidate | (Election.method = Plurality and Election.seats = 1) and
		a.outcome = Winner implies #b.votes <= #a.votes
}

fact transferToNextContinuingCandidate {
	all disj skipped, receiving: Candidate | all b: Ballot |
		b.preferences.idxOf[skipped] < b.preferences.idxOf[receiving] and
		receiving in b.assignees and (not skipped in b.assignees) implies
		(skipped in Scenario.eliminated or skipped.outcome = Winner or
		skipped.outcome = QuotaWinner)
}

// All ballots transfers are associated with the last candidate to receive the transfer
fact ownership {
	all disj c,d: Candidate | all b: Ballot | b in c.transfers implies c in b.assignees and
		(d not in b.assignees or b.preferences.idxOf[d] < b.preferences.idxOf[c])
}

// Lowest candidate is eliminated first
fact lowestElimination {
	all disj c,d: Candidate | c in Scenario.eliminated and d not in Scenario.eliminated implies
		#c.votes + #c.transfers <= #d.votes + #d.transfers
}

// All ties involve equality between at least one winner and at least one loser on either original votes or
// on transfers plus original votes
fact equalityOfTiedWinner {
   all w: Candidate | some l: Candidate | w.outcome = TiedWinner and
	 	(l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome = TiedEarlyLoser) implies
		(#l.votes = #w.votes) or (#l.votes + #l.transfers = #w.votes + #w.transfers)
}

fact equalityOfTiedLosers {
  all s: Candidate | some w: Candidate | w.outcome = TiedWinner and
       (s.outcome = SoreLoser or s.outcome = TiedLoser or s.outcome = TiedEarlyLoser) implies
       (#s.votes = #w.votes) or (#s.votes + #s.transfers = #w.votes + #w.transfers)
}

-- Scenario Validity Axioms
// When there is a tied sore loser then there are no non-sore losers
fact typeOfTiedLoser {
   no disj a,b: Candidate | a.outcome = TiedSoreLoser and
        (b.outcome = TiedLoser or b.outcome = TiedEarlyLoser or
         b.outcome=Loser or b.outcome=EarlyLoser)
}

fact tieBreaker {
	all w: Candidate | some l: Candidate | w.outcome = TiedWinner implies
		(l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome = TiedEarlyLoser)
}

fact validTieBreaker {
	all l: Candidate | some w: Candidate |
    (l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome = TiedEarlyLoser) implies
    w.outcome = TiedWinner and 0 < #w.votes + #w.transfers
}

// Compromise winner must have more votes than any tied winners
fact compromiseNotTied {
	all disj c,t: Candidate | (c.outcome = CompromiseWinner and t.outcome = TiedWinner) implies
		#t.votes + #t.transfers < #c.votes + #c.transfers
}

// Equal losers are tied
fact equalityofTiedWinnersAndLosers {
	all disj w,l: Candidate | w in Scenario.winners and l in Scenario.losers and
		#w.votes = #l.votes and #w.transfers = #l.transfers implies
			w.outcome = TiedWinner and 0 < #w.votes + #w.transfers and
			(l.outcome = TiedLoser or l.outcome = TiedEarlyLoser or l.outcome = TiedSoreLoser)
}

// Highest winner has a quota
fact highestWinners {
   all c: Candidate | Election.method = STV and c.outcome = Winner implies
		Scenario.quota <= #c.votes + #c.transfers
}

// Tied Winners and Tied Losers have an equal number of votes
fact equalTies {
	all disj a,b: Candidate | a.outcome = TiedWinner and b.outcome = TiedLoser implies
		#a.votes = #b.votes and #a.transfers = #b.transfers
}

// Winners have more votes than non-tied losers
fact winnersHaveVotes {
	all w,l: Candidate | w.outcome = Winner and
      (l.outcome = Loser or l.outcome = EarlyLoser or l.outcome = SoreLoser) implies
     ((#l.votes < #w.votes) or (#l.votes + #l.transfers < #w.votes + #w.transfers))
}

-- Basic Lemmas
assert honestCount {
	  all c: Candidate | all b: Ballot | b in c.votes + c.transfers implies c in b.assignees
}
check honestCount for 15 but 6 int

assert atLeastOneLoser {
	0 < #Scenario.losers
}
check atLeastOneLoser for 15 but 6 int

assert atLeastOneWinner {
	0 < #Scenario.winners
}
check atLeastOneWinner for 14 but 6 int

assert plurality {
	all c: Candidate | all b: Ballot | b in c.votes and
		Election.method = Plurality implies c in b.preferences.first
}
check plurality for 18 but 6 int

assert wellFormedTieBreaker {
	some w,l : Candidate | (w in Scenario.winners and l in Scenario.losers and
		#w.votes = #l.votes and #w.transfers = #l.transfers) implies
		w.outcome = TiedWinner and
		(l.outcome = TiedLoser or l.outcome = TiedSoreLoser or l.outcome=TiedEarlyLoser)
}
check wellFormedTieBreaker for 18 but 6 int

assert validSurplus {
	all c: Candidate | 0 < #c.surplus implies (c.outcome = Winner or c.outcome = QuotaWinner or
		c in Scenario.eliminated)
}
check validSurplus for 16 but 6 int

-- Advanced Lemmas
// No lost votes during counting
assert accounting {
	all b: Ballot | some c: Candidate | b in c.votes and c in b.assignees
}
check accounting for 16 but 6 int

// Cannot have tie breaker with both tied sore loser and non-sore loser
assert tiedWinnerLoserTiedSoreLoser {
	no disj c,w,l: Candidate | c.outcome = TiedSoreLoser and
	   w.outcome = TiedWinner and (l.outcome = Loser or l.outcome = TiedLoser)
}
check tiedWinnerLoserTiedSoreLoser for 6 int

// Compromise winner must have at least one vote
assert validCompromise {
	all c: Candidate | c.outcome = CompromiseWinner implies 0 < #c.votes + #c.transfers
}
check validCompromise for 6 int

// Quota not more than the number of ballots cast
assert maxQuota {
  Scenario.quota < Election.ballots
}
check maxQuota for 7 int

-- Sample scenarios
pred TwoCandidatePlurality {
	Election.method = Plurality
	Election.seats = 1
	#Election.candidates = 2
}
run TwoCandidatePlurality for 10 but 1 Ballot, 6 int

pred PluralityTiedWinner {
	Election.method = Plurality
	Election.seats = 1
	some disj a,b: Candidate | a.outcome = TiedWinner and b.outcome = TiedLoser
}
run PluralityTiedWinner for 10 but 2 Ballot, 6 int

pred ThreeCandidatePlurality {
	Election.method = Plurality
	Election.seats = 1
	#Election.candidates = 3
}
run ThreeCandidatePlurality for 6 int

pred Plurality {
	Election.method = Plurality
	Election.seats = 1
	3 < #Election.candidates
}
run Plurality for 5 but 6 int

pred TenCandidatePluralityWithTwoSeats {
	Election.method = Plurality
	Election.seats = 2
	#Election.candidates = 10
}
run TenCandidatePluralityWithTwoSeats for 10 but 6 int

pred InstantRunoffVoting {
	Election.method = STV
	Election.seats = 1
	3 < #Election.candidates
}
run InstantRunoffVoting for 10 but 6 int

pred STV3 {
	Election.method = STV
	Election.seats = 3
}
run STV3 for 5 but 6 int

pred ThreeWinnersOneLoser {
    Election.method = STV
	some disj a,b,d: Candidate | a.outcome = Winner
   	  and b.outcome = QuotaWinner or b.outcome = CompromiseWinner
	  and d in Scenario.losers
}
run ThreeWinnersOneLoser for 6 but 6 int

pred LoserAndEarlyLoser {
	one d: Candidate | d.outcome = Loser
	one e: Candidate | e.outcome = EarlyLoser
}
run LoserAndEarlyLoser for 5 but 6 int

pred OneWinnerNineLosers {
	#Scenario.winners = 1
	#Scenario.losers = 9
}
run OneWinnerNineLosers for 16 but 6 int

pred ThreeWayTie {
	#Election.candidates = 3
    Election.method = Plurality
	some disj a,b,c: Candidate | a.outcome = TiedWinner and
		b.outcome = TiedLoser and
		c.outcome = TiedLoser
}
run ThreeWayTie for 5 but 6 int

pred FiveWayTie {
	some disj a,b,c,d,e: Candidate | a.outcome = TiedWinner and
	    b.outcome = TiedLoser and
		c.outcome = TiedLoser and d.outcome = TiedLoser and e.outcome = TiedWinner
}
run FiveWayTie for 7 but 6 int

pred ScenarioLWW {
	some disj a,b,c: Candidate | a.outcome = Loser and b.outcome = Winner and
		c.outcome = Winner
    #Election.candidates = 3
	Election.method = STV
    0 < #Ballot
}
run ScenarioLWW for 7 but 7 int

pred LongBallot {
	some b: Ballot | #b.preferences = 7
}
run LongBallot for 7 but 6 int

pred MultipleBallotsUnderSTV {
	Election.method = STV
	some disj a,b,c,d: Ballot | 1 < #a.preferences and 1 < #b.preferences
	and 0 < #c.preferences and 0 < #d.preferences and
        a.preferences.first = b.preferences.last
}
run MultipleBallotsUnderSTV for 10 but 6 int

pred WinnerLoserEarlyLoser {
	some a,b,c,d : Candidate | a.outcome = Winner and b.outcome = Loser and
		c.outcome = EarlyLoser and d.outcome = SoreLoser
	Election.method = STV
}
run WinnerLoserEarlyLoser for 7 but 6 int

pred TiedScenario {
  some disj a,b: Candidate | a.outcome = TiedLoser and b.outcome = TiedWinner
     Election.method = STV
     #Election.candidates = 2
     #Election.seats = 1
}
run TiedScenario for 7 but 6 int

pred NoTiesAndNoSoresScenarios {
  Election.method = STV
  #Election.candidates > 3
  #Ballot > 6
  no c: Candidate | c.outcome = TiedLoser or c.outcome = TiedWinner or
    c.outcome = TiedEarlyLoser or c.outcome = TiedSoreLoser or c.outcome = SoreLoser
}
run NoTiesAndNoSoresScenarios for 10 but 6 int

-- Unit Tests
pred UnitTest {
  some disj c0,c1: Candidate | c0.outcome = Winner and c1.outcome = Loser and
	Election.method = STV and #Election.candidates = 2 and #Election.seats = 1
}
run UnitTest for 10 but 6 int

pred LQQW {
	some disj a,b,c,d: Candidate | a.outcome = Loser and b.outcome = QuotaWinner and
		c.outcome = Winner and d.outcome = QuotaWinner
    #Election.candidates = 4
	Election.method = STV
    0 < #Ballot
}
run LQQW for 10 but 7 int

-- Version Control for changes to signatures and axioms, exlcuding lemmas and tests
one sig Version {
   year, month, day : Int
} {
  year = 11
  month = 01
  day = 13
  -- Dermot Cochran 2011-01-13
}


Update lecture example

Update lecture example

// A file system object in the file system
// Every object has at most one parent
sig FSObject { parent: lone Dir }

// The set of directories in the file system
sig Dir extends FSObject { contents: set FSObject }

// The set of files in the file system
sig File extends FSObject { }

// There exists a unique root
one sig Root extends Dir { } { no parent }

//All file system objects are either files or directories
fact { File + Dir = FSObject }

// Every directory is the parent of each of  its contents
fact { all d: Dir, o: d.contents | o.parent = d }

// Property asserting a model has at least 3 Dirs and 3 Files
pred ismodel { #Dir>2 && #File>2 }

// Command to find a model of size at most 6
run ismodel for 6

// Comment out the above command to proceed futher

// Uncomment the fact below to implement the axiom that
// every file system object is in the hereditary contents of the root
// fact { all o: FSObject | o in Root.*contents }

// Check to see that file systems are acyclic
assert acyclic { no d: Dir | d in d.^contents }
check acyclic for 8

// This example is developed much further in the on-line Alloy tutorial:
// 	http://alloy.mit.edu/alloy/tutorials/online/

// A file system object in the file system
sig FSObject { parent: lone Dir }

// A directory in the file system
sig Dir extends FSObject { contents: set FSObject }

// A file in the file system
sig File extends FSObject { }

// There exists a root
one sig Root extends Dir { } { no parent }

//All file system objects are either files or directories
fact { File + Dir = FSObject }

// Every directory is the parent of each of  its contents
fact { all d: Dir, o: d.contents | o.parent = d }

// Every file system object is in the hereditary contents of the root
fact { all o: FSObject | o in Root.*contents }

// Existence of a model with 3 Dirs and 3 Files
pred ismodel [] {
	#Dir>2 && #File>2
} run ismodel for 6

// Check to see that file systems are acyclic
assert acyclic { no d: Dir | d in d.^contents }
check acyclic for 6

// This example is developed much further in the on-line Alloy tutorial:
// 	http://alloy.mit.edu/alloy/tutorials/online/


can marry with grandma

can marry with grandma

open util/ordering[Time]
open named_man_ja [Man]
open named_woman_ja [Woman]

sig Time {
	event: lone Event
}

fact {
	no first.event
	all t: Time - first {one t.event}
}

abstract sig Person {
	state: State -> Time,
	partner: Person -> Time,
	parent_bio: set Person,
  parent_think: set Person
}{
	all t: Time | one state.t
	all t: Time | lone partner.t
	let p = parent_bio {
		no p or born_in_scope
  }
	let p = parent_think {
		no p or born_in_scope
  }
}

pred born_in_scope(p: Person){
	p.state.first = NotExist
	p.state.last != NotExist
}

abstract sig Man, Woman extends Person {}

enum State {NotExist, Married, NotMarried}

enum Event {Marriage, Divorce, Birth}

pred init (t: Time) {
	all p: Person | p.state.t in NotMarried + NotExist
	all p: Person | p.partner.t = none
}

pred change_state (
	target : Person,
	t, t': Time,
	before, after : State){
		some target
		all p: target {
			p.state.t = before
			p.state.t' = after
		}
		// others don't change their state
		all other: (Person - target) {
			other.state.t = other.state.t'
		}
}

pred keep_partner(others: Person, t, t': Time){
	all other: others {
		other.partner.t = other.partner.t'
	}
}
pred step (t, t': Time) {
	{some disj p1 : Man, p2 : Woman {
		{
			t'.event = Marriage
			change_state[p1 + p2, t, t', NotMarried, Married]
			p1.partner.t' = p2
			p2.partner.t' = p1
			keep_partner[Person - p1 - p2, t, t']
		} or {
			t'.event = Divorce
			change_state[p1 + p2, t, t', Married, NotMarried]
			p1.partner.t' = none
			p2.partner.t' = none
			keep_partner[Person - p1 - p2, t, t']
		}
	}}
	or
	some p: Person {
		// birth
		t'.event = Birth
		change_state[p, t, t', NotExist, NotMarried]
		let father = p.parent_bio & Man {
			one father
			father.state.t != NotExist
		}
		let mother = p.parent_bio & Woman {
			one mother
			mother.state.t != NotExist
			let hasband = mother.partner.t {
				// p always think his biological mother is his mother
				// if mother married, p think mother's hasband is his father
				// no other person is tought as parent
				p.parent_think = mother + hasband
			}
		}
		keep_partner[Person, t, t']
	}
}

fact Traces {
	init[first]
	all t: Time - last {
		step[t, t.next]
	}
}

pred can_marry_think (from, to: Person){
	to not in from.^parent_think
	from not in to.^parent_think
	to not in from.parent_think.~parent_think
}

pred can_marry_bio (from, to: Person){
	to not in from.^parent_bio
	from not in to.^parent_bio
	to not in from.parent_bio.~parent_bio
}

run {
	some parent_bio
	some p1: Man, p2: Woman {
		not can_marry_think[p1, p2] and can_marry_bio[p1, p2]
	}
} for 6 Person, 8 Time

open util/ordering[Time]
open named_man_ja [Man]
open named_woman_ja [Woman]

sig Time {
	event: lone Event
}

fact {
	no first.event
	all t: Time - first {one t.event}
}

abstract sig Person {
	state: State -> Time,
	partner: Person -> Time,
	parent_bio: set Person,
  parent_think: set Person
}{
	all t: Time | one state.t
	all t: Time | lone partner.t
	let p = parent_bio {
		no p or born_in_scope
  }
	let p = parent_think {
		no p or born_in_scope
  }
}

pred born_in_scope(p: Person){
	p.state.first = NotExist
	p.state.last != NotExist
}

abstract sig Man, Woman extends Person {}

enum State {NotExist, Married, NotMarried}

enum Event {Marriage, Divorce, Birth}

pred init (t: Time) {
	all p: Person | p.state.t in NotMarried + NotExist
	all p: Person | p.partner.t = none
}

pred change_state (
	target : Person,
	t, t': Time,
	before, after : State){
		some target
		all p: target {
			p.state.t = before
			p.state.t' = after
		}
		// others don't change their state
		all other: (Person - target) {
			other.state.t = other.state.t'
		}
}

pred keep_partner(others: Person, t, t': Time){
	all other: others {
		other.partner.t = other.partner.t'
	}
}
pred step (t, t': Time) {
	{some disj p1 : Man, p2 : Woman {
		{
			t'.event = Marriage
			change_state[p1 + p2, t, t', NotMarried, Married]
			p1.partner.t' = p2
			p2.partner.t' = p1
			keep_partner[Person - p1 - p2, t, t']
		} or {
			t'.event = Divorce
			change_state[p1 + p2, t, t', Married, NotMarried]
			p1.partner.t' = none
			p2.partner.t' = none
			keep_partner[Person - p1 - p2, t, t']
		}
	}}
	or
	some p: Person {
		// birth
		t'.event = Birth
		change_state[p, t, t', NotExist, NotMarried]
		let father = p.parent_bio & Man {
			one father
			father.state.t != NotExist
		}
		let mother = p.parent_bio & Woman {
			one mother
			mother.state.t != NotExist
			let hasband = mother.partner.t {
				// p always think his biological mother is his mother
				// if mother married, p think mother's hasband is his father
				// no other person is tought as parent
				p.parent_think = mother + hasband
			}
		}
		keep_partner[Person, t, t']
	}
}

fact Traces {
	init[first]
	all t: Time - last {
		step[t, t.next]
	}
}

pred can_marry_think (from, to: Person){
	to not in from.^parent_think
	from not in to.^parent_think
	to not in from.parent_think.~parent_think
}

pred can_marry_bio (from, to: Person){
	to not in from.^parent_bio
	from not in to.^parent_bio
	to not in from.parent_bio.~parent_bio
}

run {
	some parent_bio
	some p1: Man, p2: Woman {
//		p.parent_bio & Man != p.parent_think & Man
//		one p.parent_think & Man
		can_marry_think[p1, p2] and not can_marry_bio[p1, p2]
	}
} for exactly 4 Person, 4 Time


forgot to add file.

forgot to add file.

error: pathspec 'execution_hints/c11_strengthening_mo.als' did not match any file(s) known to git


mystery

mystery

open util/ordering[Time]
enum Person {A, B, C}
sig Place {}
one sig Nowhere extends Place {}
sig Time {
   visit: Person -> Place
}
fact {
   all t: Time, p: Person {
      one t.visit[p] // 人は一度に一箇所にしかいない
   }
}

enum Bool {T, F}
enum BoolBool {TT, TF, FT, FF}

abstract sig Constrain{
   by: one Person,
   who: one Person
}

sig is_honest extends Constrain {}
sig is_visit extends Constrain {
   when: Time,
   where: Place
}

pred satisfy(cs: Constrain, a, b, c: BoolBool){
   let
      bb = (A -> a) + (B -> b) + (C -> c),
      b0 = bb.(TT -> T + TF -> T + FT -> F + FF -> F),
      b1 = bb.(TT -> T + TF -> F + FT -> T + FF -> F)
   {
      // b0: Person -> Bool // 正直T 嘘をつくかもしれない人
      // b1: Person -> Bool // 犯人T
      // 正直者の人数は1人
      #{b0.T} = 2
      // 犯人は1人
      #{b1.T} = 1

      // すべての正直発言について、
      // 発言者が正直なら対象も正直
      all c: cs & is_honest{
	 (c.by.b0 = T) => (c.who.b0 = T)
      }
      // すべての目撃情報について
      // 発言者が正直なら
      all c: cs & is_visit{
	 (c.by.b0 = T) => {
	    let t = c.when {
	       t.visit[c.who] = c.where // その時刻にそこにいる
	    }
	 }
      }
   }
}

fact {
   // 人の移動に関する制約
   all t: Time - first, p: Person {
      t.visit[p] = t.prev.visit[p] // 同じ位置にとどまる
      or t.visit[p] = Nowhere or t.prev.visit[p] = Nowhere
   }
}

run {
   let answers = {
      a, b, c: BoolBool |
    	 satisfy[Constrain, a, b, c]}
   {
	some answers
//      one answers
/*
      all x: Constrain {
	 not one {
	    a, b, c: BoolBool |
	       satisfy[Constrain - x, a, b, c]
	 }
      }
*/
   }
} for 3 Place, 3 Time, 20 Constrain

open util/ordering[Time]
enum Person {A, B, C}
sig Place {}
one sig Nowhere extends Place {}
sig Time {
   visit: Person -> Place
}
fact {
   all t: Time, p: Person {
      one t.visit[p] // 人は一度に一箇所にしかいない
   }
}

enum Bool {T, F}
enum BoolBool {TT, TF, FT, FF}

abstract sig Constrain{
   by: one Person,
   who: one Person
}

sig is_honest extends Constrain {}
sig is_visit extends Constrain {
   when: Time,
   where: Place
}

pred satisfy(cs: Constrain, a, b, c: BoolBool){
   let
      bb = (A -> a) + (B -> b) + (C -> c),
      b0 = bb.(TT -> T + TF -> T + FT -> F + FF -> F),
      b1 = bb.(TT -> T + TF -> F + FT -> T + FF -> F)
   {
      // b0: Person -> Bool // 正直T 嘘をつくかもしれない人
      // b1: Person -> Bool // 犯人T
      // 正直者の人数は1人
      //#{b0.T} = 1
      // 犯人は1人
      #{b1.T} = 1

      // すべての正直発言について、
      // 発言者が正直なら対象も正直
      all c: cs & is_honest{
	 (c.by.b0 = T) => (c.who.b0 = T)
      }
      // すべての目撃情報について
      // 発言者が正直なら
      all c: cs & is_visit{
	 (c.by.b0 = T) => {
	    let t = c.when {
	       t.visit[c.who] = c.where // その時刻にそこにいる
	    }
	 }
      }
   }
}

fact {
   // 人の移動に関する制約
   all t: Time - first, p: Person {
      t.visit[p] = t.prev.visit[p] // 同じ位置にとどまる
      or t.visit[p] = Nowhere or t.prev.visit[p] = Nowhere
   }
}

run {
   let answers = {
      a, b, c: BoolBool |
    	 satisfy[Constrain, a, b, c]}
   {
//	some answers
      one answers
/*
      all x: Constrain {
	 not one {
	    a, b, c: BoolBool |
	       satisfy[Constrain - x, a, b, c]
	 }
      }
*/
   }
} for 3 Place, 3 Time, 20 Constrain


birth

birth

open util/ordering[Time]
open named_man_ja [Man]
open named_woman_ja [Woman]

sig Time {}

abstract sig Person {
	state: State -> Time,
}{
	all t: Time | one state.t
}

abstract sig Man, Woman extends Person {}

enum State {NotExist, Married, NotMarried}

pred init (t: Time) {
	all p: Person | p.state.t in NotMarried + NotExist
}

pred change_state (
	target : Person,
	t, t': Time,
	before, after : State){
		some target
		all p: target {
			p.state.t = before
			p.state.t' = after
		}
		// others don't change their state
		all other: (Person - target) {
			other.state.t = other.state.t'
		}
}

pred step (t, t': Time) {
	{some disj p1 : Man, p2 : Woman {
		// marriage
		change_state[p1 + p2, t, t', NotMarried, Married]
		or
		// divorce
		change_state[p1 + p2, t, t', Married, NotMarried]
	}}
	or
	some p: Person {
		// birth
		change_state[p, t, t', NotExist, NotMarried]
	}
}

fact Traces {
	init[first]
	all t: Time - last {
		step[t, t.next]
	}
}

run {} for exactly 4 Person, 4 Time

error: pathspec 'etude17.als' did not match any file(s) known to git