L.symm – Calculemus

Pruebas de equivalencia de definiciones de inversa

PorJosé A. Alonso 11 septiembre 20217 septiembre 2021

En Lean, está definida la función

   reverse : list α → list α

1	reverse : list α → list α

tal que (reverse xs) es la lista obtenida invirtiendo el orden de los elementos de xs. Por ejemplo,

   reverse  [3,2,5,1] = [1,5,2,3]

1	reverse [3,2,5,1] = [1,5,2,3]

Su definición es

   def reverse_core : list α → list α → list α
   | []     r := r
   | (a::l) r := reverse_core l (a::r)

   def reverse : list α → list α :=
   λ l, reverse_core l []

def reverse_core : list α → list α → list α

| [] r := r

| (a::l) r := reverse_core l (a::r)

def reverse : list α → list α :=

λ l, reverse_core l []

Una definición alternativa es

   def inversa : list α → list α
   | []        := []
   | (x :: xs) := inversa xs ++ [x]

def inversa : list α → list α

| [] := []

| (x :: xs) := inversa xs ++ [x]

Demostrar que las dos definiciones son equivalentes; es decir,

   reverse xs = inversa xs

1	reverse xs = inversa xs

Para ello, completar la siguiente teoría de Lean:

import data.list.basic
open list

variable  {α : Type*}
variable  (x : α)
variables (xs ys : list α)

def inversa : list α → list α
| []        := []
| (x :: xs) := inversa xs ++ [x]

example : reverse xs = inversa xs :=
sorry

import data.list.basic

open list

variable {α : Type*}

variable (x : α)

variables (xs ys : list α)

def inversa : list α → list α

| [] := []

| (x :: xs) := inversa xs ++ [x]

example : reverse xs = inversa xs :=

sorry

[expand title=»Soluciones con Lean»]

import data.list.basic
open list

variable  {α : Type*}
variable  (x : α)
variables (xs ys : list α)

-- Definición y reglas de simplificación de inversa
-- ================================================

def inversa : list α → list α
| []        := []
| (x :: xs) := inversa xs ++ [x]

@[simp]
lemma inversa_nil :
  inversa ([] : list α) = [] :=
rfl

@[simp]
lemma inversa_cons :
  inversa (x :: xs) = inversa xs ++ [x] :=
rfl

-- Reglas de simplificación de reverse_core
-- ========================================

@[simp]
lemma reverse_core_nil :
  reverse_core [] ys = ys :=
rfl

@[simp]
lemma reverse_core_cons :
  reverse_core (x :: xs) ys = reverse_core xs (x :: ys) :=
rfl

-- Lema auxiliar: reverse_core xs ys = (inversa xs) ++ ys
-- ======================================================

-- 1ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : reverse_core_nil ys
     ... = [] ++ ys                  : (nil_append ys).symm
     ... = inversa [] ++ ys          : congr_arg2 (++) inversa_nil.symm rfl, },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : reverse_core_cons a as ys
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : congr_arg2 (++) rfl singleton_append
     ... = (inversa as ++ [a]) ++ ys : (append_assoc (inversa as) [a] ys).symm
     ... = inversa (a :: as) ++ ys   : congr_arg2 (++) (inversa_cons a as).symm rfl},
end

-- 2ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : by rw reverse_core_nil
     ... = [] ++ ys                  : by rw nil_append
     ... = inversa [] ++ ys          : by rw inversa_nil },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : by rw reverse_core_cons
     ... = inversa as ++ (a :: ys)   : by rw (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : by rw singleton_append
     ... = (inversa as ++ [a]) ++ ys : by rw append_assoc
     ... = inversa (a :: as) ++ ys   : by rw inversa_cons },
end

-- 3ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : rfl
     ... = [] ++ ys                  : rfl
     ... = inversa [] ++ ys          : rfl },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : rfl
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : rfl
     ... = (inversa as ++ [a]) ++ ys : by rw append_assoc
     ... = inversa (a :: as) ++ ys   : rfl },
end

-- 3ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { calc reverse_core [] ys
         = ys                        : by simp
     ... = [] ++ ys                  : by simp
     ... = inversa [] ++ ys          : by simp },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : by simp
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa as ++ ([a] ++ ys) : by simp
     ... = (inversa as ++ [a]) ++ ys : by simp
     ... = inversa (a :: as) ++ ys   : by simp },
end

-- 4ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { by simp, },
  { calc reverse_core (a :: as) ys
         = reverse_core as (a :: ys) : by simp
     ... = inversa as ++ (a :: ys)   : (HI (a :: ys))
     ... = inversa (a :: as) ++ ys   : by simp },
end

-- 5ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { simp, },
  { simp [HI (a :: ys)], },
end

-- 6ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
by induction xs generalizing ys ; simp [*]

-- 7ª demostración del lema auxiliar
example :
  reverse_core xs ys = (inversa xs) ++ ys :=
begin
  induction xs with a as HI generalizing ys,
  { rw reverse_core_nil,
    rw inversa_nil,
    rw nil_append, },
  { rw reverse_core_cons,
    rw (HI (a :: ys)),
    rw inversa_cons,
    rw append_assoc,
    rw singleton_append, },
end

-- 8ª demostración  del lema auxiliar
@[simp]
lemma inversa_equiv :
  ∀ xs : list α, ∀ ys, reverse_core xs ys = (inversa xs) ++ ys
| []         := by simp
| (a :: as)  := by simp [inversa_equiv as]

-- Demostraciones del lema principal
-- =================================

-- 1ª demostración
example : reverse xs = inversa xs :=
calc reverse xs
     = reverse_core xs [] : rfl
 ... = inversa xs ++ []   : by rw inversa_equiv
 ... = inversa xs         : by rw append_nil

-- 2ª demostración
example : reverse xs = inversa xs :=
by simp [inversa_equiv, reverse]

-- 3ª demostración
example : reverse xs = inversa xs :=
by simp [reverse]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

import data.list.basic

open list

variable {α : Type*}

variable (x : α)

variables (xs ys : list α)

-- Definición y reglas de simplificación de inversa

-- ================================================

def inversa : list α → list α

| [] := []

| (x :: xs) := inversa xs ++ [x]

@[simp]

lemma inversa_nil :

inversa ([] : list α) = [] :=

rfl

@[simp]

lemma inversa_cons :

inversa (x :: xs) = inversa xs ++ [x] :=

rfl

-- Reglas de simplificación de reverse_core

-- ========================================

@[simp]

lemma reverse_core_nil :

reverse_core [] ys = ys :=

rfl

@[simp]

lemma reverse_core_cons :

reverse_core (x :: xs) ys = reverse_core xs (x :: ys) :=

rfl

-- Lema auxiliar: reverse_core xs ys = (inversa xs) ++ ys

-- ======================================================

-- 1ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

begin

induction xs with a as HI generalizing ys,

{ calc reverse_core [] ys

= ys : reverse_core_nil ys

... = [] ++ ys : (nil_append ys).symm

... = inversa [] ++ ys : congr_arg2 (++) inversa_nil.symm rfl, },

{ calc reverse_core (a :: as) ys

= reverse_core as (a :: ys) : reverse_core_cons a as ys

... = inversa as ++ (a :: ys) : (HI (a :: ys))

... = inversa as ++ ([a] ++ ys) : congr_arg2 (++) rfl singleton_append

... = (inversa as ++ [a]) ++ ys : (append_assoc (inversa as) [a] ys).symm

... = inversa (a :: as) ++ ys : congr_arg2 (++) (inversa_cons a as).symm rfl},

end

-- 2ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

begin

induction xs with a as HI generalizing ys,

{ calc reverse_core [] ys

= ys : by rw reverse_core_nil

... = [] ++ ys : by rw nil_append

... = inversa [] ++ ys : by rw inversa_nil },

{ calc reverse_core (a :: as) ys

= reverse_core as (a :: ys) : by rw reverse_core_cons

... = inversa as ++ (a :: ys) : by rw (HI (a :: ys))

... = inversa as ++ ([a] ++ ys) : by rw singleton_append

... = (inversa as ++ [a]) ++ ys : by rw append_assoc

... = inversa (a :: as) ++ ys : by rw inversa_cons },

end

-- 3ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

begin

induction xs with a as HI generalizing ys,

{ calc reverse_core [] ys

= ys : rfl

... = [] ++ ys : rfl

... = inversa [] ++ ys : rfl },

{ calc reverse_core (a :: as) ys

= reverse_core as (a :: ys) : rfl

... = inversa as ++ (a :: ys) : (HI (a :: ys))

... = inversa as ++ ([a] ++ ys) : rfl

... = (inversa as ++ [a]) ++ ys : by rw append_assoc

... = inversa (a :: as) ++ ys : rfl },

end

-- 3ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

begin

induction xs with a as HI generalizing ys,

{ calc reverse_core [] ys

= ys : by simp

... = [] ++ ys : by simp

... = inversa [] ++ ys : by simp },

