(*
    Title:      Fundamental_Subspaces.thy
    Author:     Jose Divasón <jose.divasonm at unirioja.es>
    Author:     Jesús Aransay <jesus-maria.aransay at unirioja.es>
    Maintainer: Jose Divasón <jose.divasonm at unirioja.es>
*)

header{*Fundamental Subspaces*}

theory Fundamental_Subspaces
imports
    "~~/src/HOL/Multivariate_Analysis/Multivariate_Analysis"
    Miscellaneous
begin

subsection{*The fundamental subspaces of a matrix*}

subsubsection{*Definitions*}

definition left_null_space :: "'a::{semiring_1}^'n^'m => ('a^'m) set"
  where "left_null_space A = {x. x v* A = 0}"

definition null_space :: "'a::{semiring_1}^'n^'m => ('a^'n) set"
  where "null_space A = {x. A *v x = 0}"

definition row_space :: "'a::{field}^'n^'m=>('a^'n) set"
  where "row_space A = vec.span (rows A)"

definition col_space :: "'a::{field}^'n^'m=>('a^'m) set"
  where "col_space A = vec.span (columns A)"

subsubsection{*Relationships among them*}

lemma left_null_space_eq_null_space_transpose: "left_null_space A = null_space (transpose A)"
  unfolding null_space_def left_null_space_def transpose_vector ..

lemma null_space_eq_left_null_space_transpose: "null_space A = left_null_space (transpose A)"
  using left_null_space_eq_null_space_transpose[of "transpose A"]
  unfolding transpose_transpose ..

lemma row_space_eq_col_space_transpose:
  fixes A::"'a::{field}^'columns^'rows"
  shows "row_space A = col_space (transpose A)"
  unfolding col_space_def row_space_def columns_transpose[of A] ..

lemma col_space_eq_row_space_transpose:
  fixes A::"'a::{field}^'n^'m"
  shows "col_space A = row_space (transpose A)"
  unfolding col_space_def row_space_def unfolding rows_transpose[of A] ..

subsection{*Proving that they are subspaces*}

lemma subspace_null_space:
  fixes A::"'a::{field}^'n^'m"
  shows "vec.subspace (null_space A)"
proof (unfold vec.subspace_def null_space_def, auto)
  show "A *v 0 = 0" by (metis add_diff_cancel eq_iff_diff_eq_0 matrix_vector_right_distrib)
  fix x y
  assume Ax: "A *v x = 0" and Ay: "A *v y = 0"
  have "A *v (x + y) = (A *v x) + (A *v y)" unfolding matrix_vector_right_distrib ..
  also have "... = 0" unfolding Ax Ay by simp
  finally show "A *v (x + y) = 0" .
  fix c
  have "A *v (c *s x) = c *s (A *v x)"
    unfolding scalar_matrix_vector_assoc matrix_scalar_vector_ac by auto
  also have "... = 0" unfolding Ax by simp
  finally show "A *v (c *s x) = 0" .
  qed

lemma subspace_left_null_space:
  fixes A::"'a::{field}^'n^'m"
  shows "vec.subspace (left_null_space A)"
  unfolding left_null_space_eq_null_space_transpose using subspace_null_space .

lemma subspace_row_space:
  shows "vec.subspace (row_space A)" by (metis row_space_def vec.subspace_span)

lemma subspace_col_space:
  shows "vec.subspace (col_space A)" by (metis col_space_def vec.subspace_span)

subsection{*More useful properties and equivalences*}

