1. 1
2. 2
3. 3
4. 4
5. 5
6. 6
7. 7
8. 8
9. 9
10. 10
11. 11
12. 12
13. 13
14. 14
15. 15
16. 16
17. 17
18. 18
19. 19
20. 20
21. 21
22. 22
23. 23
24. 24
25. 25
26. 26
27. 27
28. 28
29. 29
30. 30
31. 31
32. 32
33. 33
34. 34
35. 35
36. 36
37. 37
38. 38
39. 39
40. 40
41. 41
42. 42
43. 43
44. 44
45. 45
46. 46
47. 47
48. 48
49. 49
50. 50
51. 51
52. 52
53. 53
54. 54
55. 55
56. 56
57. 57
58. 58
59. 59
60. 60
61. 61
62. 62
63. 63
64. 64
65. 65
66. 66
67. 67
68. 68
69. 69
70. 70
71. 71
72. 72
73. 73
74. 74
75. 75

import Std.Tactic.Do
import Batteries.Data.Array.Pairwise
import Mathlib.Data.Nat.Basic

variable [LinearOrder α] (A : Array α)

def ICan'tBelieveItCanSort :=
  Id.run
    (do
      let N := A.size
      let mut A := A.toVector
      for hi : i in [:N]do
        for hj : j in [:N]do
          if A[i] < A[j] then
            A := A.swap i j
      return A.toArray)

#guard
  let A := #[69, 420, 1, 1, 13, 1, 65536]
  ICan'tBelieveItCanSort A = A.qsort

open Std.Do

-- https://leanprover.zulipchat.com/#narrow/channel/113489-new-members/topic/mvcgen.20doesn't.20produce.20any.20invariant.20goals/near/557949517
theorem perm : ICan'tBelieveItCanSort A |>.Perm A :=
  by
  generalize h : ICan'tBelieveItCanSort A = x
  apply Id.of_wp_run_eq h
  mvcgen invariants
  · ⇓⟨_, A'⟩ => ⌜A.Perm A'.toArray⌝
  · ⇓⟨_, A'⟩ => ⌜A.Perm A'.toArray⌝with grind [Array.Perm.trans, Array.Perm.symm, Array.swap_perm]

theorem sorted : ICan'tBelieveItCanSort A |>.Pairwise (· ≤ ·) :=
  by
  generalize h : ICan'tBelieveItCanSort A = x
  apply Id.of_wp_run_eq h
  mvcgen <;> expose_names
  case inv1 => exact ⇓⟨xs, A'⟩ => ⌜A'.take xs.pos |>.toArray.Pairwise (· ≤ ·)⌝
  case inv2 =>
    exact ⇓⟨xs, A'⟩ =>
      ⌜(A'.take cur).toArray.Pairwise (· ≤ ·) ∧
          ∀ i (_ : i < xs.pos), A'[i]'(by grind [List.length_append, xs.property]) ≤ A'[cur]'(by grind)⌝
  case vc1.step.isTrue =>
    simp [Array.pairwise_iff_getElem] at h_5 ⊢
    grind
  case vc4.step.post.success =>
    simp [Array.pairwise_iff_getElem] at h_3 ⊢
    grind
  case vc6.a.post.success =>
    simp at h_1
    exact (show r.toArray = r.toArray.extract 0 N by grind) ▸ h_1
  all_goals grind

theorem ICan'tBelieveICanProveItCanSort :
    (ICan'tBelieveItCanSort A).Perm A ∧ (ICan'tBelieveItCanSort A).Pairwise (· ≤ ·) :=
  ⟨perm A, sorted A⟩

-- Not sure why this needs so much boilerplate
abbrev le (a b : (ℕ × String)) :=
  a.1 > b.1 ∨ (a.1 = b.1 ∧ a.2 ≤ b.2)

instance : LE (ℕ × String) where le := le

@[grind]
lemma le_def {a b : (ℕ × String)} : a ≤ b ↔ le a b :=
  .rfl

instance : LinearOrder (ℕ × String) where
  le_refl := by grind
  le_trans := by grind
  le_antisymm := by grind
  le_total := by grind
  toDecidableLE a b := inferInstanceAs <| Decidable <| le a b

#eval ICan'tBelieveItCanSort #[(69, "hi"), (1729, "blah"), (13, "a"), (420, "a"), (420, "meow")]