{ calc reverse_core (a :: as) ys

= reverse_core as (a :: ys) : by simp

... = inversa as ++ (a :: ys) : (HI (a :: ys))

... = inversa as ++ ([a] ++ ys) : by simp

... = (inversa as ++ [a]) ++ ys : by simp

... = inversa (a :: as) ++ ys : by simp },

end

-- 4ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

begin

induction xs with a as HI generalizing ys,

{ by simp, },

{ calc reverse_core (a :: as) ys

= reverse_core as (a :: ys) : by simp

... = inversa as ++ (a :: ys) : (HI (a :: ys))

... = inversa (a :: as) ++ ys : by simp },

end

-- 5ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

begin

induction xs with a as HI generalizing ys,

{ simp, },

{ simp [HI (a :: ys)], },

end

-- 6ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

by induction xs generalizing ys ; simp [*]

-- 7ª demostración del lema auxiliar

example :

reverse_core xs ys = (inversa xs) ++ ys :=

begin

induction xs with a as HI generalizing ys,

{ rw reverse_core_nil,

rw inversa_nil,

rw nil_append, },

{ rw reverse_core_cons,

rw (HI (a :: ys)),

rw inversa_cons,

rw append_assoc,

rw singleton_append, },

end

-- 8ª demostración del lema auxiliar

@[simp]

lemma inversa_equiv :

∀ xs : list α, ∀ ys, reverse_core xs ys = (inversa xs) ++ ys

| [] := by simp

| (a :: as) := by simp [inversa_equiv as]

-- Demostraciones del lema principal

-- =================================

-- 1ª demostración

example : reverse xs = inversa xs :=

calc reverse xs

= reverse_core xs [] : rfl

... = inversa xs ++ [] : by rw inversa_equiv

... = inversa xs : by rw append_nil

-- 2ª demostración

example : reverse xs = inversa xs :=

by simp [inversa_equiv, reverse]

-- 3ª demostración

example : reverse xs = inversa xs :=

by simp [reverse]

Se puede interactuar con la prueba anterior en esta sesión con Lean.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="lean"> y otra con </pre>
[/expand]

[expand title=»Soluciones con Isabelle/HOL»]

theory Pruebas_de_equivalencia_de_definiciones_de_inversa
imports Main
begin

(* Definición alternativa *)
(* ====================== *)

fun inversa_aux :: "'a list ⇒ 'a list ⇒ 'a list" where
  "inversa_aux [] ys     = ys"
| "inversa_aux (x#xs) ys = inversa_aux xs (x#ys)"

fun inversa :: "'a list ⇒ 'a list" where
  "inversa xs = inversa_aux xs []"

(* Lema auxiliar: inversa_aux xs ys = (rev xs) @ ys *)
(* ================================================ *)

(* 1ª demostración del lema auxiliar *)
lemma
  "inversa_aux xs ys = (rev xs) @ ys"
proof (induct xs arbitrary: ys)
  fix ys :: "'a list"
  have "inversa_aux [] ys = ys"
    by (simp only: inversa_aux.simps(1))
  also have "… = [] @ ys"
    by (simp only: append.simps(1))
  also have "… = rev [] @ ys"
    by (simp only: rev.simps(1))
  finally show "inversa_aux [] ys = rev [] @ ys"
    by this
next
  fix a ::'a and xs :: "'a list"
  assume HI: "⋀ys. inversa_aux xs ys = rev xs@ys"
  show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys"
  proof -
    fix ys
    have "inversa_aux (a#xs) ys = inversa_aux xs (a#ys)"
      by (simp only: inversa_aux.simps(2))
    also have "… = rev xs@(a#ys)"
      by (simp only: HI)
    also have "… = rev xs @ ([a] @ ys)"
      by (simp only: append.simps)
    also have "… = (rev xs @ [a]) @ ys"
      by (simp only: append_assoc)
    also have "… = rev (a # xs) @ ys"
      by (simp only: rev.simps(2))
    finally show "inversa_aux (a#xs) ys = rev (a#xs)@ys"
      by this
  qed
qed

(* 2ª demostración del lema auxiliar *)
lemma
  "inversa_aux xs ys = (rev xs) @ ys"
proof (induct xs arbitrary: ys)
  fix ys :: "'a list"
  have "inversa_aux [] ys = ys" by simp
  also have "… = [] @ ys" by simp
  also have "… = rev [] @ ys" by simp
  finally show "inversa_aux [] ys = rev [] @ ys" .
next
  fix a ::'a and xs :: "'a list"
  assume HI: "⋀ys. inversa_aux xs ys = rev xs@ys"
  show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys"
  proof -
    fix ys
    have "inversa_aux (a#xs) ys = inversa_aux xs (a#ys)" by simp
    also have "… = rev xs@(a#ys)" using HI by simp
    also have "… = rev xs @ ([a] @ ys)" by simp
    also have "… = (rev xs @ [a]) @ ys" by simp
    also have "… = rev (a # xs) @ ys" by simp
    finally show "inversa_aux (a#xs) ys = rev (a#xs)@ys" .
  qed
qed

(* 3ª demostración del lema auxiliar *)
lemma
  "inversa_aux xs ys = (rev xs) @ ys"
proof (induct xs arbitrary: ys)
  fix ys :: "'a list"
  show "inversa_aux [] ys = rev [] @ ys" by simp
next
  fix a ::'a and xs :: "'a list"
  assume HI: "⋀ys. inversa_aux xs ys = rev xs@ys"
  show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys"
  proof -
    fix ys
    have "inversa_aux (a#xs) ys = rev xs@(a#ys)" using HI by simp
    also have "… = rev (a # xs) @ ys" by simp
    finally show "inversa_aux (a#xs) ys = rev (a#xs)@ys" .
  qed
qed

(* 4ª demostración del lema auxiliar *)
lemma
  "inversa_aux xs ys = (rev xs) @ ys"
proof (induct xs arbitrary: ys)
  show "⋀ys. inversa_aux [] ys = rev [] @ ys" by simp
next
  fix a ::'a and xs :: "'a list"
  assume "⋀ys. inversa_aux xs ys = rev xs@ys"
  then show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys" by simp
qed

(* 5ª demostración del lema auxiliar *)
lemma
  "inversa_aux xs ys = (rev xs) @ ys"
proof (induct xs arbitrary: ys)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  then show ?case by simp
qed

(* 6ª demostración del lema auxiliar *)
lemma inversa_equiv:
  "inversa_aux xs ys = (rev xs) @ ys"
by (induct xs arbitrary: ys) simp_all

(* Demostraciones del lema principal *)
(* ================================= *)

(* 1ª demostración *)
lemma "inversa xs = rev xs"
proof -
  have "inversa xs = inversa_aux xs []"
    by (rule inversa.simps)
  also have "… = (rev xs) @ []"
    by (rule inversa_equiv)
  also have "… = rev xs"
    by (rule append.right_neutral)
  finally show "inversa xs = rev xs"
    by this
qed

(* 2ª demostración *)
lemma "inversa xs = rev xs"
proof -
  have "inversa xs = inversa_aux xs []"  by simp
  also have "… = (rev xs) @ []" by (rule inversa_equiv)
  also have "… = rev xs" by simp
  finally show "inversa xs = rev xs" .
qed

(* 3ª demostración *)
lemma "inversa xs = rev xs"
by (simp add: inversa_equiv)

end

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

theory Pruebas_de_equivalencia_de_definiciones_de_inversa

imports Main

begin

(* Definición alternativa *)

(* ====================== *)

fun inversa_aux :: "'a list ⇒ 'a list ⇒ 'a list" where

"inversa_aux [] ys = ys"

| "inversa_aux (x#xs) ys = inversa_aux xs (x#ys)"

fun inversa :: "'a list ⇒ 'a list" where

"inversa xs = inversa_aux xs []"

(* Lema auxiliar: inversa_aux xs ys = (rev xs) @ ys *)

(* ================================================ *)

(* 1ª demostración del lema auxiliar *)

lemma

"inversa_aux xs ys = (rev xs) @ ys"

proof (induct xs arbitrary: ys)

fix ys :: "'a list"

have "inversa_aux [] ys = ys"

by (simp only: inversa_aux.simps(1))

also have "… = [] @ ys"

by (simp only: append.simps(1))

also have "… = rev [] @ ys"

by (simp only: rev.simps(1))

finally show "inversa_aux [] ys = rev [] @ ys"

by this

fix a ::'a and xs :: "'a list"

assume HI: "⋀ys. inversa_aux xs ys = rev xs@ys"

show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys"

proof -

fix ys

have "inversa_aux (a#xs) ys = inversa_aux xs (a#ys)"

by (simp only: inversa_aux.simps(2))

also have "… = rev xs@(a#ys)"

by (simp only: HI)

also have "… = rev xs @ ([a] @ ys)"

by (simp only: append.simps)

also have "… = (rev xs @ [a]) @ ys"

by (simp only: append_assoc)

also have "… = rev (a # xs) @ ys"

by (simp only: rev.simps(2))

finally show "inversa_aux (a#xs) ys = rev (a#xs)@ys"

by this

qed