lemma col_space_eq:
  fixes A::"'a::{field}^'m::{finite, wellorder}^'n"
  shows "col_space A = {y. \<exists>x. A *v x = y}"
  proof (unfold col_space_def vec.span_finite[OF finite_columns], auto)
  fix x
  show "\<exists>u. (\<Sum>v\<in>columns A. u v *s v) = A *v x" using matrix_vmult_column_sum[of A x] by auto
  next
  fix u::"('a, 'n) vec \<Rightarrow> 'a"
  let ?g="\<lambda>y. {i. y=column i A}"
  let ?x="(\<chi> i. if i=(LEAST a. a \<in> ?g (column i A)) then u (column i A) else 0)"
  show "\<exists>x. A *v x = (\<Sum>v\<in>columns A. u v *s v)"
  proof (unfold matrix_mult_vsum, rule exI[of _ "?x"], auto)
      have inj: "inj_on ?g (columns A)" unfolding inj_on_def unfolding columns_def by auto
      have union_univ: "\<Union>(?g`(columns A)) = UNIV" unfolding columns_def by auto
      have "setsum (\<lambda>i.(if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) UNIV
        = setsum (\<lambda>i. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) (\<Union>(?g`(columns A)))"
        unfolding union_univ ..
    also have "... = setsum (setsum (\<lambda>i.(if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A)) (?g`(columns A))"
        by (rule setsum.Union_disjoint[unfolded o_def], auto)
      also have "... = setsum ((setsum (\<lambda>i.(if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A)) \<circ> ?g)
        (columns A)" by (rule setsum.reindex, simp add: inj)
      also have "... = setsum (\<lambda>y. u y *s y) (columns A)"
       proof (rule setsum.cong, auto)
        fix x
        assume x_in_cols: "x \<in> columns A"
        obtain b where b: "x=column b A" using x_in_cols unfolding columns_def by blast
        let ?f="(\<lambda>i. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A)"
        have setsum_rw: "setsum ?f ({i. x = column i A} - {LEAST a. x = column a A}) = 0"
          by (rule setsum.neutral, auto)
        have "setsum ?f {i. x = column i A} = ?f (LEAST a. x = column a A) + setsum ?f ({i. x = column i A} - {LEAST a. x = column a A})"
          apply (rule setsum.remove, auto, rule LeastI_ex)
          using x_in_cols unfolding columns_def by auto
        also have "... = ?f (LEAST a. x = column a A)" unfolding setsum_rw by simp
        also have "... = u x *s x"
        proof (auto, rule LeastI2)
          show "x = column b A" using b .
          fix xa
          assume x: "x = column xa A"
          show "u (column xa A) *s column xa A = u x *s x" unfolding x ..
          next
          assume "(LEAST a. x = column a A) \<noteq> (LEAST a. column (LEAST c. x = column c A) A = column a A)"
          moreover have "(LEAST a. x = column a A) = (LEAST a. column (LEAST c. x = column c A) A = column a A)"
            by (rule Least_equality[symmetric], rule LeastI2, simp_all add: b, rule Least_le, metis (lifting, full_types) LeastI)
          ultimately show "u x = 0" by contradiction
          qed
       finally show " (\<Sum>i | x = column i A. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) = u x *s x" .
       qed
  finally show "(\<Sum>i\<in>UNIV. (if i = (LEAST a. column i A = column a A) then u (column i A) else 0) *s column i A) = (\<Sum>y\<in>columns A. u y *s y)" .
qed
qed

corollary col_space_eq':
  fixes A::"'a::{field}^'m::{finite, wellorder}^'n"
  shows "col_space A = range (\<lambda>x. A *v x)"
  unfolding col_space_eq by auto

lemma row_space_eq:
  fixes A::"'a::{field}^'m^'n::{finite, wellorder}"
  shows "row_space A = {w. \<exists>y. (transpose A) *v y = w}"
  unfolding row_space_eq_col_space_transpose col_space_eq ..

lemma null_space_eq_ker:
  fixes f::"('a::field^'n) => ('a^'m)"
  assumes lf: "linear op *s op *s f"
  shows "null_space (matrix f) = {x. f x = 0}"
  unfolding null_space_def using matrix_works [OF lf] by auto

lemma col_space_eq_range:
  fixes f::"('a::field^'n::{finite, wellorder}) \<Rightarrow> ('a^'m)"
  assumes lf: "linear op *s op *s f"
  shows "col_space (matrix f) = range f"
  unfolding col_space_eq unfolding matrix_works[OF lf] by blast

lemma null_space_is_preserved:
fixes A::"'a::{field}^'cols^'rows"
assumes P: "invertible P"
shows "null_space (P**A) = null_space A"
unfolding null_space_def
using P matrix_inv_left matrix_left_invertible_ker matrix_vector_mul_assoc matrix_vector_zero
by metis

lemma row_space_is_preserved:
fixes A::"'a::{field}^'cols^'rows::{finite, wellorder}"
  and P::"'a::{field}^'rows::{finite, wellorder}^'rows::{finite, wellorder}"
assumes P: "invertible P"
shows "row_space (P**A) = row_space A"
proof (auto)
fix w
assume w: "w \<in> row_space (P**A)"
from this obtain y where w_By: "w=(transpose (P**A)) *v y"
  unfolding row_space_eq[of "P ** A" ] by fast
have "w = (transpose (P**A)) *v y" using w_By .
also have "... = ((transpose A) ** (transpose P)) *v y" unfolding matrix_transpose_mul ..
also have "... = (transpose A) *v ((transpose P) *v y)" unfolding matrix_vector_mul_assoc ..
finally show "w \<in> row_space A" unfolding row_space_eq by blast
next
fix w
assume w: "w \<in> row_space A"
from this obtain y where w_Ay: "w=(transpose A) *v y" unfolding row_space_eq by fast
have "w = (transpose A) *v y" using w_Ay .
also have "... = (transpose ((matrix_inv P) ** (P**A))) *v y"
  by (metis P matrix_inv_left matrix_mul_assoc matrix_mul_lid)
also have "... = (transpose (P**A) ** (transpose (matrix_inv P))) *v y"
  unfolding matrix_transpose_mul ..
also have "... = transpose (P**A) *v (transpose (matrix_inv P) *v y)"
  unfolding matrix_vector_mul_assoc ..
finally show "w \<in> row_space (P**A)"  unfolding row_space_eq by blast
qed
end


(*
  Authors: Asta Halkjær From, Agnes Moesgård Eschen & Jørgen Villadsen, DTU Compute
*)

theory SLAI_2 imports System_L1 begin

text \<open>Inspired by Larry Wos: Conquering the Meredith Single Axiom, J. Autom. Reas. 27:175–199 2001\<close>

inductive Double (\<open>\<tturnstile>\<close>) where
  MP: \<open>\<tturnstile> q\<close> if \<open>\<tturnstile> p\<close> and \<open>\<tturnstile> (p \<rightarrow> q)\<close> |
  A1: \<open>\<tturnstile> (((p \<rightarrow> q) \<rightarrow> r) \<rightarrow> (q \<rightarrow> r))\<close> |
  A2: \<open>\<tturnstile> ((\<sim> p \<rightarrow> (q \<rightarrow> \<sim> r)) \<rightarrow> ((p \<rightarrow> (q \<rightarrow> s)) \<rightarrow> ((r \<rightarrow> q) \<rightarrow> (r \<rightarrow> s))))\<close>

lemmas AX = A1 A2

lemma L1_1: \<open>\<tturnstile> ((p \<rightarrow> q) \<rightarrow> ((q \<rightarrow> r) \<rightarrow> (p \<rightarrow> r)))\<close>
  using AX MP by meson

lemma L1_2: \<open>\<tturnstile> ((\<sim> p \<rightarrow> p) \<rightarrow> p)\<close>
  using AX MP by metis

lemma L1_3: \<open>\<tturnstile> (p \<rightarrow> (\<sim> p \<rightarrow> q))\<close>
  using AX MP by metis

theorem \<open>\<turnstile> p \<longleftrightarrow> \<tturnstile> p\<close>
proof
  show \<open>\<turnstile> p\<close> if \<open>\<tturnstile> p\<close>
    using that by induct (use System_L1.MP in fast, use L1_completeness in simp_all)
  show \<open>\<tturnstile> p\<close> if \<open>\<turnstile> p\<close>
    using that by induct (use MP in fast, rule L1_1, rule L1_2, rule L1_3)
qed

end


(*  Title:      HOL/SMT_Examples/SMT_Word_Examples.thy
    Author:     Sascha Boehme, TU Muenchen
*)

section \<open>Word examples for for SMT binding\<close>

theory SMT_Word_Examples
imports "~~/src/HOL/Word/Word"
begin

declare [[smt_oracle = true]]
declare [[z3_extensions = true]]
declare [[smt_certificates = "SMT_Word_Examples.certs"]]
declare [[smt_read_only_certificates = true]]

text \<open>
Currently, there is no proof reconstruction for words.
All lemmas are proved using the oracle mechanism.
\<close>

section \<open>Bitvector numbers\<close>

lemma "(27 :: 4 word) = -5" by smt
lemma "(27 :: 4 word) = 11" by smt
lemma "23 < (27::8 word)" by smt
lemma "27 + 11 = (6::5 word)" by smt
lemma "7 * 3 = (21::8 word)" by smt
lemma "11 - 27 = (-16::8 word)" by smt
lemma "- (- 11) = (11::5 word)" by smt
lemma "-40 + 1 = (-39::7 word)" by smt
lemma "a + 2 * b + c - b = (b + c) + (a :: 32 word)" by smt
lemma "x = (5 :: 4 word) \<Longrightarrow> 4 * x = 4" by smt

section \<open>Bit-level logic\<close>

lemma "0b110 AND 0b101 = (0b100 :: 32 word)" by smt
lemma "0b110 OR 0b011 = (0b111 :: 8 word)" by smt
lemma "0xF0 XOR 0xFF = (0x0F :: 8 word)" by smt
lemma "NOT (0xF0 :: 16 word) = 0xFF0F" by smt
lemma "word_cat (27::4 word) (27::8 word) = (2843::12 word)" by smt
lemma "word_cat (0b0011::4 word) (0b1111::6word) = (0b0011001111 :: 10 word)" by smt
lemma "slice 1 (0b10110 :: 4 word) = (0b11 :: 2 word)" by smt
lemma "ucast (0b1010 :: 4 word) = (0b1010 :: 10 word)" by smt
lemma "scast (0b1010 :: 4 word) = (0b111010 :: 6 word)" by smt
lemma "0b10011 << 2 = (0b1001100::8 word)" by smt
lemma "0b11001 >> 2 = (0b110::8 word)" by smt
lemma "0b10011 >>> 2 = (0b100::8 word)" by smt
lemma "word_rotr 2 0b0110 = (0b1001::4 word)" by smt
lemma "word_rotl 1 0b1110 = (0b1101::4 word)" by smt
lemma "(x AND 0xff00) OR (x AND 0x00ff) = (x::16 word)" by smt
lemma "w < 256 \<Longrightarrow> (w :: 16 word) AND 0x00FF = w" by smt

section \<open>Combined integer-bitvector properties\<close>

lemma
  assumes "bv2int 0 = 0"
      and "bv2int 1 = 1"
      and "bv2int 2 = 2"
      and "bv2int 3 = 3"
      and "\<forall>x::2 word. bv2int x > 0"
  shows "\<forall>i::int. i < 0 \<longrightarrow> (\<forall>x::2 word. bv2int x > i)"
  using assms by smt

lemma "P (0 \<le> (a :: 4 word)) = P True" by smt

end


theory Submission
imports Defs
begin

(* The append lemma - gives 30% of the points.
   Note: While this lemma gives less points, it's actually harder to prove! *)

lemma rle_aux:
  assumes "x \<noteq> y"
  shows "rle (xs @ replicate (Suc n) x @ y # ys) = rle (xs @ replicate (Suc n) x) @ rle (y # ys)"
  using assms
proof (induction xs arbitrary: n x y ys rule: rev_induct)
  case Nil
  then show ?case
    by (induction n) auto
next
  case (snoc z zs)
  then show ?case
  proof (cases "z = x")
    case False
    have "rle (zs @ replicate (Suc 0) z @ x # replicate n x @ y # ys) =
      rle (zs @ replicate (Suc 0) z @ x # replicate n x) @ rle (y # ys)"
      unfolding snoc(1)[OF False, of 0 "replicate n x @ y # ys"]
        snoc(1)[OF False, of 0 "replicate n x"]
      using snoc(2)
      by (induction n) auto
    then show ?thesis
      by auto
  qed (metis append.assoc append.simps(1) append.simps(2) replicate_Suc)
qed

lemma rle_append: "xs = [] \<or> ys = [] \<or> last xs \<noteq> hd ys \<Longrightarrow> rle (xs @ ys) = rle xs @ rle ys"
  apply (cases xs rule: rev_cases; cases ys)
     apply auto[3]
  subgoal for zs z w ws
    using rle_aux[of z w zs 0 ws]
    by auto
  done

lemma rle_repl: "rle (replicate (Suc n) z) = [(z, Suc n)]"
  by (induction n) auto

(* Given the append lemma show the reverse lemma - gives 70% of the points.
   Note: While this lemma gives more points, it might actually be easier to prove *)
lemma rle_rev_if_rle_aux:
  fixes xs :: "'a list"
  shows "rle (rev xs) = rev (rle xs)"
proof (induction "length xs" arbitrary: xs rule: nat_less_induct)
  case 1
  have IH: "\<And>ys :: 'a list. length ys < length xs \<Longrightarrow> rle (rev ys) = rev (rle ys)"
    using 1
    by auto
  show ?case
  proof (cases xs)
    case (Cons z zs)
    note xs_Cons = Cons
    define ys where "ys = z # takeWhile (\<lambda>y. y = z) zs"
    define ys' where "ys' = dropWhile (\<lambda>y. y = z) zs"
    define n where "n = length (takeWhile (\<lambda>y. y = z) zs)"
    have ys_repl: "ys = replicate (Suc n) z"
      unfolding ys_def
      by (auto simp: n_def) (meson replicate_eqI set_takeWhileD)
    have xs_app: "xs = ys @ ys'"
      by (auto simp: xs_Cons ys_def ys'_def)
    have ys_Nil: "ys \<noteq> []"
      by (auto simp: ys_def)
    show ?thesis
    proof (cases ys')
      case Nil
      show ?thesis
        unfolding xs_app Nil ys_repl append_Nil2 rev_replicate rle_repl
        by auto
    next
      case (Cons w ws)
      have z_neq_w: "z \<noteq> w"
        using ys'_def
        unfolding Cons
        by (metis (mono_tags) hd_dropWhile list.distinct(1) list.sel(1))
      have aux1: "rev (rle xs) = rev (rle (w # ws)) @ [(z, Suc n)]"
        using rle_aux[OF z_neq_w, of "[]" n ws]
        unfolding append_Nil rle_repl xs_app ys_repl Cons
        by auto
      have aux2: "rle (rev xs) = rle (rev ws @ [w]) @ [(z, Suc n)]"
        using rle_aux[OF z_neq_w[symmetric], of "rev ws" 0 "replicate n z"]
        unfolding replicate.simps
        unfolding replicate.simps[symmetric] rle_repl
        unfolding xs_app ys_repl Cons
        by (auto simp: replicate_append_same)
      have prem: "length (w # ws) < length xs"
        by (auto simp: xs_app Cons ys_def)
      show ?thesis
        unfolding aux1 aux2 IH[OF prem, symmetric]
        by auto
    qed
  qed auto
qed

lemma rle_rev_if_rle_append: "(xs = [] \<or> ys = [] \<or> last xs \<noteq> hd ys \<Longrightarrow>
  rle (xs @ ys) = rle xs @ rle ys) \<Longrightarrow> rle (rev xs) = rev (rle xs)"
  by (rule rle_rev_if_rle_aux)

end