theory Basics_Vectors3DSpace_E1
imports "$HETS_LIB/Isabelle/MainHCPairs"
uses "$HETS_LIB/Isabelle/prelude"
begin

ML "Header.initialize
    [\"binary_inverse\", \"antisym\", \"refl\", \"trans\",
     \"subtype_def\", \"subtype_pred_def\", \"ga_assoc___Xx__\",
     \"ga_right_unit___Xx__\", \"ga_left_unit___Xx__\", \"inv_Group\",
     \"rinv_Group\", \"ga_comm___Xx__\", \"ga_assoc___Xx___1\",
     \"ga_right_unit___Xx___1\", \"ga_left_unit___Xx___1\",
     \"distr1_Ring\", \"distr2_Ring\", \"left_zero\", \"right_zero\",
     \"ga_comm___Xx___1\", \"noZeroDiv\", \"zeroNeqOne\", \"Ax1\",
     \"ga_assoc___Xx___2\", \"ga_right_unit___Xx___2\",
     \"ga_left_unit___Xx___2\", \"inv_Group_1\", \"rinv_Group_1\",
     \"binary_inverse_1\", \"Ax1_1\", \"refl_1\", \"trans_1\",
     \"antisym_1\", \"dichotomy_TotalOrder\", \"FWO_plus_left\",
     \"FWO_times_left\", \"FWO_plus_right\", \"FWO_times_right\",
     \"FWO_plus\", \"inf_def\", \"Real_completeness\",
     \"geq_def_ExtPartialOrder\", \"less_def_ExtPartialOrder\",
     \"greater_def_ExtPartialOrder\", \"ga_comm_inf\", \"ga_comm_sup\",
     \"inf_def_ExtPartialOrder\", \"sup_def_ExtPartialOrder\",
     \"ga_comm_min\", \"ga_comm_max\", \"ga_assoc_min\",
     \"ga_assoc_max\", \"ga_left_comm_min\", \"ga_left_comm_max\",
     \"min_def_ExtTotalOrder\", \"max_def_ExtTotalOrder\",
     \"min_inf_relation\", \"max_sup_relation\",
     \"RealNonNeg_pred_def\", \"RealPos_pred_def\", \"Ax3\", \"Ax4\",
     \"RealNonNeg_subtype\", \"RealPos_subtype\", \"abs_def\",
     \"times_cancel_right_nonneg_leq\", \"times_leq_nonneg_cond\",
     \"sqr_def\", \"sqrt_def\", \"Pos_def\", \"X2_def_Real\",
     \"X3_def_Real\", \"X4_def_Real\", \"X5_def_Real\", \"X6_def_Real\",
     \"X7_def_Real\", \"X8_def_Real\", \"X9_def_Real\",
     \"ZeroToNine_type\", \"decimal_def\", \"ga_select_C1\",
     \"ga_select_C2\", \"ga_select_C3\", \"Zero_Vector\",
     \"VectorStar_pred_def\", \"Ax7\", \"VectorStar_subtype\",
     \"def_of_vector_addition\", \"def_of_minus_vector\",
     \"binary_inverse_2\", \"scalar_multiplication\",
     \"scalar_product\", \"vector_product\", \"ONB1\", \"ONB2\",
     \"ONB3\", \"cross_left_homogenity\",
     \"cross_product_antisymmetric\", \"binary_inverse_1_1\",
     \"distributive\", \"homogeneous\", \"symmetric\", \"pos_definite\",
     \"unit\", \"mix_assoc\", \"distr_Field\", \"distr_Space\",
     \"ga_assoc___Xx___3_1\", \"ga_right_unit___Xx___3_1\",
     \"ga_left_unit___Xx___3_1\", \"inv_Group_2_1\", \"rinv_Group_2_1\",
     \"ga_comm___Xx___3\", \"zero_by_left_zero\",
     \"zero_by_right_zero\", \"inverse_by_XMinus1\",
     \"right_distributive\", \"right_homogeneous\", \"non_degenerate\",
     \"lindep_def\", \"lindep_reflexivity\", \"lindep_symmetry\",
     \"simple_lindep_condition\", \"lindep_nonlindep_transitivity\",
     \"norm_from_inner_prod_def\", \"proj_def\", \"orthcomp_def\",
     \"orthogonal_def\", \"orth_symmetric\", \"lindep_orth_transitive\",
     \"orthogonal_existence_theorem\",
     \"orthogonal_on_zero_projection\",
     \"orthogonal_projection_theorem\",
     \"orthogonal_decomposition_theorem\",
     \"unique_orthogonal_decomposition\", \"cross_product_orthogonal\",
     \"cross_product_zero_iff_lindep\", \"e1e2_nonlindep\"]"

typedecl NonZero
typedecl Real
typedecl RealNonNeg
typedecl RealPos
typedecl VectorStar
typedecl ZeroToNine

datatype Vector = X_V "Real" "Real" "Real" ("V/'(_,/ _,/ _')" [3,3,3] 999)

consts
X0X1 :: "Real" ("0''")
X0X2 :: "Vector" ("0''''")
X1X1 :: "NonZero" ("1''")
X1X2 :: "Real" ("1''''")
X2 :: "Real" ("2''")
X3 :: "Real" ("3''")
X4 :: "Real" ("4''")
X5 :: "Real" ("5''")
X6 :: "Real" ("6''")
X7 :: "Real" ("7''")
X8 :: "Real" ("8''")
X9 :: "Real" ("9''")
XMinus__XX1 :: "Real => Real" ("(-''/ _)" [56] 56)
XMinus__XX2 :: "Vector => Vector" ("(-''''/ _)" [56] 56)
XVBarXVBar__XVBarXVBar :: "Vector => Real" ("(||/ _/ ||)" [10] 999)
X_C1 :: "Vector => Real" ("C1/'(_')" [3] 999)
X_C2 :: "Vector => Real" ("C2/'(_')" [3] 999)
X_C3 :: "Vector => Real" ("C3/'(_')" [3] 999)
X_Pos :: "Real => bool" ("Pos/'(_')" [3] 999)
X_RealNonNeg_inj :: "RealNonNeg => Real" ("RealNonNeg'_inj/'(_')" [3] 999)
X_RealNonNeg_pred :: "Real => bool" ("RealNonNeg'_pred/'(_')" [3] 999)
X_RealNonNeg_proj :: "Real => RealNonNeg" ("RealNonNeg'_proj/'(_')" [3] 999)
X_RealPos_inj :: "RealPos => Real" ("RealPos'_inj/'(_')" [3] 999)
X_RealPos_pred :: "Real => bool" ("RealPos'_pred/'(_')" [3] 999)
X_RealPos_proj :: "Real => RealPos" ("RealPos'_proj/'(_')" [3] 999)
X_VectorStar_inj :: "VectorStar => Vector" ("VectorStar'_inj/'(_')" [3] 999)
X_VectorStar_pred :: "Vector => bool" ("VectorStar'_pred/'(_')" [3] 999)
X_VectorStar_proj :: "Vector => VectorStar" ("VectorStar'_proj/'(_')" [3] 999)
X__XAtXAt__X :: "ZeroToNine => Real => Real" ("(_/ @@/ _)" [54,54] 52)
X__XGtXEq__X :: "Real => Real => bool" ("(_/ >=''/ _)" [44,44] 42)
X__XGt__X :: "Real => Real => bool" ("(_/ >''/ _)" [44,44] 42)
X__XHash__X :: "Vector => Vector => Vector" ("(_/ #''/ _)" [54,54] 52)
X__XLtXEq__X :: "Real => Real => bool" ("(_/ <=''/ _)" [44,44] 42)
X__XLt__X :: "Real => Real => bool" ("(_/ <''/ _)" [44,44] 42)
X__XMinus__XX1 :: "Real => Real => Real" ("(_/ -''/ _)" [54,54] 52)
X__XMinus__XX2 :: "Vector => Vector => Vector" ("(_/ -''''/ _)" [54,54] 52)
X__XPlus__XX1 :: "Real => Real => Real" ("(_/ +''/ _)" [54,54] 52)
X__XPlus__XX2 :: "Vector => Vector => Vector" ("(_/ +''''/ _)" [54,54] 52)
X__XSlash__X :: "Real => NonZero => Real" ("(_/ '/''/ _)" [54,54] 52)
X__Xx__XX1 :: "NonZero => NonZero => NonZero" ("(_/ *''/ _)" [54,54] 52)
X__Xx__XX2 :: "Real => Real => Real" ("(_/ *''''/ _)" [54,54] 52)
X__Xx__XX3 :: "Real => Vector => Vector" ("(_/ *'_3/ _)" [54,54] 52)
X__Xx__XX4 :: "Vector => Vector => Real" ("(_/ *'_4/ _)" [54,54] 52)
X_abs :: "Real => RealNonNeg" ("abs''/'(_')" [3] 999)
X_gn_inj :: "'a => 'b" ("gn'_inj/'(_')" [3] 999)
X_gn_proj :: "'a => 'b partial" ("gn'_proj/'(_')" [3] 999)
X_inv :: "NonZero => NonZero" ("inv''/'(_')" [3] 999)
X_isSubtype :: "('s => 't) => ('t => 's) => bool" ("isSubtype/'(_,/ _')" [3,3] 999)
X_isSubtypeWithPred :: "('t => bool) => ('s => 't) => ('t => 's) => bool" ("isSubtypeWithPred/'(_,/ _,/ _')" [3,3,3] 999)
X_lindep :: "Vector => Vector => bool" ("lindep/'(_,/ _')" [3,3] 999)
X_max :: "Real => Real => Real" ("max''/'(_,/ _')" [3,3] 999)
X_min :: "Real => Real => Real" ("min''/'(_,/ _')" [3,3] 999)
X_orth :: "Vector => Vector => bool" ("orth/'(_,/ _')" [3,3] 999)
X_orthcomp :: "Vector => Vector => Vector" ("orthcomp/'(_,/ _')" [3,3] 999)
X_proj :: "Vector => Vector => Vector" ("proj/'(_,/ _')" [3,3] 999)
X_sqr :: "Real => RealNonNeg" ("sqr/'(_')" [3] 999)
X_sqrt :: "RealNonNeg => RealNonNeg" ("sqrt/'(_')" [3] 999)
X_sup :: "Real => Real => Real partial" ("sup/'(_,/ _')" [3,3] 999)
e1 :: "Vector"
e2 :: "Vector"
e3 :: "Vector"
infX1 :: "Real => Real => Real partial" ("inf''/'(_,/ _')" [3,3] 999)
infX2 :: "(Real => bool) => Real partial" ("inf''''/'(_')" [3] 999)

axioms

binary_inverse [rule_format] :
"ALL x. ALL y. x /' y = x *'' gn_inj(inv'(y))"

subtype_def [rule_format] :
"ALL injection.
 ALL projection.
 isSubtype(injection, projection) =
 (ALL x. x = projection (injection x))"

subtype_pred_def [rule_format] :
"ALL P.
 ALL injection.
 ALL projection.
 isSubtypeWithPred(P, injection, projection) =
 ((isSubtype(injection, projection) &
   (ALL x. P x --> x = injection (projection x))) &
  (ALL x. P (injection x)))"

ga_assoc___Xx__ [rule_format] :
"ALL x. ALL y. ALL z. (x +' y) +' z = x +' (y +' z)"

ga_right_unit___Xx__ [rule_format] : "ALL x. x +' 0' = x"

ga_left_unit___Xx__ [rule_format] : "ALL x. 0' +' x = x"

inv_Group [rule_format] : "ALL x. -' x +' x = 0'"

rinv_Group [rule_format] : "ALL x. x +' -' x = 0'"

ga_comm___Xx__ [rule_format] : "ALL x. ALL y. x +' y = y +' x"

ga_assoc___Xx___1 [rule_format] :
"ALL x. ALL y. ALL z. (x *'' y) *'' z = x *'' (y *'' z)"

ga_right_unit___Xx___1 [rule_format] : "ALL x. x *'' 1'' = x"

ga_left_unit___Xx___1 [rule_format] : "ALL x. 1'' *'' x = x"

distr1_Ring [rule_format] :
"ALL x. ALL y. ALL z. (x +' y) *'' z = (x *'' z) +' (y *'' z)"

distr2_Ring [rule_format] :
"ALL x. ALL y. ALL z. z *'' (x +' y) = (z *'' x) +' (z *'' y)"

left_zero [rule_format] : "ALL x. 0' *'' x = 0'"

right_zero [rule_format] : "ALL x. x *'' 0' = 0'"

ga_comm___Xx___1 [rule_format] : "ALL x. ALL y. x *'' y = y *'' x"

noZeroDiv [rule_format] :
"ALL x. ALL y. x *'' y = 0' --> x = 0' | y = 0'"

zeroNeqOne [rule_format] : "~ 1'' = 0'"

Ax1 [rule_format] : "ALL x. defOp (gn_proj(x)) = (~ x = 0')"

ga_assoc___Xx___2 [rule_format] :
"ALL x. ALL y. ALL z. (x *' y) *' z = x *' (y *' z)"

ga_right_unit___Xx___2 [rule_format] : "ALL x. x *' 1' = x"

ga_left_unit___Xx___2 [rule_format] : "ALL x. 1' *' x = x"

inv_Group_1 [rule_format] : "ALL x. inv'(x) *' x = 1'"

rinv_Group_1 [rule_format] : "ALL x. x *' inv'(x) = 1'"

binary_inverse_1 [rule_format] : "ALL x. ALL y. x -' y = x +' -' y"

Ax1_1 [rule_format] :
"ALL x. ALL y. x /' y = x *'' gn_inj(inv'(y))"

refl_1 [rule_format] : "ALL x. x <=' x"

trans_1 [rule_format] :
"ALL x. ALL y. ALL z. x <=' y & y <=' z --> x <=' z"

antisym_1 [rule_format] :
"ALL x. ALL y. x <=' y & y <=' x --> x = y"

dichotomy_TotalOrder [rule_format] :
"ALL x. ALL y. x <=' y | y <=' x"

FWO_plus_left [rule_format] :
"ALL a. ALL b. ALL c. a <=' b --> a +' c <=' b +' c"

FWO_times_left [rule_format] :
"ALL a. ALL b. ALL c. a <=' b & 0' <=' c --> a *'' c <=' b *'' c"

FWO_plus_right [rule_format] :
"ALL a. ALL b. ALL c. b <=' c --> a +' b <=' a +' c"

FWO_times_right [rule_format] :
"ALL a. ALL b. ALL c. b <=' c & 0' <=' a --> a *'' b <=' a *'' c"

FWO_plus [rule_format] :
"ALL a.
 ALL b. ALL c. ALL d. a <=' c & b <=' d --> a +' b <=' c +' d"

inf_def [rule_format] :
"ALL S.
 ALL m.
 inf''(S) = makePartial m =
 (ALL m2. (ALL x. S x --> x <=' m2) --> m <=' m2)"

Real_completeness [rule_format] :
"ALL S.
 (EX x. S x) & (EX B. ALL x. S x --> x <=' B) -->
 (EX m. makePartial m = inf''(S))"

geq_def_ExtPartialOrder [rule_format] :
"ALL x. ALL y. (x >=' y) = (y <=' x)"

less_def_ExtPartialOrder [rule_format] :
"ALL x. ALL y. (x <' y) = (x <=' y & ~ x = y)"

greater_def_ExtPartialOrder [rule_format] :
"ALL x. ALL y. (x >' y) = (y <' x)"

ga_comm_inf [rule_format] : "ALL x. ALL y. inf'(x, y) = inf'(y, x)"

ga_comm_sup [rule_format] : "ALL x. ALL y. sup(x, y) = sup(y, x)"

inf_def_ExtPartialOrder [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 inf'(x, y) = makePartial z =
 (z <=' x & z <=' y & (ALL t. t <=' x & t <=' y --> t <=' z))"

sup_def_ExtPartialOrder [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 sup(x, y) = makePartial z =
 (x <=' z & y <=' z & (ALL t. x <=' t & y <=' t --> z <=' t))"

ga_comm_min [rule_format] : "ALL x. ALL y. min'(x, y) = min'(y, x)"

ga_comm_max [rule_format] : "ALL x. ALL y. max'(x, y) = max'(y, x)"

ga_assoc_min [rule_format] :
"ALL x. ALL y. ALL z. min'(min'(x, y), z) = min'(x, min'(y, z))"

ga_assoc_max [rule_format] :
"ALL x. ALL y. ALL z. max'(max'(x, y), z) = max'(x, max'(y, z))"

ga_left_comm_min [rule_format] :
"ALL x. ALL y. ALL z. min'(x, min'(y, z)) = min'(y, min'(x, z))"

ga_left_comm_max [rule_format] :
"ALL x. ALL y. ALL z. max'(x, max'(y, z)) = max'(y, max'(x, z))"

min_def_ExtTotalOrder [rule_format] :
"ALL x. ALL y. min'(x, y) = (if x <=' y then x else y)"

max_def_ExtTotalOrder [rule_format] :
"ALL x. ALL y. max'(x, y) = (if x <=' y then y else x)"

min_inf_relation [rule_format] :
"ALL x. ALL y. makePartial (min'(x, y)) = inf'(x, y)"

max_sup_relation [rule_format] :
"ALL x. ALL y. makePartial (max'(x, y)) = sup(x, y)"

RealNonNeg_pred_def [rule_format] :
"ALL x. RealNonNeg_pred(x) = (x >=' 0')"

RealPos_pred_def [rule_format] :
"ALL x. RealPos_pred(x) = (x >' 0')"

Ax3 [rule_format] :
"ALL x. defOp (gn_proj(x)) = RealNonNeg_pred(x)"

Ax4 [rule_format] : "ALL x. defOp (gn_proj(x)) = RealPos_pred(x)"

RealNonNeg_subtype [rule_format] :
"isSubtypeWithPred(X_RealNonNeg_pred, X_RealNonNeg_inj,
 X_RealNonNeg_proj)"

RealPos_subtype [rule_format] :
"isSubtypeWithPred(X_RealPos_pred, X_RealPos_inj, X_RealPos_proj)"

abs_def [rule_format] :
"ALL x.
 makePartial (abs'(x)) =
 (if 0' <=' x then gn_proj(x) else gn_proj(-' x))"

times_cancel_right_nonneg_leq [rule_format] :
"ALL a. ALL b. ALL c. a *'' b <=' c *'' b & b >=' 0' --> a <=' c"

times_leq_nonneg_cond [rule_format] :
"ALL a. ALL b. 0' <=' a *'' b & b >=' 0' --> 0' <=' a"

sqr_def [rule_format] :
"ALL r. gn_inj(sqr(r)) = makePartial (r *'' r)"

sqrt_def [rule_format] : "ALL q. sqr(gn_inj(sqrt(q))) = q"

Pos_def [rule_format] : "ALL x. Pos(x) = (0' <=' x)"

X2_def_Real [rule_format] : "2' = gn_inj(1') +' gn_inj(1')"

X3_def_Real [rule_format] : "3' = 2' +' gn_inj(1')"

X4_def_Real [rule_format] : "4' = 3' +' gn_inj(1')"

X5_def_Real [rule_format] : "5' = 4' +' gn_inj(1')"

X6_def_Real [rule_format] : "6' = 5' +' gn_inj(1')"

X7_def_Real [rule_format] : "7' = 6' +' gn_inj(1')"

X8_def_Real [rule_format] : "8' = 7' +' gn_inj(1')"

X9_def_Real [rule_format] : "9' = 8' +' gn_inj(1')"

ZeroToNine_type [rule_format] :
"ALL x.
 defOp (gn_proj(x)) =
 (((((((((x = 0' | makePartial x = gn_inj(1')) | x = 2') | x = 3') |
       x = 4') |
      x = 5') |
     x = 6') |
    x = 7') |
   x = 8') |
  x = 9')"

decimal_def [rule_format] :
"ALL m.
 ALL X_n. m @@ X_n = (gn_inj(m) *'' (9' +' gn_inj(1'))) +' X_n"

ga_select_C1 [rule_format] :
"ALL x_1. ALL x_2. ALL x_3. C1(V(x_1, x_2, x_3)) = x_1"

ga_select_C2 [rule_format] :
"ALL x_1. ALL x_2. ALL x_3. C2(V(x_1, x_2, x_3)) = x_2"

ga_select_C3 [rule_format] :
"ALL x_1. ALL x_2. ALL x_3. C3(V(x_1, x_2, x_3)) = x_3"

Zero_Vector [rule_format] : "0'' = V(0', 0', 0')"

VectorStar_pred_def [rule_format] :
"ALL x. VectorStar_pred(x) = (~ x = 0'')"

Ax7 [rule_format] :
"ALL x. defOp (gn_proj(x)) = VectorStar_pred(x)"

VectorStar_subtype [rule_format] :
"isSubtypeWithPred(X_VectorStar_pred, X_VectorStar_inj,
 X_VectorStar_proj)"

def_of_vector_addition [rule_format] :
"ALL x.
 ALL y. x +'' y = V(C1(x) +' C1(y), C2(x) +' C2(y), C3(x) +' C3(y))"

def_of_minus_vector [rule_format] :
"ALL x. -'' x = V(-' C1(x), -' C2(x), -' C3(x))"

binary_inverse_2 [rule_format] :
"ALL x. ALL y. x -'' y = x +'' -'' y"

scalar_multiplication [rule_format] :
"ALL x. ALL y. x *_3 y = V(x *'' C1(y), x *'' C2(y), x *'' C3(y))"

scalar_product [rule_format] :
"ALL x.
 ALL y.
 x *_4 y =
 ((C1(x) *'' C1(y)) +' (C2(x) *'' C2(y))) +' (C3(x) *'' C3(y))"

vector_product [rule_format] :
"ALL x.
 ALL y.
 x #' y =
 V((C2(x) *'' C3(y)) -' (C2(y) *'' C3(x)),
 (C3(x) *'' C1(y)) -' (C3(y) *'' C1(x)),
 (C1(x) *'' C2(y)) -' (C1(y) *'' C2(x)))"

ONB1 [rule_format] : "e1 = V(gn_inj(1'), 0', 0')"

ONB2 [rule_format] : "e2 = V(0', gn_inj(1'), 0')"

ONB3 [rule_format] : "e3 = V(0', 0', gn_inj(1'))"

cross_left_homogenity [rule_format] :
"ALL r. ALL x. ALL y. r *_3 (x #' y) = (r *_3 x) #' y"

cross_product_antisymmetric [rule_format] :
"ALL x. ALL y. x #' y = -'' (y #' x)"

distributive [rule_format] :
"ALL v. ALL v'. ALL w. (v +'' v') *_4 w = (v *_4 w) +' (v' *_4 w)"

homogeneous [rule_format] :
"ALL a. ALL v. ALL w. (a *_3 v) *_4 w = a *'' (v *_4 w)"

symmetric [rule_format] : "ALL v. ALL w. v *_4 w = w *_4 v"

pos_definite [rule_format] : "ALL v. ~ v = 0'' --> v *_4 v >' 0'"

unit [rule_format] : "ALL x. gn_inj(1') *_3 x = x"

mix_assoc [rule_format] :
"ALL r. ALL s. ALL x. (r *'' s) *_3 x = r *_3 (s *_3 x)"

distr_Field [rule_format] :
"ALL r. ALL s. ALL x. (r +' s) *_3 x = (r *_3 x) +'' (s *_3 x)"

distr_Space [rule_format] :
"ALL r. ALL x. ALL y. r *_3 (x +'' y) = (r *_3 x) +'' (r *_3 y)"

ga_assoc___Xx___3_1 [rule_format] :
"ALL x. ALL y. ALL z. (x +'' y) +'' z = x +'' (y +'' z)"

ga_right_unit___Xx___3_1 [rule_format] : "ALL x. x +'' 0'' = x"

ga_left_unit___Xx___3_1 [rule_format] : "ALL x. 0'' +'' x = x"

inv_Group_2_1 [rule_format] : "ALL x. -'' x +'' x = 0''"

rinv_Group_2_1 [rule_format] : "ALL x. x +'' -'' x = 0''"

ga_comm___Xx___3 [rule_format] : "ALL x. ALL y. x +'' y = y +'' x"

zero_by_left_zero [rule_format] : "ALL x. 0' *_3 x = 0''"

zero_by_right_zero [rule_format] : "ALL r. r *_3 0'' = 0''"

inverse_by_XMinus1 [rule_format] :
"ALL x. -' gn_inj(1') *_3 x = -'' x"

right_distributive [rule_format] :
"ALL v. ALL v'. ALL w. w *_4 (v +'' v') = (w *_4 v) +' (w *_4 v')"

right_homogeneous [rule_format] :
"ALL a. ALL v. ALL w. v *_4 (a *_3 w) = a *'' (v *_4 w)"

non_degenerate [rule_format] : "ALL v. v *_4 v = 0' --> v = 0''"

lindep_def [rule_format] :
"ALL x. ALL y. lindep(x, y) = (y = 0'' | (EX r. x = r *_3 y))"

lindep_reflexivity [rule_format] : "ALL x. lindep(x, x)"

lindep_symmetry [rule_format] :
"ALL x. ALL y. lindep(x, y) --> lindep(y, x)"

simple_lindep_condition [rule_format] :
"ALL r. ALL x. ALL y. x = r *_3 y --> lindep(x, y)"

lindep_nonlindep_transitivity [rule_format] :
"ALL x.
 ALL y.
 ALL z.
 (~ x = 0'' & lindep(x, y)) & ~ lindep(y, z) --> ~ lindep(x, z)"

norm_from_inner_prod_def [rule_format] :
"ALL x.
 makePartial ( || x || ) =
 restrictOp (gn_proj(sqrt(makeTotal (gn_proj(x *_4 x)))))
 (defOp (gn_proj(x *_4 x)))"

proj_def [rule_format] :
"ALL v.
 ALL w.
 makePartial (proj(v, w)) =
 (if w = 0'' then makePartial 0''
     else restrictOp
          (makePartial (((v *_4 w) /' makeTotal (gn_proj(w *_4 w))) *_3 w))
          (defOp (gn_proj(w *_4 w))))"

orthcomp_def [rule_format] :
"ALL v. ALL w. orthcomp(v, w) = v -'' proj(v, w)"

orthogonal_def [rule_format] :
"ALL x. ALL y. orth(x, y) = (x *_4 y = 0')"

orth_symmetric [rule_format] :
"ALL x. ALL y. orth(x, y) --> orth(y, x)"

lindep_orth_transitive [rule_format] :
"ALL x. ALL y. ALL z. lindep(x, y) & orth(y, z) --> orth(x, z)"

orthogonal_existence_theorem [rule_format] :
"ALL x.
 (EX a. EX b. ~ lindep(a, b)) --> (EX c. ~ c = 0'' & orth(c, x))"

orthogonal_on_zero_projection [rule_format] :
"ALL x. ALL y. proj(x, y) = 0'' --> orth(x, y)"

orthogonal_projection_theorem [rule_format] :
"ALL x. ALL y. orth(orthcomp(x, y), y)"

orthogonal_decomposition_theorem [rule_format] :
"ALL x. ALL y. proj(x, y) +'' orthcomp(x, y) = x"

unique_orthogonal_decomposition [rule_format] :
"ALL v.
 ALL w.
 ALL x.
 ALL y.
 ALL z.
 ((((~ z = 0'' & x +'' y = v +'' w) & lindep(x, z)) &
   lindep(v, z)) &
  orth(z, y)) &
 orth(z, w) -->
 x = v & y = w"

declare refl [simp]
declare ga_assoc___Xx__ [simp]
declare ga_right_unit___Xx__ [simp]
declare ga_left_unit___Xx__ [simp]
declare inv_Group [simp]
declare rinv_Group [simp]
declare ga_comm___Xx__ [simp]
declare ga_assoc___Xx___1 [simp]
declare ga_right_unit___Xx___1 [simp]
declare ga_left_unit___Xx___1 [simp]
declare left_zero [simp]
declare right_zero [simp]
declare ga_comm___Xx___1 [simp]
declare ga_assoc___Xx___2 [simp]
declare ga_right_unit___Xx___2 [simp]
declare ga_left_unit___Xx___2 [simp]
declare inv_Group_1 [simp]
declare rinv_Group_1 [simp]
declare refl_1 [simp]
declare FWO_plus_left [simp]
declare FWO_plus_right [simp]
declare ga_comm_inf [simp]
declare ga_comm_sup [simp]
declare ga_comm_min [simp]
declare ga_comm_max [simp]
declare ga_assoc_min [simp]
declare ga_assoc_max [simp]
declare ga_left_comm_min [simp]
declare ga_left_comm_max [simp]
declare min_inf_relation [simp]
declare max_sup_relation [simp]
declare Ax3 [simp]
declare Ax4 [simp]
declare RealNonNeg_subtype [simp]
declare RealPos_subtype [simp]
declare sqrt_def [simp]
declare ga_select_C1 [simp]
declare ga_select_C2 [simp]
declare ga_select_C3 [simp]
declare Ax7 [simp]
declare VectorStar_subtype [simp]
declare unit [simp]
declare ga_assoc___Xx___3_1 [simp]
declare ga_right_unit___Xx___3_1 [simp]
declare ga_left_unit___Xx___3_1 [simp]
declare inv_Group_2_1 [simp]
declare rinv_Group_2_1 [simp]
declare ga_comm___Xx___3 [simp]
declare zero_by_left_zero [simp]
declare zero_by_right_zero [simp]
declare inverse_by_XMinus1 [simp]
declare lindep_reflexivity [simp]
declare lindep_symmetry [simp]
declare orth_symmetric [simp]
declare orthogonal_on_zero_projection [simp]
declare orthogonal_projection_theorem [simp]
declare orthogonal_decomposition_theorem [simp]

theorem cross_product_orthogonal : "ALL x. ALL y. orth(x, x #' y)"
unfolding vector_product orthogonal_def
proof (rule allI)+
  have Vector_struct: "!!a. a = V(C1(a), C2(a), C3(a))" by (case_tac a, simp)
  fix x y
  show "x *_4 V((C2(x) *'' C3(y)) -' (C2(y) *'' C3(x)),
       (C3(x) *'' C1(y)) -' (C3(y) *'' C1(x)),
       (C1(x) *'' C2(y)) -' (C1(y) *'' C2(x))) =
       0'"
    apply (subst Vector_struct)
    apply (subst scalar_product)
    apply simp
    apply (simp only: distr2_Ring binary_inverse_1)
    apply simp
    apply auto
    by auto
  fix a
  show "a = V(C1(a), C2(a), C3(a))"
      thm Vector.exhaust
    apply (insert Vector.exhaust [where P=False])
    apply (insert Vector.exhaust [where Real1="C1(a)" and Real2="C2(a)" and Real3="C3(a)"])

  from Vector.exhaust ga_select_C1 ga_select_C2 ga_select_C3 have "!!a. a = V(C1(a), C2(a), C3(a))"

ML "Header.record \"cross_product_orthogonal\""

theorem cross_product_zero_iff_lindep :
"ALL x. ALL y. lindep(x, y) = (x #' y = 0'')"
using subtype_def subtype_pred_def Ax1_1 inf_def
      RealNonNeg_pred_def RealPos_pred_def abs_def sqr_def sqrt_def
      Pos_def X2_def_Real X3_def_Real X4_def_Real X5_def_Real X6_def_Real
      X7_def_Real X8_def_Real X9_def_Real decimal_def Zero_Vector
      VectorStar_pred_def scalar_multiplication scalar_product
      vector_product ONB1 ONB2 ONB3 lindep_def norm_from_inner_prod_def
      proj_def orthcomp_def orthogonal_def
by (auto)

ML "Header.record \"cross_product_zero_iff_lindep\""

theorem e1e2_nonlindep : "~ lindep(e1, e2)"
using subtype_def subtype_pred_def Ax1_1 inf_def
      RealNonNeg_pred_def RealPos_pred_def abs_def sqr_def sqrt_def
      Pos_def X2_def_Real X3_def_Real X4_def_Real X5_def_Real X6_def_Real
      X7_def_Real X8_def_Real X9_def_Real decimal_def Zero_Vector
      VectorStar_pred_def scalar_multiplication scalar_product
      vector_product ONB1 ONB2 ONB3 lindep_def norm_from_inner_prod_def
      proj_def orthcomp_def orthogonal_def
by (auto)

ML "Header.record \"e1e2_nonlindep\""

end


theory Schnorr_Sigma_Commit imports
  Abstract_Commitment
  Abstract_Sigma_Protocols
  Cyclic_Group_Ext
  Discrete_log
  Uniform_Sampling
  Uniform_Sampling_Defs
begin

locale schnorr_base =
  fixes \<G> :: "'grp cyclic_group" (structure)
  assumes finite_group: "finite (carrier \<G>)"
    and order_gt_0: "order \<G> > 0"
    and prime_order: "prime (order \<G>)"
    and prime_field: "a < (order \<G>) \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> coprime a (order \<G>)"
begin

type_synonym witness = "nat"
type_synonym rand = nat
type_synonym 'grp' msg = "'grp'"
type_synonym response = nat
type_synonym challenge = nat
type_synonym 'grp' pub_in = "'grp'"

definition R_DL :: "'grp pub_in \<Rightarrow> witness \<Rightarrow> bool"
  where "R_DL h w \<equiv> (h = \<^bold>g (^) w \<and> w \<noteq> 0 \<and> w < order \<G>)"

lemma lossless_samp_uni_excl: "lossless_spmf (samp_uni_excl (order \<G>) p)"
  apply(simp add: samp_uni_excl_def)
  using order_gt_0
  by (metis One_nat_def card.insert card_empty card_lessThan empty_iff finite.intros(1) less_irrefl prime_gt_1_nat prime_order subset_singletonD)

lemma set_spmf_samp_uni [simp]: "set_spmf (sample_uniform (order \<G>)) = {x. x < order \<G>}"
  by(auto simp add: sample_uniform_def)

definition init :: "'grp pub_in \<Rightarrow> witness \<Rightarrow> (rand \<times> 'grp msg) spmf"
  where "init h w = do {
    r \<leftarrow> sample_uniform (order \<G>);
    return_spmf (r, \<^bold>g (^) r)}"

definition "challenge = sample_uniform (order \<G>)"

definition "snd_challenge p = samp_uni_excl (order \<G>) p"

definition "response r w c = return_spmf ((w*c + r) mod (order \<G>))"

definition check :: "'grp pub_in \<Rightarrow> 'grp msg \<Rightarrow> challenge \<Rightarrow> response \<Rightarrow> bool spmf"
  where "check h a e z = return_spmf (a \<otimes> (h (^) e) = \<^bold>g (^) z)"

definition R2 :: "'grp pub_in \<Rightarrow> witness \<Rightarrow> ('grp msg, challenge, response) conv_tuple spmf"
where "R2 h w = do {
  (r, a) \<leftarrow> init h w;
  c \<leftarrow> sample_uniform (order \<G>);
  let z = (w*c + r) mod (order \<G>);
  return_spmf (a,c, z)}"

lemma "R2 h w = do {
  r \<leftarrow> sample_uniform (order \<G>);
  let (r, a) = (r, \<^bold>g (^) r);
  c \<leftarrow> sample_uniform (order \<G>);
  let z = (w*c + r) mod (order \<G>);
  return_spmf (a,c, z)}"
  by(simp add: R2_def init_def)

definition S2 :: "'grp \<Rightarrow> challenge \<Rightarrow> ('grp msg, challenge, response) conv_tuple spmf"
where "S2 h e = do {
  c \<leftarrow> sample_uniform (order \<G>);
  let a = \<^bold>g (^) c \<otimes> (inv (h (^) e));
  return_spmf (a, e, c)}"

definition pk_adversary :: "'grp \<Rightarrow> ('grp msg, challenge, response) conv_tuple \<Rightarrow> ('grp msg, challenge, response) conv_tuple \<Rightarrow> nat spmf"
  where "pk_adversary x c1 c2 = do {
    let (a, e, z) = c1;
    let (a', e', z') = c2;
    return_spmf (if e > e' then (nat ((int z - int z') * (fst (bezw (e - e') (order \<G>))) mod order \<G>)) else
(nat ((int z' - int z) * (fst (bezw (e' - e) (order \<G>))) mod order \<G>)))}"

sublocale epsilon_protocols_base: epsilon_protocols_base init challenge snd_challenge response check R_DL S2 .

lemma R2_eq_R: "R2 h w = epsilon_protocols_base.R h w"
  unfolding  R2_def epsilon_protocols_base.R_def Let_def
  by(simp add: challenge_def response_def)

(*use Schnorr to make commitment protocol*)

type_synonym 'grp' ck = "'grp'"
type_synonym 'grp' vk = "'grp' \<times> nat"
type_synonym plain = "nat"
type_synonym 'grp' commit = "'grp'"
type_synonym opening = "nat" (*just z, as this is the opening value as the message is set with it*)

definition gen :: "('grp ck \<times> 'grp vk) spmf" (*outputs commitment key and verify key*)
  where "gen = do {
    w \<leftarrow> sample_uniform (order \<G>);
    return_spmf (\<^bold>g (^) w, (\<^bold>g (^) w, w))}"

definition commit :: "'grp ck \<Rightarrow> plain \<Rightarrow> ('grp commit \<times> opening) spmf"
  where "commit ck e = do {
    (a, e, z) \<leftarrow> S2 ck e;
    return_spmf (a, z)}"

definition verify :: "'grp vk \<Rightarrow> plain \<Rightarrow> 'grp commit \<Rightarrow> opening \<Rightarrow> bool spmf"
  where "verify h e c z = (check (fst h) c e z)"

definition "valid_msg m \<equiv> m < order \<G>"

definition \_cond :: "'grp commit \<Rightarrow> plain \<Rightarrow> opening \<Rightarrow> plain \<Rightarrow> opening \<Rightarrow> bool"
  where "\_cond c m d m' d' = (m > m' \<and> \<not> [m = m'] (mod order \<G>) \<and> (gcd (m - m') (order \<G>) = 1) \<and> c \<in> carrier \<G>)"

definition dis_log_\ :: "('grp ck, plain, 'grp commit, opening) bind_adv \<Rightarrow> 'grp ck \<Rightarrow> nat spmf"
where "dis_log_\ \ h = do {
  (c, e, z, e', z') \<leftarrow> \ h;
  _ :: unit \<leftarrow> assert_spmf (e > e' \<and> \<not> [e = e'] (mod order \<G>) \<and> (gcd (e - e') (order \<G>) = 1) \<and> c \<in> carrier \<G>);
  _ :: unit \<leftarrow> assert_spmf (((c \<otimes> h (^) e) = \<^bold>g (^) z) \<and> (c \<otimes> h (^) e') = \<^bold>g (^) z');
  return_spmf  (nat ((int z - int z') * (fst (bezw (e - e') (order \<G>))) mod order \<G>))}"

sublocale abstract_commitment: abstract_commitment gen commit verify valid_msg \_cond .
sublocale discrete_log: dis_log .

end

locale schnorr_sigma_protocol = schnorr_base + cyclic_group \<G>
begin

lemma complete: assumes "h = \<^bold>g (^) (w::nat)"
  shows "spmf (epsilon_protocols_base.completeness_game h w) True = 1"
proof-
  have "\<^bold>g (^) y \<otimes> (\<^bold>g (^) w) (^) e = \<^bold>g (^) (y + w * e)" for y e
    using nat_pow_pow nat_pow_mult by simp
  then show ?thesis
    unfolding  epsilon_protocols_base.completeness_game_def
    by(simp add: init_def challenge_def response_def check_def pow_generator_mod assms add.commute bind_spmf_const order_gt_0)
qed

lemma completeness: "epsilon_protocols_base.completeness h w"
  by(simp add: epsilon_protocols_base.completeness_def R_DL_def complete)

lemma zr:
  assumes z: "z = (x*c + r) mod (order \<G>)"
    and x: "x < order \<G>"
    and c: "c < order \<G>"
    and r: "r < order \<G>"
  shows "(z + (order \<G>)*(order \<G>) - x*c) mod (order \<G>) = r"
proof-
  have cong: "[z + (order \<G>)*(order \<G>) = x*c + r] (mod (order \<G>))"
    by(simp add: cong_nat_def z)
  hence "[z + (order \<G>)*(order \<G>) - x*c = r] (mod (order \<G>))"
  proof-
    have "z + (order \<G>)*(order \<G>) > x*c"
      using x c by (simp add: mult_strict_mono trans_less_add2)
    then show ?thesis
      by (metis cong add_diff_inverse_nat cong_add_lcancel_nat less_imp_le linorder_not_le)
  qed
  then show ?thesis
    by(simp add: cong_nat_def r)
qed

lemma h_sub:
  assumes "h = \<^bold>g (^) x" and x_not_0: "x \<noteq> 0" and x: "x < order \<G>" and z: "z < order \<G>" and c: "c < order \<G>"
  shows "\<^bold>g (^) ((z + (order \<G>)*(order \<G>) - x*c)) = \<^bold>g (^) z \<otimes> inv (h (^) c)"
(is "?lhs = ?rhs")
proof-
  have "(z + order \<G> * order \<G> - x * c) = (z + (order \<G> * order \<G> - x * c))"
    using x c z by (simp add: less_imp_le_nat mult_le_mono)
  then have lhs: "?lhs = \<^bold>g (^) z \<otimes> \<^bold>g (^) ((order \<G>)*(order \<G>) - x*c)" by(simp add: nat_pow_mult)
  have " \<^bold>g (^) ((order \<G>)*(order \<G>) - x*c) =  inv (h (^) c)"
  proof-
    have "((order \<G>)*(order \<G>) - x*c) > 0" using assms
      by (simp add: mult_strict_mono)
    then have " \<^bold>g (^) ((order \<G>)*(order \<G>) - x*c) =  \<^bold>g (^) int ((order \<G>)*(order \<G>) - x*c)"
      by (simp add: int_pow_int)
    also have "... = \<^bold>g (^) int ((order \<G>)*(order \<G>)) \<otimes> inv (\<^bold>g (^) (x*c))"
      using int_pow_diff[of "\<^bold>g" "order \<G> * order \<G>" "x * c"]
      by (smt \<open>0 < order \<G> * order \<G> - x * c\<close> generator_closed group.int_pow_def2 group_l_invI int_minus int_pow_int l_inv_ex of_nat_less_iff zero_less_diff)
    also have "... = \<^bold>g (^) ((order \<G>)*(order \<G>)) \<otimes> inv (\<^bold>g (^) (x*c))"
      by (metis int_pow_int)
    also have "... = \<^bold>g (^) ((order \<G>)*(order \<G>)) \<otimes> inv ((\<^bold>g (^) x) (^) c)"
      by(simp add: nat_pow_pow)
    also have "... = \<^bold>g (^) ((order \<G>)*(order \<G>)) \<otimes> inv (h (^) c)"
      using assms by simp
    also have "... = \<one> \<otimes> inv (h (^) c)"
      using generator_pow_order
      by (metis generator_closed mult_is_0 nat_pow_0 nat_pow_pow)
    ultimately show ?thesis
      by (simp add: assms(1))
  qed
  then show ?thesis using lhs by simp
qed

lemma hv_zk: assumes "h = \<^bold>g (^) x" and "x \<noteq> 0" and "x < order \<G>"
  shows "epsilon_protocols_base.R h x = bind_spmf challenge (S2 h)"
  including monad_normalisation
proof-
  have "R2 h x = bind_spmf challenge (S2 h)"
  proof-
    have "R2 h x = do {
      r \<leftarrow> sample_uniform (order \<G>);
      c \<leftarrow> sample_uniform (order \<G>);
      let z = (x*c + r) mod (order \<G>);
      let a = \<^bold>g (^) ((z + (order \<G>)*(order \<G>) - x*c) mod (order \<G>));
      return_spmf (a,c,z)}"
      apply(simp add: Let_def R2_def init_def)
      using assms zr by(simp cong: bind_spmf_cong_simp)
    also have "... = do {
      c \<leftarrow> sample_uniform (order \<G>);
      z \<leftarrow> map_spmf (\<lambda> r. (x*c + r) mod (order \<G>)) (sample_uniform (order \<G>));
      let a = \<^bold>g (^) ((z + (order \<G>)*(order \<G>) - x*c) mod (order \<G>));
      return_spmf (a,c,z)}"
      by(simp add: bind_map_spmf o_def Let_def)
    also have "... = do {
      c \<leftarrow> sample_uniform (order \<G>);
      z \<leftarrow>  (sample_uniform (order \<G>));
      let a = \<^bold>g (^) ((z + (order \<G>)*(order \<G>) - x*c));
      return_spmf (a,c,z)}"
      by(simp add: samp_uni_plus_one_time_pad pow_generator_mod)
    also have "... = do {
      c \<leftarrow> sample_uniform (order \<G>);
      z \<leftarrow>  (sample_uniform (order \<G>));
      let a = \<^bold>g (^) z \<otimes> inv (h (^) c);
      return_spmf (a,c,z)}"
      using h_sub assms by(simp cong: bind_spmf_cong_simp)
    ultimately show ?thesis
      unfolding S2_def Let_def R2_def challenge_def by simp
  qed
  then show ?thesis using R2_eq_R by simp
qed

lemma honest_verifier_ZK:
  shows "epsilon_protocols_base.honest_V_ZK h w"
    unfolding epsilon_protocols_base.honest_V_ZK_def
    by(auto simp add: hv_zk R_DL_def)

lemma inverse: assumes "gcd x (order \<G>) = 1"
  shows "[x * (fst (bezw x (order \<G>))) = 1] (mod order \<G>)"
proof-
  have 2: "fst (bezw  x (order \<G>)) * x + snd (bezw x (order \<G>)) * int (order \<G>) = 1"
    using bezw_aux assms int_minus by presburger
  hence 3: "(fst (bezw  x (order \<G>)) * x + snd (bezw x (order \<G>)) * int (order \<G>)) mod (order \<G>) = 1 mod (order \<G>)"
    by (simp add: zmod_int)
  hence 4: "(fst (bezw x (order \<G>)) * x) mod (order \<G>) = 1 mod (order \<G>)"
    by simp
  hence 5:  "[(fst (bezw x (order \<G>))) * x  = 1] (mod order \<G>)"
    using 2 3 cong_int_def by auto
  then show ?thesis by(simp add: mult.commute)
qed

lemma witness_find:
  assumes "ya < order \<G>" and "yb < order \<G>" and "y < order \<G>" and w: "w < order \<G>" and "ya \<noteq> yb" and "w \<noteq> 0"
  shows "w = (if (ya > yb) then nat ((int ((w * ya + y) mod order \<G>) - int ((w * yb + y) mod order \<G>)) * fst (bezw (ya - yb) (order \<G>)) mod int (order \<G>))
            else nat ((int ((w * yb + y) mod order \<G>) - int ((w * ya + y) mod order \<G>)) * fst (bezw (yb - ya) (order \<G>)) mod int (order \<G>)))"
proof(cases "ya > yb")
  case True
 have gcd: "gcd (ya - yb) (order \<G>) = 1"
  proof-
    have "(ya - yb) < order \<G>" and "(ya - yb) \<noteq> 0"
      apply(simp add: less_imp_diff_less assms True)
      using True by simp
    then show ?thesis using prime_field by blast
  qed
  have "[w*(ya - yb)*(fst (bezw (ya - yb) (order \<G>))) = (w*ya - w*yb)*(fst (bezw (ya - yb) (order \<G>)))] (mod (order \<G>))"
    by (simp add: diff_mult_distrib2 assms cong_nat_def)
  hence "[w*((ya - yb)*(fst (bezw (ya - yb) (order \<G>)))) = (w*ya - w*yb)*(fst (bezw (ya - yb) (order \<G>)))] (mod (order \<G>))"
    by (simp add: mult.assoc)
  hence "[w = (w*ya - w*yb)*(fst (bezw (ya - yb) (order \<G>)))] (mod (order \<G>))"
    by (metis (no_types, hide_lams) gcd inverse[of "(ya - yb)"] cong_scalar_int cong_sym_int cong_trans_int mult.commute mult.left_neutral)
  hence "[int w = (int w* int ya - int w* int yb)*(fst (bezw (ya - yb) (order \<G>)))] (mod (order \<G>))"
    by (simp add: True less_imp_le_nat of_nat_diff)
  hence "int w mod order \<G>  = (int w* int ya - int w* int yb)*(fst (bezw (ya - yb) (order \<G>))) mod (order \<G>)"
    using cong_int_def by blast
  hence "w mod order \<G>  = (int w* int ya - int w* int yb)*(fst (bezw (ya - yb) (order \<G>))) mod (order \<G>)"
    by (simp add: zmod_int)
  then show ?thesis using w
  proof -
    have f1: "\<forall>n na nb. int (nb + na) - int (nb + n) = int na - int n"
      by simp
    have "(int (w * ya) - int (w * yb)) * fst (bezw (ya - yb) (order \<G>)) mod int (order \<G>) = int w"
      using \<open>int (w mod order \<G>) = (int w * int ya - int w * int yb) * fst (bezw (ya - yb) (order \<G>)) mod int (order \<G>)\<close> w by force
    then show ?thesis
      using f1
    proof -
      have "nat ((int ((y + w * ya) mod order \<G>) - int ((y + w * yb) mod order \<G>)) * fst (bezw (if True then ya - yb else yb - ya) (order \<G>)) mod int (order \<G>)) = w"
        by (metis (no_types) \<open>(int (w * ya) - int (w * yb)) * fst (bezw (ya - yb) (order \<G>)) mod int (order \<G>) = int w\<close> \<open>\<forall>n na nb. int (nb + na) - int (nb + n) = int na - int n\<close> mod_diff_left_eq mod_diff_right_eq mod_mult_cong nat_int zmod_int)
      then show ?thesis
        by (simp add: True add.commute)
    qed
  qed
next
  case False
  have False': "yb > ya" using False assms
    using nat_neq_iff by blast
  have gcd: "gcd (yb - ya) (order \<G>) = 1"
  proof-
    have "(yb - ya) < order \<G>" and "(yb - ya) \<noteq> 0"
      using less_imp_diff_less assms apply blast
      using assms(6) zero_less_diff False' by blast
    then show ?thesis using prime_field by blast
  qed
  have "[w*(yb - ya)*(fst (bezw (yb - ya) (order \<G>))) = (w*yb - w*ya)*(fst (bezw (yb - ya) (order \<G>)))] (mod (order \<G>))"
    using assms cong_nat_def
    by (simp add: diff_mult_distrib2)
  then have "[w*((yb - ya)*(fst (bezw (yb - ya) (order \<G>)))) = (w*yb - w*ya)*(fst (bezw (yb - ya) (order \<G>)))] (mod (order \<G>))"
    by (simp add: mult.assoc)
  then have "[w = (w*yb - w*ya)*(fst (bezw (yb - ya) (order \<G>)))] (mod (order \<G>))"
    using gcd inverse[of "(yb - ya)"]
    by (metis (no_types, hide_lams) cong_scalar_int cong_sym_int cong_trans_int mult.commute mult.left_neutral)
  then have "[int w = (int w* int yb - int w* int ya)*(fst (bezw (yb - ya) (order \<G>)))] (mod (order \<G>))"
    by (simp add: False' less_imp_le_nat of_nat_diff)
  then have "int w mod order \<G>  = (int w* int yb - int w* int ya)*(fst (bezw (yb - ya) (order \<G>))) mod (order \<G>)"
    using cong_int_def by blast
  hence "w mod order \<G>  = (int w* int yb - int w* int ya)*(fst (bezw (yb - ya) (order \<G>))) mod (order \<G>)"
    by (simp add: zmod_int)
  then show ?thesis using w
  proof -
    have f1: "\<forall>n na nb. int (nb + na) - int (nb + n) = int na - int n"
      by simp
    have "(int (w * yb) - int (w * ya)) * fst (bezw (yb - ya) (order \<G>)) mod int (order \<G>) = int w"
      using \<open>int (w mod order \<G>) = (int w * int yb - int w * int ya) * fst (bezw (yb - ya) (order \<G>)) mod int (order \<G>)\<close> w by force
    then show ?thesis
      using f1
    proof -
      have "nat ((int ((y + w * yb) mod order \<G>) - int ((y + w * ya) mod order \<G>)) * fst (bezw (if True then yb - ya else ya - yb) (order \<G>)) mod int (order \<G>)) = w"
        by (metis (no_types) \<open>(int (w * yb) - int (w * ya)) * fst (bezw (yb - ya) (order \<G>)) mod int (order \<G>) = int w\<close> \<open>\<forall>n na nb. int (nb + na) - int (nb + n) = int na - int n\<close> mod_diff_left_eq mod_diff_right_eq mod_mult_cong nat_int zmod_int)
      then show ?thesis
        by (simp add: False add.commute)
    qed
  qed
qed

lemma special_soundness:
  shows "epsilon_protocols_base.special_soundness h w"
proof-
  {assume w1: "w \<noteq> 0" and w2: "w < order \<G>"
    have "local.epsilon_protocols_base.special_soundness_game h w pk_adversary = return_spmf True"
      (is "?lhs = ?rhs")
  proof-
    have "?lhs = do {
      y \<leftarrow> sample_uniform (order \<G>);
      ya \<leftarrow> sample_uniform (order \<G>);
      yb \<leftarrow> samp_uni_excl (order \<G>) ya;
      return_spmf (w = (if (ya > yb) then nat ((int ((w * ya + y) mod order \<G>) - int ((w * yb + y) mod order \<G>)) * fst (bezw (ya - yb) (order \<G>)) mod int (order \<G>))
          else nat ((int ((w * yb + y) mod order \<G>) - int ((w * ya + y) mod order \<G>)) * fst (bezw (yb - ya) (order \<G>)) mod int (order \<G>))))}"
       unfolding local.epsilon_protocols_base.special_soundness_game_def pk_adversary_def
       by(simp add: response_def challenge_def init_def snd_challenge_def)
    then show ?thesis
      by(simp add: witness_find w1 w2 bind_spmf_const lossless_samp_uni_excl order_gt_0 lossless_weight_spmfD cong: bind_spmf_cong_simp)
  qed }
  then have "w \<noteq> 0 \<Longrightarrow> w < order \<G> \<Longrightarrow> spmf (local.epsilon_protocols_base.special_soundness_game h w pk_adversary) True = 1"
     by simp
  then show ?thesis unfolding epsilon_protocols_base.special_soundness_def R_DL_def by auto
qed

theorem sigma_protocol: "epsilon_protocols_base.\<Sigma>_protocol h w"
  by(simp add: epsilon_protocols_base.\<Sigma>_protocol_def completeness honest_verifier_ZK special_soundness)

end

locale schnorr_commitment = schnorr_base + cyclic_group \<G>
begin

lemma correct: "abstract_commitment.correct_game m = return_spmf True"
proof-
  have carrier: "(\<^bold>g (^) (y::nat)) (^) m \<in> carrier \<G>" for y by simp
  have "\<^bold>g (^) (ya::nat) \<otimes> inv ((\<^bold>g (^) (y::nat)) (^) m) \<otimes> (\<^bold>g (^) y) (^) m = \<^bold>g (^) ya" for ya y
  proof-
    have "\<^bold>g (^) (ya::nat) \<otimes> inv ((\<^bold>g (^) (y::nat)) (^) m) \<otimes> (\<^bold>g (^) y) (^) m = \<^bold>g (^) (ya::nat) \<otimes> (inv ((\<^bold>g (^) (y::nat)) (^) m) \<otimes> (\<^bold>g (^) y) (^) m)"
      by (simp add: monoid.m_assoc)
    then show ?thesis by simp
  qed
  then show ?thesis
    by(simp add: commit_def gen_def Abstract_Commitment.abstract_commitment.correct_game_def verify_def S2_def bind_spmf_const order_gt_0 check_def)
qed

lemma abstract_correct: "abstract_commitment.correct m"
  by(simp add: abstract_commitment.correct_def correct[of "m"])

lemma perfect_hiding: "abstract_commitment.hiding_game \ = coin_spmf"
  including monad_normalisation
proof-
  obtain \1 and \2 where "\ = (\1, \2)" by(cases \)
  note [simp] = this order_gt_0_iff_finite finite_group try_spmf_bind_out split_def o_def spmf_of_set bind_map_spmf weight_spmf_le_1 scale_bind_spmf bind_spmf_const
    and [cong] = bind_spmf_cong_simp
  have "abstract_commitment.hiding_game (\1, \2) = TRY do {
  w \<leftarrow> sample_uniform (order \<G>);
  ((m0, m1), \<sigma>) \<leftarrow> \1 ( \<^bold>g (^) w ,w);
  _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
  b \<leftarrow> coin_spmf;
  c' \<leftarrow> sample_uniform (order \<G>);
  let c = \<^bold>g (^) c' \<otimes> (inv ((\<^bold>g (^) w) (^) (if b then m0 else m1)));
  b' \<leftarrow> \2 c \<sigma>;
  return_spmf (b' = b)} ELSE coin_spmf"
    by(simp add: Abstract_Commitment.abstract_commitment.hiding_game_def gen_def commit_def S2_def)
  also have "... = TRY do {
  w \<leftarrow> sample_uniform (order \<G>);
  ((m0, m1), \<sigma>) \<leftarrow> \1 (\<^bold>g (^) w, w);
  _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
  b \<leftarrow> coin_spmf;
  c \<leftarrow> map_spmf (\<lambda> c'. \<^bold>g (^) c' \<otimes> (inv ((\<^bold>g (^) w) (^) (if b then m0 else m1)))) (sample_uniform (order \<G>));
  b' \<leftarrow> \2 c \<sigma>;
  return_spmf (b' = b)} ELSE coin_spmf"
    by(simp add: Let_def)
  also have "... = TRY do {
  w :: nat \<leftarrow> sample_uniform (order \<G>);
  ((m0, m1), \<sigma>) \<leftarrow> \1 (\<^bold>g (^) w, w);
  _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
  b :: bool \<leftarrow> coin_spmf;
  c \<leftarrow> map_spmf (\<lambda> c'. \<^bold>g (^) c') (sample_uniform (order \<G>));
  b' :: bool \<leftarrow> \2 c \<sigma>;
  return_spmf (b' = b)} ELSE coin_spmf"
    by(simp add: sample_uniform_one_time_pad)
  also have "... = TRY do {
  w :: nat \<leftarrow> sample_uniform (order \<G>);
  ((m0, m1), \<sigma>) \<leftarrow> \1 (\<^bold>g (^) w, w);
  _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
  c \<leftarrow> map_spmf (\<lambda> c'. \<^bold>g (^) c') (sample_uniform (order \<G>));
  b' :: bool \<leftarrow> \2 c \<sigma>;
  map_spmf (op = b') coin_spmf} ELSE coin_spmf"
    by(simp add: sample_uniform_one_time_pad map_spmf_conv_bind_spmf[where p=coin_spmf])
  also have "... = TRY do {
  w :: nat \<leftarrow> sample_uniform (order \<G>);
  ((m0, m1), \<sigma>) \<leftarrow> \1 (\<^bold>g (^) w, w);
  _ :: unit \<leftarrow> assert_spmf (valid_msg m0 \<and> valid_msg m1);
  c' \<leftarrow> (sample_uniform (order \<G>));
  let c =  \<^bold>g (^) c';
  b' :: bool \<leftarrow> \2 c \<sigma>;
  map_spmf (op = b') coin_spmf} ELSE coin_spmf"
    by(simp add: Let_def)
  also have "... = coin_spmf"
    by(auto simp add:  try_bind_spmf_lossless2' map_eq_const_coin_spmf Let_def   )
  ultimately show ?thesis by simp
qed

theorem abstract_perfect_hiding:
  shows "abstract_commitment.perfect_hiding \"
  by(simp add: spmf_of_set perfect_hiding abstract_commitment.perfect_hiding_def)

lemma mod_one_cancel: assumes "[int y * z * x = y' * x] (mod order \<G>)" and "[z * x = 1] (mod order \<G>)"
  shows "[int y = y' * x] (mod order \<G>)"
  by (metis ab_semigroup_mult_class.mult_ac(1) cong_refl_int cong_scalar2_int cong_sym_int cong_trans_int mult.left_neutral semiring_normalization_rules(7) assms)

lemma dis_log_break:
  fixes z z' e e' :: nat
  assumes c: "c \<otimes> (\<^bold>g (^) w) (^) e = \<^bold>g (^) z"
    and c': "c \<otimes> (\<^bold>g (^) w) (^) e' = \<^bold>g (^) z'"
    and c_carrier: "c \<in> carrier \<G>"
    and w_less_order: "w < order \<G>"
    and gcd: "gcd (e - e') (order \<G>) = 1"
    and m_ge_m': "e > e'"
    and mm': "\<not> [e = e'] (mod order \<G>)"
  shows "w = nat ((int z - int z') * (fst (bezw (e -  e') (order \<G>))) mod order \<G>)"
proof -
  have carrier1: "\<^bold>g (^) (w*e) \<in> carrier \<G>" by simp
  have carrier2: "inv (\<^bold>g (^) (w*e)) \<in> carrier \<G>" by simp
  have carrier3: "\<^bold>g (^) (w*e') \<in> carrier \<G>" by simp
  have carrier4: "inv (\<^bold>g (^) (w*e')) \<in> carrier \<G>" by simp
  have group_monoid: "Group.monoid \<G>" by simp
  have "c \<otimes> \<^bold>g (^) (w*e) = \<^bold>g (^) z" using c by(simp add: nat_pow_pow)
  then have "c \<otimes> \<^bold>g (^) (w*e) \<otimes> inv (\<^bold>g (^) (w*e)) = \<^bold>g (^) z \<otimes> inv (\<^bold>g (^) (w*e))" by simp
  then have "c \<otimes> (\<^bold>g (^) (w*e) \<otimes> inv (\<^bold>g (^) (w*e))) = \<^bold>g (^) z \<otimes> inv (\<^bold>g (^) (w*e))"
  proof-
    have "c \<otimes> \<^bold>g (^) (w*e) \<otimes> inv (\<^bold>g (^) (w*e)) = c \<otimes> (\<^bold>g (^) (w*e) \<otimes> inv (\<^bold>g (^) (w*e)))"
    using carrier2 monoid.m_assoc[of "\<G>" "c" "\<^bold>g (^) (w*e)" "inv (\<^bold>g (^) (w*e))"] carrier1 group_monoid c_carrier
    by linarith
  then show ?thesis
    by (simp add: \<open>c \<otimes> \<^bold>g (^) (w * e) = \<^bold>g (^) z\<close>)
  qed
  then have c1: "c = \<^bold>g (^) z \<otimes> inv (\<^bold>g (^) (w*e))" using carrier1 carrier2
    by (simp add: c_carrier)
  have "c \<otimes> \<^bold>g (^) (w*e') = \<^bold>g (^) z'" using c' by(simp add: nat_pow_pow)
  then have "c \<otimes> \<^bold>g (^) (w*e') \<otimes> inv (\<^bold>g (^) (w*e')) = \<^bold>g (^) z' \<otimes> inv (\<^bold>g (^) (w*e'))" by simp
  then have "c \<otimes> (\<^bold>g (^) (w*e') \<otimes> inv (\<^bold>g (^) (w*e'))) = \<^bold>g (^) z' \<otimes> inv (\<^bold>g (^) (w*e'))"
  proof-
    have "c \<otimes> \<^bold>g (^) (w*e') \<otimes> inv (\<^bold>g (^) (w*e')) = c \<otimes> (\<^bold>g (^) (w*e') \<otimes> inv (\<^bold>g (^) (w*e')))"
    using carrier4 monoid.m_assoc[of "\<G>" "c" "\<^bold>g (^) (w*e')" "inv (\<^bold>g (^) (w*e'))"] carrier3 group_monoid c_carrier
    by linarith
  then show ?thesis
    by (simp add: \<open>c \<otimes> \<^bold>g (^) (w * e') = \<^bold>g (^) z'\<close>)
  qed
  then have c2: "c = \<^bold>g (^) z' \<otimes> inv (\<^bold>g (^) (w*e'))" using carrier1 carrier2
    by (simp add: c_carrier)
  have "\<^bold>g (^) z \<otimes> inv (\<^bold>g (^) (w*e)) = \<^bold>g (^) z' \<otimes> inv (\<^bold>g (^) (w*e'))" using c1 c2 by simp
  then have "\<^bold>g (^) (z + order \<G> * e) \<otimes> inv (\<^bold>g (^) (w*e)) = \<^bold>g (^) (z' + order \<G> + order \<G> * e') \<otimes> inv (\<^bold>g (^) (w*e'))"   using  mod_mult_self2 pow_generator_mod
    by (metis mod_add_self2)
  then have "\<^bold>g (^) (int z + int (order \<G>) * int e) \<otimes> inv (\<^bold>g (^) (int w* int e)) = \<^bold>g (^) (int z' + int (order \<G>) + int (order \<G>) * int e') \<otimes> inv (\<^bold>g (^) (int w* int e'))"
    by (metis (no_types, hide_lams) int_pow_int of_nat_add of_nat_mult)
  then have int_exp: "\<^bold>g (^) (int z + int (order \<G>) * int e - int w* int e) = \<^bold>g (^) (int z' + int (order \<G>) + int (order \<G>) * int e' - int w* int e')"
    using int_pow_diff by simp
  have exp_lhs: "(int z + int (order \<G>) * int e - int w* int e) = (z + (order \<G>) * e - w* e)"
  proof-
    have "z + (order \<G>) * e - w* e > 0" using w_less_order
      by (metis m_ge_m' mult.commute nat_mult_less_cancel_disj neq0_conv not_less0 trans_less_add2 zero_less_diff)
    then show ?thesis
      by (simp add: of_nat_diff)
  qed
  have exp_rhs: "(int z' + int (order \<G>) + int (order \<G>) * int e' - int w* int e') = (z' + order \<G> + (order \<G>) * e' - w* e')"
  proof-
    have "(z' + order \<G> + (order \<G>) * e' - w* e') > 0" using w_less_order
      by (metis Nat.add_diff_assoc add_gr_0 less_imp_le_nat mult.commute nat_mult_le_cancel_disj order_gt_0)
    then show ?thesis by (simp add: of_nat_diff)
  qed
  have "\<^bold>g (^) (z + (order \<G>) * e - w* e) = \<^bold>g (^) (z' + order \<G> + (order \<G>) * e' - w* e')" using exp_lhs exp_rhs int_exp
    by (simp add: int_pow_int)
  then have "[(z + (order \<G>) * e - w* e) = (z' + order \<G> + (order \<G>) * e' - w* e')] (mod order \<G>)"
    by(simp add: pow_generator_eq_iff_cong finite_group)
  then have "[(z + (order \<G>) * e ) = (z' + order \<G> + (order \<G>) * e' - w* e' +  w* e)] (mod order \<G>)"
    by (metis (no_types, hide_lams) add.commute add_diff_inverse_nat cong_add_lcancel_nat distrib_right nat_diff_split nat_neq_iff trans_less_add1 w_less_order zero_less_diff)
  then have "[(z + (order \<G>) * e ) = (z' + order \<G> + (order \<G>) * e' + w* e -  w* e')] (mod order \<G>)"
   by (simp add: less_imp_le_nat trans_le_add2 w_less_order)
  then have "[(z + (order \<G>) * e ) = (z' + order \<G> + (order \<G>) * e' + w*(e -e'))] (mod order \<G>)"
    by (simp add: diff_mult_distrib2 less_imp_le_nat m_ge_m')
  then have "[z = z' + w*(e - e')] (mod order \<G>)"
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1) cong_nat_def mod_add_cong mod_add_self2 semiring_div_class.mod_mult_self4)
  then have "[int z = int z' + int w* int (e - e')] (mod order \<G>)"
    using transfer_int_nat_cong by force
  then have "[int z - int z' = int w* int (e - e')] (mod order \<G>)"
    by (metis add.commute cong_add_lcancel_int diff_add_cancel)
  then have "[int z - int z' = int w* (int e - int e')] (mod order \<G>)"
    by (simp add: less_imp_le_nat m_ge_m' of_nat_diff)
  then have "[(int z - int z') * (fst (bezw (nat (int e - int e')) (order \<G>))) = int w* (int e - int e') * (fst (bezw (nat (int e - int e')) (order \<G>)))] (mod order \<G>)"
    using cong_scalar_int by blast
  then have "[(int z - int z') * (fst (bezw (nat (int e - int e')) (order \<G>))) = int w* ((int e - int e') * (fst (bezw (nat (int e - int e')) (order \<G>))))] (mod order \<G>)"
    by (simp add: mult.assoc)
  then have "[(int z - int z') * (fst (bezw (nat (int e - int e')) (order \<G>))) = int w* 1] (mod order \<G>)"
    using assms inverse
  proof -
    have f1: "int e - int e' = int e + - 1 * int e'"
      by auto
    have f2: "int w * 1 = int w"
      by simp
    have "nat (int e + - 1 * int e') = e - e'"
      by force
    then show ?thesis
      using f2 f1 by (metis \<open>[(int z - int z') * fst (bezw (nat (int e - int e')) (order \<G>)) = int w * (int e - int e') * fst (bezw (nat (int e - int e')) (order \<G>))] (mod int (order \<G>))\<close> cong_sym_int gcd inverse m_ge_m' schnorr_commitment.mod_one_cancel schnorr_commitment_axioms)
  qed
  then have "[(int z - int z') * (fst (bezw (nat (int e - int e')) (order \<G>))) = int w] (mod order \<G>)"
    by simp
  then have "(int z - int z') * (fst (bezw (nat (int e - int e')) (order \<G>))) mod order \<G> = int w mod order \<G>"
    using cong_int_def by blast
  then have "(int z - int z') * (fst (bezw (nat (int e - int e')) (order \<G>))) mod order \<G> = w mod int (order \<G>)"
    by (simp add: zmod_int)
  then have "w mod order \<G> = (int z - int z') * (fst (bezw (( e -  e')) (order \<G>))) mod order \<G> "
    by (metis int_minus nat_int zmod_int)
  then show ?thesis using w_less_order by simp
qed

lemma bind_game_eq_dis_log:
  shows "abstract_commitment.bind_game \ = discrete_log.dis_log (dis_log_\ \)"
proof-
  have "abstract_commitment.bind_game \ = TRY do {
    (ck,vk) \<leftarrow> gen;
    (c, e, z, e', z') \<leftarrow> \ ck;
    _ :: unit \<leftarrow> assert_spmf (e > e' \<and> \<not> [e = e'] (mod order \<G>) \<and> (gcd (e - e') (order \<G>) = 1) \<and> c \<in> carrier \<G>);
    b \<leftarrow> verify vk e c z;
    b' \<leftarrow> verify vk e' c z';
    _ :: unit \<leftarrow> assert_spmf (b \<and> b');
    return_spmf True} ELSE return_spmf False"
    by(simp add: abstract_commitment.bind_game_def \_cond_def)
  also have "... = TRY do {
    w :: nat \<leftarrow> sample_uniform (order \<G>);
    (c, e, z, e', z') \<leftarrow> \ (\<^bold>g (^) w);
    _ :: unit \<leftarrow> assert_spmf (e > e' \<and> \<not> [e = e'] (mod order \<G>) \<and> (gcd (e - e') (order \<G>) = 1) \<and> c \<in> carrier \<G>);
    b \<leftarrow> check (\<^bold>g (^) w) c e z;
    b' \<leftarrow> check (\<^bold>g (^) w) c e' z';
    _ :: unit \<leftarrow> assert_spmf (b \<and> b');
    return_spmf True} ELSE return_spmf False"
    by(simp add: gen_def split_def verify_def)
  also have "... = TRY do {
    w :: nat \<leftarrow> sample_uniform (order \<G>);
    (c, e, z, e', z') \<leftarrow> \ (\<^bold>g (^) w);
    _ :: unit \<leftarrow> assert_spmf (e > e' \<and> \<not> [e = e'] (mod order \<G>) \<and> (gcd (e - e') (order \<G>) = 1) \<and> c \<in> carrier \<G>);
    _ :: unit \<leftarrow> assert_spmf (((c \<otimes> (\<^bold>g (^) w) (^) e) = \<^bold>g (^) z) \<and> (c \<otimes> (\<^bold>g (^) w) (^) e') = \<^bold>g (^) z');
    return_spmf True} ELSE return_spmf False"
    by(simp add: check_def)
  also have "... = TRY do {
    w :: nat \<leftarrow> sample_uniform (order \<G>);
    (c, e, z, e', z') \<leftarrow> \ (\<^bold>g (^) w);
    _ :: unit \<leftarrow> assert_spmf (e > e' \<and> \<not> [e = e'] (mod order \<G>) \<and> (gcd (e - e') (order \<G>) = 1) \<and> c \<in> carrier \<G>);
    _ :: unit \<leftarrow> assert_spmf (((c \<otimes> (\<^bold>g (^) w) (^) e) = \<^bold>g (^) z) \<and> (c \<otimes> (\<^bold>g (^) w) (^) e') = \<^bold>g (^) z');
    return_spmf (w = nat ((int z - int z') * (fst (bezw (e -  e') (order \<G>))) mod order \<G>))} ELSE return_spmf False"
    apply(intro try_spmf_cong)
    apply(intro bind_spmf_cong[OF refl]; clarsimp?)+
    apply(rule dis_log_break)
    by auto
  ultimately show ?thesis
    by(simp add: discrete_log.dis_log_def dis_log_\_def Let_def split_def cong: bind_spmf_cong_simp)
qed

end

locale asy_schnorr_commit =
  fixes \<G> :: "nat \<Rightarrow> 'grp cyclic_group"
  assumes schnorr_commitment: "\<And>n. schnorr_commitment (\<G> n)"
begin

sublocale schnorr_commitment "(\<G> n)" for n by(simp add: schnorr_commitment)

theorem correct:
  shows "abstract_commitment.correct n m"
  using abstract_correct by simp

theorem perfect_hiding:
  shows "abstract_commitment.perfect_hiding n (\ n)"
    by (simp add:  abstract_perfect_hiding)

theorem binding:
  shows "abstract_commitment.bind_advantage n (\ n)
            = discrete_log.advantage n (dis_log_\ n (\ n))"
  by (simp add: discrete_log.advantage_def local.abstract_commitment.bind_advantage_def bind_game_eq_dis_log )

theorem "negligible (\<lambda> n. abstract_commitment.bind_advantage n (\ n))
            \<longleftrightarrow> negligible (\<lambda> n. discrete_log.advantage n (dis_log_\ n (\ n)))"
  by(simp add: binding)

end

end