(* 2ª demostración del lema auxiliar *)

lemma

"inversa_aux xs ys = (rev xs) @ ys"

proof (induct xs arbitrary: ys)

fix ys :: "'a list"

have "inversa_aux [] ys = ys" by simp

also have "… = [] @ ys" by simp

also have "… = rev [] @ ys" by simp

finally show "inversa_aux [] ys = rev [] @ ys" .

fix a ::'a and xs :: "'a list"

assume HI: "⋀ys. inversa_aux xs ys = rev xs@ys"

show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys"

proof -

fix ys

have "inversa_aux (a#xs) ys = inversa_aux xs (a#ys)" by simp

also have "… = rev xs@(a#ys)" using HI by simp

also have "… = rev xs @ ([a] @ ys)" by simp

also have "… = (rev xs @ [a]) @ ys" by simp

also have "… = rev (a # xs) @ ys" by simp

finally show "inversa_aux (a#xs) ys = rev (a#xs)@ys" .

qed

(* 3ª demostración del lema auxiliar *)

lemma

"inversa_aux xs ys = (rev xs) @ ys"

proof (induct xs arbitrary: ys)

fix ys :: "'a list"

show "inversa_aux [] ys = rev [] @ ys" by simp

fix a ::'a and xs :: "'a list"

assume HI: "⋀ys. inversa_aux xs ys = rev xs@ys"

show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys"

proof -

fix ys

have "inversa_aux (a#xs) ys = rev xs@(a#ys)" using HI by simp

also have "… = rev (a # xs) @ ys" by simp

finally show "inversa_aux (a#xs) ys = rev (a#xs)@ys" .

qed

(* 4ª demostración del lema auxiliar *)

lemma

"inversa_aux xs ys = (rev xs) @ ys"

proof (induct xs arbitrary: ys)

show "⋀ys. inversa_aux [] ys = rev [] @ ys" by simp

fix a ::'a and xs :: "'a list"

assume "⋀ys. inversa_aux xs ys = rev xs@ys"

then show "⋀ys. inversa_aux (a#xs) ys = rev (a#xs)@ys" by simp

qed

(* 5ª demostración del lema auxiliar *)

lemma

"inversa_aux xs ys = (rev xs) @ ys"

proof (induct xs arbitrary: ys)

case Nil

then show ?case by simp

case (Cons a xs)

then show ?case by simp

qed

(* 6ª demostración del lema auxiliar *)

lemma inversa_equiv:

"inversa_aux xs ys = (rev xs) @ ys"

by (induct xs arbitrary: ys) simp_all

(* Demostraciones del lema principal *)

(* ================================= *)

(* 1ª demostración *)

lemma "inversa xs = rev xs"

proof -

have "inversa xs = inversa_aux xs []"

by (rule inversa.simps)

also have "… = (rev xs) @ []"

by (rule inversa_equiv)

also have "… = rev xs"

by (rule append.right_neutral)

finally show "inversa xs = rev xs"

by this

qed

(* 2ª demostración *)

lemma "inversa xs = rev xs"

proof -

have "inversa xs = inversa_aux xs []" by simp

also have "… = (rev xs) @ []" by (rule inversa_equiv)

also have "… = rev xs" by simp

finally show "inversa xs = rev xs" .

qed

(* 3ª demostración *)

lemma "inversa xs = rev xs"

by (simp add: inversa_equiv)

end

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="isar"> y otra con </pre>
[/expand]

Pruebas de length (xs ++ ys) = length xs + length ys

PorJosé A. Alonso 9 septiembre 20215 septiembre 2021

En Lean están definidas las funciones

   length : list α → nat
   (++)   : list α → list α → list α

1 2	length : list α → nat (++) : list α → list α → list α

tales que

(length xs) es la longitud de xs. Por ejemplo,

     length [2,3,5,3] = 4

1	length [2,3,5,3] = 4

(xs ++ ys) es la lista obtenida concatenando xs e ys. Por ejemplo.

     [1,2] ++ [2,3,5,3] = [1,2,2,3,5,3]

1	[1,2] ++ [2,3,5,3] = [1,2,2,3,5,3]

Dichas funciones están caracterizadas por los siguientes lemas:

   length_nil  : length [] = 0
   length_cons : length (x :: xs) = length xs + 1
   nil_append  : [] ++ ys = ys
   cons_append : (x :: xs) ++ y = x :: (xs ++ ys)

length_nil : length [] = 0

length_cons : length (x :: xs) = length xs + 1

nil_append : [] ++ ys = ys

cons_append : (x :: xs) ++ y = x :: (xs ++ ys)

Demostrar que

   length (xs ++ ys) = length xs + length ys

1	length (xs ++ ys) = length xs + length ys

Para ello, completar la siguiente teoría de Lean:

import tactic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys zs : list α)

lemma length_nil  : length ([] : list α) = 0 := rfl

example :
  length (xs ++ ys) = length xs + length ys :=
sorry

import tactic

open list

variable {α : Type}

variable (x : α)

variables (xs ys zs : list α)

lemma length_nil : length ([] : list α) = 0 := rfl

example :

length (xs ++ ys) = length xs + length ys :=

sorry

[expand title=»Soluciones con Lean»]

import tactic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys zs : list α)

lemma length_nil  : length ([] : list α) = 0 := rfl

-- 1ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw length_nil,
    rw zero_add, },
  { rw cons_append,
    rw length_cons,
    rw HI,
    rw length_cons,
    rw add_assoc,
    rw add_comm (length ys),
    rw add_assoc, },
end

-- 2ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw length_nil,
    rw zero_add, },
  { rw cons_append,
    rw length_cons,
    rw HI,
    rw length_cons,
    -- library_search,
    exact add_right_comm (length as) (length ys) 1 },
end

-- 3ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw length_nil,
    rw zero_add, },
  { rw cons_append,
    rw length_cons,
    rw HI,
    rw length_cons,
    -- by hint,
    linarith, },
end

-- 4ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { simp, },
  { simp [HI],
    linarith, },
end

-- 5ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { simp, },
  { finish [HI],},
end

-- 6ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
by induction xs ; finish [*]

-- 7ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { calc length ([] ++ ys)
         = length ys                    : congr_arg length (nil_append ys)
     ... = 0 + length ys                : (zero_add (length ys)).symm
     ... = length [] + length ys        : congr_arg2 (+) length_nil.symm rfl, },
  { calc length ((a :: as) ++ ys)
         = length (a :: (as ++ ys))     : congr_arg length (cons_append a as ys)
     ... = length (as ++ ys) + 1        : length_cons a (as ++ ys)
     ... = (length as + length ys) + 1  : congr_arg2 (+) HI rfl
     ... = (length as + 1) + length ys  : add_right_comm (length as) (length ys) 1
     ... = length (a :: as) + length ys : congr_arg2 (+) (length_cons a as).symm rfl, },
end

-- 8ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
begin
  induction xs with a as HI,
  { calc length ([] ++ ys)
         = length ys                    : by rw nil_append
     ... = 0 + length ys                : (zero_add (length ys)).symm
     ... = length [] + length ys        : by rw length_nil },
  { calc length ((a :: as) ++ ys)
         = length (a :: (as ++ ys))     : by rw cons_append
     ... = length (as ++ ys) + 1        : by rw length_cons
     ... = (length as + length ys) + 1  : by rw HI
     ... = (length as + 1) + length ys  : add_right_comm (length as) (length ys) 1
     ... = length (a :: as) + length ys : by rw length_cons, },
end

-- 9ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
list.rec_on xs
  ( show length ([] ++ ys) = length [] + length ys, from
      calc length ([] ++ ys)
           = length ys                    : by rw nil_append
       ... = 0 + length ys                : by exact (zero_add (length ys)).symm
       ... = length [] + length ys        : by rw length_nil )
  ( assume a as,
    assume HI : length (as ++ ys) = length as + length ys,
    show length ((a :: as) ++ ys) = length (a :: as) + length ys, from
      calc length ((a :: as) ++ ys)
           = length (a :: (as ++ ys))     : by rw cons_append
       ... = length (as ++ ys) + 1        : by rw length_cons
       ... = (length as + length ys) + 1  : by rw HI
       ... = (length as + 1) + length ys  : by exact add_right_comm (length as) (length ys) 1
       ... = length (a :: as) + length ys : by rw length_cons)

-- 10ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
list.rec_on xs
  ( by simp)
  ( λ a as HI, by simp [HI, add_right_comm])

-- 11ª demostración
lemma longitud_conc_1 :
  ∀ xs, length (xs ++ ys) = length xs + length ys
| [] := by calc
    length ([] ++ ys)
        = length ys                    : by rw nil_append
    ... = 0 + length ys                : by rw zero_add
    ... = length [] + length ys        : by rw length_nil
| (a :: as) := by calc
    length ((a :: as) ++ ys)
        = length (a :: (as ++ ys))     : by rw cons_append
    ... = length (as ++ ys) + 1        : by rw length_cons
    ... = (length as + length ys) + 1  : by rw longitud_conc_1
    ... = (length as + 1) + length ys  : by exact add_right_comm (length as) (length ys) 1
    ... = length (a :: as) + length ys : by rw length_cons

