Theory PAL

section ‹Public Announcement Logic (PAL) in HOL›

text ‹An earlier encoding and automation of the wise men puzzle, utilizing a shallow embedding of 
higher-order (multi-)modal logic in HOL, has been presented in cite"J41" and "J44". However, this work did not 
convincingly address the interaction dynamics between the involved agents. Here we therefore extend and adapt 
the universal (meta-)logical reasoning approach of cite"J41" for public announcement logic (PAL) and 
we demonstrate how it can be utilized to achieve a convincing encoding and automation of the 
wise men puzzle in HOL, so that also the interaction dynamics as given in the scenario is adequately 
addressed. For further background information on the work presented here we refer to cite"R78" and "C90".›

theory PAL imports Main begin  (* Sebastian Reiche and Christoph Benzmüller, 2021 *)
nitpick_params[user_axioms,expect=genuine]

text ‹Type i is associated with possible worlds›
 typedecl i (* Type of possible worlds *)
 type_synonym σ = "ibool" (*Type of world domains *)
 type_synonym τ = "σibool" (* Type of world depended formulas (truth sets) *) 
 type_synonym α = "iibool" (* Type of accessibility relations between world *)
 type_synonym ρ = "αbool" (* Type of groups of agents *)

text ‹Some useful relations (for constraining accessibility relations)›
definition reflexive::"αbool" 
  where "reflexive R  x. R x x"
definition symmetric::"αbool" 
  where "symmetric R  x y. R x y  R y x"
definition transitive::"αbool" 
  where "transitive R  x y z. R x y  R y z  R x z"
definition euclidean::"αbool" 
  where "euclidean R  x y z. R x y  R x z  R y z"
definition intersection_rel::"ααα" 
  where "intersection_rel R Q  λu v. R u v  Q u v"
definition union_rel::"ααα" 
  where "union_rel R Q  λu v. R u v  Q u v"
definition sub_rel::"ααbool" 
  where "sub_rel R Q  u v. R u v  Q u v"
definition inverse_rel::"αα" 
  where "inverse_rel R  λu v. R v u"
definition big_union_rel::"ρα" 
  where "big_union_rel X  λu v. R. (X R)  (R u v)"
definition big_intersection_rel::"ρα"
  where "big_intersection_rel X  λu v. R. (X R)  (R u v)"

text ‹In HOL the transitive closure of a relation can be defined in a single line.›
definition tc::"αα" 
  where "tc R  λx y.Q. transitive Q  (sub_rel R Q  Q x y)"

text ‹Logical connectives for PAL›
abbreviation patom::"στ" (A_›[79]80) 
  where "Ap  λW w. W w  p w"
abbreviation ptop::"τ" () 
  where "  λW w. True" 
abbreviation pneg::"ττ" (¬_›[52]53) 
  where "¬φ  λW w. ¬(φ W w)" 
abbreviation pand::"τττ" (infixr51) 
  where "φψ  λW w. (φ W w)  (ψ W w)"   
abbreviation por::"τττ" (infixr50) 
  where "φψ  λW w. (φ W w)  (ψ W w)"   
abbreviation pimp::"τττ" (infixr49) 
  where "φψ  λW w. (φ W w)  (ψ W w)"  
abbreviation pequ::"τττ" (infixr48) 
  where "φψ  λW w. (φ W w)  (ψ W w)"
abbreviation pknow::"αττ" (K_ _›) 
  where "K r φ  λW w.v. (W v  r w v)  (φ W v)"
abbreviation ppal::"τττ" ([!_]_›) 
  where "[!φ]ψ  λW w. (φ W w)  (ψ (λz. W z  φ W z) w)"

text ‹Glogal validity of PAL formulas›
abbreviation pvalid::"τ  bool" (_[7]8) 
  where "φ  W.w. W w  φ W w"

text ‹Introducing agent knowledge (K), mutual knowledge (E), distributed knowledge (D) and common knowledge (C).›
abbreviation EVR::"ρα"
  where "EVR G  big_union_rel G"
abbreviation DIS::"ρα" 
  where "DIS G  big_intersection_rel G"
abbreviation agttknows::"αττ" (K_ _›) 
  where "Kr φ   K r φ" 
abbreviation evrknows::"ρττ" (E_ _›) 
  where "EG φ   K (EVR G) φ"
abbreviation disknows :: "ρττ" (D_ _›) 
  where "DG φ  K (DIS G) φ"