-- 12ª demostración
lemma longitud_conc_2 :
  ∀ xs, length (xs ++ ys) = length xs + length ys
| []        := by simp
| (a :: as) := by simp [longitud_conc_2 as, add_right_comm]

-- 13ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
-- by library_search
length_append xs ys

-- 14ª demostración
example :
  length (xs ++ ys) = length xs + length ys :=
by simp

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

import tactic

open list

variable {α : Type}

variable (x : α)

variables (xs ys zs : list α)

lemma length_nil : length ([] : list α) = 0 := rfl

-- 1ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

begin

induction xs with a as HI,

{ rw nil_append,

rw length_nil,

rw zero_add, },

{ rw cons_append,

rw length_cons,

rw HI,

rw length_cons,

rw add_assoc,

rw add_comm (length ys),

rw add_assoc, },

end

-- 2ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

begin

induction xs with a as HI,

{ rw nil_append,

rw length_nil,

rw zero_add, },

{ rw cons_append,

rw length_cons,

rw HI,

rw length_cons,

-- library_search,

exact add_right_comm (length as) (length ys) 1 },

end

-- 3ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

begin

induction xs with a as HI,

{ rw nil_append,

rw length_nil,

rw zero_add, },

{ rw cons_append,

rw length_cons,

rw HI,

rw length_cons,

-- by hint,

linarith, },

end

-- 4ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

begin

induction xs with a as HI,

{ simp, },

{ simp [HI],

linarith, },

end

-- 5ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

begin

induction xs with a as HI,

{ simp, },

{ finish [HI],},

end

-- 6ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

by induction xs ; finish [*]

-- 7ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

begin

induction xs with a as HI,

{ calc length ([] ++ ys)

= length ys : congr_arg length (nil_append ys)

... = 0 + length ys : (zero_add (length ys)).symm

... = length [] + length ys : congr_arg2 (+) length_nil.symm rfl, },

{ calc length ((a :: as) ++ ys)

= length (a :: (as ++ ys)) : congr_arg length (cons_append a as ys)

... = length (as ++ ys) + 1 : length_cons a (as ++ ys)

... = (length as + length ys) + 1 : congr_arg2 (+) HI rfl

... = (length as + 1) + length ys : add_right_comm (length as) (length ys) 1

... = length (a :: as) + length ys : congr_arg2 (+) (length_cons a as).symm rfl, },

end

-- 8ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

begin

induction xs with a as HI,

{ calc length ([] ++ ys)

= length ys : by rw nil_append

... = 0 + length ys : (zero_add (length ys)).symm

... = length [] + length ys : by rw length_nil },

{ calc length ((a :: as) ++ ys)

= length (a :: (as ++ ys)) : by rw cons_append

... = length (as ++ ys) + 1 : by rw length_cons

... = (length as + length ys) + 1 : by rw HI

... = (length as + 1) + length ys : add_right_comm (length as) (length ys) 1

... = length (a :: as) + length ys : by rw length_cons, },

end

-- 9ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

list.rec_on xs

( show length ([] ++ ys) = length [] + length ys, from

calc length ([] ++ ys)

= length ys : by rw nil_append

... = 0 + length ys : by exact (zero_add (length ys)).symm

... = length [] + length ys : by rw length_nil )

( assume a as,

assume HI : length (as ++ ys) = length as + length ys,

show length ((a :: as) ++ ys) = length (a :: as) + length ys, from

calc length ((a :: as) ++ ys)

= length (a :: (as ++ ys)) : by rw cons_append

... = length (as ++ ys) + 1 : by rw length_cons

... = (length as + length ys) + 1 : by rw HI

... = (length as + 1) + length ys : by exact add_right_comm (length as) (length ys) 1

... = length (a :: as) + length ys : by rw length_cons)

-- 10ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

list.rec_on xs

( by simp)

( λ a as HI, by simp [HI, add_right_comm])

-- 11ª demostración

lemma longitud_conc_1 :

∀ xs, length (xs ++ ys) = length xs + length ys

| [] := by calc

length ([] ++ ys)

= length ys : by rw nil_append

... = 0 + length ys : by rw zero_add

... = length [] + length ys : by rw length_nil

| (a :: as) := by calc

length ((a :: as) ++ ys)

= length (a :: (as ++ ys)) : by rw cons_append

... = length (as ++ ys) + 1 : by rw length_cons

... = (length as + length ys) + 1 : by rw longitud_conc_1

... = (length as + 1) + length ys : by exact add_right_comm (length as) (length ys) 1

... = length (a :: as) + length ys : by rw length_cons

-- 12ª demostración

lemma longitud_conc_2 :

∀ xs, length (xs ++ ys) = length xs + length ys

| [] := by simp

| (a :: as) := by simp [longitud_conc_2 as, add_right_comm]

-- 13ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

-- by library_search

length_append xs ys

-- 14ª demostración

example :

length (xs ++ ys) = length xs + length ys :=

by simp

Se puede interactuar con la prueba anterior en esta sesión con Lean.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="lean"> y otra con </pre>
[/expand]

[expand title=»Soluciones con Isabelle/HOL»]

theory "Pruebas_de_length(xs_++_ys)_Ig_length_xs+length_ys"
imports Main
begin

(* 1ª demostración *)
lemma "length (xs @ ys) = length xs + length ys"
proof (induct xs)
  have "length ([] @ ys) = length ys"
    by (simp only: append_Nil)
  also have "… = 0 + length ys"
    by (rule add_0 [symmetric])
  also have "… = length [] + length ys"
    by (simp only: list.size(3))
  finally show "length ([] @ ys) = length [] + length ys"
    by this
next
  fix x xs
  assume HI : "length (xs @ ys) = length xs + length ys"
  have "length ((x # xs) @ ys) =
        length (x # (xs @ ys))"
    by (simp only: append_Cons)
  also have "… = length (xs @ ys) + 1"
    by (simp only: list.size(4))
  also have "… = (length xs + length ys) + 1"
    by (simp only: HI)
  also have "… = (length xs + 1) + length ys"
    by (simp only: add.assoc add.commute)
  also have "… = length (x # xs) + length ys"
    by (simp only: list.size(4))
  then show "length ((x # xs) @ ys) = length (x # xs) + length ys"
    by simp
qed

(* 2ª demostración *)
lemma "length (xs @ ys) = length xs + length ys"
proof (induct xs)
  show "length ([] @ ys) = length [] + length ys"
    by simp
next
  fix x xs
  assume "length (xs @ ys) = length xs + length ys"
  then show "length ((x # xs) @ ys) = length (x # xs) + length ys"
    by simp
qed

(* 3ª demostración *)
lemma "length (xs @ ys) = length xs + length ys"
proof (induct xs)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  then show ?case by simp
qed

(* 4ª demostración *)
lemma "length (xs @ ys) = length xs + length ys"
by (induct xs) simp_all

(* 5ª demostración *)
lemma "length (xs @ ys) = length xs + length ys"
by (fact length_append)

end

theory "Pruebas_de_length(xs_++_ys)_Ig_length_xs+length_ys"

imports Main

begin

(* 1ª demostración *)

lemma "length (xs @ ys) = length xs + length ys"

proof (induct xs)

have "length ([] @ ys) = length ys"

by (simp only: append_Nil)

also have "… = 0 + length ys"

by (rule add_0 [symmetric])

also have "… = length [] + length ys"

by (simp only: list.size(3))

finally show "length ([] @ ys) = length [] + length ys"

by this

fix x xs

assume HI : "length (xs @ ys) = length xs + length ys"

have "length ((x # xs) @ ys) =

length (x # (xs @ ys))"

by (simp only: append_Cons)

also have "… = length (xs @ ys) + 1"

by (simp only: list.size(4))

also have "… = (length xs + length ys) + 1"

by (simp only: HI)

also have "… = (length xs + 1) + length ys"

by (simp only: add.assoc add.commute)

also have "… = length (x # xs) + length ys"

by (simp only: list.size(4))

then show "length ((x # xs) @ ys) = length (x # xs) + length ys"

by simp

qed

(* 2ª demostración *)

lemma "length (xs @ ys) = length xs + length ys"

proof (induct xs)

show "length ([] @ ys) = length [] + length ys"

by simp

fix x xs

assume "length (xs @ ys) = length xs + length ys"

then show "length ((x # xs) @ ys) = length (x # xs) + length ys"

by simp

qed

(* 3ª demostración *)

lemma "length (xs @ ys) = length xs + length ys"

proof (induct xs)

case Nil

then show ?case by simp

case (Cons a xs)

then show ?case by simp

qed

(* 4ª demostración *)

lemma "length (xs @ ys) = length xs + length ys"

by (induct xs) simp_all

(* 5ª demostración *)

lemma "length (xs @ ys) = length xs + length ys"

by (fact length_append)

end

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="isar"> y otra con </pre>
[/expand]

Asociatividad de la concatenación de listas

PorJosé A. Alonso 8 septiembre 20218 septiembre 2021

En Lean la operación de concatenación de listas se representa por (++) y está caracterizada por los siguientes lemas

   nil_append  : [] ++ ys = ys
   cons_append : (x :: xs) ++ y = x :: (xs ++ ys)

1 2	nil_append : [] ++ ys = ys cons_append : (x :: xs) ++ y = x :: (xs ++ ys)

Demostrar que la concatenación es asociativa; es decir,

   xs ++ (ys ++ zs) = (xs ++ ys) ++ zs

1	xs ++ (ys ++ zs) = (xs ++ ys) ++ zs

Para ello, completar la siguiente teoría de Lean:

import data.list.basic
import tactic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys zs : list α)

example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
sorry

import data.list.basic

import tactic

open list

variable {α : Type}

variable (x : α)

variables (xs ys zs : list α)

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

sorry

[expand title=»Soluciones con Lean»]

import data.list.basic
import tactic
open list

variable  {α : Type}
variable  (x : α)
variables (xs ys zs : list α)

-- 1ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : append.equations._eqn_1 (ys ++ zs)
     ... = ([] ++ ys) ++ zs        : congr_arg2 (++) (append.equations._eqn_1 ys) rfl, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : append.equations._eqn_2 a as (ys ++ zs)
     ... = a :: ((as ++ ys) ++ zs) : congr_arg2 (::) rfl HI
     ... = (a :: (as ++ ys)) ++ zs : (append.equations._eqn_2 a (as ++ ys) zs).symm
     ... = ((a :: as) ++ ys) ++ zs : congr_arg2 (++) (append.equations._eqn_2 a as ys).symm rfl, },
end

-- 2ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : nil_append (ys ++ zs)
     ... = ([] ++ ys) ++ zs        : congr_arg2 (++) (nil_append ys) rfl, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : cons_append a as (ys ++ zs)
     ... = a :: ((as ++ ys) ++ zs) : congr_arg2 (::) rfl HI
     ... = (a :: (as ++ ys)) ++ zs : (cons_append a (as ++ ys) zs).symm
     ... = ((a :: as) ++ ys) ++ zs : congr_arg2 (++) (cons_append a as ys).symm rfl, },
end

-- 3ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : by rw nil_append
     ... = ([] ++ ys) ++ zs        : by rw nil_append, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : by rw cons_append
     ... = a :: ((as ++ ys) ++ zs) : by rw HI
     ... = (a :: (as ++ ys)) ++ zs : by rw cons_append
     ... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append, },
end

-- 4ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : rfl
     ... = ([] ++ ys) ++ zs        : rfl, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : rfl
     ... = a :: ((as ++ ys) ++ zs) : by rw HI
     ... = (a :: (as ++ ys)) ++ zs : rfl
     ... = ((a :: as) ++ ys) ++ zs : rfl, },
end

-- 5ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { calc [] ++ (ys ++ zs)
         = ys ++ zs                : by simp
     ... = ([] ++ ys) ++ zs        : by simp, },
  { calc (a :: as) ++ (ys ++ zs)
         = a :: (as ++ (ys ++ zs)) : by simp
     ... = a :: ((as ++ ys) ++ zs) : congr_arg (cons a) HI
     ... = (a :: (as ++ ys)) ++ zs : by simp
     ... = ((a :: as) ++ ys) ++ zs : by simp, },
end

-- 6ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { by simp, },
  { by exact (cons_inj a).mpr HI, },
end

-- 7ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
begin
  induction xs with a as HI,
  { rw nil_append,
    rw nil_append, },
  { rw cons_append,
    rw HI,
    rw cons_append,
    rw cons_append, },
end

-- 8ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
list.rec_on xs
  ( show [] ++ (ys ++ zs) = ([] ++ ys) ++ zs,
      from calc
        [] ++ (ys ++ zs)
            = ys ++ zs         : by rw nil_append
        ... = ([] ++ ys) ++ zs : by rw nil_append )
  ( assume a as,
    assume HI : as ++ (ys ++ zs) = (as ++ ys) ++ zs,
    show (a :: as) ++ (ys  ++ zs) = ((a :: as) ++ ys) ++ zs,
      from calc
        (a :: as) ++ (ys ++ zs)
            = a :: (as ++ (ys ++ zs)) : by rw cons_append
        ... = a :: ((as ++ ys) ++ zs) : by rw HI
        ... = (a :: (as ++ ys)) ++ zs : by rw cons_append
        ... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append)

-- 9ª demostración
example :
  xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=
list.rec_on xs
  (by simp)
  (by simp [*])

-- 10ª demostración
lemma conc_asoc_1 :
  ∀ xs, xs ++ (ys ++ zs) = (xs ++ ys) ++ zs
| [] := by calc
    [] ++ (ys ++ zs)
        = ys ++ zs         : by rw nil_append
    ... = ([] ++ ys) ++ zs : by rw nil_append
| (a :: as) := by calc
    (a :: as) ++ (ys ++ zs)
        = a :: (as ++ (ys ++ zs)) : by rw cons_append
    ... = a :: ((as ++ ys) ++ zs) : by rw conc_asoc_1
    ... = (a :: (as ++ ys)) ++ zs : by rw cons_append
    ... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append