abbreviation prck::"ρτττ" (C__|_)
  where "CGφ|ψ  λW w. v. (tc (intersection_rel (EVR G) (λu v. W v  φ W v)) w v)  (ψ W v)"
abbreviation pcmn::"ρττ" (C_ _›) 
  where "CG φ   CG|φ"

text ‹Postulating S5 principles for the agent's accessibility relations.›
abbreviation S5Agent::"αbool"
  where  "S5Agent i  reflexive i  transitive i  euclidean i"
abbreviation S5Agents::"ρbool"
  where "S5Agents A  i. (A i  S5Agent i)"

text ‹Introducing "Defs" as the set of the above definitions; useful for convenient unfolding.›
named_theorems Defs
declare reflexive_def[Defs] symmetric_def[Defs] transitive_def[Defs] 
  euclidean_def[Defs] intersection_rel_def[Defs] union_rel_def[Defs] 
  sub_rel_def[Defs] inverse_rel_def[Defs] big_union_rel_def[Defs] 
  big_intersection_rel_def[Defs] tc_def[Defs]

text ‹Consistency: nitpick reports a model.›
 lemma True nitpick [satisfy] oops (* model found *)


section ‹Automating the Wise Men Puzzle›

text ‹Agents are modeled as accessibility relations.›
consts a::"α" b::"α" c::"α" 
abbreviation  Agent::"αbool" (𝒜) where "𝒜 x  x = a  x = b  x = c"
axiomatization where  group_S5: "S5Agents 𝒜"

text ‹Common knowledge: At least one of a, b and c has a white spot.›
consts ws::"ασ" 
axiomatization where WM1: "C𝒜 (Aws a  Aws b  Aws c)" 

text ‹Common knowledge: If x does not have a white spot then y knows this.›
axiomatization where
  WM2ab: "C𝒜 (¬(Aws a)  (Kb (¬(Aws a))))" and
  WM2ac: "C𝒜 (¬(Aws a)  (Kc (¬(Aws a))))" and
  WM2ba: "C𝒜 (¬(Aws b)  (Ka (¬(Aws b))))" and
  WM2bc: "C𝒜 (¬(Aws b)  (Kc (¬(Aws b))))" and
  WM2ca: "C𝒜 (¬(Aws c)  (Ka (¬(Aws c))))" and
  WM2cb: "C𝒜 (¬(Aws c)  (Kb (¬(Aws c))))" 

text ‹Positive introspection principles are implied.›
lemma WM2ab': "C𝒜 ((Aws a)  Kb (Aws a))" 
  using WM2ab group_S5 unfolding Defs by metis
lemma WM2ac': "C𝒜 ((Aws a)  Kc (Aws a))" 
  using WM2ac group_S5 unfolding Defs by metis
lemma WM2ba': "C𝒜 ((Aws b)  Ka (Aws b))" 
  using WM2ba group_S5 unfolding Defs by metis
lemma WM2bc': "C𝒜 ((Aws b)  Kc (Aws b))" 
  using WM2bc group_S5 unfolding Defs by metis
lemma WM2ca': "C𝒜 ((Aws c)  Ka (Aws c))" 
  using WM2ca group_S5 unfolding Defs by metis
lemma WM2cb': "C𝒜 ((Aws c)  Kb (Aws c))" 
  using WM2cb group_S5 unfolding Defs by metis

text ‹Automated solutions of the Wise Men Puzzle.›
theorem whitespot_c: "[!¬Ka(Aws a)]([!¬Kb(Aws b)](Kc (Aws c)))" 
  using WM1 WM2ba WM2ca WM2cb unfolding Defs by (smt (verit))

text ‹For the following, alternative formulation a proof is found by sledgehammer, while the
reconstruction of this proof using trusted methods (often) fails; this hints at further opportunities to
improve the reasoning tools in Isabelle/HOL.›
theorem whitespot_c':
  "[!¬((Ka (Aws a))  (Ka (¬Aws a)))]([!¬((Kb (Aws b))  (Kb (¬Aws b)))](Kc (Aws c)))"
  using WM1 WM2ab WM2ac WM2ba WM2bc WM2ca WM2cb unfolding Defs 
   ― ‹sledgehammer by (smt (verit))›
  oops
   
text ‹Consistency: nitpick reports a model.›
lemma True nitpick [satisfy] oops  
end