-- 11ª demostración
example :
  (xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=
-- by library_search
append_assoc xs ys zs

-- 12ª demostración
example :
  (xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=
by induction xs ; simp [*]

-- 13ª demostración
example :
  (xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=
by simp

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

import data.list.basic

import tactic

open list

variable {α : Type}

variable (x : α)

variables (xs ys zs : list α)

-- 1ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

begin

induction xs with a as HI,

{ calc [] ++ (ys ++ zs)

= ys ++ zs : append.equations._eqn_1 (ys ++ zs)

... = ([] ++ ys) ++ zs : congr_arg2 (++) (append.equations._eqn_1 ys) rfl, },

{ calc (a :: as) ++ (ys ++ zs)

= a :: (as ++ (ys ++ zs)) : append.equations._eqn_2 a as (ys ++ zs)

... = a :: ((as ++ ys) ++ zs) : congr_arg2 (::) rfl HI

... = (a :: (as ++ ys)) ++ zs : (append.equations._eqn_2 a (as ++ ys) zs).symm

... = ((a :: as) ++ ys) ++ zs : congr_arg2 (++) (append.equations._eqn_2 a as ys).symm rfl, },

end

-- 2ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

begin

induction xs with a as HI,

{ calc [] ++ (ys ++ zs)

= ys ++ zs : nil_append (ys ++ zs)

... = ([] ++ ys) ++ zs : congr_arg2 (++) (nil_append ys) rfl, },

{ calc (a :: as) ++ (ys ++ zs)

= a :: (as ++ (ys ++ zs)) : cons_append a as (ys ++ zs)

... = a :: ((as ++ ys) ++ zs) : congr_arg2 (::) rfl HI

... = (a :: (as ++ ys)) ++ zs : (cons_append a (as ++ ys) zs).symm

... = ((a :: as) ++ ys) ++ zs : congr_arg2 (++) (cons_append a as ys).symm rfl, },

end

-- 3ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

begin

induction xs with a as HI,

{ calc [] ++ (ys ++ zs)

= ys ++ zs : by rw nil_append

... = ([] ++ ys) ++ zs : by rw nil_append, },

{ calc (a :: as) ++ (ys ++ zs)

= a :: (as ++ (ys ++ zs)) : by rw cons_append

... = a :: ((as ++ ys) ++ zs) : by rw HI

... = (a :: (as ++ ys)) ++ zs : by rw cons_append

... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append, },

end

-- 4ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

begin

induction xs with a as HI,

{ calc [] ++ (ys ++ zs)

= ys ++ zs : rfl

... = ([] ++ ys) ++ zs : rfl, },

{ calc (a :: as) ++ (ys ++ zs)

= a :: (as ++ (ys ++ zs)) : rfl

... = a :: ((as ++ ys) ++ zs) : by rw HI

... = (a :: (as ++ ys)) ++ zs : rfl

... = ((a :: as) ++ ys) ++ zs : rfl, },

end

-- 5ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

begin

induction xs with a as HI,

{ calc [] ++ (ys ++ zs)

= ys ++ zs : by simp

... = ([] ++ ys) ++ zs : by simp, },

{ calc (a :: as) ++ (ys ++ zs)

= a :: (as ++ (ys ++ zs)) : by simp

... = a :: ((as ++ ys) ++ zs) : congr_arg (cons a) HI

... = (a :: (as ++ ys)) ++ zs : by simp

... = ((a :: as) ++ ys) ++ zs : by simp, },

end

-- 6ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

begin

induction xs with a as HI,

{ by simp, },

{ by exact (cons_inj a).mpr HI, },

end

-- 7ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

begin

induction xs with a as HI,

{ rw nil_append,

rw nil_append, },

{ rw cons_append,

rw HI,

rw cons_append,

rw cons_append, },

end

-- 8ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

list.rec_on xs

( show [] ++ (ys ++ zs) = ([] ++ ys) ++ zs,

from calc

[] ++ (ys ++ zs)

= ys ++ zs : by rw nil_append

... = ([] ++ ys) ++ zs : by rw nil_append )

( assume a as,

assume HI : as ++ (ys ++ zs) = (as ++ ys) ++ zs,

show (a :: as) ++ (ys ++ zs) = ((a :: as) ++ ys) ++ zs,

from calc

(a :: as) ++ (ys ++ zs)

= a :: (as ++ (ys ++ zs)) : by rw cons_append

... = a :: ((as ++ ys) ++ zs) : by rw HI

... = (a :: (as ++ ys)) ++ zs : by rw cons_append

... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append)

-- 9ª demostración

example :

xs ++ (ys ++ zs) = (xs ++ ys) ++ zs :=

list.rec_on xs

(by simp)

(by simp [*])

-- 10ª demostración

lemma conc_asoc_1 :

∀ xs, xs ++ (ys ++ zs) = (xs ++ ys) ++ zs

| [] := by calc

[] ++ (ys ++ zs)

= ys ++ zs : by rw nil_append

... = ([] ++ ys) ++ zs : by rw nil_append

| (a :: as) := by calc

(a :: as) ++ (ys ++ zs)

= a :: (as ++ (ys ++ zs)) : by rw cons_append

... = a :: ((as ++ ys) ++ zs) : by rw conc_asoc_1

... = (a :: (as ++ ys)) ++ zs : by rw cons_append

... = ((a :: as) ++ ys) ++ zs : by rw ← cons_append

-- 11ª demostración

example :

(xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=

-- by library_search

append_assoc xs ys zs

-- 12ª demostración

example :

(xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=

by induction xs ; simp [*]

-- 13ª demostración

example :

(xs ++ ys) ++ zs = xs ++ (ys ++ zs) :=

by simp

Se puede interactuar con la prueba anterior en esta sesión con Lean.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="lean"> y otra con </pre>
[/expand]

[expand title=»Soluciones con Isabelle/HOL»]

theory Asociatividad_de_la_concatenacion_de_listas
imports Main
begin

(* 1ª demostración *)
lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"
proof (induct xs)
  have "[] @ (ys @ zs) = ys @ zs"
    by (simp only: append_Nil)
  also have "… = ([] @ ys) @ zs"
    by (simp only: append_Nil)
  finally show "[] @ (ys @ zs) = ([] @ ys) @ zs"
    by this
next
  fix x xs
  assume HI : "xs @ (ys @ zs) = (xs @ ys) @ zs"
  have "(x # xs) @ (ys @ zs) = x # (xs @ (ys @ zs))"
    by (simp only: append_Cons)
  also have "… = x # ((xs @ ys) @ zs)"
    by (simp only: HI)
  also have "… = (x # (xs @ ys)) @ zs"
    by (simp only: append_Cons)
  also have "… = ((x # xs) @ ys) @ zs"
    by (simp only: append_Cons)
  finally show "(x # xs) @ (ys @ zs) = ((x # xs) @ ys) @ zs"
    by this
qed

(* 2ª demostración *)
lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"
proof (induct xs)
  have "[] @ (ys @ zs) = ys @ zs" by simp
  also have "… = ([] @ ys) @ zs" by simp
  finally show "[] @ (ys @ zs) = ([] @ ys) @ zs" .
next
  fix x xs
  assume HI : "xs @ (ys @ zs) = (xs @ ys) @ zs"
  have "(x # xs) @ (ys @ zs) = x # (xs @ (ys @ zs))" by simp
  also have "… = x # ((xs @ ys) @ zs)" by simp
  also have "… = (x # (xs @ ys)) @ zs" by simp
  also have "… = ((x # xs) @ ys) @ zs" by simp
  finally show "(x # xs) @ (ys @ zs) = ((x # xs) @ ys) @ zs" .
qed

(* 3ª demostración *)
lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"
proof (induct xs)
  show "[] @ (ys @ zs) = ([] @ ys) @ zs" by simp
next
  fix x xs
  assume "xs @ (ys @ zs) = (xs @ ys) @ zs"
  then show "(x # xs) @ (ys @ zs) = ((x # xs) @ ys) @ zs" by simp
qed

(* 4ª demostración *)
lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"
proof (induct xs)
  case Nil
  then show ?case by simp
next
  case (Cons a xs)
  then show ?case by simp
qed

(* 5ª demostración *)
lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"
  by (rule append_assoc [symmetric])

(* 6ª demostración *)
lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"
  by (induct xs) simp_all

(* 7ª demostración *)
lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"
  by simp

end

theory Asociatividad_de_la_concatenacion_de_listas

imports Main

begin

(* 1ª demostración *)

lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"

proof (induct xs)

have "[] @ (ys @ zs) = ys @ zs"

by (simp only: append_Nil)

also have "… = ([] @ ys) @ zs"

by (simp only: append_Nil)

finally show "[] @ (ys @ zs) = ([] @ ys) @ zs"

by this

fix x xs

assume HI : "xs @ (ys @ zs) = (xs @ ys) @ zs"

have "(x # xs) @ (ys @ zs) = x # (xs @ (ys @ zs))"

by (simp only: append_Cons)

also have "… = x # ((xs @ ys) @ zs)"

by (simp only: HI)

also have "… = (x # (xs @ ys)) @ zs"

by (simp only: append_Cons)

also have "… = ((x # xs) @ ys) @ zs"

by (simp only: append_Cons)

finally show "(x # xs) @ (ys @ zs) = ((x # xs) @ ys) @ zs"

by this

qed

(* 2ª demostración *)

lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"

proof (induct xs)

have "[] @ (ys @ zs) = ys @ zs" by simp

also have "… = ([] @ ys) @ zs" by simp

finally show "[] @ (ys @ zs) = ([] @ ys) @ zs" .

fix x xs

assume HI : "xs @ (ys @ zs) = (xs @ ys) @ zs"

have "(x # xs) @ (ys @ zs) = x # (xs @ (ys @ zs))" by simp

also have "… = x # ((xs @ ys) @ zs)" by simp

also have "… = (x # (xs @ ys)) @ zs" by simp

also have "… = ((x # xs) @ ys) @ zs" by simp

finally show "(x # xs) @ (ys @ zs) = ((x # xs) @ ys) @ zs" .

qed

(* 3ª demostración *)

lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"

proof (induct xs)

show "[] @ (ys @ zs) = ([] @ ys) @ zs" by simp

fix x xs

assume "xs @ (ys @ zs) = (xs @ ys) @ zs"

then show "(x # xs) @ (ys @ zs) = ((x # xs) @ ys) @ zs" by simp

qed

(* 4ª demostración *)

lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"

proof (induct xs)

case Nil

then show ?case by simp

case (Cons a xs)

then show ?case by simp

qed

(* 5ª demostración *)

lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"

by (rule append_assoc [symmetric])

(* 6ª demostración *)

lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"

by (induct xs) simp_all

(* 7ª demostración *)

lemma "xs @ (ys @ zs) = (xs @ ys) @ zs"

by simp

end

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="isar"> y otra con </pre>
[/expand]

Las particiones definen relaciones de equivalencia

PorJosé A. Alonso 28 agosto 202123 agosto 2021

Cada familia de conjuntos P define una relación de forma que dos elementos están relacionados si algún conjunto de P contiene a ambos elementos. Se puede definir en Lean por

   def relacion (P : set (set X)) (x y : X) :=
     ∃ A ∈ P, x ∈ A ∧ y ∈ A

1 2	def relacion (P : set (set X)) (x y : X) := ∃ A ∈ P, x ∈ A ∧ y ∈ A

Una familia de subconjuntos de X es una partición de X si cada elemento de X pertenece a un único conjunto de P y todos los elementos de P son no vacíos. Se puede definir en Lean por

   def particion (P : set (set X)) : Prop :=
     (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

1 2	def particion (P : set (set X)) : Prop := (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

Demostrar que si P es una partición de X, entonces la relación definida por P es una relación de equivalencia.

Para ello, completar la siguiente teoría de Lean:

import tactic

variable {X : Type}
variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=
  ∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=
  (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

example
  (h : particion P)
  : equivalence (relacion P) :=
sorry

import tactic

variable {X : Type}

variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=

∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=

(∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

example

(h : particion P)

: equivalence (relacion P) :=

sorry

[expand title=»Soluciones con Lean»]

import tactic

variable {X : Type}
variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=
  ∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=
  (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

example
  (h : particion P)
  : equivalence (relacion P) :=
begin
  repeat { split },
  { intro x,
    rcases (h.1 x) with ⟨A, hAP, hxA, -⟩,
    use [A, ⟨hAP, hxA, hxA⟩], },
  { intros x y hxy,
    rcases hxy with ⟨B, hBP, ⟨hxB, hyB⟩⟩,
    use [B, ⟨hBP, hyB, hxB⟩], },
  { rintros x y z ⟨B1,hB1P,hxB1,hyB1⟩ ⟨B2,hB2P,hyB2,hzB2⟩,
    use B1,
    repeat { split },
    { exact hB1P, },
    { exact hxB1, },
    { convert hzB2,
      rcases (h.1 y) with ⟨B, -, -, hB⟩,
      exact eq.trans (hB B1 hB1P hyB1).symm (hB B2 hB2P hyB2), }},
end

import tactic

variable {X : Type}

variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=

∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=

(∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

example

(h : particion P)

: equivalence (relacion P) :=

begin

repeat { split },

{ intro x,

rcases (h.1 x) with ⟨A, hAP, hxA, -⟩,

use [A, ⟨hAP, hxA, hxA⟩], },

{ intros x y hxy,

rcases hxy with ⟨B, hBP, ⟨hxB, hyB⟩⟩,

use [B, ⟨hBP, hyB, hxB⟩], },

{ rintros x y z ⟨B1,hB1P,hxB1,hyB1⟩ ⟨B2,hB2P,hyB2,hzB2⟩,

use B1,

repeat { split },

{ exact hB1P, },

{ exact hxB1, },

{ convert hzB2,

rcases (h.1 y) with ⟨B, -, -, hB⟩,

exact eq.trans (hB B1 hB1P hyB1).symm (hB B2 hB2P hyB2), }},

end

Se puede interactuar con la prueba anterior en esta sesión con Lean.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="lean"> y otra con </pre>
[/expand]

[expand title=»Soluciones con Isabelle/HOL»]

theory Las_particiones_definen_relaciones_de_equivalencia
imports Main
begin

definition relacion :: "('a set) set ⇒ 'a ⇒ 'a ⇒ bool" where
  "relacion P x y ⟷ (∃A∈P. x ∈ A ∧ y ∈ A)"

definition particion :: "('a set) set ⇒ bool" where
  "particion P ⟷ (∀x. (∃B∈P. x ∈ B ∧ (∀C∈P. x ∈ C ⟶ B = C))) ∧ {} ∉ P"

(* 1ª demostración *)
lemma
  assumes "particion P"
  shows   "equivp (relacion P)"
proof (rule equivpI)
  show "reflp (relacion P)"
  proof (rule reflpI)
    fix x
    obtain A where "A ∈ P ∧ x ∈ A"
      using assms particion_def by metis
    then show "relacion P x x"
      using relacion_def by metis
  qed
next
  show "symp (relacion P)"
  proof (rule sympI)
    fix x y
    assume "relacion P x y"
    then obtain A where "A ∈ P ∧ x ∈ A ∧ y ∈ A"
      using relacion_def by metis
    then show "relacion P y x"
      using relacion_def by metis
  qed
next
  show "transp (relacion P)"
  proof (rule transpI)
    fix x y z
    assume "relacion P x y" and "relacion P y z"
    obtain A where "A ∈ P" and hA : "x ∈ A ∧ y ∈ A"
      using ‹relacion P x y› by (meson relacion_def)
    obtain B where "B ∈ P" and hB : "y ∈ B ∧ z ∈ B"
      using ‹relacion P y z› by (meson relacion_def)
    have "A = B"
    proof -
      obtain C where "C ∈ P"
                 and hC : "y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"
        using assms particion_def by metis
      then show "A = B"
        using ‹A ∈ P› ‹B ∈ P› hA hB by blast
    qed
    then have "x ∈ A ∧ z ∈ A"  using hA hB by auto
    then show "relacion P x z"
      using ‹A = B› ‹A ∈ P› relacion_def by metis
  qed
qed

(* 2ª demostración *)
lemma
  assumes "particion P"
  shows   "equivp (relacion P)"
proof (rule equivpI)
  show "reflp (relacion P)"
    using assms particion_def relacion_def
    by (metis reflpI)
next
  show "symp (relacion P)"
    using assms relacion_def
    by (metis sympI)
next
  show "transp (relacion P)"
    using assms relacion_def particion_def
    by (smt (verit) transpI)
qed

end

theory Las_particiones_definen_relaciones_de_equivalencia

imports Main

begin

definition relacion :: "('a set) set ⇒ 'a ⇒ 'a ⇒ bool" where

"relacion P x y ⟷ (∃A∈P. x ∈ A ∧ y ∈ A)"

definition particion :: "('a set) set ⇒ bool" where

"particion P ⟷ (∀x. (∃B∈P. x ∈ B ∧ (∀C∈P. x ∈ C ⟶ B = C))) ∧ {} ∉ P"

(* 1ª demostración *)

lemma

assumes "particion P"

shows "equivp (relacion P)"

proof (rule equivpI)

show "reflp (relacion P)"

proof (rule reflpI)

fix x

obtain A where "A ∈ P ∧ x ∈ A"

using assms particion_def by metis

then show "relacion P x x"

using relacion_def by metis

qed

show "symp (relacion P)"

proof (rule sympI)

fix x y

assume "relacion P x y"

then obtain A where "A ∈ P ∧ x ∈ A ∧ y ∈ A"

using relacion_def by metis

then show "relacion P y x"

using relacion_def by metis

qed

show "transp (relacion P)"

proof (rule transpI)

fix x y z

assume "relacion P x y" and "relacion P y z"

obtain A where "A ∈ P" and hA : "x ∈ A ∧ y ∈ A"

using ‹relacion P x y› by (meson relacion_def)

obtain B where "B ∈ P" and hB : "y ∈ B ∧ z ∈ B"

using ‹relacion P y z› by (meson relacion_def)

have "A = B"

proof -

obtain C where "C ∈ P"

and hC : "y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"

using assms particion_def by metis

then show "A = B"

using ‹A ∈ P› ‹B ∈ P› hA hB by blast

qed

then have "x ∈ A ∧ z ∈ A" using hA hB by auto

then show "relacion P x z"

using ‹A = B› ‹A ∈ P› relacion_def by metis

qed

(* 2ª demostración *)

lemma

assumes "particion P"

shows "equivp (relacion P)"

proof (rule equivpI)

show "reflp (relacion P)"

using assms particion_def relacion_def

by (metis reflpI)

show "symp (relacion P)"

using assms relacion_def

by (metis sympI)

show "transp (relacion P)"

using assms relacion_def particion_def

by (smt (verit) transpI)

qed

end

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="isar"> y otra con </pre>
[/expand]

Las particiones definen relaciones transitivas

PorJosé A. Alonso 27 agosto 202121 agosto 2021

Cada familia de conjuntos P define una relación de forma que dos elementos están relacionados si algún conjunto de P contiene a ambos elementos. Se puede definir en Lean por

   def relacion (P : set (set X)) (x y : X) :=
     ∃ A ∈ P, x ∈ A ∧ y ∈ A

1 2	def relacion (P : set (set X)) (x y : X) := ∃ A ∈ P, x ∈ A ∧ y ∈ A

Una familia de subconjuntos de X es una partición de X si cada de X pertenece a un único conjunto de P y todos los elementos de P son no vacíos. Se puede definir en Lean por

   def particion (P : set (set X)) : Prop :=
     (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

1 2	def particion (P : set (set X)) : Prop := (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

Demostrar que si P es una partición de X, entonces la relación definida por P es transitiva.

Para ello, completar la siguiente teoría de Lean:

import tactic

variable {X : Type}
variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=
  ∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=
  (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

example
  (h : particion P)
  : transitive (relacion P) :=
sorry

import tactic

variable {X : Type}

variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=

∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=

(∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

example

(h : particion P)

: transitive (relacion P) :=

sorry

[expand title=»Soluciones con Lean»]

import tactic

variable {X : Type}
variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=
  ∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=
  (∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

-- 1ª demostración
example
  (h : particion P)
  : transitive (relacion P) :=
begin
  unfold transitive,
  intros x y z h1 h2,
  unfold relacion at *,
  rcases h1 with ⟨B1, hB1P, hxB1, hyB1⟩,
  rcases h2 with ⟨B2, hB2P, hyB2, hzB2⟩,
  use B1,
  repeat { split },
  { exact hB1P, },
  { exact hxB1, },
  { convert hzB2,
    rcases (h.1 y) with ⟨B, -, -, hB⟩,
    have hBB1 : B = B1 := hB B1 hB1P hyB1,
    have hBB2 : B = B2 := hB B2 hB2P hyB2,
    exact eq.trans hBB1.symm hBB2, },
end

-- 2ª demostración
example
  (h : particion P)
  : transitive (relacion P) :=
begin
  rintros x y z ⟨B1,hB1P,hxB1,hyB1⟩ ⟨B2,hB2P,hyB2,hzB2⟩,
  use B1,
  repeat { split },
  { exact hB1P, },
  { exact hxB1, },
  { convert hzB2,
    rcases (h.1 y) with ⟨B, -, -, hB⟩,
    exact eq.trans (hB B1 hB1P hyB1).symm (hB B2 hB2P hyB2), },
end

-- 3ª demostración
example
  (h : particion P)
  : transitive (relacion P) :=
begin
  rintros x y z ⟨B1,hB1P,hxB1,hyB1⟩ ⟨B2,hB2P,hyB2,hzB2⟩,
  use [B1, ⟨hB1P,
            hxB1,
            by { convert hzB2,
                 rcases (h.1 y) with ⟨B, -, -, hB⟩,
                 exact eq.trans (hB B1 hB1P hyB1).symm
                                (hB B2 hB2P hyB2), }⟩],
end

import tactic

variable {X : Type}

variable (P : set (set X))

def relacion (P : set (set X)) (x y : X) :=

∃ A ∈ P, x ∈ A ∧ y ∈ A

def particion (P : set (set X)) : Prop :=

(∀ x, (∃ B ∈ P, x ∈ B ∧ ∀ C ∈ P, x ∈ C → B = C)) ∧ ∅ ∉ P

-- 1ª demostración

example

(h : particion P)

: transitive (relacion P) :=

begin

unfold transitive,

intros x y z h1 h2,

unfold relacion at *,

rcases h1 with ⟨B1, hB1P, hxB1, hyB1⟩,

rcases h2 with ⟨B2, hB2P, hyB2, hzB2⟩,

use B1,

repeat { split },

{ exact hB1P, },

{ exact hxB1, },

{ convert hzB2,

rcases (h.1 y) with ⟨B, -, -, hB⟩,

have hBB1 : B = B1 := hB B1 hB1P hyB1,

have hBB2 : B = B2 := hB B2 hB2P hyB2,

exact eq.trans hBB1.symm hBB2, },

end

-- 2ª demostración

example

(h : particion P)

: transitive (relacion P) :=

begin

rintros x y z ⟨B1,hB1P,hxB1,hyB1⟩ ⟨B2,hB2P,hyB2,hzB2⟩,

use B1,

repeat { split },

{ exact hB1P, },

{ exact hxB1, },

{ convert hzB2,

rcases (h.1 y) with ⟨B, -, -, hB⟩,

exact eq.trans (hB B1 hB1P hyB1).symm (hB B2 hB2P hyB2), },

end

-- 3ª demostración

example

(h : particion P)

: transitive (relacion P) :=

begin

rintros x y z ⟨B1,hB1P,hxB1,hyB1⟩ ⟨B2,hB2P,hyB2,hzB2⟩,

use [B1, ⟨hB1P,

hxB1,

by { convert hzB2,

rcases (h.1 y) with ⟨B, -, -, hB⟩,

exact eq.trans (hB B1 hB1P hyB1).symm

(hB B2 hB2P hyB2), }⟩],

end

Se puede interactuar con la prueba anterior en esta sesión con Lean.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="lean"> y otra con </pre>
[/expand]

[expand title=»Soluciones con Isabelle/HOL»]

theory Las_particiones_definen_relaciones_transitivas
imports Main
begin

definition relacion :: "('a set) set ⇒ 'a ⇒ 'a ⇒ bool" where
  "relacion P x y ⟷ (∃A∈P. x ∈ A ∧ y ∈ A)"

definition particion :: "('a set) set ⇒ bool" where
  "particion P ⟷ (∀x. (∃B∈P. x ∈ B ∧ (∀C∈P. x ∈ C ⟶ B = C))) ∧ {} ∉ P"

(* 1ª demostración *)
lemma
  assumes "particion P"
  shows   "transp (relacion P)"
proof (rule transpI)
  fix x y z
  assume "relacion P x y" and "relacion P y z"
  have "∃A∈P. x ∈ A ∧ y ∈ A"
    using ‹relacion P x y›
    by (simp only: relacion_def)
  then obtain A where "A ∈ P" and hA : "x ∈ A ∧ y ∈ A"
    by (rule bexE)
  have "∃B∈P. y ∈ B ∧ z ∈ B"
    using ‹relacion P y z›
    by (simp only: relacion_def)
  then obtain B where "B ∈ P" and hB : "y ∈ B ∧ z ∈ B"
    by (rule bexE)
  have "A = B"
  proof -
    have "∃C ∈ P. y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"
      using assms
      by (simp only: particion_def)
    then obtain C where "C ∈ P"
                    and hC : "y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"
      by (rule bexE)
    have hC' : "∀D∈P. y ∈ D ⟶ C = D"
      using hC by (rule conjunct2)
    have "C = A"
      using ‹A ∈ P› hA hC' by simp
    moreover have "C = B"
      using ‹B ∈ P› hB hC by simp
    ultimately show "A = B"
      by (rule subst)
  qed
  then have "x ∈ A ∧ z ∈ A"
    using hA hB by simp
  then have "∃A∈P. x ∈ A ∧ z ∈ A"
    using ‹A ∈ P› by (rule bexI)
  then show "relacion P x z"
    using ‹A = B› ‹A ∈ P›
    by (unfold relacion_def)
qed

(* 2ª demostración *)
lemma
  assumes "particion P"
  shows   "transp (relacion P)"
proof (rule transpI)
  fix x y z
  assume "relacion P x y" and "relacion P y z"
  obtain A where "A ∈ P" and hA : "x ∈ A ∧ y ∈ A"
    using ‹relacion P x y›
    by (meson relacion_def)
  obtain B where "B ∈ P" and hB : "y ∈ B ∧ z ∈ B"
    using ‹relacion P y z›
    by (meson relacion_def)
  have "A = B"
  proof -
    obtain C where "C ∈ P" and hC : "y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"
      using assms particion_def
      by metis
    have "C = A"
      using ‹A ∈ P› hA hC by auto
    moreover have "C = B"
      using ‹B ∈ P› hB hC by auto
    ultimately show "A = B"
      by simp
  qed
  then have "x ∈ A ∧ z ∈ A"
    using hA hB by auto
  then show "relacion P x z"
    using ‹A = B› ‹A ∈ P› relacion_def
    by metis
qed

(* 3ª demostración *)
lemma
  assumes "particion P"
  shows   "transp (relacion P)"
  using assms particion_def relacion_def
  by (smt (verit) transpI)

end

theory Las_particiones_definen_relaciones_transitivas

imports Main

begin

definition relacion :: "('a set) set ⇒ 'a ⇒ 'a ⇒ bool" where

"relacion P x y ⟷ (∃A∈P. x ∈ A ∧ y ∈ A)"

definition particion :: "('a set) set ⇒ bool" where

"particion P ⟷ (∀x. (∃B∈P. x ∈ B ∧ (∀C∈P. x ∈ C ⟶ B = C))) ∧ {} ∉ P"

(* 1ª demostración *)

lemma

assumes "particion P"

shows "transp (relacion P)"

proof (rule transpI)

fix x y z

assume "relacion P x y" and "relacion P y z"

have "∃A∈P. x ∈ A ∧ y ∈ A"

using ‹relacion P x y›

by (simp only: relacion_def)

then obtain A where "A ∈ P" and hA : "x ∈ A ∧ y ∈ A"

by (rule bexE)

have "∃B∈P. y ∈ B ∧ z ∈ B"

using ‹relacion P y z›

by (simp only: relacion_def)

then obtain B where "B ∈ P" and hB : "y ∈ B ∧ z ∈ B"

by (rule bexE)

have "A = B"

proof -

have "∃C ∈ P. y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"

using assms

by (simp only: particion_def)

then obtain C where "C ∈ P"

and hC : "y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"

by (rule bexE)

have hC' : "∀D∈P. y ∈ D ⟶ C = D"

using hC by (rule conjunct2)

have "C = A"

using ‹A ∈ P› hA hC' by simp

moreover have "C = B"

using ‹B ∈ P› hB hC by simp

ultimately show "A = B"

by (rule subst)

qed

then have "x ∈ A ∧ z ∈ A"

using hA hB by simp

then have "∃A∈P. x ∈ A ∧ z ∈ A"

using ‹A ∈ P› by (rule bexI)

then show "relacion P x z"

using ‹A = B› ‹A ∈ P›

by (unfold relacion_def)

qed

(* 2ª demostración *)

lemma

assumes "particion P"

shows "transp (relacion P)"

proof (rule transpI)

fix x y z

assume "relacion P x y" and "relacion P y z"

obtain A where "A ∈ P" and hA : "x ∈ A ∧ y ∈ A"

using ‹relacion P x y›

by (meson relacion_def)

obtain B where "B ∈ P" and hB : "y ∈ B ∧ z ∈ B"

using ‹relacion P y z›

by (meson relacion_def)

have "A = B"

proof -

obtain C where "C ∈ P" and hC : "y ∈ C ∧ (∀D∈P. y ∈ D ⟶ C = D)"

using assms particion_def

by metis

have "C = A"

using ‹A ∈ P› hA hC by auto

moreover have "C = B"

using ‹B ∈ P› hB hC by auto

ultimately show "A = B"

by simp

qed

then have "x ∈ A ∧ z ∈ A"

using hA hB by auto

then show "relacion P x z"

using ‹A = B› ‹A ∈ P› relacion_def

by metis

qed

(* 3ª demostración *)

lemma

assumes "particion P"

shows "transp (relacion P)"

using assms particion_def relacion_def

by (smt (verit) transpI)

end

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="isar"> y otra con </pre>
[/expand]