Compare commits

...

97 Commits

Author SHA1 Message Date
Leonardo de Moura
d30c7d3195 chore: improve grind case-split trace 2025-02-02 19:36:05 -08:00
Leonardo de Moura
40d9f49d68 chore: improve grind pattern pretty printer (#6910) 2025-02-03 03:04:33 +00:00
Leonardo de Moura
15f1aeed6e test: grind_guide.lean (#6908) 2025-02-03 02:11:41 +00:00
Kim Morrison
c193195a05 chore: fixing short-circuiting issue in Ordering.then (#6907)
Thanks to @PatrickMassot for noticing the bug, and @digama0 for
diagnosing, fixing, and testing.
2025-02-03 00:44:45 +00:00
Kyle Miller
1f6abcaf6c feat: make all app unexpanders respond to pp.tagAppFns (#6730)
This PR changes how app unexpanders are invoked. Before the ref was
`.missing`, but now the ref is the head constant's delaborated syntax.
This way, when `pp.tagAppFns` is true, then tokens in app unexpanders
are annotated with the head constant. The consequence is that in docgen,
tokens will be linkified. This new behavior is consistent with how
`notation` defines app unexpanders.

In a followup PR we can slightly simplify the `notation` unexpander
macro to not set the ref.
2025-02-02 23:29:12 +00:00
Kyle Miller
89d897a34d feat: make coeFun delaborator respect pp.tagAppFns (#6729)
This PR makes the pretty printer for `.coeFun`-tagged functions respect
`pp.tagAppFns`. The effect is that in docgen, when an expression pretty
prints as `f x y z` with `f` a coerced function, then if `f` is a
constant it will be linkified.
2025-02-02 22:54:23 +00:00
Kyle Miller
3fb264b569 feat: modify delaborator to tag generalized field notation (#6703)
This PR modifies the delaborator so that in `pp.tagAppFns` mode,
generalized field notation is tagged with the head constant. The effect
is that docgen documentation will linkify dot notation. Internal change:
now formatted `rawIdent` can be tagged.
2025-02-02 21:34:49 +00:00
Sebastian Ullrich
d68c2ce28b chore: remove stray profiler option from test 2025-02-02 09:54:57 +01:00
Leonardo de Moura
64b5bedc8c feat: try? tactic (#6905)
This PR adds the `try?` tactic. This is the first draft, but it can
already solve examples such as:
```lean
example (e : Expr) : e.simplify.eval σ = e.eval σ := by
  try?
```
in `grind_constProp.lean`. In the example above, it suggests:
```lean
induction e using Expr.simplify.induct <;> grind?
``` 
In the same test file, we have
```lean
example (σ₁ σ₂ : State) : σ₁.join σ₂ ≼ σ₂ := by
  try?
```
and the following suggestion is produced
```lean
induction σ₁, σ₂ using State.join.induct <;> grind? 
```
2025-02-02 06:37:49 +00:00
Leonardo de Moura
38086a83cb feat: add Grind.Config.verbose and reportIssue! macro (#6904)
This PR adds the `grind` configuration option `verbose`. For example,
`grind -verbose` disables all diagnostics. We are going to use this flag
to implement `try?`.
2025-02-01 21:12:00 +00:00
Joachim Breitner
deb3299263 refactor: simpMatch to not etaStruct (#6901)
This PR changes the `simpMatch` function, used inside the equation
generator for WF-rec functions, to not do eta-expansion.

This makes the process a bit more robust and disciplined, and avoids
removing match-statements (and introduce projections and dependencies)
that we'd rather split instead.

Also adds more tracing to the equational theorem generator.

Extracted from #6898.
2025-02-01 19:04:05 +00:00
Malvin Gattinger
2b0e75748b doc: correct docstring for TransGen.tail and TransGen.trans (#6900)
This PR only modifies docstrings and should fix issue #6899
2025-02-01 13:52:52 +00:00
Vlad Tsyrklevich
ca96ea331e feat: teach bv_normalize to rewrite subtractions to additions (#6890)
This PR teaches bv_normalize to replace subtractions on one side of an
equality with an addition on the other side, this re-write eliminates a
not + addition in the normalized form so it is easier on the solver.

Note that I also make a point to normalize (1 + ~~~x) to (~~~x + 1) to
limit the amount of boilerplate symmetry theorems we require.
2025-02-01 10:56:54 +00:00
Leonardo de Moura
66471ba6e2 feat: attributes [grind =>] and [grind <=] (#6897)
This PR adds the new attributes `[grind =>]` and `[grind <=]` for
controlling pattern selection and minimizing the number of places where
we have to use verbose `grind_pattern` command. It also fixes a bug in
the new pattern selection procedure, and improves the automatic pattern
selection for local lemmas.

The tests `grind_constProp.lean` and `no_grind_constProp.lean` are the
same use case with and without `grind`.
2025-02-01 04:41:19 +00:00
Leonardo de Moura
425c7a12d0 fix: grind issues exposed by grind_constProp (#6895)
This PR fixes a few `grind` issues exposed by the `grind_constProp.lean`
test.
- Support for equational theorem hypotheses created before invoking
`grind`. Example: applying an induction principle.s
- Support of `Unit`-like types. 
- Missing recursion depth checks.
2025-02-01 01:35:12 +00:00
Henrik Böving
1776758971 perf: inline a few functions in the bv_decide circuit cache (#6889)
This PR inlines a few functions in the `bv_decide` circuit cache.
2025-01-31 22:25:15 +00:00
Leonardo de Moura
5286b21126 feat: bug in pattern selection heuristic in grind (#6892)
This PR fixes a bug in the pattern selection heuristic used in `grind`.
It was unfolding definitions/abstractions that were not supposed to be
unfolded. See `grind_constProp.lean` for examples affected by this bug.
2025-01-31 20:22:49 +00:00
Leonardo de Moura
5900f39638 feat: add [grind intro] attribute (#6888)
This PR adds the `[grind intro]` attribute. It instructs `grind` to mark
the introduction rules of an inductive predicate as E-matching theorems.
2025-01-31 17:03:54 +00:00
Sebastian Ullrich
b3a8d5b04e feat: async modes for environment access (#6852)
This PR allows environment extensions to opt into access modes that do
not block on the entire environment up to this point as a necessary
prerequisite for parallel proof elaboration.
2025-01-31 16:35:50 +00:00
Vlad Tsyrklevich
a3f7d44593 chore: small clean-up in DivModLemmas (#6877)
As a follow-up to #6718, refactor a few bmod proofs to be shorter and
exactly match their emod* equivalents for uniformity.
2025-01-31 16:17:16 +00:00
Vlad Tsyrklevich
7bd12c71c8 feat: add or/and/xor lemmas for BitVec/bv_normalize (#6872)
This PR adds lemmas for xor injectivity and when and/or/xor equal
allOnes or zero. Then I plumb support for the new lemmas through to
bv_normalize.
2025-01-31 13:27:43 +00:00
François G. Dorais
9b5813eeda feat: add BitVec lemmas about msb and shiftConcat (#6875)
This PR adds a lemma relating `msb` and `getMsbD`, and three lemmas
regarding `getElem` and `shiftConcat`. These lemmas were needed in
[Batteries#1078](https://github.com/leanprover-community/batteries/pull/1078)
and the request to upstream was made in the review of that PR.

---------

Co-authored-by: Siddharth <siddu.druid@gmail.com>
2025-01-31 12:07:57 +00:00
Markus Himmel
fe3a78d262 fix: name of Int.tdiv in HDiv.hDiv docstring (#6885)
This PR fixes the name of the truncating integer division function in
the `HDiv.hDiv` docstring (which is shown when hovering over `/`). It
was changed from `Int.div` to `Int.tdiv` in #5301.
2025-01-31 08:52:22 +00:00
Kim Morrison
6c2573fc38 feat: alignment of lemmas about monadic functions on List/Array/Vector (#6883)
This PR completes the alignment of lemmas about monadic functions on
`List/Array/Vector`. Amongst other changes, we change the simp normal
form from `List.forM` to `ForM.forM`, and correct the definition of
`List.flatMapM`, which previously was returning results in the incorrect
order. There remain many gaps in the verification lemmas for monadic
functions; this PR only makes the lemmas uniform across
`List/Array/Vector`.
2025-01-31 07:25:24 +00:00
Paul Reichert
ad48761032 feat: add simple Ordering lemmas (#6821)
This PR adds basic lemmas about `Ordering`, describing the interaction
of `isLT`/`isLE`/`isGE`/`isGT`, `swap` and the constructors.
Additionally, it refactors the instance derivation code such that a
`LawfulBEq Ordering` instance is also derived automatically.

Some of these lemmas are helpful for the `TreeMap` verification.

---------

Co-authored-by: Paul Reichert <6992158+datokrat@users.noreply.github.com>
2025-01-31 06:32:53 +00:00
Johan Commelin
0a42a47ea8 chore: mark Mul.mul and HMul.hMul as match_pattern (#6863)
This PR allows fixing regressions in mathlib introduced in
nightly-2024-02-25 by allowing the use of `x * y` in match patterns.
There are currently 11 instances in mathlib explicitly flagging the lack
of this match pattern.

This issue was previously pointed out in the following Zulip threads:

-
https://leanprover.zulipchat.com/#narrow/channel/287929-mathlib4/topic/Algebra.2EFree/near/321482426
-
https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/match_pattern.20attribute.20on.20Mul.2Emul/near/321505298
-
https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/.40.5Bmatch_pattern.5D.20for.20basic.20binary.20operators/near/423734085
-
https://leanprover.zulipchat.com/#narrow/channel/270676-lean4/topic/Mul.20match_pattern/near/430635623
2025-01-31 05:39:33 +00:00
Leonardo de Moura
d70a596887 feat: hide grind auxiliary gadgets in messages (#6882)
This PR ensures `grind` auxiliary gadgets are "hidden" in error and
diagnostic messages.
2025-01-31 05:10:59 +00:00
Cameron Zwarich
3331ed9bb1 fix: add Float32 to LCNF.builtinRuntimeTypes list (#6837)
This PR adds Float32 to the LCNF builtinRuntimeTypes list. This was
missed during the initial Float32 implementation, but this omission has
the side effect of lowering Float32 to obj in the IR.
2025-01-31 04:53:49 +00:00
Leonardo de Moura
b3be4ea66e feat: include Case analyses trace in the grind error message (#6881)
This PR improves the `grind` error message by including a trace of the
terms on which `grind` applied `cases`-like operations.
2025-01-31 04:22:50 +00:00
Leonardo de Moura
b329c4b5db feat: improve pattern selection heuristic in grind (#6880)
This PR improves the E-matching pattern selection heuristic used in
`grind`.
2025-01-31 02:16:15 +00:00
Leonardo de Moura
a2155e0741 fix: bug in mkMatchCondProf? in grind (#6879)
This PR fixes a bug in `mkMatchCondProf?` used by the `grind` tactic.
This bug was introducing a failure in the test `grind_constProp.lean`.
2025-01-31 01:18:49 +00:00
Kim Morrison
40eefb1df6 feat: alignment of List/Array/Vector lemmas about range, range', zipIdx (#6878)
This PR completes alignments of `List/Array/Vector` lemmas about
`range`, `range'`, and `zipIdx`.
2025-01-31 00:06:51 +00:00
Leonardo de Moura
146f6e6b2f feat: use profileitM in grind (#6876) 2025-01-30 22:15:27 +00:00
Kim Morrison
52a27697be feat: Cooper resolution (#6862)
This PR defines Cooper resolution with a divisibility constraint as
formulated in
"Cutting to the Chase: Solving Linear Integer Arithmetic" by Dejan
Jovanović and Leonardo de Moura,
DOI 10.1007/s10817-013-9281-x.
2025-01-30 18:47:14 +00:00
Leonardo de Moura
270934cbb6 test: constProp using grind (#6873)
It has many TODOs
2025-01-30 18:28:54 +00:00
Leonardo de Moura
731551d670 chore: cleanup grind tests (#6871) 2025-01-30 17:51:45 +00:00
Leonardo de Moura
2fedd7144a feat: normalize != and == in grind (#6870)
This PR adds two new normalization steps in `grind` that reduces `a !=
b` and `a == b` to `decide (¬ a = b)` and `decide (a = b)`,
respectively.
2025-01-30 16:00:18 +00:00
Kim Morrison
5bd75695f4 feat: align List/Array/Vector eraseP/erase/eraseIdx lemmas (#6868)
This PR completes the alignment across `List/Array/Vector` of lemmas
about the `eraseP/erase/eraseIdx` operations.
2025-01-30 12:29:55 +00:00
Joachim Breitner
cd62b8cd80 refactor: WF.Eqns: rewrite fix without duplicating F (#6859)
This PR changes how WF.Eqns unfolds the fixpoint. Instead of delta'ing
until we have `fix`, and then blindly applying `fix_eq`, we delta one
step less and preserve the function on the right hand side. This leads
to smaller terms in the next step, so easier to debug, possibly faster,
possibly more robust.
2025-01-30 10:23:18 +00:00
Vlad Tsyrklevich
dc445d7af6 feat: add BitVec multiplication simp lemmas (#6718)
This PR adds BitVec lemmas required to cancel multiplicative negatives,
and plumb support through to bv_normalize to make use of this result in
the normalized twos-complement form.

I include some bmod lemmas I found useful to prove this result, the two
helper lemmas I add use the same naming/proofs as their emod
equivalents.
2025-01-30 08:24:18 +00:00
Kim Morrison
e7d8948fa6 feat: lemmas relating findIdx?/findFinIdx?/idxOf?/findIdxOf?/eraseP/erase on List and Array (#6864)
This PR adds lemmas relating the operations on
findIdx?/findFinIdx?/idxOf?/findIdxOf?/eraseP/erase on List and on
Array. It's preliminary to aligning the verification lemmas for
`find...` and `erase...`.
2025-01-30 07:04:50 +00:00
Leonardo de Moura
e922edfc21 feat: Bool.and, Bool.or, and Bool.not propagation in grind (#6861)
This PR adds propagation rules for `Bool.and`, `Bool.or`, and `Bool.not`
to the `grind` tactic.
2025-01-30 02:47:06 +00:00
Kim Morrison
5b1c6b558a feat: align take/drop/extract across List/Array/Vector (#6860)
This PR makes `take`/`drop`/`extract` available for each of
`List`/`Array`/`Vector`. The simp normal forms differ, however: in
`List`, we simplify `extract` to `take+drop`, while in `Array` and
`Vector` we simplify `take` and `drop` to `extract`. We also provide
`Array/Vector.shrink`, which simplifies to `take`, but is implemented by
repeatedly popping. Verification lemmas for `Array/Vector.extract` to
follow in a subsequent PR.
2025-01-30 01:24:25 +00:00
Kim Morrison
21e8a99eff feat: refactor of find functions on List/Array/Vector (#6833)
This PR makes the signatures of `find` functions across
`List`/`Array`/`Vector` consistent. Verification lemmas will follow in
subsequent PRs.

We were previously quite inconsistent about the signature of
`indexOf`/`findIdx` functions across `List` and `Array`. Moreover, there
are still quite large gaps in the verification lemma coverage for these
even at the `List` level.

My intention is to make the signatures consistent by providing:
`findIdx` / `findIdx?` / `findFinIdx?` (these all take a predicate, and
return respectively a `Nat`, `Option Nat`, `Option (Fin l.length)`) and
similarly `idxOf` / `idxOf?` / `finIdxOf?` (which look for an element)
for each of List/Array/Vector. I've seen enough examples by now where
each variant is genuinely the most convenient at the call-site, so I'm
going to accept the cost of having many closely related functions.
*Hopefully* for the verification lemmas we can simp all of these into
"projections" of the `Option (Fin l.length)` versions, and then only
have to specify that.

However, I will not plan on immediately either filling in the missing
verification lemmas (or even deciding what the simp normal forms
relating these operations are), and just reach parity amongst
List/Array/Vector for what is already there.
2025-01-30 01:14:21 +00:00
Leonardo de Moura
49fe87e0d1 feat: missing propagation rules in grind (#6858)
This PR adds new propagation rules for `decide` and equality in `grind`.
It also adds new tests and cleans old ones
2025-01-29 23:40:33 +00:00
Henrik Böving
61c843a3c7 refactor: pull out some LRAT functionality from bv_decide (#6856)
This PR refactors a bit of the functionality in bv_decide's frontend to
make it accessible for external users.
2025-01-29 20:47:47 +00:00
Lean stage0 autoupdater
ca3c7571e5 chore: update stage0 2025-01-29 19:45:27 +00:00
Leonardo de Moura
5075153c15 feat: better support for inductive predicates in grind (#6854)
This PR adds a convenience for inductive predicates in `grind`. Now,
give an inductive predicate `C`, `grind [C]` marks `C` terms as
case-split candidates **and** `C` constructors as E-matching theorems.
Here is an example:
```lean
example {B S T s t} (hcond : B s) : (ifThenElse B S T, s) ==> t → (S, s) ==> t := by
  grind [BigStep]
```
Users can still use `grind [cases BigStep]` to only mark `C` as a case
split candidate.
2025-01-29 18:17:34 +00:00
Henrik Böving
c7dec60428 feat: support UIntX and USize in bv_decide (#6711)
This PR adds support for `UIntX` and `USize` in `bv_decide` by adding a
preprocessor that turns them into `BitVec` of their corresponding size.
2025-01-29 15:41:38 +00:00
Henrik Böving
41fe7bc71a feat: bv_normalize rewrite shifts by BitVec const to shift by Nat const (#6851)
This PR makes `bv_normalize` rewrite shifts by `BitVec` constants to
shifts by `Nat` constants. This is part of the greater effort in
providing good support for constant shift simplification in
`bv_normalize`.
2025-01-29 15:17:39 +00:00
Arthur Adjedj
2c00f8fe2f fix: consume mdata in casesOnStuckLHS when checking that major is fvar (#6791)
This PR fixes #6789 by ensuring metadata generated for inaccessible
variables in pattern-matches is consumed in `casesOnStuckLHS`
accordingly.

Closes #6789
2025-01-29 14:32:11 +00:00
Sebastian Ullrich
68653297d1 chore: re-enable Lake 2025-01-29 15:59:05 +01:00
Sebastian Ullrich
729d6e5d5c chore: update stage0 2025-01-29 15:59:05 +01:00
Sebastian Ullrich
c6677e0b6f perf: avoid environment extension indirection 2025-01-29 15:59:05 +01:00
Vlad Tsyrklevich
0c43f05047 feat: add BitVec add_self/self_add lemmas (#6848)
This PR adds simp lemmas proving `x + y = x ↔ x = 0` for BitVec, along
with symmetries, and then adds these to the bv_normalize simpset.
2025-01-29 13:52:57 +00:00
Kim Morrison
3c8cf7a905 chore: remove unneeded LawfulBEq hypotheses (#6847) 2025-01-29 12:24:36 +00:00
Kim Morrison
51b56b20ec feat: missing monadic functions on List/Array/Vector (#6845)
This PR adds missing monadic higher order functions on
`List`/`Array`/`Vector`. Only the most basic verification lemmas
(relating the operations on the three container types) are provided for
now.
2025-01-29 12:19:30 +00:00
Vlad Tsyrklevich
5c0231f508 feat: add BitVec add/sub injectivity lemmas (#6828)
This PR adds add/sub injectivity lemmas for BitVec, and then adds
specialized forms with additional symmetries for the `bv_normalize`
normal form.

Since I need `neg_inj`, I add `not_inj`/`neg_inj` at once, and use it in
`BitVec.not_beq_not` instead of re-proving it.
2025-01-29 10:35:44 +00:00
Sebastian Ullrich
a35bf7ee4c chore: revert "perf: use C23's free_sized when available" (#6841)
Reverts leanprover/lean4#6598, which broke Windows CI
2025-01-29 09:11:23 +00:00
Kim Morrison
bc234f9f8d feat: align List/Array/Vector.zip/zipWith/zipWithAll/unzip (#6840)
This PR completes the alignment of
`List/Array/Vector.zip/zipWith/zipWithAll/unzip` lemmas.
2025-01-29 07:58:17 +00:00
Leonardo de Moura
08ec2541c7 feat: add support for constructors and axioms to the grind E-matching module (#6839)
This PR ensures `grind` can use constructors and axioms for heuristic
instantiation based on E-matching. It also allows patterns without
pattern variables for theorems such as `theorem evenz : Even 0`.
2025-01-29 05:22:05 +00:00
Kim Morrison
e05131122b feat: finish aligning List/Array/Vector.ofFn lemmas (#6838)
This PR completes aligning the (limited) verification API for
`List/Array/Vector.ofFn`.
2025-01-29 04:53:33 +00:00
Kim Morrison
e4749eb6b5 chore: preparation for Array.erase lemmas (#6836)
This PR rearranges some material, and adds some missing lemmas, in
preparation for aligning `List/Array/Vector.erase(P)`.
2025-01-29 04:07:51 +00:00
Kim Morrison
84311122ac feat: align List/Array/Vector lemmas for isEqv and == (#6831)
This PR completes the alignment of `List/Array/Vector` lemmas about
`isEqv` and `==`.
2025-01-29 03:12:02 +00:00
Kim Morrison
c93012faa1 feat: add Vector.mapM, ForIn/ToStream instances (#6835)
This PR fills some gaps in the `Vector` API, adding `mapM`, `zip`, and
`ForIn'` and `ToStream` instances.
2025-01-29 02:58:40 +00:00
Leonardo de Moura
aa65107523 feat: "performance" counters for grind (#6834)
This PR adds "performance" counters (e.g., number of instances per
theorem) to `grind`. The counters are always reported on failures, and
on successes when `set_option diagnostics true`.
2025-01-29 02:12:31 +00:00
Kim Morrison
07e2b7d913 chore: update some Array doc-strings (#6832) 2025-01-29 01:32:41 +00:00
Kim Morrison
9b5fadd275 chore: remove unnecessary simp priorities (#6812)
This PR remove simp priorities that are not needed. Some of these will
probably cause complaints from the `simpNF` linter downstream in
Batteries, which I will re-address separately.
2025-01-28 23:50:33 +00:00
Kim Morrison
7e8af0fc9d feat: rename List.enum(From) to List.zipIdx, and Array/Vector.zipWithIndex to zipIdx (#6800)
This PR uniformizes the naming of `enum`/`enumFrom` (on `List`) and
`zipWithIndex` (on `Array` on `Vector`), replacing all with `zipIdx`. At
the same time, we generalize to add an optional `Nat` parameter for the
initial value of the index (which previously existed, only for `List`,
as the separate function `enumFrom`).
2025-01-28 23:34:30 +00:00
Kim Morrison
f10d0d07d9 feat: lemmas about BitVec.setWidth (#6808)
This PR adds simp lemmas replacing `BitVec.setWidth'` with `setWidth`,
and conditionally simplifying `setWidth v (setWidth w v)`.

---------

Co-authored-by: Tobias Grosser <tobias@grosser.es>
2025-01-28 23:33:45 +00:00
Joachim Breitner
312759e369 fix: injectivity theorems for more prelude inductives (#6826)
This PR adds injectivity theorems for inductives that did not get them
automatically (because they are defined too early) but also not yet
manuall later.

It also adds a test case to notice when new ones fall through.o

It does not add them for clearly meta-programming related types that are
not yet defined in `Init/Core.lean`, and uses `#guard_msgs` as an
allowlist.

---------

Co-authored-by: Kim Morrison <scott.morrison@gmail.com>
2025-01-28 23:09:28 +00:00
Vlad Tsyrklevich
1d9439752c feat: teach bv_normalize that (x >> x) = 0 (#6818)
This PR adds a BitVec lemma that `(x >> x) = 0` and plumbs it through to
bv_normalize. I also move some theorems I found useful to the top of the
ushiftRight section.
2025-01-28 20:56:21 +00:00
Leonardo de Moura
9f5a9a071a feat: add %reset_grind_attrs (#6824)
This PR introduces the auxiliary command `%reset_grind_attrs` for
debugging purposes. It is particularly useful for writing self-contained
tests.
2025-01-28 18:29:02 +00:00
Leonardo de Moura
26bc8c5b2a feat: builtin case splits for grind (#6822)
This PR adds a few builtin case-splits for `grind`. They are similar to
builtin `simp` theorems. They reduce the noise in the tactics produced
by `grind?`.
2025-01-28 17:30:36 +00:00
Kim Morrison
eea2d49078 chore: lower List/Array/Vector.mem_map simp priority (#6815)
This PR lowers the simp priority of `List/Array/Vector.mem_map`, as
downstream in Mathlib many lemmas currently need their priority raised
to fire before this.
2025-01-28 12:23:24 +00:00
Markus Himmel
f9d3deaafe perf: improve elaboration performance of Std.Data.DHashMap.Internal.RawLemmas (#6814)
This PR optimizes the proofs in the internal file
`Std/Data/DHashMap/Internal/RawLemmas.lean` so that the file is quicker
to elaborate.
2025-01-28 11:04:42 +00:00
Sebastian Ullrich
e4364e747f chore: temporarily disable async in server (#6813)
... pending an interruption bug fix and further testing
2025-01-28 10:42:17 +00:00
Eric Wieser
6aa6407af1 perf: use C23's free_sized when available (#6598)
See https://www.open-std.org/jtc1/sc22/wg14/www/docs/n2699.htm for an
explanation of this feature.

---------

Co-authored-by: Chris Kennelly <ckennelly@google.com>
2025-01-28 10:17:15 +00:00
Eric Wieser
9247206c0e doc: clarify that lean_initialize_runtime_module is implied by lean_initialize (#6677)
Calling both runs the initializers twice, resulting in a memory leak
2025-01-28 10:12:59 +00:00
Vlad Tsyrklevich
c7c1e091c9 feat: add BitVec comparison lemmas to bv_normalize (#6799)
This PR adds a number of simple comparison lemmas to the top/bottom
element for BitVec. Then they are applied to teach bv_normalize that
`(a<1) = (a==0)` and to remove an intermediate proof that is no longer
necessary along the way.
2025-01-28 08:48:11 +00:00
Leonardo de Moura
20c616503a feat: add grind? (#6810)
This PR implements a basic `grind?` tactic companion for `grind`. We
will add more bells and whistles later.
2025-01-28 04:17:25 +00:00
Kim Morrison
104b3519d7 feat: add Fin.ofNat'_zero (#6806)
This PR adds a simp lemma for `Fin.ofNat'`.
2025-01-28 02:00:01 +00:00
Kim Morrison
d8fcfead97 feat: add LawfulMonad helper simp lemmas (#6805)
This PR adds to helper lemmas in the `LawfulMonad` namespace, which
sometimes fire via `simp` when the original versions taking
`LawfulApplicative` or `Functor` do not fire.
2025-01-28 01:59:55 +00:00
Kim Morrison
d0b947bf52 chore: add @[simp] to Option.not_mem_none (#6804)
This PR improves simp lemma confluence.
2025-01-28 01:59:47 +00:00
Mac Malone
5f0fea60a6 refactor: lake: deprecate -U (#6798)
This PR deprecates the `-U` shorthand for the `--update` option.

It is likely the `-U` option will be used for something different in the
future, so deprecating it now seems wise.
2025-01-28 01:54:55 +00:00
Mac Malone
3e54597db4 feat: lake query (#6323)
This PR adds a new Lake CLI command, `lake query`, that both builds
targets and outputs their results. It can produce raw text or JSON
-formatted output (with `--json` / `-J`).

This PR removes the `lean.` prefix from the module import facets (for
ease-of-use in the `lake query` CLII). It also renames the package
`deps` facet, `transDeps`. The new `deps` facet just returns the
package's direct dependencies.
2025-01-28 01:43:03 +00:00
Kim Morrison
eb1c9b9ab2 chore: two BitVec lemmas that help simp confluence (#6807)
This PR adds two simple `BitVec` lemmas which improve `simp` local
confluence.
2025-01-28 01:12:05 +00:00
Kim Morrison
4d66e7bdc0 feat: add List.modifyHead_dropLast (#6803)
This PR adds the simp lemma `List.modifyHead_dropLast`. This is one of
many small PRs that will improve simp lemma confluence.
2025-01-28 00:25:58 +00:00
Kim Morrison
f8660485d7 feat: Option.elim_pmap, improving simp confluence (#6802)
This PR adds the simp lemma `Option.elim_pmap`. This is one of many
small PRs that will improve simp lemma confluence.
2025-01-28 00:21:10 +00:00
Leonardo de Moura
64766f8724 fix: offset constraint propagation in grind (#6801)
This PR fixes a bug in the exhaustive offset constraint propagation
module used in `grind`.
2025-01-27 23:43:31 +00:00
Marc Huisinga
f64bce6ef1 fix: auto-completion performance regression (#6794)
This PR fixes a significant auto-completion performance regression that
was introduced in #5666, i.e. v4.14.0.

#5666 introduced tactic docstrings, which were attempted to be collected
for every single completion item. This is slow for hundreds of thousands
of completion items. To fix this, this PR moves the docstring
computation into the completion item resolution, which is only called
when users select a specific completion item in the UI.

A downside of this approach is that we currently can't test completion
item resolution, so we lose a few tests that cover docstrings in
completions in this PR.
2025-01-27 21:15:09 +00:00
Marc Huisinga
0160aa1a89 test: identifier completion benchmark (#6796)
Adds a basic identifier completion benchmark so that bugs like the one
in #6794 are caught earlier.
2025-01-27 19:31:32 +00:00
Joachim Breitner
3418d6db8e fix: more robust equational theorems generation for partial_fixpoint (#6790)
This PR fixes an issue with the generation of equational theorems from
`partial_fixpoint` when case-splitting is necessary. Fixes #6786.
2025-01-27 14:00:55 +00:00
Vlad Tsyrklevich
3aea0fd810 feat: add comparison lemmas to bv_normalize (#6788)
This PR teaches bv_normalize that !(x < x) and !(x < 0).
2025-01-27 13:44:44 +00:00
Joachim Breitner
4ca98dcca2 doc: typos in partial_fixpoint related docstrings (#6787)
H'T David
2025-01-27 09:43:09 +00:00
Markus Himmel
55b0bed5df doc: standard library vision and call for contributions (#6762) 2025-01-27 09:07:02 +00:00
Henrik Böving
d86a408944 feat: bv_decide can reason about equality of structures (#6740)
This PR extends `bv_decide`'s structure reasoning support for also
reasoning about equalities of supported structures.
2025-01-27 08:11:43 +00:00
537 changed files with 10369 additions and 1808 deletions

View File

@@ -140,7 +140,7 @@ lean_object * initialize_C(uint8_t builtin, lean_object *);
...
lean_initialize_runtime_module();
//lean_initialize(); // necessary if you (indirectly) access the `Lean` package
//lean_initialize(); // necessary (and replaces `lean_initialize_runtime_module`) if you (indirectly) access the `Lean` package
lean_object * res;
// use same default as for Lean executables

10
doc/std/style.md Normal file
View File

@@ -0,0 +1,10 @@
Please take some time to familiarize yourself with the stylistic conventions of
the project and the specific part of the library you are planning to contribute
to. While the Lean compiler may not enforce strict formatting rules,
consistently formatted code is much easier for others to read and maintain.
Attention to formatting is more than a cosmetic concern—it reflects the same
level of precision and care required to meet the deeper standards of the Lean 4
standard library.
A full style guide and naming convention are currently under construction and
will be added here soon.

97
doc/std/vision.md Normal file
View File

@@ -0,0 +1,97 @@
# The Lean 4 standard library
Maintainer team (in alphabetical order): Henrik Böving, Markus Himmel
(community contact & external contribution coordinator), Kim Morrison, Paul
Reichert, Sofia Rodrigues.
The Lean 4 standard library is a core part of the Lean distribution, providing
essential building blocks for functional programming, verified software
development, and software verification. Unlike the standard libraries of most
other languages, many of its components are formally verified and can be used
as part of verified applications.
The standard library is a public API that contains the components listed in the
standard library outline below. Not all public APIs in the Lean distribution
are part of the standard library, and the standard library does not correspond
to a certain directory within the Lean source repository. For example, the
metaprogramming framework is not part of the standard library.
The standard library is under active development. Our guiding principles are:
* Provide comprehensive, verified building blocks for real-world software.
* Build a public API of the highest quality with excellent internal consistency.
* Carefully optimize components that may be used in performance-critical software.
* Ensure smooth adoption and maintenance for users.
* Offer excellent documentation, example projects, and guides.
* Provide a reliable and extensible basis that libraries for software
development, software verification and mathematics can build on.
The standard library is principally developed by the Lean FRO. Community
contributions are welcome. If you would like to contribute, please refer to the
call for contributions below.
### Standard library outline
1. Core types and operations
1. Basic types
2. Numeric types, including floating point numbers
3. Containers
4. Strings and formatting
2. Language constructs
1. Ranges and iterators
2. Comparison, ordering, hashing and related type classes
3. Basic monad infrastructure
3. Libraries
1. Random numbers
2. Dates and times
4. Operating system abstractions
1. Concurrency and parallelism primitives
2. Asynchronous I/O
3. FFI helpers
4. Environment, file system, processes
5. Locales
The material covered in the first three sections (core types and operations,
language constructs and libraries) will be verified, with the exception of
floating point numbers and the parts of the libraries that interface with the
operating system (e.g., sources of operating system randomness or time zone
database access).
### Call for contributions
Thank you for taking interest in contributing to the Lean standard library\!
There are two main ways for community members to contribute to the Lean
standard library: by contributing experience reports or by contributing code
and lemmas.
**If you are using Lean for software verification or verified software
development:** hearing about your experiences using Lean and its standard
library for software verification is extremely valuable to us. We are committed
to building a standard library suitable for real-world applications and your
input will directly influence the continued evolution of the Lean standard
library. Please reach out to the standard library maintainer team via Zulip
(either in a public thread in the \#lean4 channel or via direct message). Even
just a link to your code helps. Thanks\!
**If you have code that you believe could enhance the Lean 4 standard
library:** we encourage you to initiate a discussion in the \#lean4 channel on
Zulip. This is the most effective way to receive preliminary feedback on your
contribution. The Lean standard library has a very precise scope and it has
very high quality standards, so at the moment we are mostly interested in
contributions that expand upon existing material rather than introducing novel
concepts.
**If you would like to contribute code to the standard library but dont know
what to work on:** we are always excited to meet motivated community members
who would like to contribute, and there is always impactful work that is
suitable for new contributors. Please reach out to Markus Himmel on Zulip to
discuss possible contributions.
As laid out in the [project-wide External Contribution
Guidelines](../../CONTRIBUTING.md),
PRs are much more likely to be merged if they are preceded by an RFC or if you
discussed your planned contribution with a member of the standard library
maintainer team. When in doubt, introducing yourself is always a good idea.
All code in the standard library is expected to strictly adhere to the
[standard library coding conventions](./style.md).

View File

@@ -38,3 +38,4 @@ import Init.Grind
import Init.While
import Init.Syntax
import Init.Internal
import Init.Try

View File

@@ -6,3 +6,4 @@ Authors: Sebastian Ullrich, Leonardo de Moura, Mario Carneiro
prelude
import Init.Control.Lawful.Basic
import Init.Control.Lawful.Instances
import Init.Control.Lawful.Lemmas

View File

@@ -136,6 +136,23 @@ theorem seqLeft_eq_bind [Monad m] [LawfulMonad m] (x : m α) (y : m β) : x <* y
theorem Functor.map_unit [Monad m] [LawfulMonad m] {a : m PUnit} : (fun _ => PUnit.unit) <$> a = a := by
simp [map]
/--
This is just a duplicate of `LawfulApplicative.map_pure`,
but sometimes applies when that doesn't.
It is named with a prime to avoid conflict with the inherited field `LawfulMonad.map_pure`.
-/
@[simp] theorem LawfulMonad.map_pure' [Monad m] [LawfulMonad m] {a : α} :
(f <$> pure a : m β) = pure (f a) := by
simp only [map_pure]
/--
This is just a duplicate of `Functor.map_map`, but sometimes applies when that doesn't.
-/
@[simp] theorem LawfulMonad.map_map {m} [Monad m] [LawfulMonad m] {x : m α} :
g <$> f <$> x = (fun a => g (f a)) <$> x := by
simp only [Functor.map_map]
/--
An alternative constructor for `LawfulMonad` which has more
defaultable fields in the common case.

View File

@@ -0,0 +1,33 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Control.Lawful.Basic
import Init.RCases
import Init.ByCases
-- Mapping by a function with a left inverse is injective.
theorem map_inj_of_left_inverse [Applicative m] [LawfulApplicative m] {f : α β}
(w : g : β α, x, g (f x) = x) {x y : m α}
(h : f <$> x = f <$> y) : x = y := by
rcases w with g, w
replace h := congrArg (g <$> ·) h
simpa [w] using h
-- Mapping by an injective function is injective, as long as the domain is nonempty.
theorem map_inj_of_inj [Applicative m] [LawfulApplicative m] [Nonempty α] {f : α β}
(w : x y, f x = f y x = y) {x y : m α}
(h : f <$> x = f <$> y) : x = y := by
apply map_inj_of_left_inverse ?_ h
let a := Nonempty α
refine ?_, ?_
· intro b
by_cases p : a, f a = b
· exact Exists.choose p
· exact a
· intro b
simp only [exists_apply_eq_apply, reduceDIte]
apply w
apply Exists.choose_spec (p := fun a => f a = f b)

View File

@@ -1138,14 +1138,16 @@ transitive and contains `r`. `TransGen r a z` if and only if there exists a sequ
`a r b r ... r z` of length at least 1 connecting `a` to `z`.
-/
inductive Relation.TransGen {α : Sort u} (r : α α Prop) : α α Prop
/-- If `r a b` then `TransGen r a b`. This is the base case of the transitive closure. -/
/-- If `r a b`, then `TransGen r a b`. This is the base case of the transitive closure. -/
| single {a b} : r a b TransGen r a b
/-- The transitive closure is transitive. -/
/-- If `TransGen r a b` and `r b c`, then `TransGen r a c`.
This is the inductive case of the transitive closure. -/
| tail {a b c} : TransGen r a b r b c TransGen r a c
/-- Deprecated synonym for `Relation.TransGen`. -/
@[deprecated Relation.TransGen (since := "2024-07-16")] abbrev TC := @Relation.TransGen
/-- The transitive closure is transitive. -/
theorem Relation.TransGen.trans {α : Sort u} {r : α α Prop} {a b c} :
TransGen r a b TransGen r b c TransGen r a c := by
intro hab hbc
@@ -1384,21 +1386,43 @@ instance {p q : Prop} [d : Decidable (p ↔ q)] : Decidable (p = q) :=
| isTrue h => isTrue (propext h)
| isFalse h => isFalse fun heq => h (heq Iff.rfl)
gen_injective_theorems% Prod
gen_injective_theorems% PProd
gen_injective_theorems% MProd
gen_injective_theorems% Subtype
gen_injective_theorems% Fin
gen_injective_theorems% Array
gen_injective_theorems% Sum
gen_injective_theorems% PSum
gen_injective_theorems% Option
gen_injective_theorems% List
gen_injective_theorems% Except
gen_injective_theorems% BitVec
gen_injective_theorems% Char
gen_injective_theorems% DoResultBC
gen_injective_theorems% DoResultPR
gen_injective_theorems% DoResultPRBC
gen_injective_theorems% DoResultSBC
gen_injective_theorems% EStateM.Result
gen_injective_theorems% Except
gen_injective_theorems% Fin
gen_injective_theorems% ForInStep
gen_injective_theorems% Lean.Name
gen_injective_theorems% Lean.Syntax
gen_injective_theorems% BitVec
gen_injective_theorems% List
gen_injective_theorems% MProd
gen_injective_theorems% NonScalar
gen_injective_theorems% Option
gen_injective_theorems% PLift
gen_injective_theorems% PNonScalar
gen_injective_theorems% PProd
gen_injective_theorems% Prod
gen_injective_theorems% PSigma
gen_injective_theorems% PSum
gen_injective_theorems% Sigma
gen_injective_theorems% String
gen_injective_theorems% String.Pos
gen_injective_theorems% Substring
gen_injective_theorems% Subtype
gen_injective_theorems% Sum
gen_injective_theorems% Task
gen_injective_theorems% Thunk
gen_injective_theorems% UInt16
gen_injective_theorems% UInt32
gen_injective_theorems% UInt64
gen_injective_theorems% UInt8
gen_injective_theorems% ULift
gen_injective_theorems% USize
theorem Nat.succ.inj {m n : Nat} : m.succ = n.succ m = n :=
fun x => Nat.noConfusion x id

View File

@@ -23,3 +23,6 @@ import Init.Data.Array.FinRange
import Init.Data.Array.Perm
import Init.Data.Array.Find
import Init.Data.Array.Lex
import Init.Data.Array.Range
import Init.Data.Array.Erase
import Init.Data.Array.Zip

View File

@@ -291,6 +291,20 @@ theorem foldr_pmap (l : Array α) {P : α → Prop} (f : (a : α) → P a → β
(l.pmap f H).foldr g x = l.attach.foldr (fun a acc => g (f a.1 (H _ a.2)) acc) x := by
rw [pmap_eq_map_attach, foldr_map]
@[simp] theorem foldl_attachWith
(l : Array α) {q : α Prop} (H : a, a l q a) {f : β { x // q x} β} {b} (w : stop = l.size) :
(l.attachWith q H).foldl f b 0 stop = l.attach.foldl (fun b a, h => f b a, H _ h) b := by
subst w
rcases l with l
simp [List.foldl_attachWith, List.foldl_map]
@[simp] theorem foldr_attachWith
(l : Array α) {q : α Prop} (H : a, a l q a) {f : { x // q x} β β} {b} (w : start = l.size) :
(l.attachWith q H).foldr f b start 0 = l.attach.foldr (fun a acc => f a.1, H _ a.2 acc) b := by
subst w
rcases l with l
simp [List.foldr_attachWith, List.foldr_map]
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
@@ -571,7 +585,7 @@ and simplifies these to the function directly taking the value.
-/
theorem foldl_subtype {p : α Prop} {l : Array { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} :
(hf : b x h, f b x, h = g b x) :
l.foldl f x = l.unattach.foldl g x := by
cases l
simp only [List.foldl_toArray', List.unattach_toArray]
@@ -581,7 +595,7 @@ theorem foldl_subtype {p : α → Prop} {l : Array { x // p x }}
/-- Variant of `foldl_subtype` with side condition to check `stop = l.size`. -/
@[simp] theorem foldl_subtype' {p : α Prop} {l : Array { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} (h : stop = l.size) :
(hf : b x h, f b x, h = g b x) (h : stop = l.size) :
l.foldl f x 0 stop = l.unattach.foldl g x := by
subst h
rwa [foldl_subtype]
@@ -592,7 +606,7 @@ and simplifies these to the function directly taking the value.
-/
theorem foldr_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} :
(hf : x h b, f x, h b = g x b) :
l.foldr f x = l.unattach.foldr g x := by
cases l
simp only [List.foldr_toArray', List.unattach_toArray]
@@ -602,7 +616,7 @@ theorem foldr_subtype {p : α → Prop} {l : Array { x // p x }}
/-- Variant of `foldr_subtype` with side condition to check `stop = l.size`. -/
@[simp] theorem foldr_subtype' {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} (h : start = l.size) :
(hf : x h b, f x, h b = g x b) (h : start = l.size) :
l.foldr f x start 0 = l.unattach.foldr g x := by
subst h
rwa [foldr_subtype]
@@ -612,7 +626,7 @@ This lemma identifies maps over arrays of subtypes, where the function only depe
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
{f : { x // p x } β} {g : α β} (hf : x h, f x, h = g x) :
l.map f = l.unattach.map g := by
cases l
simp only [List.map_toArray, List.unattach_toArray]
@@ -620,7 +634,7 @@ and simplifies these to the function directly taking the value.
simp [hf]
@[simp] theorem filterMap_subtype {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
{f : { x // p x } Option β} {g : α Option β} (hf : x h, f x, h = g x) :
l.filterMap f = l.unattach.filterMap g := by
cases l
simp only [size_toArray, List.filterMap_toArray', List.unattach_toArray, List.length_unattach,
@@ -629,7 +643,7 @@ and simplifies these to the function directly taking the value.
simp [hf]
@[simp] theorem unattach_filter {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
{f : { x // p x } Bool} {g : α Bool} (hf : x h, f x, h = g x) :
(l.filter f).unattach = l.unattach.filter g := by
cases l
simp [hf]

View File

@@ -244,6 +244,10 @@ def ofFn {n} (f : Fin n → α) : Array α := go 0 (mkEmpty n) where
def range (n : Nat) : Array Nat :=
ofFn fun (i : Fin n) => i
/-- The array `#[start, start + step, ..., start + step * (size - 1)]`. -/
def range' (start size : Nat) (step : Nat := 1) : Array Nat :=
ofFn fun (i : Fin size) => start + step * i
@[inline] protected def singleton (v : α) : Array α := #[v]
def back! [Inhabited α] (a : Array α) : α :=
@@ -270,14 +274,22 @@ def swapAt! (a : Array α) (i : Nat) (v : α) : α × Array α :=
have : Inhabited (α × Array α) := (v, a)
panic! ("index " ++ toString i ++ " out of bounds")
/-- `take a n` returns the first `n` elements of `a`. -/
def take (a : Array α) (n : Nat) : Array α :=
/-- `shrink a n` returns the first `n` elements of `a`, implemented by repeatedly popping the last element. -/
def shrink (a : Array α) (n : Nat) : Array α :=
let rec loop
| 0, a => a
| n+1, a => loop n a.pop
loop (a.size - n) a
@[deprecated take (since := "2024-10-22")] abbrev shrink := @take
/-- `take a n` returns the first `n` elements of `a`, implemented by copying the first `n` elements. -/
abbrev take (a : Array α) (n : Nat) : Array α := extract a 0 n
@[simp] theorem take_eq_extract (a : Array α) (n : Nat) : a.take n = a.extract 0 n := rfl
/-- `drop a n` removes the first `n` elements of `a`, implemented by copying the remaining elements. -/
abbrev drop (a : Array α) (n : Nat) : Array α := extract a n a.size
@[simp] theorem drop_eq_extract (a : Array α) (n : Nat) : a.drop n = a.extract n a.size := rfl
@[inline]
unsafe def modifyMUnsafe [Monad m] (a : Array α) (i : Nat) (f : α m α) : m (Array α) := do
@@ -345,6 +357,9 @@ instance : ForIn' m (Array α) α inferInstance where
-- No separate `ForIn` instance is required because it can be derived from `ForIn'`.
-- We simplify `Array.forIn'` to `forIn'`.
@[simp] theorem forIn'_eq_forIn' [Monad m] : @Array.forIn' α β m _ = forIn' := rfl
/-- See comment at `forIn'Unsafe` -/
@[inline]
unsafe def foldlMUnsafe {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : β α m β) (init : β) (as : Array α) (start := 0) (stop := as.size) : m β :=
@@ -452,7 +467,7 @@ def mapM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m] (f : α
@[deprecated mapM (since := "2024-11-11")] abbrev sequenceMap := @mapM
/-- Variant of `mapIdxM` which receives the index as a `Fin as.size`. -/
/-- Variant of `mapIdxM` which receives the index `i` along with the bound `i < as.size`. -/
@[inline]
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m]
(as : Array α) (f : (i : Nat) α (h : i < as.size) m β) : m (Array β) :=
@@ -464,13 +479,25 @@ def mapFinIdxM {α : Type u} {β : Type v} {m : Type v → Type w} [Monad m]
rw [ inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
apply Nat.le_add_right
have : i + (j + 1) = as.size := by rw [ inv, Nat.add_comm j 1, Nat.add_assoc]
map i (j+1) this (bs.push ( f j (as.get j j_lt) j_lt))
map i (j+1) this (bs.push ( f j as[j] j_lt))
map as.size 0 rfl (mkEmpty as.size)
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : Nat α m β) (as : Array α) : m (Array β) :=
as.mapFinIdxM fun i a _ => f i a
@[inline]
def firstM {α : Type u} {m : Type v Type w} [Alternative m] (f : α m β) (as : Array α) : m β :=
go 0
where
go (i : Nat) : m β :=
if hlt : i < as.size then
f as[i] <|> go (i+1)
else
failure
termination_by as.size - i
decreasing_by exact Nat.sub_succ_lt_self as.size i hlt
@[inline]
def findSomeM? {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : α m (Option β)) (as : Array α) : m (Option β) := do
for a in as do
@@ -561,9 +588,16 @@ def findRevM? {α : Type} {m : Type → Type w} [Monad m] (p : α → m Bool) (a
as.findSomeRevM? fun a => return if ( p a) then some a else none
@[inline]
def forM {α : Type u} {m : Type v Type w} [Monad m] (f : α m PUnit) (as : Array α) (start := 0) (stop := as.size) : m PUnit :=
protected def forM {α : Type u} {m : Type v Type w} [Monad m] (f : α m PUnit) (as : Array α) (start := 0) (stop := as.size) : m PUnit :=
as.foldlM (fun _ => f) start stop
instance : ForM m (Array α) α where
forM xs f := Array.forM f xs
-- We simplify `Array.forM` to `forM`.
@[simp] theorem forM_eq_forM [Monad m] (f : α m PUnit) :
Array.forM f as 0 as.size = forM as f := rfl
@[inline]
def forRevM {α : Type u} {m : Type v Type w} [Monad m] (f : α m PUnit) (as : Array α) (start := as.size) (stop := 0) : m PUnit :=
as.foldrM (fun a _ => f a) start stop
@@ -595,6 +629,9 @@ def count {α : Type u} [BEq α] (a : α) (as : Array α) : Nat :=
def map {α : Type u} {β : Type v} (f : α β) (as : Array α) : Array β :=
Id.run <| as.mapM f
instance : Functor Array where
map := map
/-- Variant of `mapIdx` which receives the index as a `Fin as.size`. -/
@[inline]
def mapFinIdx {α : Type u} {β : Type v} (as : Array α) (f : (i : Nat) α (h : i < as.size) β) : Array β :=
@@ -605,8 +642,10 @@ def mapIdx {α : Type u} {β : Type v} (f : Nat → α → β) (as : Array α) :
Id.run <| as.mapIdxM f
/-- Turns `#[a, b]` into `#[(a, 0), (b, 1)]`. -/
def zipWithIndex (arr : Array α) : Array (α × Nat) :=
arr.mapIdx fun i a => (a, i)
def zipIdx (arr : Array α) (start := 0) : Array (α × Nat) :=
arr.mapIdx fun i a => (a, start + i)
@[deprecated zipIdx (since := "2025-01-21")] abbrev zipWithIndex := @zipIdx
@[inline]
def find? {α : Type u} (p : α Bool) (as : Array α) : Option α :=
@@ -654,18 +693,51 @@ def findFinIdx? {α : Type u} (p : α → Bool) (as : Array α) : Option (Fin as
decreasing_by simp_wf; decreasing_trivial_pre_omega
loop 0
theorem findIdx?_loop_eq_map_findFinIdx?_loop_val {xs : Array α} {p : α Bool} {j} :
findIdx?.loop p xs j = (findFinIdx?.loop p xs j).map (·.val) := by
unfold findIdx?.loop
unfold findFinIdx?.loop
split <;> rename_i h
case isTrue =>
split
case isTrue => simp
case isFalse =>
have : xs.size - (j + 1) < xs.size - j := Nat.sub_succ_lt_self xs.size j h
rw [findIdx?_loop_eq_map_findFinIdx?_loop_val (j := j + 1)]
case isFalse => simp
termination_by xs.size - j
theorem findIdx?_eq_map_findFinIdx?_val {xs : Array α} {p : α Bool} :
xs.findIdx? p = (xs.findFinIdx? p).map (·.val) := by
simp [findIdx?, findFinIdx?, findIdx?_loop_eq_map_findFinIdx?_loop_val]
@[inline]
def findIdx (p : α Bool) (as : Array α) : Nat := (as.findIdx? p).getD as.size
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def indexOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
def idxOfAux [BEq α] (a : Array α) (v : α) (i : Nat) : Option (Fin a.size) :=
if h : i < a.size then
if a[i] == v then some i, h
else indexOfAux a v (i+1)
else idxOfAux a v (i+1)
else none
decreasing_by simp_wf; decreasing_trivial_pre_omega
def indexOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
indexOfAux a v 0
@[deprecated idxOfAux (since := "2025-01-29")]
abbrev indexOfAux := @idxOfAux
@[deprecated indexOf? (since := "2024-11-20")]
def finIdxOf? [BEq α] (a : Array α) (v : α) : Option (Fin a.size) :=
idxOfAux a v 0
@[deprecated "`Array.indexOf?` has been deprecated, use `idxOf?` or `finIdxOf?` instead." (since := "2025-01-29")]
abbrev indexOf? := @finIdxOf?
/-- Returns the index of the first element equal to `a`, or the length of the array otherwise. -/
def idxOf [BEq α] (a : α) : Array α Nat := findIdx (· == a)
def idxOf? [BEq α] (a : Array α) (v : α) : Option Nat :=
(a.finIdxOf? v).map (·.val)
@[deprecated idxOf? (since := "2024-11-20")]
def getIdx? [BEq α] (a : Array α) (v : α) : Option Nat :=
a.findIdx? fun a => a == v
@@ -730,6 +802,24 @@ def flatMap (f : α → Array β) (as : Array α) : Array β :=
@[inline] def flatten (as : Array (Array α)) : Array α :=
as.foldl (init := empty) fun r a => r ++ a
def reverse (as : Array α) : Array α :=
if h : as.size 1 then
as
else
loop as 0 as.size - 1, Nat.pred_lt (mt (fun h : as.size = 0 => h by decide) h)
where
termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
rw [Nat.sub_sub, Nat.add_comm]
exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
loop (as : Array α) (i : Nat) (j : Fin as.size) :=
if h : i < j then
have := termination h
let as := as.swap i j (Nat.lt_trans h j.2)
have : j-1 < as.size := by rw [size_swap]; exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
loop as (i+1) j-1, this
else
as
@[inline]
def filter (p : α Bool) (as : Array α) (start := 0) (stop := as.size) : Array α :=
as.foldl (init := #[]) (start := start) (stop := stop) fun r a =>
@@ -740,6 +830,11 @@ def filterM {α : Type} [Monad m] (p : α → m Bool) (as : Array α) (start :=
as.foldlM (init := #[]) (start := start) (stop := stop) fun r a => do
if ( p a) then return r.push a else return r
@[inline]
def filterRevM {α : Type} [Monad m] (p : α m Bool) (as : Array α) (start := as.size) (stop := 0) : m (Array α) :=
reverse <$> as.foldrM (init := #[]) (start := start) (stop := stop) fun a r => do
if ( p a) then return r.push a else return r
@[specialize]
def filterMapM [Monad m] (f : α m (Option β)) (as : Array α) (start := 0) (stop := as.size) : m (Array β) :=
as.foldlM (init := #[]) (start := start) (stop := stop) fun bs a => do
@@ -771,24 +866,6 @@ def partition (p : α → Bool) (as : Array α) : Array α × Array α := Id.run
cs := cs.push a
return (bs, cs)
def reverse (as : Array α) : Array α :=
if h : as.size 1 then
as
else
loop as 0 as.size - 1, Nat.pred_lt (mt (fun h : as.size = 0 => h by decide) h)
where
termination {i j : Nat} (h : i < j) : j - 1 - (i + 1) < j - i := by
rw [Nat.sub_sub, Nat.add_comm]
exact Nat.lt_of_le_of_lt (Nat.pred_le _) (Nat.sub_succ_lt_self _ _ h)
loop (as : Array α) (i : Nat) (j : Fin as.size) :=
if h : i < j then
have := termination h
let as := as.swap i j (Nat.lt_trans h j.2)
have : j-1 < as.size := by rw [size_swap]; exact Nat.lt_of_le_of_lt (Nat.pred_le _) j.2
loop as (i+1) j-1, this
else
as
@[semireducible] -- This is otherwise irreducible because it uses well-founded recursion.
def popWhile (p : α Bool) (as : Array α) : Array α :=
if h : as.size > 0 then
@@ -854,16 +931,23 @@ it has to backshift all elements at positions greater than `i`. -/
def eraseIdx! (a : Array α) (i : Nat) : Array α :=
if h : i < a.size then a.eraseIdx i h else panic! "invalid index"
/-- Remove a specified element from an array, or do nothing if it is not present.
This function takes worst case O(n) time because
it has to backshift all later elements. -/
def erase [BEq α] (as : Array α) (a : α) : Array α :=
match as.indexOf? a with
match as.finIdxOf? a with
| none => as
| some i => as.eraseIdx i
/-- Erase the first element that satisfies the predicate `p`. -/
/-- Erase the first element that satisfies the predicate `p`.
This function takes worst case O(n) time because
it has to backshift all later elements. -/
def eraseP (as : Array α) (p : α Bool) : Array α :=
match as.findIdx? p with
match as.findFinIdx? p with
| none => as
| some i => as.eraseIdxIfInBounds i
| some i => as.eraseIdx i
/-- Insert element `a` at position `i`. -/
@[inline] def insertIdx (as : Array α) (i : Nat) (a : α) (_ : i as.size := by get_elem_tactic) : Array α :=
@@ -932,13 +1016,13 @@ def zipWithAux (as : Array α) (bs : Array β) (f : α → β → γ) (i : Nat)
cs
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[inline] def zipWith (as : Array α) (bs : Array β) (f : α β γ) : Array γ :=
@[inline] def zipWith (f : α β γ) (as : Array α) (bs : Array β) : Array γ :=
zipWithAux as bs f 0 #[]
def zip (as : Array α) (bs : Array β) : Array (α × β) :=
zipWith as bs Prod.mk
zipWith Prod.mk as bs
def zipWithAll (as : Array α) (bs : Array β) (f : Option α Option β γ) : Array γ :=
def zipWithAll (f : Option α Option β γ) (as : Array α) (bs : Array β) : Array γ :=
go as bs 0 #[]
where go (as : Array α) (bs : Array β) (i : Nat) (cs : Array γ) :=
if i < max as.size bs.size then

View File

@@ -11,7 +11,7 @@ import Init.ByCases
namespace Array
theorem rel_of_isEqvAux
private theorem rel_of_isEqvAux
{r : α α Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i a.size)
(heqv : Array.isEqvAux a b hsz r i hi)
{j : Nat} (hj : j < i) : r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz hi))) := by
@@ -27,7 +27,7 @@ theorem rel_of_isEqvAux
subst hj'
exact heqv.left
theorem isEqvAux_of_rel {r : α α Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i a.size)
private theorem isEqvAux_of_rel {r : α α Bool} {a b : Array α} (hsz : a.size = b.size) {i : Nat} (hi : i a.size)
(w : j, (hj : j < i) r (a[j]'(Nat.lt_of_lt_of_le hj hi)) (b[j]'(Nat.lt_of_lt_of_le hj (hsz hi)))) : Array.isEqvAux a b hsz r i hi := by
induction i with
| zero => simp [Array.isEqvAux]
@@ -35,7 +35,8 @@ theorem isEqvAux_of_rel {r : αα → Bool} {a b : Array α} (hsz : a.size
simp only [isEqvAux, Bool.and_eq_true]
exact w i (Nat.lt_add_one i), ih _ fun j hj => w j (Nat.lt_add_right 1 hj)
theorem rel_of_isEqv {r : α α Bool} {a b : Array α} :
-- This is private as the forward direction of `isEqv_iff_rel` may be used.
private theorem rel_of_isEqv {r : α α Bool} {a b : Array α} :
Array.isEqv a b r h : a.size = b.size, (i : Nat) (h' : i < a.size), r (a[i]) (b[i]'(h h')) := by
simp only [isEqv]
split <;> rename_i h
@@ -69,7 +70,7 @@ theorem eq_of_isEqv [DecidableEq α] (a b : Array α) (h : Array.isEqv a b (fun
have h, h' := rel_of_isEqv h
exact ext _ _ h (fun i lt _ => by simpa using h' i lt)
theorem isEqvAux_self (r : α α Bool) (hr : a, r a a) (a : Array α) (i : Nat) (h : i a.size) :
private theorem isEqvAux_self (r : α α Bool) (hr : a, r a a) (a : Array α) (i : Nat) (h : i a.size) :
Array.isEqvAux a a rfl r i h = true := by
induction i with
| zero => simp [Array.isEqvAux]

View File

@@ -0,0 +1,400 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.List.Nat.Erase
import Init.Data.List.Nat.Basic
/-!
# Lemmas about `Array.eraseP`, `Array.erase`, and `Array.eraseIdx`.
-/
namespace Array
open Nat
/-! ### eraseP -/
@[simp] theorem eraseP_empty : #[].eraseP p = #[] := rfl
theorem eraseP_of_forall_mem_not {l : Array α} (h : a, a l ¬p a) : l.eraseP p = l := by
cases l
simp_all [List.eraseP_of_forall_not]
theorem eraseP_of_forall_getElem_not {l : Array α} (h : i, (h : i < l.size) ¬p l[i]) : l.eraseP p = l :=
eraseP_of_forall_mem_not fun a m => by
rw [mem_iff_getElem] at m
obtain i, w, rfl := m
exact h i w
@[simp] theorem eraseP_eq_empty_iff {xs : Array α} {p : α Bool} : xs.eraseP p = #[] xs = #[] x, p x xs = #[x] := by
cases xs
simp
theorem eraseP_ne_empty_iff {xs : Array α} {p : α Bool} : xs.eraseP p #[] xs #[] x, p x xs #[x] := by
simp
theorem exists_of_eraseP {l : Array α} {a} (hm : a l) (hp : p a) :
a l₁ l₂, ( b l₁, ¬p b) p a l = l₁.push a ++ l₂ l.eraseP p = l₁ ++ l₂ := by
rcases l with l
obtain a, l₁, l₂, h₁, h₂, rfl, h₃ := List.exists_of_eraseP (by simpa using hm) (hp)
refine a, l₁, l₂, by simpa using h₁, h₂, by simp, by simpa using h₃
theorem exists_or_eq_self_of_eraseP (p) (l : Array α) :
l.eraseP p = l
a l₁ l₂, ( b l₁, ¬p b) p a l = l₁.push a ++ l₂ l.eraseP p = l₁ ++ l₂ :=
if h : a l, p a then
let _, ha, pa := h
.inr (exists_of_eraseP ha pa)
else
.inl (eraseP_of_forall_mem_not (h ·, ·, ·))
@[simp] theorem size_eraseP_of_mem {l : Array α} (al : a l) (pa : p a) :
(l.eraseP p).size = l.size - 1 := by
let _, l₁, l₂, _, _, e₁, e₂ := exists_of_eraseP al pa
rw [e₂]; simp [size_append, e₁]; omega
theorem size_eraseP {l : Array α} : (l.eraseP p).size = if l.any p then l.size - 1 else l.size := by
split <;> rename_i h
· simp only [any_eq_true] at h
obtain i, h, w := h
simp [size_eraseP_of_mem (l := l) (by simp) w]
· simp only [any_eq_true] at h
rw [eraseP_of_forall_getElem_not]
simp_all
theorem size_eraseP_le (l : Array α) : (l.eraseP p).size l.size := by
rcases l with l
simpa using List.length_eraseP_le l
theorem le_size_eraseP (l : Array α) : l.size - 1 (l.eraseP p).size := by
rcases l with l
simpa using List.le_length_eraseP l
theorem mem_of_mem_eraseP {l : Array α} : a l.eraseP p a l := by
rcases l with l
simpa using List.mem_of_mem_eraseP
@[simp] theorem mem_eraseP_of_neg {l : Array α} (pa : ¬p a) : a l.eraseP p a l := by
rcases l with l
simpa using List.mem_eraseP_of_neg pa
@[simp] theorem eraseP_eq_self_iff {p} {l : Array α} : l.eraseP p = l a l, ¬ p a := by
rcases l with l
simp
theorem eraseP_map (f : β α) (l : Array β) : (map f l).eraseP p = map f (l.eraseP (p f)) := by
rcases l with l
simpa using List.eraseP_map f l
theorem eraseP_filterMap (f : α Option β) (l : Array α) :
(filterMap f l).eraseP p = filterMap f (l.eraseP (fun x => match f x with | some y => p y | none => false)) := by
rcases l with l
simpa using List.eraseP_filterMap f l
theorem eraseP_filter (f : α Bool) (l : Array α) :
(filter f l).eraseP p = filter f (l.eraseP (fun x => p x && f x)) := by
rcases l with l
simpa using List.eraseP_filter f l
theorem eraseP_append_left {a : α} (pa : p a) {l₁ : Array α} l₂ (h : a l₁) :
(l₁ ++ l₂).eraseP p = l₁.eraseP p ++ l₂ := by
rcases l₁ with l₁
rcases l₂ with l₂
simpa using List.eraseP_append_left pa l₂ (by simpa using h)
theorem eraseP_append_right {l₁ : Array α} l₂ (h : b l₁, ¬p b) :
(l₁ ++ l₂).eraseP p = l₁ ++ l₂.eraseP p := by
rcases l₁ with l₁
rcases l₂ with l₂
simpa using List.eraseP_append_right l₂ (by simpa using h)
theorem eraseP_append (l₁ l₂ : Array α) :
(l₁ ++ l₂).eraseP p = if l₁.any p then l₁.eraseP p ++ l₂ else l₁ ++ l₂.eraseP p := by
rcases l₁ with l₁
rcases l₂ with l₂
simp only [List.append_toArray, List.eraseP_toArray, List.eraseP_append l₁ l₂, List.any_toArray']
split <;> simp
theorem eraseP_mkArray (n : Nat) (a : α) (p : α Bool) :
(mkArray n a).eraseP p = if p a then mkArray (n - 1) a else mkArray n a := by
simp only [ List.toArray_replicate, List.eraseP_toArray, List.eraseP_replicate]
split <;> simp
@[simp] theorem eraseP_mkArray_of_pos {n : Nat} {a : α} (h : p a) :
(mkArray n a).eraseP p = mkArray (n - 1) a := by
simp only [ List.toArray_replicate, List.eraseP_toArray]
simp [h]
@[simp] theorem eraseP_mkArray_of_neg {n : Nat} {a : α} (h : ¬p a) :
(mkArray n a).eraseP p = mkArray n a := by
simp only [ List.toArray_replicate, List.eraseP_toArray]
simp [h]
theorem eraseP_eq_iff {p} {l : Array α} :
l.eraseP p = l'
(( a l, ¬ p a) l = l')
a l₁ l₂, ( b l₁, ¬ p b) p a l = l₁.push a ++ l₂ l' = l₁ ++ l₂ := by
rcases l with l
rcases l' with l'
simp [List.eraseP_eq_iff]
constructor
· rintro (h | a, l₁, h₁, h₂, x, rfl, rfl)
· exact Or.inl h
· exact Or.inr a, l₁, by simpa using h₁, h₂, x, by simp
· rintro (h | a, l₁, h₁, h₂, x, rfl, rfl)
· exact Or.inl h
· exact Or.inr a, l₁, by simpa using h₁, h₂, x, by simp
theorem eraseP_comm {l : Array α} (h : a l, ¬ p a ¬ q a) :
(l.eraseP p).eraseP q = (l.eraseP q).eraseP p := by
rcases l with l
simpa using List.eraseP_comm (by simpa using h)
/-! ### erase -/
section erase
variable [BEq α]
theorem erase_of_not_mem [LawfulBEq α] {a : α} {l : Array α} (h : a l) : l.erase a = l := by
rcases l with l
simp [List.erase_of_not_mem (by simpa using h)]
theorem erase_eq_eraseP' (a : α) (l : Array α) : l.erase a = l.eraseP (· == a) := by
rcases l with l
simp [List.erase_eq_eraseP']
theorem erase_eq_eraseP [LawfulBEq α] (a : α) (l : Array α) : l.erase a = l.eraseP (a == ·) := by
rcases l with l
simp [List.erase_eq_eraseP]
@[simp] theorem erase_eq_empty_iff [LawfulBEq α] {xs : Array α} {a : α} :
xs.erase a = #[] xs = #[] xs = #[a] := by
rcases xs with xs
simp [List.erase_eq_nil_iff]
theorem erase_ne_empty_iff [LawfulBEq α] {xs : Array α} {a : α} :
xs.erase a #[] xs #[] xs #[a] := by
rcases xs with xs
simp [List.erase_ne_nil_iff]
theorem exists_erase_eq [LawfulBEq α] {a : α} {l : Array α} (h : a l) :
l₁ l₂, a l₁ l = l₁.push a ++ l₂ l.erase a = l₁ ++ l₂ := by
let _, l₁, l₂, h₁, e, h₂, h₃ := exists_of_eraseP h (beq_self_eq_true _)
rw [erase_eq_eraseP]; exact l₁, l₂, fun h => h₁ _ h (beq_self_eq_true _), eq_of_beq e h₂, h₃
@[simp] theorem size_erase_of_mem [LawfulBEq α] {a : α} {l : Array α} (h : a l) :
(l.erase a).size = l.size - 1 := by
rw [erase_eq_eraseP]; exact size_eraseP_of_mem h (beq_self_eq_true a)
theorem size_erase [LawfulBEq α] (a : α) (l : Array α) :
(l.erase a).size = if a l then l.size - 1 else l.size := by
rw [erase_eq_eraseP, size_eraseP]
congr
simp [mem_iff_getElem, eq_comm (a := a)]
theorem size_erase_le (a : α) (l : Array α) : (l.erase a).size l.size := by
rcases l with l
simpa using List.length_erase_le a l
theorem le_size_erase [LawfulBEq α] (a : α) (l : Array α) : l.size - 1 (l.erase a).size := by
rcases l with l
simpa using List.le_length_erase a l
theorem mem_of_mem_erase {a b : α} {l : Array α} (h : a l.erase b) : a l := by
rcases l with l
simpa using List.mem_of_mem_erase (by simpa using h)
@[simp] theorem mem_erase_of_ne [LawfulBEq α] {a b : α} {l : Array α} (ab : a b) :
a l.erase b a l :=
erase_eq_eraseP b l mem_eraseP_of_neg (mt eq_of_beq ab.symm)
@[simp] theorem erase_eq_self_iff [LawfulBEq α] {l : Array α} : l.erase a = l a l := by
rw [erase_eq_eraseP', eraseP_eq_self_iff]
simp [forall_mem_ne']
theorem erase_filter [LawfulBEq α] (f : α Bool) (l : Array α) :
(filter f l).erase a = filter f (l.erase a) := by
rcases l with l
simpa using List.erase_filter f l
theorem erase_append_left [LawfulBEq α] {l₁ : Array α} (l₂) (h : a l₁) :
(l₁ ++ l₂).erase a = l₁.erase a ++ l₂ := by
rcases l₁ with l₁
rcases l₂ with l₂
simpa using List.erase_append_left l₂ (by simpa using h)
theorem erase_append_right [LawfulBEq α] {a : α} {l₁ : Array α} (l₂ : Array α) (h : a l₁) :
(l₁ ++ l₂).erase a = (l₁ ++ l₂.erase a) := by
rcases l₁ with l₁
rcases l₂ with l₂
simpa using List.erase_append_right l₂ (by simpa using h)
theorem erase_append [LawfulBEq α] {a : α} {l₁ l₂ : Array α} :
(l₁ ++ l₂).erase a = if a l₁ then l₁.erase a ++ l₂ else l₁ ++ l₂.erase a := by
rcases l₁ with l₁
rcases l₂ with l₂
simp only [List.append_toArray, List.erase_toArray, List.erase_append, mem_toArray]
split <;> simp
theorem erase_mkArray [LawfulBEq α] (n : Nat) (a b : α) :
(mkArray n a).erase b = if b == a then mkArray (n - 1) a else mkArray n a := by
simp only [ List.toArray_replicate, List.erase_toArray]
simp only [List.erase_replicate, beq_iff_eq, List.toArray_replicate]
split <;> simp
theorem erase_comm [LawfulBEq α] (a b : α) (l : Array α) :
(l.erase a).erase b = (l.erase b).erase a := by
rcases l with l
simpa using List.erase_comm a b l
theorem erase_eq_iff [LawfulBEq α] {a : α} {l : Array α} :
l.erase a = l'
(a l l = l')
l₁ l₂, a l₁ l = l₁.push a ++ l₂ l' = l₁ ++ l₂ := by
rw [erase_eq_eraseP', eraseP_eq_iff]
simp only [beq_iff_eq, forall_mem_ne', exists_and_left]
constructor
· rintro (h, rfl | a', l', h, rfl, x, rfl, rfl)
· left; simp_all
· right; refine l', h, x, by simp
· rintro (h, rfl | l₁, h, x, rfl, rfl)
· left; simp_all
· right; refine a, l₁, h, rfl, x, by simp
@[simp] theorem erase_mkArray_self [LawfulBEq α] {a : α} :
(mkArray n a).erase a = mkArray (n - 1) a := by
simp only [ List.toArray_replicate, List.erase_toArray]
simp [List.erase_replicate]
@[simp] theorem erase_mkArray_ne [LawfulBEq α] {a b : α} (h : !b == a) :
(mkArray n a).erase b = mkArray n a := by
rw [erase_of_not_mem]
simp_all
end erase
/-! ### eraseIdx -/
theorem eraseIdx_eq_take_drop_succ (l : Array α) (i : Nat) (h) : l.eraseIdx i = l.take i ++ l.drop (i + 1) := by
rcases l with l
simp only [size_toArray] at h
simp only [List.eraseIdx_toArray, List.eraseIdx_eq_take_drop_succ, take_eq_extract,
List.extract_toArray, List.extract_eq_drop_take, Nat.sub_zero, List.drop_zero, drop_eq_extract,
size_toArray, List.append_toArray, mk.injEq, List.append_cancel_left_eq]
rw [List.take_of_length_le]
simp
theorem getElem?_eraseIdx (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) :
(l.eraseIdx i)[j]? = if j < i then l[j]? else l[j + 1]? := by
rcases l with l
simp [List.getElem?_eraseIdx]
theorem getElem?_eraseIdx_of_lt (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) (h' : j < i) :
(l.eraseIdx i)[j]? = l[j]? := by
rw [getElem?_eraseIdx]
simp [h']
theorem getElem?_eraseIdx_of_ge (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) (h' : i j) :
(l.eraseIdx i)[j]? = l[j + 1]? := by
rw [getElem?_eraseIdx]
simp only [dite_eq_ite, ite_eq_right_iff]
intro h'
omega
theorem getElem_eraseIdx (l : Array α) (i : Nat) (h : i < l.size) (j : Nat) (h' : j < (l.eraseIdx i).size) :
(l.eraseIdx i)[j] = if h'' : j < i then
l[j]
else
l[j + 1]'(by rw [size_eraseIdx] at h'; omega) := by
apply Option.some.inj
rw [ getElem?_eq_getElem, getElem?_eraseIdx]
split <;> simp
@[simp] theorem eraseIdx_eq_empty_iff {l : Array α} {i : Nat} {h} : eraseIdx l i = #[] l.size = 1 i = 0 := by
rcases l with l
simp only [List.eraseIdx_toArray, mk.injEq, List.eraseIdx_eq_nil_iff, size_toArray,
or_iff_right_iff_imp]
rintro rfl
simp_all
theorem eraseIdx_ne_empty_iff {l : Array α} {i : Nat} {h} : eraseIdx l i #[] 2 l.size := by
rcases l with _ | a, (_ | b, l)
· simp
· simp at h
simp [h]
· simp
theorem mem_of_mem_eraseIdx {l : Array α} {i : Nat} {h} {a : α} (h : a l.eraseIdx i) : a l := by
rcases l with l
simpa using List.mem_of_mem_eraseIdx (by simpa using h)
theorem eraseIdx_append_of_lt_size {l : Array α} {k : Nat} (hk : k < l.size) (l' : Array α) (h) :
eraseIdx (l ++ l') k = eraseIdx l k ++ l' := by
rcases l with l
rcases l' with l'
simp at hk
simp [List.eraseIdx_append_of_lt_length, *]
theorem eraseIdx_append_of_length_le {l : Array α} {k : Nat} (hk : l.size k) (l' : Array α) (h) :
eraseIdx (l ++ l') k = l ++ eraseIdx l' (k - l.size) (by simp at h; omega) := by
rcases l with l
rcases l' with l'
simp at hk
simp [List.eraseIdx_append_of_length_le, *]
theorem eraseIdx_mkArray {n : Nat} {a : α} {k : Nat} {h} :
(mkArray n a).eraseIdx k = mkArray (n - 1) a := by
simp at h
simp only [ List.toArray_replicate, List.eraseIdx_toArray]
simp [List.eraseIdx_replicate, h]
theorem mem_eraseIdx_iff_getElem {x : α} {l} {k} {h} : x eraseIdx l k h i w, i k l[i]'w = x := by
rcases l with l
simp [List.mem_eraseIdx_iff_getElem, *]
theorem mem_eraseIdx_iff_getElem? {x : α} {l} {k} {h} : x eraseIdx l k h i k, l[i]? = some x := by
rcases l with l
simp [List.mem_eraseIdx_iff_getElem?, *]
theorem erase_eq_eraseIdx_of_idxOf [BEq α] [LawfulBEq α] (l : Array α) (a : α) (i : Nat) (w : l.idxOf a = i) (h : i < l.size) :
l.erase a = l.eraseIdx i := by
rcases l with l
simp at w
simp [List.erase_eq_eraseIdx_of_idxOf, *]
theorem getElem_eraseIdx_of_lt (l : Array α) (i : Nat) (w : i < l.size) (j : Nat) (h : j < (l.eraseIdx i).size) (h' : j < i) :
(l.eraseIdx i)[j] = l[j] := by
rcases l with l
simp [List.getElem_eraseIdx_of_lt, *]
theorem getElem_eraseIdx_of_ge (l : Array α) (i : Nat) (w : i < l.size) (j : Nat) (h : j < (l.eraseIdx i).size) (h' : i j) :
(l.eraseIdx i)[j] = l[j + 1]'(by simp at h; omega) := by
rcases l with l
simp [List.getElem_eraseIdx_of_ge, *]
theorem eraseIdx_set_eq {l : Array α} {i : Nat} {a : α} {h : i < l.size} :
(l.set i a).eraseIdx i (by simp; omega) = l.eraseIdx i := by
rcases l with l
simp [List.eraseIdx_set_eq, *]
theorem eraseIdx_set_lt {l : Array α} {i : Nat} {w : i < l.size} {j : Nat} {a : α} (h : j < i) :
(l.set i a).eraseIdx j (by simp; omega) = (l.eraseIdx j).set (i - 1) a (by simp; omega) := by
rcases l with l
simp [List.eraseIdx_set_lt, *]
theorem eraseIdx_set_gt {l : Array α} {i : Nat} {j : Nat} {a : α} (h : i < j) {w : j < l.size} :
(l.set i a).eraseIdx j (by simp; omega) = (l.eraseIdx j).set i a (by simp; omega) := by
rcases l with l
simp [List.eraseIdx_set_gt, *]
@[simp] theorem set_getElem_succ_eraseIdx_succ
{l : Array α} {i : Nat} (h : i + 1 < l.size) :
(l.eraseIdx (i + 1)).set i l[i + 1] (by simp; omega) = l.eraseIdx i := by
rcases l with l
simp [List.set_getElem_succ_eraseIdx_succ, *]
end Array

View File

@@ -397,6 +397,10 @@ theorem getElem_of_mem {a} {l : Array α} (h : a ∈ l) : ∃ (i : Nat) (h : i <
theorem getElem?_of_mem {a} {l : Array α} (h : a l) : i : Nat, l[i]? = some a :=
let n, _, e := getElem_of_mem h; n, e getElem?_eq_getElem _
theorem mem_of_getElem {l : Array α} {i : Nat} {h} {a : α} (e : l[i] = a) : a l := by
subst e
simp
theorem mem_of_getElem? {l : Array α} {i : Nat} {a : α} (e : l[i]? = some a) : a l :=
let _, e := getElem?_eq_some_iff.1 e; e getElem_mem ..
@@ -836,9 +840,6 @@ theorem mem_or_eq_of_mem_set
cases as
simpa using List.mem_or_eq_of_mem_set (by simpa using h)
@[simp] theorem toList_set (a : Array α) (i x h) :
(a.set i x).toList = a.toList.set i x := rfl
/-! ### setIfInBounds -/
@[simp] theorem set!_eq_setIfInBounds : @set! = @setIfInBounds := rfl
@@ -1002,7 +1003,7 @@ private theorem beq_of_beq_singleton [BEq α] {a b : α} : #[a] == #[b] → a ==
· intro h
constructor
· intro a b h
obtain hs, hi := rel_of_isEqv h
obtain hs, hi := isEqv_iff_rel.mp h
ext i h₁ h₂
· exact hs
· simpa using hi _ h₁
@@ -1091,7 +1092,9 @@ theorem map_id'' {f : αα} (h : ∀ x, f x = x) (l : Array α) : map f l =
theorem map_singleton (f : α β) (a : α) : map f #[a] = #[f a] := rfl
@[simp] theorem mem_map {f : α β} {l : Array α} : b l.map f a, a l f a = b := by
-- We use a lower priority here as there are more specific lemmas in downstream libraries
-- which should be able to fire first.
@[simp 500] theorem mem_map {f : α β} {l : Array α} : b l.map f a, a l f a = b := by
simp only [mem_def, toList_map, List.mem_map]
theorem exists_of_mem_map (h : b map f l) : a, a l f a = b := mem_map.1 h
@@ -1662,7 +1665,7 @@ theorem getElem_of_append {l l₁ l₂ : Array α} (eq : l = l₁.push a ++ l₂
rw [ getElem?_eq_getElem, eq, getElem?_append_left (by simp; omega), h]
simp
@[simp 1100] theorem append_singleton {a : α} {as : Array α} : as ++ #[a] = as.push a := rfl
@[simp] theorem append_singleton {a : α} {as : Array α} : as ++ #[a] = as.push a := rfl
theorem push_eq_append {a : α} {as : Array α} : as.push a = as ++ #[a] := rfl
@@ -2281,10 +2284,6 @@ theorem flatMap_mkArray {β} (f : α → Array β) : (mkArray n a).flatMap f = (
/-! ### Preliminaries about `swap` needed for `reverse`. -/
theorem swap_def (a : Array α) (i j : Nat) (hi hj) :
a.swap i j hi hj = (a.set i a[j]).set j a[i] (by simpa using hj) := by
simp [swap]
theorem getElem?_swap (a : Array α) (i j : Nat) (hi hj) (k : Nat) : (a.swap i j hi hj)[k]? =
if j = k then some a[i] else if i = k then some a[j] else a[k]? := by
simp [swap_def, getElem?_set]
@@ -2566,8 +2565,14 @@ theorem getElem?_extract {as : Array α} {start stop : Nat} :
· omega
· rfl
@[congr] theorem extract_congr {as bs : Array α}
(w : as = bs) (h : start = start') (h' : stop = stop') :
as.extract start stop = bs.extract start' stop' := by
subst w h h'
rfl
@[simp] theorem toList_extract (as : Array α) (start stop : Nat) :
(as.extract start stop).toList = (as.toList.drop start).take (stop - start) := by
(as.extract start stop).toList = as.toList.extract start stop := by
apply List.ext_getElem
· simp only [length_toList, size_extract, List.length_take, List.length_drop]
omega
@@ -2596,7 +2601,7 @@ theorem extract_empty_of_size_le_start (as : Array α) {start stop : Nat} (h : a
extract_empty_of_size_le_start _ (Nat.zero_le _)
@[simp] theorem _root_.List.extract_toArray (l : List α) (start stop : Nat) :
l.toArray.extract start stop = ((l.drop start).take (stop - start)).toArray := by
l.toArray.extract start stop = (l.extract start stop).toArray := by
apply ext'
simp
@@ -3301,9 +3306,6 @@ theorem get_set (a : Array α) (i : Nat) (hi : i < a.size) (j : Nat) (hj : j < a
(h : i j) : (a.set i v)[j]'(by simp [*]) = a[j] := by
simp only [set, getElem_toList, List.getElem_set_ne h]
@[simp] theorem toList_swap (a : Array α) (i j : Nat) (hi hj) :
(a.swap i j hi hj).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
@[simp] theorem swapAt_def (a : Array α) (i : Nat) (v : α) (hi) :
a.swapAt i v hi = (a[i], a.set i v) := rfl
@@ -3358,45 +3360,65 @@ theorem size_eq_length_toList (as : Array α) : as.size = as.toList.length := rf
@[deprecated size_swapIfInBounds (since := "2024-11-24")] abbrev size_swap! := @size_swapIfInBounds
@[simp] theorem size_range {n : Nat} : (range n).size = n := by
induction n <;> simp [range]
simp [range]
@[simp] theorem toList_range (n : Nat) : (range n).toList = List.range n := by
apply List.ext_getElem <;> simp [range]
@[simp]
theorem getElem_range {n : Nat} {x : Nat} (h : x < (Array.range n).size) : (Array.range n)[x] = x := by
theorem getElem_range {n : Nat} {i : Nat} (h : i < (Array.range n).size) : (Array.range n)[i] = i := by
simp [ getElem_toList]
theorem getElem?_range {n : Nat} {i : Nat} : (Array.range n)[i]? = if i < n then some i else none := by
simp [getElem?_def, getElem_range]
@[simp] theorem size_range' {start size step} : (range' start size step).size = size := by
simp [range']
@[simp] theorem toList_range' {start size step} :
(range' start size step).toList = List.range' start size step := by
apply List.ext_getElem <;> simp [range']
/-! ### take -/
@[simp]
theorem getElem_range' {start size step : Nat} {i : Nat}
(h : i < (Array.range' start size step).size) :
(Array.range' start size step)[i] = start + step * i := by
simp [ getElem_toList]
@[simp] theorem size_take_loop (a : Array α) (n : Nat) : (take.loop n a).size = a.size - n := by
theorem getElem?_range' {start size step : Nat} {i : Nat} :
(Array.range' start size step)[i]? = if i < size then some (start + step * i) else none := by
simp [getElem?_def, getElem_range']
/-! ### shrink -/
@[simp] theorem size_shrink_loop (a : Array α) (n : Nat) : (shrink.loop n a).size = a.size - n := by
induction n generalizing a with
| zero => simp [take.loop]
| zero => simp [shrink.loop]
| succ n ih =>
simp [take.loop, ih]
simp [shrink.loop, ih]
omega
@[simp] theorem getElem_take_loop (a : Array α) (n : Nat) (i : Nat) (h : i < (take.loop n a).size) :
(take.loop n a)[i] = a[i]'(by simp at h; omega) := by
@[simp] theorem getElem_shrink_loop (a : Array α) (n : Nat) (i : Nat) (h : i < (shrink.loop n a).size) :
(shrink.loop n a)[i] = a[i]'(by simp at h; omega) := by
induction n generalizing a i with
| zero => simp [take.loop]
| zero => simp [shrink.loop]
| succ n ih =>
simp [take.loop, ih]
simp [shrink.loop, ih]
@[simp] theorem size_take (a : Array α) (n : Nat) : (a.take n).size = min n a.size := by
simp [take]
@[simp] theorem size_shrink (a : Array α) (n : Nat) : (a.shrink n).size = min n a.size := by
simp [shrink]
omega
@[simp] theorem getElem_take (a : Array α) (n : Nat) (i : Nat) (h : i < (a.take n).size) :
(a.take n)[i] = a[i]'(by simp at h; omega) := by
simp [take]
@[simp] theorem getElem_shrink (a : Array α) (n : Nat) (i : Nat) (h : i < (a.shrink n).size) :
(a.shrink n)[i] = a[i]'(by simp at h; omega) := by
simp [shrink]
@[simp] theorem toList_take (a : Array α) (n : Nat) : (a.take n).toList = a.toList.take n := by
@[simp] theorem toList_shrink (a : Array α) (n : Nat) : (a.shrink n).toList = a.toList.take n := by
apply List.ext_getElem <;> simp
@[simp] theorem shrink_eq_take (a : Array α) (n : Nat) : a.shrink n = a.take n := by
ext <;> simp
/-! ### forIn -/
@[simp] theorem forIn_toList [Monad m] (as : Array α) (b : β) (f : α β m (ForInStep β)) :
@@ -3547,23 +3569,23 @@ theorem eraseIdx_eq_eraseIdxIfInBounds {a : Array α} {i : Nat} (h : i < a.size)
/-! ### zipWith -/
@[simp] theorem toList_zipWith (f : α β γ) (as : Array α) (bs : Array β) :
(Array.zipWith as bs f).toList = List.zipWith f as.toList bs.toList := by
(zipWith f as bs).toList = List.zipWith f as.toList bs.toList := by
cases as
cases bs
simp
@[simp] theorem toList_zip (as : Array α) (bs : Array β) :
(Array.zip as bs).toList = List.zip as.toList bs.toList := by
(zip as bs).toList = List.zip as.toList bs.toList := by
simp [zip, toList_zipWith, List.zip]
@[simp] theorem toList_zipWithAll (f : Option α Option β γ) (as : Array α) (bs : Array β) :
(Array.zipWithAll as bs f).toList = List.zipWithAll f as.toList bs.toList := by
(zipWithAll f as bs).toList = List.zipWithAll f as.toList bs.toList := by
cases as
cases bs
simp
@[simp] theorem size_zipWith (as : Array α) (bs : Array β) (f : α β γ) :
(as.zipWith bs f).size = min as.size bs.size := by
(zipWith f as bs).size = min as.size bs.size := by
rw [size_eq_length_toList, toList_zipWith, List.length_zipWith]
@[simp] theorem size_zip (as : Array α) (bs : Array β) :
@@ -3571,8 +3593,8 @@ theorem eraseIdx_eq_eraseIdxIfInBounds {a : Array α} {i : Nat} (h : i < a.size)
as.size_zipWith bs Prod.mk
@[simp] theorem getElem_zipWith (as : Array α) (bs : Array β) (f : α β γ) (i : Nat)
(hi : i < (as.zipWith bs f).size) :
(as.zipWith bs f)[i] = f (as[i]'(by simp at hi; omega)) (bs[i]'(by simp at hi; omega)) := by
(hi : i < (zipWith f as bs).size) :
(zipWith f as bs)[i] = f (as[i]'(by simp at hi; omega)) (bs[i]'(by simp at hi; omega)) := by
cases as
cases bs
simp
@@ -3633,11 +3655,6 @@ theorem toListRev_toArray (l : List α) : l.toArray.toListRev = l.reverse := by
theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray.size) :
l.toArray.uset i a h = (l.set i.toNat a).toArray := by simp
@[simp] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
l.toArray.swap i j hi hj = ((l.set i l[j]).set j l[i]).toArray := by
apply ext'
simp
@[simp] theorem modify_toArray (f : α α) (l : List α) :
l.toArray.modify i f = (l.modify f i).toArray := by
apply ext'
@@ -3652,34 +3669,14 @@ theorem uset_toArray (l : List α) (i : USize) (a : α) (h : i.toNat < l.toArray
apply ext'
simp
@[simp] theorem toArray_range' (start size step : Nat) :
(range' start size step).toArray = Array.range' start size step := by
apply ext'
simp
@[simp] theorem toArray_ofFn (f : Fin n α) : (ofFn f).toArray = Array.ofFn f := by
ext <;> simp
@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
l.toArray.eraseIdx i h = (l.eraseIdx i).toArray := by
rw [Array.eraseIdx]
split <;> rename_i h'
· rw [eraseIdx_toArray]
simp only [swap_toArray, Fin.getElem_fin, toList_toArray, mk.injEq]
rw [eraseIdx_set_gt (by simp), eraseIdx_set_eq]
simp
· simp at h h'
have t : i = l.length - 1 := by omega
simp [t]
termination_by l.length - i
decreasing_by
rename_i h
simp at h
simp
omega
@[simp] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
l.toArray.eraseIdxIfInBounds i = (l.eraseIdx i).toArray := by
rw [Array.eraseIdxIfInBounds]
split
· simp
· simp_all [eraseIdx_eq_self.2]
end List
namespace Array
@@ -3793,6 +3790,27 @@ namespace List
as.toArray.unzip = Prod.map List.toArray List.toArray as.unzip := by
ext1 <;> simp
@[simp] theorem firstM_toArray [Alternative m] (as : List α) (f : α m β) :
as.toArray.firstM f = as.firstM f := by
unfold Array.firstM
suffices i, i as.length firstM.go f as.toArray (as.length - i) = firstM f (as.drop (as.length - i)) by
specialize this as.length
simpa
intro i
induction i with
| zero => simp [firstM.go]
| succ i ih =>
unfold firstM.go
split <;> rename_i h
· rw [drop_eq_getElem_cons h]
intro h'
specialize ih (by omega)
have : as.length - (i + 1) + 1 = as.length - i := by omega
simp_all [ih]
· simp only [size_toArray, Nat.not_lt] at h
have : as.length = 0 := by omega
simp_all
end List
namespace Array

View File

@@ -48,9 +48,11 @@ theorem mapFinIdx_spec (as : Array α) (f : (i : Nat) → α → (h : i < as.siz
(a.mapFinIdx f).size = a.size :=
(mapFinIdx_spec (p := fun _ _ _ => True) (hs := fun _ _ => trivial)).1
@[simp] theorem size_zipWithIndex (as : Array α) : as.zipWithIndex.size = as.size :=
@[simp] theorem size_zipIdx (as : Array α) (k : Nat) : (as.zipIdx k).size = as.size :=
Array.size_mapFinIdx _ _
@[deprecated size_zipIdx (since := "2025-01-21")] abbrev size_zipWithIndex := @size_zipIdx
@[simp] theorem getElem_mapFinIdx (a : Array α) (f : (i : Nat) α (h : i < a.size) β) (i : Nat)
(h : i < (mapFinIdx a f).size) :
(a.mapFinIdx f)[i] = f i (a[i]'(by simp_all)) (by simp_all) :=
@@ -115,34 +117,58 @@ end List
namespace Array
/-! ### zipWithIndex -/
/-! ### zipIdx -/
@[simp] theorem getElem_zipWithIndex (a : Array α) (i : Nat) (h : i < a.zipWithIndex.size) :
(a.zipWithIndex)[i] = (a[i]'(by simp_all), i) := by
simp [zipWithIndex]
@[simp] theorem getElem_zipIdx (a : Array α) (k : Nat) (i : Nat) (h : i < (a.zipIdx k).size) :
(a.zipIdx k)[i] = (a[i]'(by simp_all), k + i) := by
simp [zipIdx]
@[simp] theorem zipWithIndex_toArray {l : List α} :
l.toArray.zipWithIndex = (l.enum.map fun (i, x) => (x, i)).toArray := by
ext i hi₁ hi₂ <;> simp
@[deprecated getElem_zipIdx (since := "2025-01-21")]
abbrev getElem_zipWithIndex := @getElem_zipIdx
@[simp] theorem toList_zipWithIndex (a : Array α) :
a.zipWithIndex.toList = a.toList.enum.map (fun (i, a) => (a, i)) := by
@[simp] theorem zipIdx_toArray {l : List α} {k : Nat} :
l.toArray.zipIdx k = (l.zipIdx k).toArray := by
ext i hi₁ hi₂ <;> simp [Nat.add_comm]
@[deprecated zipIdx_toArray (since := "2025-01-21")]
abbrev zipWithIndex_toArray := @zipIdx_toArray
@[simp] theorem toList_zipIdx (a : Array α) (k : Nat) :
(a.zipIdx k).toList = a.toList.zipIdx k := by
rcases a with a
simp
theorem mk_mem_zipWithIndex_iff_getElem? {x : α} {i : Nat} {l : Array α} :
(x, i) l.zipWithIndex l[i]? = x := by
rcases l with l
simp only [zipWithIndex_toArray, mem_toArray, List.mem_map, Prod.mk.injEq, Prod.exists,
List.mk_mem_enum_iff_getElem?, List.getElem?_toArray]
constructor
· rintro a, b, h, rfl, rfl
exact h
· intro h
exact i, x, by simp [h]
@[deprecated toList_zipIdx (since := "2025-01-21")]
abbrev toList_zipWithIndex := @toList_zipIdx
theorem mem_enum_iff_getElem? {x : α × Nat} {l : Array α} : x l.zipWithIndex l[x.2]? = some x.1 :=
mk_mem_zipWithIndex_iff_getElem?
theorem mk_mem_zipIdx_iff_le_and_getElem?_sub {k i : Nat} {x : α} {l : Array α} :
(x, i) zipIdx l k k i l[i - k]? = some x := by
rcases l with l
simp [List.mk_mem_zipIdx_iff_le_and_getElem?_sub]
/-- Variant of `mk_mem_zipIdx_iff_le_and_getElem?_sub` specialized at `k = 0`,
to avoid the inequality and the subtraction. -/
theorem mk_mem_zipIdx_iff_getElem? {x : α} {i : Nat} {l : Array α} :
(x, i) l.zipIdx l[i]? = x := by
rw [mk_mem_zipIdx_iff_le_and_getElem?_sub]
simp
theorem mem_zipIdx_iff_le_and_getElem?_sub {x : α × Nat} {l : Array α} {k : Nat} :
x zipIdx l k k x.2 l[x.2 - k]? = some x.1 := by
cases x
simp [mk_mem_zipIdx_iff_le_and_getElem?_sub]
/-- Variant of `mem_zipIdx_iff_le_and_getElem?_sub` specialized at `k = 0`,
to avoid the inequality and the subtraction. -/
theorem mem_zipIdx_iff_getElem? {x : α × Nat} {l : Array α} :
x l.zipIdx l[x.2]? = some x.1 := by
rw [mk_mem_zipIdx_iff_getElem?]
@[deprecated mk_mem_zipIdx_iff_getElem? (since := "2025-01-21")]
abbrev mk_mem_zipWithIndex_iff_getElem? := @mk_mem_zipIdx_iff_getElem?
@[deprecated mem_zipIdx_iff_getElem? (since := "2025-01-21")]
abbrev mem_zipWithIndex_iff_getElem? := @mem_zipIdx_iff_getElem?
/-! ### mapFinIdx -/
@@ -179,12 +205,15 @@ theorem mapFinIdx_singleton {a : α} {f : (i : Nat) → α → (h : i < 1) →
#[a].mapFinIdx f = #[f 0 a (by simp)] := by
simp
theorem mapFinIdx_eq_zipWithIndex_map {l : Array α} {f : (i : Nat) α (h : i < l.size) β} :
l.mapFinIdx f = l.zipWithIndex.attach.map
theorem mapFinIdx_eq_zipIdx_map {l : Array α} {f : (i : Nat) α (h : i < l.size) β} :
l.mapFinIdx f = l.zipIdx.attach.map
fun x, i, m =>
f i x (by simp [mk_mem_zipWithIndex_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
f i x (by simp [mk_mem_zipIdx_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
ext <;> simp
@[deprecated mapFinIdx_eq_zipIdx_map (since := "2025-01-21")]
abbrev mapFinIdx_eq_zipWithIndex_map := @mapFinIdx_eq_zipIdx_map
@[simp]
theorem mapFinIdx_eq_empty_iff {l : Array α} {f : (i : Nat) α (h : i < l.size) β} :
l.mapFinIdx f = #[] l = #[] := by
@@ -285,10 +314,13 @@ theorem mapIdx_eq_mapFinIdx {l : Array α} {f : Nat → α → β} :
l.mapIdx f = l.mapFinIdx (fun i a _ => f i a) := by
simp [mapFinIdx_eq_mapIdx]
theorem mapIdx_eq_zipWithIndex_map {l : Array α} {f : Nat α β} :
l.mapIdx f = l.zipWithIndex.map fun a, i => f i a := by
theorem mapIdx_eq_zipIdx_map {l : Array α} {f : Nat α β} :
l.mapIdx f = l.zipIdx.map fun a, i => f i a := by
ext <;> simp
@[deprecated mapIdx_eq_zipIdx_map (since := "2025-01-21")]
abbrev mapIdx_eq_zipWithIndex_map := @mapIdx_eq_zipIdx_map
theorem mapIdx_append {K L : Array α} :
(K ++ L).mapIdx f = K.mapIdx f ++ L.mapIdx fun i => f (i + K.size) := by
rcases K with K

View File

@@ -20,6 +20,12 @@ open Nat
/-! ### mapM -/
@[simp] theorem mapM_append [Monad m] [LawfulMonad m] (f : α m β) {l₁ l₂ : Array α} :
(l₁ ++ l₂).mapM f = (return ( l₁.mapM f) ++ ( l₂.mapM f)) := by
rcases l₁ with l₁
rcases l₂ with l₂
simp
theorem mapM_eq_foldlM_push [Monad m] [LawfulMonad m] (f : α m β) (l : Array α) :
mapM f l = l.foldlM (fun acc a => return (acc.push ( f a))) #[] := by
rcases l with l
@@ -37,58 +43,85 @@ theorem mapM_eq_foldlM_push [Monad m] [LawfulMonad m] (f : α → m β) (l : Arr
/-! ### foldlM and foldrM -/
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : Array β₁) (init : α) :
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : Array β₁) (init : α) (w : stop = l.size) :
(l.map f).foldlM g init 0 stop = l.foldlM (fun x y => g x (f y)) init 0 stop := by
subst w
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ β₂) (g : β₂ α m α) (l : Array β₁)
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
(init : α) (w : start = l.size) :
(l.map f).foldrM g init start 0 = l.foldrM (fun x y => g (f x) y) init start 0 := by
subst w
cases l
rw [List.map_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_map]
theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : γ β m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldlM g init =
theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : γ β m γ)
(l : Array α) (init : γ) (w : stop = (l.filterMap f).size) :
(l.filterMap f).foldlM g init 0 stop =
l.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
subst w
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filterMap]
rfl
theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : β γ m γ) (l : Array α) (init : γ) :
(l.filterMap f).foldrM g init =
theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : β γ m γ)
(l : Array α) (init : γ) (w : start = (l.filterMap f).size) :
(l.filterMap f).foldrM g init start 0 =
l.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
subst w
cases l
rw [List.filterMap_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filterMap]
rfl
theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : β α m β) (l : Array α) (init : β) :
(l.filter p).foldlM g init =
theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : β α m β)
(l : Array α) (init : β) (w : stop = (l.filter p).size) :
(l.filter p).foldlM g init 0 stop =
l.foldlM (fun x y => if p y then g x y else pure x) init := by
subst w
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_filter]
theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : α β m β) (l : Array α) (init : β) :
(l.filter p).foldrM g init =
theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : α β m β)
(l : Array α) (init : β) (w : start = (l.filter p).size) :
(l.filter p).foldrM g init start 0 =
l.foldrM (fun x y => if p x then g x y else pure y) init := by
subst w
cases l
rw [List.filter_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldrM_filter]
@[simp] theorem foldlM_attachWith [Monad m]
(l : Array α) {q : α Prop} (H : a, a l q a) {f : β { x // q x} m β} {b} (w : stop = l.size):
(l.attachWith q H).foldlM f b 0 stop =
l.attach.foldlM (fun b a, h => f b a, H _ h) b := by
subst w
rcases l with l
simp [List.foldlM_map]
@[simp] theorem foldrM_attachWith [Monad m] [LawfulMonad m]
(l : Array α) {q : α Prop} (H : a, a l q a) {f : { x // q x} β m β} {b} (w : start = l.size):
(l.attachWith q H).foldrM f b start 0 =
l.attach.foldrM (fun a acc => f a.1, H _ a.2 acc) b := by
subst w
rcases l with l
simp [List.foldrM_map]
/-! ### forM -/
@[congr] theorem forM_congr [Monad m] {as bs : Array α} (w : as = bs)
{f : α m PUnit} :
forM f as = forM f bs := by
forM as f = forM bs f := by
cases as <;> cases bs
simp_all
@[simp] theorem forM_append [Monad m] [LawfulMonad m] (l₁ l₂ : Array α) (f : α m PUnit) :
forM (l₁ ++ l₂) f = (do forM l₁ f; forM l₂ f) := by
rcases l₁ with l₁
rcases l₂ with l₂
simp
@[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : Array α) (g : α β) (f : β m PUnit) :
(l.map g).forM f = l.forM (fun a => f (g a)) := by
forM (l.map g) f = forM l (fun a => f (g a)) := by
cases l
simp
@@ -115,9 +148,7 @@ theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
| .yield b => f a m b
| .done b => pure (.done b)) (ForInStep.yield init) := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp only [List.forIn'_toArray, List.forIn'_eq_foldlM, List.attachWith_mem_toArray, size_toArray,
List.length_map, List.length_attach, List.foldlM_toArray', List.foldlM_map]
simp [List.forIn'_eq_foldlM, List.foldlM_map]
congr
/-- We can express a for loop over an array which always yields as a fold. -/
@@ -126,7 +157,6 @@ theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
forIn' l init (fun a m b => (fun c => .yield (g a m b c)) <$> f a m b) =
l.attach.foldlM (fun b a, m => g a m b <$> f a m b) init := by
cases l
rw [List.attach_toArray] -- Why doesn't this fire via `simp`?
simp [List.foldlM_map]
theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
@@ -191,4 +221,59 @@ theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
cases l
simp
/-! ### Recognizing higher order functions using a function that only depends on the value. -/
/--
This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldlM_subtype [Monad m] {p : α Prop} {l : Array { x // p x }}
{f : β { x // p x } m β} {g : β α m β} {x : β}
(hf : b x h, f b x, h = g b x) (w : stop = l.size) :
l.foldlM f x 0 stop = l.unattach.foldlM g x 0 stop := by
subst w
rcases l with l
simp
rw [List.foldlM_subtype hf]
/--
This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldrM_subtype [Monad m] [LawfulMonad m] {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } β m β} {g : α β m β} {x : β}
(hf : x h b, f x, h b = g x b) (w : start = l.size) :
l.foldrM f x start 0 = l.unattach.foldrM g x start 0:= by
subst w
rcases l with l
simp
rw [List.foldrM_subtype hf]
/--
This lemma identifies monadic maps over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem mapM_subtype [Monad m] [LawfulMonad m] {p : α Prop} {l : Array { x // p x }}
{f : { x // p x } m β} {g : α m β} (hf : x h, f x, h = g x) :
l.mapM f = l.unattach.mapM g := by
rcases l with l
simp
rw [List.mapM_subtype hf]
-- Without `filterMapM_toArray` relating `filterMapM` on `List` and `Array` we can't prove this yet:
-- @[simp] theorem filterMapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : Array { x // p x }}
-- {f : { x // p x } → m (Option β)} {g : α → m (Option β)} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
-- l.filterMapM f = l.unattach.filterMapM g := by
-- rcases l with ⟨l⟩
-- simp
-- rw [List.filterMapM_subtype hf]
-- Without `flatMapM_toArray` relating `flatMapM` on `List` and `Array` we can't prove this yet:
-- @[simp] theorem flatMapM_subtype [Monad m] [LawfulMonad m] {p : α → Prop} {l : Array { x // p x }}
-- {f : { x // p x } → m (Array β)} {g : α → m (Array β)} (hf : ∀ x h, f ⟨x, h⟩ = g x) :
-- (l.flatMapM f) = l.unattach.flatMapM g := by
-- rcases l with ⟨l⟩
-- simp
-- rw [List.flatMapM_subtype hf]
end Array

View File

@@ -0,0 +1,30 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.List.OfFn
/-!
# Theorems about `Array.ofFn`
-/
namespace Array
@[simp]
theorem ofFn_eq_empty_iff {f : Fin n α} : ofFn f = #[] n = 0 := by
rw [ Array.toList_inj]
simp
@[simp 500]
theorem mem_ofFn {n} (f : Fin n α) (a : α) : a ofFn f i, f i = a := by
constructor
· intro w
obtain i, h, rfl := getElem_of_mem w
exact i, by simpa using h, by simp
· rintro i, rfl
apply mem_of_getElem (i := i) <;> simp
end Array

View File

@@ -0,0 +1,297 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.Lemmas
import Init.Data.Array.OfFn
import Init.Data.Array.MapIdx
import Init.Data.Array.Zip
import Init.Data.List.Nat.Range
/-!
# Lemmas about `Array.range'`, `Array.range`, and `Array.zipIdx`
-/
namespace Array
open Nat
/-! ## Ranges and enumeration -/
/-! ### range' -/
theorem range'_succ (s n step) : range' s (n + 1) step = #[s] ++ range' (s + step) n step := by
rw [ toList_inj]
simp [List.range'_succ]
@[simp] theorem range'_eq_empty_iff : range' s n step = #[] n = 0 := by
rw [ size_eq_zero, size_range']
theorem range'_ne_empty_iff (s : Nat) {n step : Nat} : range' s n step #[] n 0 := by
cases n <;> simp
@[simp] theorem range'_zero : range' s 0 step = #[] := by
simp
@[simp] theorem range'_one {s step : Nat} : range' s 1 step = #[s] := rfl
@[simp] theorem range'_inj : range' s n = range' s' n' n = n' (n = 0 s = s') := by
rw [ toList_inj]
simp [List.range'_inj]
theorem mem_range' {n} : m range' s n step i < n, m = s + step * i := by
simp [range']
constructor
· rintro i, w, h, h'
exact i, w, by simp_all
· rintro i, w, h'
exact i, w, by simp_all
theorem pop_range' : (range' s n step).pop = range' s (n - 1) step := by
ext <;> simp
theorem map_add_range' (a) (s n step) : map (a + ·) (range' s n step) = range' (a + s) n step := by
ext <;> simp <;> omega
theorem range'_succ_left : range' (s + 1) n step = (range' s n step).map (· + 1) := by
ext <;> simp <;> omega
theorem range'_append (s m n step : Nat) :
range' s m step ++ range' (s + step * m) n step = range' s (m + n) step := by
ext i h₁ h₂
· simp
· simp only [size_append, size_range'] at h₁ h₂
simp only [getElem_append, size_range', getElem_range', Nat.mul_sub_left_distrib, dite_eq_ite,
ite_eq_left_iff, Nat.not_lt]
intro h
have : step * m step * i := by exact mul_le_mul_left step h
omega
@[simp] theorem range'_append_1 (s m n : Nat) :
range' s m ++ range' (s + m) n = range' s (m + n) := by simpa using range'_append s m n 1
theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ #[s + step * n] := by
exact (range'_append s n 1 step).symm
theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ #[s + n] := by
simp [range'_concat]
@[simp] theorem mem_range'_1 : m range' s n s m m < s + n := by
simp [mem_range']; exact
fun i, h, e => e Nat.le_add_right .., Nat.add_lt_add_left h _,
fun h₁, h₂ => m - s, Nat.sub_lt_left_of_lt_add h₁ h₂, (Nat.add_sub_cancel' h₁).symm
theorem map_sub_range' (a s n : Nat) (h : a s) :
map (· - a) (range' s n step) = range' (s - a) n step := by
conv => lhs; rw [ Nat.add_sub_cancel' h]
rw [ map_add_range', map_map, (?_ : __ = _), map_id]
funext x; apply Nat.add_sub_cancel_left
@[simp] theorem range'_eq_singleton_iff {s n a : Nat} : range' s n = #[a] s = a n = 1 := by
rw [ toList_inj]
simp
theorem range'_eq_append_iff : range' s n = xs ++ ys k, k n xs = range' s k ys = range' (s + k) (n - k) := by
simp [ toList_inj, List.range'_eq_append_iff]
@[simp] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat Bool} :
(range' s n).find? p = some i p i i range' s n j, s j j < i !p j := by
rw [ List.toArray_range']
simp only [List.find?_toArray, mem_toArray]
simp [List.find?_range'_eq_some]
@[simp] theorem find?_range'_eq_none {s n : Nat} {p : Nat Bool} :
(range' s n).find? p = none i, s i i < s + n !p i := by
rw [ List.toArray_range']
simp only [List.find?_toArray]
simp
theorem erase_range' :
(range' s n).erase i =
range' s (min n (i - s)) ++ range' (max s (i + 1)) (min s (i + 1) + n - (i + 1)) := by
simp only [ List.toArray_range', List.erase_toArray]
simp [List.erase_range']
/-! ### range -/
theorem range_eq_range' (n : Nat) : range n = range' 0 n := by
simp [range, range']
theorem range_succ_eq_map (n : Nat) : range (n + 1) = #[0] ++ map succ (range n) := by
ext i h₁ h₂
· simp
omega
· simp only [getElem_range, getElem_append, size_toArray, List.length_cons, List.length_nil,
Nat.zero_add, lt_one_iff, List.getElem_toArray, List.getElem_singleton, getElem_map,
succ_eq_add_one, dite_eq_ite]
split <;> omega
theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) := by
rw [range_eq_range', map_add_range']; rfl
@[simp] theorem range_eq_empty_iff {n : Nat} : range n = #[] n = 0 := by
rw [ size_eq_zero, size_range]
theorem range_ne_empty_iff {n : Nat} : range n #[] n 0 := by
cases n <;> simp
theorem range_succ (n : Nat) : range (succ n) = range n ++ #[n] := by
ext i h₁ h₂
· simp
· simp only [succ_eq_add_one, size_range] at h₁
simp only [succ_eq_add_one, getElem_range, append_singleton, getElem_push, size_range,
dite_eq_ite]
split <;> omega
theorem range_add (a b : Nat) : range (a + b) = range a ++ (range b).map (a + ·) := by
rw [ range'_eq_map_range]
simpa [range_eq_range', Nat.add_comm] using (range'_append_1 0 a b).symm
theorem reverse_range' (s n : Nat) : reverse (range' s n) = map (s + n - 1 - ·) (range n) := by
simp [ toList_inj, List.reverse_range']
@[simp]
theorem mem_range {m n : Nat} : m range n m < n := by
simp only [range_eq_range', mem_range'_1, Nat.zero_le, true_and, Nat.zero_add]
theorem not_mem_range_self {n : Nat} : n range n := by simp
theorem self_mem_range_succ (n : Nat) : n range (n + 1) := by simp
@[simp] theorem take_range (m n : Nat) : take (range n) m = range (min m n) := by
ext <;> simp
@[simp] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat Bool} :
(range n).find? p = some i p i i range n j, j < i !p j := by
simp [range_eq_range']
@[simp] theorem find?_range_eq_none {n : Nat} {p : Nat Bool} :
(range n).find? p = none i, i < n !p i := by
simp only [ List.toArray_range, List.find?_toArray, List.find?_range_eq_none]
theorem erase_range : (range n).erase i = range (min n i) ++ range' (i + 1) (n - (i + 1)) := by
simp [range_eq_range', erase_range']
/-! ### zipIdx -/
@[simp]
theorem zipIdx_eq_empty_iff {l : Array α} {n : Nat} : l.zipIdx n = #[] l = #[] := by
cases l
simp
@[simp]
theorem getElem?_zipIdx (l : Array α) (n m) : (zipIdx l n)[m]? = l[m]?.map fun a => (a, n + m) := by
simp [getElem?_def]
theorem map_snd_add_zipIdx_eq_zipIdx (l : Array α) (n k : Nat) :
map (Prod.map id (· + n)) (zipIdx l k) = zipIdx l (n + k) :=
ext_getElem? fun i by simp [(· ·), Nat.add_comm, Nat.add_left_comm]; rfl
@[simp]
theorem zipIdx_map_snd (n) (l : Array α) : map Prod.snd (zipIdx l n) = range' n l.size := by
cases l
simp
@[simp]
theorem zipIdx_map_fst (n) (l : Array α) : map Prod.fst (zipIdx l n) = l := by
cases l
simp
theorem zipIdx_eq_zip_range' (l : Array α) {n : Nat} : l.zipIdx n = l.zip (range' n l.size) := by
simp [zip_of_prod (zipIdx_map_fst _ _) (zipIdx_map_snd _ _)]
@[simp]
theorem unzip_zipIdx_eq_prod (l : Array α) {n : Nat} :
(l.zipIdx n).unzip = (l, range' n l.size) := by
simp only [zipIdx_eq_zip_range', unzip_zip, size_range']
/-- Replace `zipIdx` with a starting index `n+1` with `zipIdx` starting from `n`,
followed by a `map` increasing the indices by one. -/
theorem zipIdx_succ (l : Array α) (n : Nat) :
l.zipIdx (n + 1) = (l.zipIdx n).map (fun a, i => (a, i + 1)) := by
cases l
simp [List.zipIdx_succ]
/-- Replace `zipIdx` with a starting index with `zipIdx` starting from 0,
followed by a `map` increasing the indices. -/
theorem zipIdx_eq_map_add (l : Array α) (n : Nat) :
l.zipIdx n = l.zipIdx.map (fun a, i => (a, n + i)) := by
cases l
simp only [zipIdx_toArray, List.map_toArray, mk.injEq]
rw [List.zipIdx_eq_map_add]
@[simp]
theorem zipIdx_singleton (x : α) (k : Nat) : zipIdx #[x] k = #[(x, k)] :=
rfl
theorem mk_add_mem_zipIdx_iff_getElem? {k i : Nat} {x : α} {l : Array α} :
(x, k + i) zipIdx l k l[i]? = some x := by
simp [mem_iff_getElem?, and_left_comm]
theorem le_snd_of_mem_zipIdx {x : α × Nat} {k : Nat} {l : Array α} (h : x zipIdx l k) :
k x.2 :=
(mk_mem_zipIdx_iff_le_and_getElem?_sub.1 h).1
theorem snd_lt_add_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x zipIdx l k) :
x.2 < k + l.size := by
rcases mem_iff_getElem.1 h with i, h', rfl
simpa using h'
theorem snd_lt_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x l.zipIdx k) : x.2 < l.size + k := by
simpa [Nat.add_comm] using snd_lt_add_of_mem_zipIdx h
theorem map_zipIdx (f : α β) (l : Array α) (k : Nat) :
map (Prod.map f id) (zipIdx l k) = zipIdx (l.map f) k := by
cases l
simp [List.map_zipIdx]
theorem fst_mem_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x zipIdx l k) : x.1 l :=
zipIdx_map_fst k l mem_map_of_mem _ h
theorem fst_eq_of_mem_zipIdx {x : α × Nat} {l : Array α} {k : Nat} (h : x zipIdx l k) :
x.1 = l[x.2 - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) := by
cases l
exact List.fst_eq_of_mem_zipIdx (by simpa using h)
theorem mem_zipIdx {x : α} {i : Nat} {xs : Array α} {k : Nat} (h : (x, i) xs.zipIdx k) :
k i i < k + xs.size
x = xs[i - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
le_snd_of_mem_zipIdx h, snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h
/-- Variant of `mem_zipIdx` specialized at `k = 0`. -/
theorem mem_zipIdx' {x : α} {i : Nat} {xs : Array α} (h : (x, i) xs.zipIdx) :
i < xs.size x = xs[i]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
by simpa using snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h
theorem zipIdx_map (l : Array α) (k : Nat) (f : α β) :
zipIdx (l.map f) k = (zipIdx l k).map (Prod.map f id) := by
cases l
simp [List.zipIdx_map]
theorem zipIdx_append (xs ys : Array α) (k : Nat) :
zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + xs.size) := by
cases xs
cases ys
simp [List.zipIdx_append]
theorem zipIdx_eq_append_iff {l : Array α} {k : Nat} :
zipIdx l k = l₁ ++ l₂
l₁' l₂', l = l₁' ++ l₂' l₁ = zipIdx l₁' k l₂ = zipIdx l₂' (k + l₁'.size) := by
rcases l with l
rcases l₁ with l₁
rcases l₂ with l₂
simp only [zipIdx_toArray, List.append_toArray, mk.injEq, List.zipIdx_eq_append_iff,
toArray_eq_append_iff]
constructor
· rintro l₁', l₂', rfl, rfl, rfl
exact l₁', l₂', by simp
· rintro l₁', l₂', rfl, h
simp only [zipIdx_toArray, mk.injEq, size_toArray] at h
obtain rfl, rfl := h
exact l₁', l₂', by simp
end Array

View File

@@ -0,0 +1,363 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.TakeDrop
import Init.Data.List.Zip
/-!
# Lemmas about `Array.zip`, `Array.zipWith`, `Array.zipWithAll`, and `Array.unzip`.
-/
namespace Array
open Nat
/-! ## Zippers -/
/-! ### zipWith -/
theorem zipWith_comm (f : α β γ) (la : Array α) (lb : Array β) :
zipWith f la lb = zipWith (fun b a => f a b) lb la := by
cases la
cases lb
simpa using List.zipWith_comm _ _ _
theorem zipWith_comm_of_comm (f : α α β) (comm : x y : α, f x y = f y x) (l l' : Array α) :
zipWith f l l' = zipWith f l' l := by
rw [zipWith_comm]
simp only [comm]
@[simp]
theorem zipWith_self (f : α α δ) (l : Array α) : zipWith f l l = l.map fun a => f a a := by
cases l
simp
/--
See also `getElem?_zipWith'` for a variant
using `Option.map` and `Option.bind` rather than a `match`.
-/
theorem getElem?_zipWith {f : α β γ} {i : Nat} :
(zipWith f as bs)[i]? = match as[i]?, bs[i]? with
| some a, some b => some (f a b) | _, _ => none := by
cases as
cases bs
simp [List.getElem?_zipWith]
rfl
/-- Variant of `getElem?_zipWith` using `Option.map` and `Option.bind` rather than a `match`. -/
theorem getElem?_zipWith' {f : α β γ} {i : Nat} :
(zipWith f l₁ l₂)[i]? = (l₁[i]?.map f).bind fun g => l₂[i]?.map g := by
cases l₁
cases l₂
simp [List.getElem?_zipWith']
theorem getElem?_zipWith_eq_some {f : α β γ} {l₁ : Array α} {l₂ : Array β} {z : γ} {i : Nat} :
(zipWith f l₁ l₂)[i]? = some z
x y, l₁[i]? = some x l₂[i]? = some y f x y = z := by
cases l₁
cases l₂
simp [List.getElem?_zipWith_eq_some]
theorem getElem?_zip_eq_some {l₁ : Array α} {l₂ : Array β} {z : α × β} {i : Nat} :
(zip l₁ l₂)[i]? = some z l₁[i]? = some z.1 l₂[i]? = some z.2 := by
cases z
rw [zip, getElem?_zipWith_eq_some]; constructor
· rintro x, y, h₀, h₁, h₂
simpa [h₀, h₁] using h₂
· rintro h₀, h₁
exact _, _, h₀, h₁, rfl
@[simp]
theorem zipWith_map {μ} (f : γ δ μ) (g : α γ) (h : β δ) (l₁ : Array α) (l₂ : Array β) :
zipWith f (l₁.map g) (l₂.map h) = zipWith (fun a b => f (g a) (h b)) l₁ l₂ := by
cases l₁
cases l₂
simp [List.zipWith_map]
theorem zipWith_map_left (l₁ : Array α) (l₂ : Array β) (f : α α') (g : α' β γ) :
zipWith g (l₁.map f) l₂ = zipWith (fun a b => g (f a) b) l₁ l₂ := by
cases l₁
cases l₂
simp [List.zipWith_map_left]
theorem zipWith_map_right (l₁ : Array α) (l₂ : Array β) (f : β β') (g : α β' γ) :
zipWith g l₁ (l₂.map f) = zipWith (fun a b => g a (f b)) l₁ l₂ := by
cases l₁
cases l₂
simp [List.zipWith_map_right]
theorem zipWith_foldr_eq_zip_foldr {f : α β γ} (i : δ):
(zipWith f l₁ l₂).foldr g i = (zip l₁ l₂).foldr (fun p r => g (f p.1 p.2) r) i := by
cases l₁
cases l₂
simp [List.zipWith_foldr_eq_zip_foldr]
theorem zipWith_foldl_eq_zip_foldl {f : α β γ} (i : δ):
(zipWith f l₁ l₂).foldl g i = (zip l₁ l₂).foldl (fun r p => g r (f p.1 p.2)) i := by
cases l₁
cases l₂
simp [List.zipWith_foldl_eq_zip_foldl]
@[simp]
theorem zipWith_eq_empty_iff {f : α β γ} {l l'} : zipWith f l l' = #[] l = #[] l' = #[] := by
cases l <;> cases l' <;> simp
theorem map_zipWith {δ : Type _} (f : α β) (g : γ δ α) (l : Array γ) (l' : Array δ) :
map f (zipWith g l l') = zipWith (fun x y => f (g x y)) l l' := by
cases l
cases l'
simp [List.map_zipWith]
theorem take_zipWith : (zipWith f l l').take n = zipWith f (l.take n) (l'.take n) := by
cases l
cases l'
simp [List.take_zipWith]
theorem extract_zipWith : (zipWith f l l').extract m n = zipWith f (l.extract m n) (l'.extract m n) := by
cases l
cases l'
simp [List.drop_zipWith, List.take_zipWith]
theorem zipWith_append (f : α β γ) (l la : Array α) (l' lb : Array β)
(h : l.size = l'.size) :
zipWith f (l ++ la) (l' ++ lb) = zipWith f l l' ++ zipWith f la lb := by
cases l
cases l'
cases la
cases lb
simp at h
simp [List.zipWith_append, h]
theorem zipWith_eq_append_iff {f : α β γ} {l₁ : Array α} {l₂ : Array β} :
zipWith f l₁ l₂ = l₁' ++ l₂'
w x y z, w.size = y.size l₁ = w ++ x l₂ = y ++ z l₁' = zipWith f w y l₂' = zipWith f x z := by
cases l₁
cases l₂
cases l₁'
cases l₂'
simp only [List.zipWith_toArray, List.append_toArray, mk.injEq, List.zipWith_eq_append_iff,
toArray_eq_append_iff]
constructor
· rintro w, x, y, z, h, rfl, rfl, rfl, rfl
exact w.toArray, x.toArray, y.toArray, z.toArray, by simp [h]
· rintro w, x, y, z, h, rfl, rfl, h₁, h₂
exact w, x, y, z, by simp_all
@[simp] theorem zipWith_mkArray {a : α} {b : β} {m n : Nat} :
zipWith f (mkArray m a) (mkArray n b) = mkArray (min m n) (f a b) := by
simp [ List.toArray_replicate]
theorem map_uncurry_zip_eq_zipWith (f : α β γ) (l : Array α) (l' : Array β) :
map (Function.uncurry f) (l.zip l') = zipWith f l l' := by
cases l
cases l'
simp [List.map_uncurry_zip_eq_zipWith]
theorem map_zip_eq_zipWith (f : α × β γ) (l : Array α) (l' : Array β) :
map f (l.zip l') = zipWith (Function.curry f) l l' := by
cases l
cases l'
simp [List.map_zip_eq_zipWith]
theorem lt_size_left_of_zipWith {f : α β γ} {i : Nat} {l : Array α} {l' : Array β}
(h : i < (zipWith f l l').size) : i < l.size := by rw [size_zipWith] at h; omega
theorem lt_size_right_of_zipWith {f : α β γ} {i : Nat} {l : Array α} {l' : Array β}
(h : i < (zipWith f l l').size) : i < l'.size := by rw [size_zipWith] at h; omega
theorem zipWith_eq_zipWith_take_min (l₁ : Array α) (l₂ : Array β) :
zipWith f l₁ l₂ = zipWith f (l₁.take (min l₁.size l₂.size)) (l₂.take (min l₁.size l₂.size)) := by
cases l₁
cases l₂
simp
rw [List.zipWith_eq_zipWith_take_min]
theorem reverse_zipWith (h : l.size = l'.size) :
(zipWith f l l').reverse = zipWith f l.reverse l'.reverse := by
cases l
cases l'
simp [List.reverse_zipWith (by simpa using h)]
/-! ### zip -/
theorem lt_size_left_of_zip {i : Nat} {l : Array α} {l' : Array β} (h : i < (zip l l').size) :
i < l.size :=
lt_size_left_of_zipWith h
theorem lt_size_right_of_zip {i : Nat} {l : Array α} {l' : Array β} (h : i < (zip l l').size) :
i < l'.size :=
lt_size_right_of_zipWith h
@[simp]
theorem getElem_zip {l : Array α} {l' : Array β} {i : Nat} {h : i < (zip l l').size} :
(zip l l')[i] =
(l[i]'(lt_size_left_of_zip h), l'[i]'(lt_size_right_of_zip h)) :=
getElem_zipWith (hi := by simpa using h)
theorem zip_eq_zipWith (l₁ : Array α) (l₂ : Array β) : zip l₁ l₂ = zipWith Prod.mk l₁ l₂ := by
cases l₁
cases l₂
simp [List.zip_eq_zipWith]
theorem zip_map (f : α γ) (g : β δ) (l₁ : Array α) (l₂ : Array β) :
zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g) := by
cases l₁
cases l₂
simp [List.zip_map]
theorem zip_map_left (f : α γ) (l₁ : Array α) (l₂ : Array β) :
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [ zip_map, map_id]
theorem zip_map_right (f : β γ) (l₁ : Array α) (l₂ : Array β) :
zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [ zip_map, map_id]
theorem zip_append {l₁ r₁ : Array α} {l₂ r₂ : Array β} (_h : l₁.size = l₂.size) :
zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂ := by
cases l₁
cases l₂
cases r₁
cases r₂
simp_all [List.zip_append]
theorem zip_map' (f : α β) (g : α γ) (l : Array α) :
zip (l.map f) (l.map g) = l.map fun a => (f a, g a) := by
cases l
simp [List.zip_map']
theorem of_mem_zip {a b} {l₁ : Array α} {l₂ : Array β} : (a, b) zip l₁ l₂ a l₁ b l₂ := by
cases l₁
cases l₂
simpa using List.of_mem_zip
theorem map_fst_zip (l₁ : Array α) (l₂ : Array β) (h : l₁.size l₂.size) :
map Prod.fst (zip l₁ l₂) = l₁ := by
cases l₁
cases l₂
simp_all [List.map_fst_zip]
theorem map_snd_zip (l₁ : Array α) (l₂ : Array β) (h : l₂.size l₁.size) :
map Prod.snd (zip l₁ l₂) = l₂ := by
cases l₁
cases l₂
simp_all [List.map_snd_zip]
theorem map_prod_left_eq_zip {l : Array α} (f : α β) :
(l.map fun x => (x, f x)) = l.zip (l.map f) := by
rw [ zip_map']
congr
simp
theorem map_prod_right_eq_zip {l : Array α} (f : α β) :
(l.map fun x => (f x, x)) = (l.map f).zip l := by
rw [ zip_map']
congr
simp
@[simp] theorem zip_eq_empty_iff {l₁ : Array α} {l₂ : Array β} :
zip l₁ l₂ = #[] l₁ = #[] l₂ = #[] := by
cases l₁
cases l₂
simp [List.zip_eq_nil_iff]
theorem zip_eq_append_iff {l₁ : Array α} {l₂ : Array β} :
zip l₁ l₂ = l₁' ++ l₂'
w x y z, w.size = y.size l₁ = w ++ x l₂ = y ++ z l₁' = zip w y l₂' = zip x z := by
simp [zip_eq_zipWith, zipWith_eq_append_iff]
@[simp] theorem zip_mkArray {a : α} {b : β} {m n : Nat} :
zip (mkArray m a) (mkArray n b) = mkArray (min m n) (a, b) := by
simp [ List.toArray_replicate]
theorem zip_eq_zip_take_min (l₁ : Array α) (l₂ : Array β) :
zip l₁ l₂ = zip (l₁.take (min l₁.size l₂.size)) (l₂.take (min l₁.size l₂.size)) := by
cases l₁
cases l₂
simp only [List.zip_toArray, size_toArray, List.take_toArray, mk.injEq]
rw [List.zip_eq_zip_take_min]
/-! ### zipWithAll -/
theorem getElem?_zipWithAll {f : Option α Option β γ} {i : Nat} :
(zipWithAll f as bs)[i]? = match as[i]?, bs[i]? with
| none, none => .none | a?, b? => some (f a? b?) := by
cases as
cases bs
simp [List.getElem?_zipWithAll]
rfl
theorem zipWithAll_map {μ} (f : Option γ Option δ μ) (g : α γ) (h : β δ) (l₁ : Array α) (l₂ : Array β) :
zipWithAll f (l₁.map g) (l₂.map h) = zipWithAll (fun a b => f (g <$> a) (h <$> b)) l₁ l₂ := by
cases l₁
cases l₂
simp [List.zipWithAll_map]
theorem zipWithAll_map_left (l₁ : Array α) (l₂ : Array β) (f : α α') (g : Option α' Option β γ) :
zipWithAll g (l₁.map f) l₂ = zipWithAll (fun a b => g (f <$> a) b) l₁ l₂ := by
cases l₁
cases l₂
simp [List.zipWithAll_map_left]
theorem zipWithAll_map_right (l₁ : Array α) (l₂ : Array β) (f : β β') (g : Option α Option β' γ) :
zipWithAll g l₁ (l₂.map f) = zipWithAll (fun a b => g a (f <$> b)) l₁ l₂ := by
cases l₁
cases l₂
simp [List.zipWithAll_map_right]
theorem map_zipWithAll {δ : Type _} (f : α β) (g : Option γ Option δ α) (l : Array γ) (l' : Array δ) :
map f (zipWithAll g l l') = zipWithAll (fun x y => f (g x y)) l l' := by
cases l
cases l'
simp [List.map_zipWithAll]
@[simp] theorem zipWithAll_replicate {a : α} {b : β} {n : Nat} :
zipWithAll f (mkArray n a) (mkArray n b) = mkArray n (f a b) := by
simp [ List.toArray_replicate]
/-! ### unzip -/
@[simp] theorem unzip_fst : (unzip l).fst = l.map Prod.fst := by
induction l <;> simp_all
@[simp] theorem unzip_snd : (unzip l).snd = l.map Prod.snd := by
induction l <;> simp_all
theorem unzip_eq_map (l : Array (α × β)) : unzip l = (l.map Prod.fst, l.map Prod.snd) := by
cases l
simp [List.unzip_eq_map]
theorem zip_unzip (l : Array (α × β)) : zip (unzip l).1 (unzip l).2 = l := by
cases l
simp only [List.unzip_toArray, Prod.map_fst, Prod.map_snd, List.zip_toArray, List.zip_unzip]
theorem unzip_zip_left {l₁ : Array α} {l₂ : Array β} (h : l₁.size l₂.size) :
(unzip (zip l₁ l₂)).1 = l₁ := by
cases l₁
cases l₂
simp_all only [size_toArray, List.zip_toArray, List.unzip_toArray, Prod.map_fst,
List.unzip_zip_left]
theorem unzip_zip_right {l₁ : Array α} {l₂ : Array β} (h : l₂.size l₁.size) :
(unzip (zip l₁ l₂)).2 = l₂ := by
cases l₁
cases l₂
simp_all only [size_toArray, List.zip_toArray, List.unzip_toArray, Prod.map_snd,
List.unzip_zip_right]
theorem unzip_zip {l₁ : Array α} {l₂ : Array β} (h : l₁.size = l₂.size) :
unzip (zip l₁ l₂) = (l₁, l₂) := by
cases l₁
cases l₂
simp_all only [size_toArray, List.zip_toArray, List.unzip_toArray, List.unzip_zip, Prod.map_apply]
theorem zip_of_prod {l : Array α} {l' : Array β} {lp : Array (α × β)} (hl : lp.map Prod.fst = l)
(hr : lp.map Prod.snd = l') : lp = l.zip l' := by
rw [ hl, hr, zip_unzip lp, unzip_fst, unzip_snd, zip_unzip, zip_unzip]
@[simp] theorem unzip_mkArray {n : Nat} {a : α} {b : β} :
unzip (mkArray n (a, b)) = (mkArray n a, mkArray n b) := by
ext1 <;> simp

View File

@@ -379,7 +379,8 @@ SMT-Lib name: `extract`.
def extractLsb (hi lo : Nat) (x : BitVec n) : BitVec (hi - lo + 1) := extractLsb' lo _ x
/--
A version of `setWidth` that requires a proof, but is a noop.
A version of `setWidth` that requires a proof the new width is at least as large,
and is a computational noop.
-/
def setWidth' {n w : Nat} (le : n w) (x : BitVec n) : BitVec w :=
x.toNat#'(by

View File

@@ -378,6 +378,16 @@ theorem getElem_ofBool {b : Bool} : (ofBool b)[0] = b := by simp
@[simp] theorem msb_ofBool (b : Bool) : (ofBool b).msb = b := by
cases b <;> simp [BitVec.msb]
@[simp] theorem one_eq_zero_iff : 1#w = 0#w w = 0 := by
constructor
· intro h
cases w
· rfl
· replace h := congrArg BitVec.toNat h
simp at h
· rintro rfl
simp
/-! ### msb -/
@[simp] theorem msb_zero : (0#w).msb = false := by simp [BitVec.msb, getMsbD]
@@ -420,6 +430,9 @@ theorem toNat_ge_of_msb_true {x : BitVec n} (p : BitVec.msb x = true) : x.toNat
simp only [Nat.add_sub_cancel]
exact p
theorem msb_eq_getMsbD_zero (x : BitVec w) : x.msb = x.getMsbD 0 := by
cases w <;> simp [getMsbD_eq_getLsbD, msb_eq_getLsbD_last]
/-! ### cast -/
@[simp, bv_toNat] theorem toNat_cast (h : w = v) (x : BitVec w) : (x.cast h).toNat = x.toNat := rfl
@@ -595,12 +608,6 @@ theorem zeroExtend_eq_setWidth {v : Nat} {x : BitVec w} :
(x.setWidth v).toFin = Fin.ofNat' (2^v) x.toNat := by
ext; simp
theorem setWidth'_eq {x : BitVec w} (h : w v) : x.setWidth' h = x.setWidth v := by
apply eq_of_toNat_eq
rw [toNat_setWidth, toNat_setWidth']
rw [Nat.mod_eq_of_lt]
exact Nat.lt_of_lt_of_le x.isLt (Nat.pow_le_pow_right (Nat.zero_lt_two) h)
@[simp] theorem setWidth_eq (x : BitVec n) : setWidth n x = x := by
apply eq_of_toNat_eq
let x, lt_n := x
@@ -655,10 +662,10 @@ theorem getElem?_setWidth (m : Nat) (x : BitVec n) (i : Nat) :
simp [getLsbD, toNat_setWidth']
@[simp] theorem getMsbD_setWidth' (ge : m n) (x : BitVec n) (i : Nat) :
getMsbD (setWidth' ge x) i = (decide (i m - n) && getMsbD x (i - (m - n))) := by
getMsbD (setWidth' ge x) i = (decide (m - n i) && getMsbD x (i + n - m)) := by
simp only [getMsbD, getLsbD_setWidth', gt_iff_lt]
by_cases h₁ : decide (i < m) <;> by_cases h₂ : decide (i m - n) <;> by_cases h₃ : decide (i - (m - n) < n) <;>
by_cases h₄ : n - 1 - (i - (m - n)) = m - 1 - i
by_cases h₁ : decide (i < m) <;> by_cases h₂ : decide (m - n i) <;> by_cases h₃ : decide (i + n - m < n) <;>
by_cases h₄ : n - 1 - (i + n - m) = m - 1 - i
all_goals
simp only [h₁, h₂, h₃, h₄]
simp_all only [ge_iff_le, decide_eq_true_eq, Nat.not_le, Nat.not_lt, Bool.true_and,
@@ -671,7 +678,7 @@ theorem getElem?_setWidth (m : Nat) (x : BitVec n) (i : Nat) :
getLsbD (setWidth m x) i = (decide (i < m) && getLsbD x i) := by
simp [getLsbD, toNat_setWidth, Nat.testBit_mod_two_pow]
theorem getMsbD_setWidth {m : Nat} {x : BitVec n} {i : Nat} :
@[simp] theorem getMsbD_setWidth {m : Nat} {x : BitVec n} {i : Nat} :
getMsbD (setWidth m x) i = (decide (m - n i) && getMsbD x (i + n - m)) := by
unfold setWidth
by_cases h : n m <;> simp only [h]
@@ -685,6 +692,15 @@ theorem getMsbD_setWidth {m : Nat} {x : BitVec n} {i : Nat} :
· simp [h']
omega
-- This is a simp lemma as there is only a runtime difference between `setWidth'` and `setWidth`,
-- and for verification purposes they are equivalent.
@[simp]
theorem setWidth'_eq {x : BitVec w} (h : w v) : x.setWidth' h = x.setWidth v := by
apply eq_of_toNat_eq
rw [toNat_setWidth, toNat_setWidth']
rw [Nat.mod_eq_of_lt]
exact Nat.lt_of_lt_of_le x.isLt (Nat.pow_le_pow_right (Nat.zero_lt_two) h)
@[simp] theorem getMsbD_setWidth_add {x : BitVec w} (h : k i) :
(x.setWidth (w + k)).getMsbD i = x.getMsbD (i - k) := by
by_cases h : w = 0
@@ -755,6 +771,22 @@ theorem setWidth_one {x : BitVec w} :
rw [Nat.mod_mod_of_dvd]
exact Nat.pow_dvd_pow_iff_le_right'.mpr h
/--
Iterated `setWidth` agrees with the second `setWidth`
except in the case the first `setWidth` is a non-trivial truncation,
and the second `setWidth` is a non-trivial extension.
-/
-- Note that in the special cases `v = u` or `v = w`,
-- `simp` can discharge the side condition itself.
@[simp] theorem setWidth_setWidth {x : BitVec u} {w v : Nat} (h : ¬ (v < u v < w)) :
setWidth w (setWidth v x) = setWidth w x := by
ext
simp_all only [getLsbD_setWidth, decide_true, Bool.true_and, Bool.and_iff_right_iff_imp,
decide_eq_true_eq]
intro h
replace h := lt_of_getLsbD h
omega
/-! ## extractLsb -/
@[simp]
@@ -905,6 +937,19 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· ||| · ) (0#n) where
ext i h
simp [h]
@[simp]
theorem or_eq_zero_iff {x y : BitVec w} : (x ||| y) = 0#w x = 0#w y = 0#w := by
constructor
· intro h
constructor
all_goals
· ext i ih
have := BitVec.eq_of_getLsbD_eq_iff.mp h i ih
simp only [getLsbD_or, getLsbD_zero, Bool.or_eq_false_iff] at this
simp [this]
· intro h
simp [h]
theorem extractLsb'_or {x y : BitVec w} {start len : Nat} :
(x ||| y).extractLsb' start len = (x.extractLsb' start len) ||| (y.extractLsb' start len) := by
ext i hi
@@ -988,6 +1033,20 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· &&& · ) (allOnes n) wher
ext i h
simp [h]
@[simp]
theorem and_eq_allOnes_iff {x y : BitVec w} :
x &&& y = allOnes w x = allOnes w y = allOnes w := by
constructor
· intro h
constructor
all_goals
· ext i ih
have := BitVec.eq_of_getLsbD_eq_iff.mp h i ih
simp only [getLsbD_and, getLsbD_allOnes, ih, decide_true, Bool.and_eq_true] at this
simp [this, ih]
· intro h
simp [h]
theorem extractLsb'_and {x y : BitVec w} {start len : Nat} :
(x &&& y).extractLsb' start len = (x.extractLsb' start len) &&& (y.extractLsb' start len) := by
ext i hi
@@ -1063,6 +1122,31 @@ instance : Std.LawfulCommIdentity (α := BitVec n) (· ^^^ · ) (0#n) where
ext i
simp
@[simp]
theorem xor_left_inj {x y : BitVec w} (z : BitVec w) : (x ^^^ z = y ^^^ z) x = y := by
constructor
· intro h
ext i ih
have := BitVec.eq_of_getLsbD_eq_iff.mp h i
simp only [getLsbD_xor, Bool.xor_left_inj] at this
exact this ih
· intro h
rw [h]
@[simp]
theorem xor_right_inj {x y : BitVec w} (z : BitVec w) : (z ^^^ x = z ^^^ y) x = y := by
rw [xor_comm z x, xor_comm z y]
exact xor_left_inj _
@[simp]
theorem xor_eq_zero_iff {x y : BitVec w} : (x ^^^ y = 0#w) x = y := by
constructor
· intro h
apply (xor_left_inj y).mp
rwa [xor_self]
· intro h
simp [h]
theorem extractLsb'_xor {x y : BitVec w} {start len : Nat} :
(x ^^^ y).extractLsb' start len = (x.extractLsb' start len) ^^^ (y.extractLsb' start len) := by
ext i hi
@@ -1164,6 +1248,14 @@ theorem not_not {b : BitVec w} : ~~~(~~~b) = b := by
ext i h
simp [h]
@[simp]
protected theorem not_inj {x y : BitVec w} : ~~~x = ~~~y x = y :=
fun h => by rw [ @not_not w x, @not_not w y, h], congrArg _
@[simp] theorem and_not_self (x : BitVec n) : x &&& ~~~x = 0 := by
ext i
simp_all
theorem not_eq_comm {x y : BitVec w} : ~~~ x = y x = ~~~ y := by
constructor
· intro h
@@ -1298,7 +1390,7 @@ theorem shiftLeftZeroExtend_eq {x : BitVec w} :
apply eq_of_toNat_eq
rw [shiftLeftZeroExtend, setWidth]
split
· simp
· simp only [toNat_ofNatLt, toNat_shiftLeft, toNat_setWidth']
rw [Nat.mod_eq_of_lt]
rw [Nat.shiftLeft_eq, Nat.pow_add]
exact Nat.mul_lt_mul_of_pos_right x.isLt (Nat.two_pow_pos _)
@@ -1322,11 +1414,15 @@ theorem shiftLeftZeroExtend_eq {x : BitVec w} :
@[simp] theorem getMsbD_shiftLeftZeroExtend (x : BitVec m) (n : Nat) :
getMsbD (shiftLeftZeroExtend x n) i = getMsbD x i := by
have : m + n - m i + n := by omega
have : i + n + m - (m + n) = i := by omega
simp_all [shiftLeftZeroExtend_eq]
@[simp] theorem msb_shiftLeftZeroExtend (x : BitVec w) (i : Nat) :
(shiftLeftZeroExtend x i).msb = x.msb := by
simp [shiftLeftZeroExtend_eq, BitVec.msb]
have : w + i - w i := by omega
have : i + w - (w + i) = 0 := by omega
simp_all [shiftLeftZeroExtend_eq, BitVec.msb]
theorem shiftLeft_add {w : Nat} (x : BitVec w) (n m : Nat) :
x <<< (n + m) = (x <<< n) <<< m := by
@@ -1377,6 +1473,11 @@ theorem shiftLeft_ofNat_eq {x : BitVec w} {k : Nat} : x <<< (BitVec.ofNat w k) =
/-! ### ushiftRight -/
@[simp] theorem ushiftRight_eq' (x : BitVec w₁) (y : BitVec w₂) :
x >>> y = x >>> y.toNat := by rfl
theorem ushiftRight_ofNat_eq {x : BitVec w} {k : Nat} : x >>> (BitVec.ofNat w k) = x >>> (k % 2^w) := rfl
@[simp, bv_toNat] theorem toNat_ushiftRight (x : BitVec n) (i : Nat) :
(x >>> i).toNat = x.toNat >>> i := rfl
@@ -1500,13 +1601,9 @@ theorem msb_ushiftRight {x : BitVec w} {n : Nat} :
case succ nn ih =>
simp [BitVec.ushiftRight_eq, getMsbD_ushiftRight, BitVec.msb, ih, show nn + 1 > 0 by omega]
/-! ### ushiftRight reductions from BitVec to Nat -/
@[simp]
theorem ushiftRight_eq' (x : BitVec w) (y : BitVec w₂) :
x >>> y = x >>> y.toNat := by rfl
theorem ushiftRight_ofNat_eq {x : BitVec w} {k : Nat} : x >>> (BitVec.ofNat w k) = x >>> (k % 2^w) := rfl
theorem ushiftRight_self (n : BitVec w) : n >>> n.toNat = 0#w := by
simp [BitVec.toNat_eq, Nat.shiftRight_eq_div_pow, Nat.lt_two_pow_self, Nat.div_eq_of_lt]
/-! ### sshiftRight -/
@@ -1888,8 +1985,9 @@ theorem getElem_append {x : BitVec n} {y : BitVec m} (h : i < n + m) :
@[simp] theorem getMsbD_append {x : BitVec n} {y : BitVec m} :
getMsbD (x ++ y) i = if n i then getMsbD y (i - n) else getMsbD x i := by
simp only [append_def]
have : i + m - (n + m) = i - n := by omega
by_cases h : n i
· simp [h]
· simp_all
· simp [h]
theorem msb_append {x : BitVec w} {y : BitVec v} :
@@ -2308,6 +2406,20 @@ theorem toNat_shiftConcat_lt_of_lt {x : BitVec w} {b : Bool} {k : Nat}
have := Bool.toNat_lt b
omega
theorem getElem_shiftConcat {x : BitVec w} {b : Bool} (h : i < w) :
(x.shiftConcat b)[i] = if i = 0 then b else x[i-1] := by
rw [ getLsbD_eq_getElem, getLsbD_shiftConcat, getLsbD_eq_getElem, decide_eq_true h, Bool.true_and]
@[simp]
theorem getElem_shiftConcat_zero {x : BitVec w} (b : Bool) (h : 0 < w) :
(x.shiftConcat b)[0] = b := by
simp [getElem_shiftConcat]
@[simp]
theorem getElem_shiftConcat_succ {x : BitVec w} {b : Bool} (h : i + 1 < w) :
(x.shiftConcat b)[i+1] = x[i] := by
simp [getElem_shiftConcat]
/-! ### add -/
theorem add_def {n} (x y : BitVec n) : x + y = .ofNat n (x.toNat + y.toNat) := rfl
@@ -2454,6 +2566,11 @@ theorem eq_sub_iff_add_eq {x y z : BitVec w} : x = z - y ↔ x + y = z := by
· simp [h, sub_add_cancel]
· simp [h, add_sub_cancel]
theorem sub_eq_iff_eq_add {x y z : BitVec w} : x - y = z x = z + y := by
apply Iff.intro <;> intro h
· simp [ h, sub_add_cancel]
· simp [h, add_sub_cancel]
theorem negOne_eq_allOnes : -1#w = allOnes w := by
apply eq_of_toNat_eq
if g : w = 0 then
@@ -2476,6 +2593,10 @@ theorem neg_neg {x : BitVec w} : - - x = x := by
· simp [h]
· simp [bv_toNat, h]
@[simp]
protected theorem neg_inj {x y : BitVec w} : -x = -y x = y :=
fun h => by rw [ @neg_neg w x, @neg_neg w y, h], congrArg _
theorem neg_ne_iff_ne_neg {x y : BitVec w} : -x y x -y := by
constructor
all_goals
@@ -2518,6 +2639,49 @@ theorem not_neg (x : BitVec w) : ~~~(-x) = x + -1#w := by
show (_ - x.toNat) % _ = _ by rw [Nat.mod_eq_of_lt (by omega)]]
omega
/- ### add/sub injectivity -/
@[simp]
protected theorem add_left_inj {x y : BitVec w} (z : BitVec w) : (x + z = y + z) x = y := by
apply Iff.intro
· intro p
rw [ add_sub_cancel x z, add_sub_cancel y z, p]
· exact congrArg (· + z)
@[simp]
protected theorem add_right_inj {x y : BitVec w} (z : BitVec w) : (z + x = z + y) x = y := by
simp [BitVec.add_comm z]
@[simp]
protected theorem sub_left_inj {x y : BitVec w} (z : BitVec w) : (x - z = y - z) x = y := by
simp [sub_toAdd]
@[simp]
protected theorem sub_right_inj {x y : BitVec w} (z : BitVec w) : (z - x = z - y) x = y := by
simp [sub_toAdd]
/-! ### add self -/
@[simp]
protected theorem add_left_eq_self {x y : BitVec w} : x + y = y x = 0#w := by
conv => lhs; rhs; rw [ BitVec.zero_add y]
exact BitVec.add_left_inj y
@[simp]
protected theorem add_right_eq_self {x y : BitVec w} : x + y = x y = 0#w := by
rw [BitVec.add_comm]
exact BitVec.add_left_eq_self
@[simp]
protected theorem self_eq_add_right {x y : BitVec w} : x = x + y y = 0#w := by
rw [Eq.comm]
exact BitVec.add_right_eq_self
@[simp]
protected theorem self_eq_add_left {x y : BitVec w} : x = y + x y = 0#w := by
rw [BitVec.add_comm]
exact BitVec.self_eq_add_right
/-! ### fill -/
@[simp]
@@ -2632,6 +2796,17 @@ theorem mul_eq_and {a b : BitVec 1} : a * b = a &&& b := by
have hb : b = 0 b = 1 := eq_zero_or_eq_one _
rcases ha with h | h <;> (rcases hb with h' | h' <;> (simp [h, h']))
@[simp] protected theorem neg_mul (x y : BitVec w) : -x * y = -(x * y) := by
apply eq_of_toInt_eq
simp [toInt_neg]
@[simp] protected theorem mul_neg (x y : BitVec w) : x * -y = -(x * y) := by
rw [BitVec.mul_comm, BitVec.neg_mul, BitVec.mul_comm]
protected theorem neg_mul_neg (x y : BitVec w) : -x * -y = x * y := by simp
protected theorem neg_mul_comm (x y : BitVec w) : -x * y = x * -y := by simp
/-! ### le and lt -/
@[bv_toNat] theorem le_def {x y : BitVec n} :
@@ -2702,6 +2877,40 @@ theorem not_lt_iff_le {x y : BitVec w} : (¬ x < y) ↔ y ≤ x := by
constructor <;>
(intro h; simp only [lt_def, Nat.not_lt, le_def] at h ; omega)
@[simp]
theorem not_lt_zero {x : BitVec w} : ¬x < 0#w := of_decide_eq_false rfl
@[simp]
theorem le_zero_iff {x : BitVec w} : x 0#w x = 0#w := by
constructor
· intro h
have : x 0 := not_lt_iff_le.mp not_lt_zero
exact Eq.symm (BitVec.le_antisymm this h)
· simp_all
@[simp]
theorem lt_one_iff {x : BitVec w} (h : 0 < w) : x < 1#w x = 0#w := by
constructor
· intro h₂
rw [lt_def, toNat_ofNat, Int.ofNat_lt, Int.ofNat_emod, Int.ofNat_one, Int.natCast_pow,
Int.ofNat_two, @Int.emod_eq_of_lt 1 (2^w) (by omega) (by omega)] at h₂
simp [toNat_eq, show x.toNat = 0 by omega]
· simp_all
@[simp]
theorem not_allOnes_lt {x : BitVec w} : ¬allOnes w < x := by
have : 2^w 0 := Ne.symm (NeZero.ne' (2^w))
rw [BitVec.not_lt, le_def, Nat.le_iff_lt_add_one, toNat_allOnes, Nat.sub_one_add_one this]
exact isLt x
@[simp]
theorem allOnes_le_iff {x : BitVec w} : allOnes w x x = allOnes w := by
constructor
· intro h
have : x allOnes w := not_lt_iff_le.mp not_allOnes_lt
exact Eq.symm (BitVec.le_antisymm h this)
· simp_all
/-! ### udiv -/
theorem udiv_def {x y : BitVec n} : x / y = BitVec.ofNat n (x.toNat / y.toNat) := by
@@ -3429,7 +3638,7 @@ theorem shiftLeft_eq_mul_twoPow (x : BitVec w) (n : Nat) :
simp [getLsbD_shiftLeft, Fin.is_lt, decide_true, Bool.true_and, mul_twoPow_eq_shiftLeft]
/-- 2^i * 2^j = 2^(i + j) with bitvectors as well -/
theorem twoPow_mul_twoPow_eq {w : Nat} (i j : Nat) : twoPow w i * twoPow w j = twoPow w (i + j) := by
theorem twoPow_mul_twoPow_eq {w : Nat} (i j : Nat) : twoPow w i * twoPow w j = twoPow w (i + j) := by
apply BitVec.eq_of_toNat_eq
simp only [toNat_mul, toNat_twoPow]
rw [ Nat.mul_mod, Nat.pow_add]

View File

@@ -13,6 +13,8 @@ import Init.Omega
namespace Fin
@[simp] theorem ofNat'_zero (n : Nat) [NeZero n] : Fin.ofNat' n 0 = 0 := rfl
@[deprecated Fin.pos (since := "2024-11-11")]
theorem size_pos (i : Fin n) : 0 < n := i.pos

View File

@@ -13,3 +13,4 @@ import Init.Data.Int.Lemmas
import Init.Data.Int.LemmasAux
import Init.Data.Int.Order
import Init.Data.Int.Pow
import Init.Data.Int.Cooper

View File

@@ -0,0 +1,259 @@
/-
Copyright (c) 2023 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Int.DivModLemmas
import Init.Data.Int.Gcd
/-!
## Cooper resolution: small solutions to boundedness and divisibility constraints.
-/
namespace Int
def add_of_le {a b : Int} (h : a b) : { c : Nat // b = a + c } :=
(b - a).toNat, by rw [Int.toNat_of_nonneg (Int.sub_nonneg_of_le h), Int.add_sub_assoc,
Int.add_comm, Int.add_sub_cancel]
theorem dvd_of_mul_dvd {a b c : Int} (w : a * b a * c) (h : 0 < a) : b c := by
obtain z, w := w
refine z, ?_
replace w := congrArg (· / a) w
dsimp at w
rwa [Int.mul_ediv_cancel_left _ (Int.ne_of_gt h), Int.mul_assoc,
Int.mul_ediv_cancel_left _ (Int.ne_of_gt h)] at w
/--
Given a solution `x` to a divisibility constraint `a b * x + c`,
then `x % d` is another solution as long as `(a / gcd a b) | d`.
See `dvd_emod_add_of_dvd_add` for the specialization with `b = 1`.
-/
theorem dvd_mul_emod_add_of_dvd_mul_add {a b c d x : Int}
(w : a b * x + c) (h : (a / gcd a b) d) :
a b * (x % d) + c := by
obtain p, w := w
obtain q, rfl := h
rw [Int.emod_def, Int.mul_sub, Int.sub_eq_add_neg, Int.add_right_comm, w,
Int.dvd_add_right (Int.dvd_mul_right _ _), Int.mul_assoc, Int.mul_assoc, Int.dvd_neg,
Int.mul_ediv_assoc b gcd_dvd_left, Int.mul_comm b a, Int.mul_ediv_assoc a gcd_dvd_right,
Int.mul_assoc, Int.mul_assoc]
apply Int.dvd_mul_right
/--
Given a solution `x` to a divisibility constraint `a x + c`,
then `x % d` is another solution as long as `a | d`.
See `dvd_mul_emod_add_of_dvd_mul_add` for a more general version allowing a coefficient with `x`.
-/
theorem dvd_emod_add_of_dvd_add {a c d x : Int} (w : a x + c) (h : a d) : a (x % d) + c := by
rw [ Int.one_mul x] at w
rw [ Int.one_mul (x % d)]
apply dvd_mul_emod_add_of_dvd_mul_add w (by simpa)
/-!
There is an integer solution for `x` to the system
```
p ≤ a * x
b * x ≤ q
d | c * x + s
```
(here `a`, `b`, `d` are positive integers, `c` and `s` are integers,
and `p` and `q` are integers which it may be helpful to think of as evaluations of linear forms),
if and only if there is an integer solution for `k` to the system
```
0 ≤ k < lcm a (a * d / gcd (a * d) c)
b * k + b * p ≤ a * q
a | k + p
a * d | c * k + c * p + a * s
```
Note in the new system that `k` has explicit lower and upper bounds
(i.e. without a coefficient for `k`, and in terms of `a`, `c`, and `d` only).
This is a statement of "Cooper resolution" with a divisibility constraint,
as formulated in
"Cutting to the Chase: Solving Linear Integer Arithmetic" by Dejan Jovanović and Leonardo de Moura,
DOI 10.1007/s10817-013-9281-x
See `cooper_resolution_left` for a simpler version without the divisibility constraint.
This formulation is "biased" towards the lower bound, so it is called "left Cooper resolution".
See `cooper_resolution_dvd_right` for the version biased towards the upper bound.
-/
namespace Cooper
def resolve_left (a c d p x : Int) : Int := (a * x - p) % (lcm a (a * d / gcd (a * d) c))
/-- When `p ≤ a * x`, we can realize `resolve_left` as a natural number. -/
def resolve_left' (a c d p x : Int) (h₁ : p a * x) : Nat := (add_of_le h₁).1 % (lcm a (a * d / gcd (a * d) c))
@[simp] theorem resolve_left_eq (a c d p x : Int) (h₁ : p a * x) :
resolve_left a c d p x = resolve_left' a c d p x h₁ := by
simp only [resolve_left, resolve_left', add_of_le, ofNat_emod, ofNat_toNat]
rw [Int.max_eq_left]
omega
/-- `resolve_left` is nonnegative when `p ≤ a * x`. -/
theorem le_zero_resolve_left (a c d p x : Int) (h₁ : p a * x) :
0 resolve_left a c d p x := by
simpa [h₁] using Int.ofNat_nonneg _
/-- `resolve_left` is bounded above by `lcm a (a * d / gcd (a * d) c)`. -/
theorem resolve_left_lt_lcm (a c d p x : Int) (a_pos : 0 < a) (d_pos : 0 < d) (h₁ : p a * x) :
resolve_left a c d p x < lcm a (a * d / gcd (a * d) c) := by
simp only [h₁, resolve_left_eq, resolve_left', add_of_le, Int.ofNat_lt]
exact Nat.mod_lt _ (Nat.pos_of_ne_zero (lcm_ne_zero (Int.ne_of_gt a_pos)
(Int.ne_of_gt (Int.ediv_pos_of_pos_of_dvd (Int.mul_pos a_pos d_pos) (Int.ofNat_nonneg _)
gcd_dvd_left))))
theorem resolve_left_ineq (a c d p x : Int) (a_pos : 0 < a) (b_pos : 0 < b)
(h₁ : p a * x) (h₂ : b * x q) :
b * resolve_left a c d p x + b * p a * q := by
simp only [h₁, resolve_left_eq, resolve_left']
obtain k', w := add_of_le h₁
replace h₂ : a * b * x a * q :=
Int.mul_assoc _ _ _ Int.mul_le_mul_of_nonneg_left h₂ (Int.le_of_lt a_pos)
rw [Int.mul_right_comm, w, Int.add_mul, Int.mul_comm p b, Int.mul_comm _ b] at h₂
rw [Int.add_comm]
calc
_ _ := Int.add_le_add_left (Int.mul_le_mul_of_nonneg_left
(Int.ofNat_le.mpr <| Nat.mod_le _ _) (Int.le_of_lt b_pos)) _
_ _ := h₂
theorem resolve_left_dvd₁ (a c d p x : Int) (h₁ : p a * x) :
a resolve_left a c d p x + p := by
simp only [h₁, resolve_left_eq, resolve_left']
obtain k', w := add_of_le h₁
exact Int.ofNat_emod _ _ dvd_emod_add_of_dvd_add (x := k') x, by rw [w, Int.add_comm] dvd_lcm_left
theorem resolve_left_dvd₂ (a c d p x : Int)
(h₁ : p a * x) (h₃ : d c * x + s) :
a * d c * resolve_left a c d p x + c * p + a * s := by
simp only [h₁, resolve_left_eq, resolve_left']
obtain k', w := add_of_le h₁
simp only [Int.add_assoc, ofNat_emod]
apply dvd_mul_emod_add_of_dvd_mul_add
· obtain z, r := h₃
refine z, ?_
rw [Int.mul_assoc, r, Int.mul_add, Int.mul_comm c x, Int.mul_assoc, w, Int.add_mul,
Int.mul_comm c, Int.mul_comm c, Int.add_assoc, Int.add_comm (p * c)]
· exact Int.dvd_lcm_right
def resolve_left_inv (a p k : Int) : Int := (k + p) / a
theorem le_mul_resolve_left_inv (a p k : Int)
(h₁ : 0 k) (h₄ : a k + p) :
p a * resolve_left_inv a p k := by
simp only [resolve_left_inv]
rw [Int.mul_ediv_cancel' h₄]
apply Int.le_add_of_nonneg_left h₁
theorem mul_resolve_left_inv_le (a p k : Int) (a_pos : 0 < a)
(h₃ : b * k + b * p a * q) (h₄ : a k + p) :
b * resolve_left_inv a p k q := by
suffices h : a * (b * ((k + p) / a)) a * q from le_of_mul_le_mul_left h a_pos
rw [Int.mul_left_comm a b, Int.mul_ediv_cancel' h₄, Int.mul_add]
exact h₃
theorem resolve_left_inv_dvd (a c d p k : Int) (a_pos : 0 < a)
(h₄ : a k + p) (h₅ : a * d c * k + c * p + a * s) :
d c * resolve_left_inv a p k + s := by
suffices h : a * d a * ((c * ((k + p) / a)) + s) from dvd_of_mul_dvd h a_pos
rw [Int.mul_add, Int.mul_left_comm, Int.mul_ediv_cancel' h₄, Int.mul_add]
exact h₅
end Cooper
open Cooper
/--
Left Cooper resolution of an upper and lower bound with divisibility constraint.
-/
theorem cooper_resolution_dvd_left
{a b c d s p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) (d_pos : 0 < d) :
( x, p a * x b * x q d c * x + s)
( k : Int, 0 k k < lcm a (a * d / gcd (a * d) c)
b * k + b * p a * q
a k + p
a * d c * k + c * p + a * s) := by
constructor
· rintro x, h₁, h₂, h₃
exact resolve_left a c d p x,
le_zero_resolve_left a c d p x h₁,
resolve_left_lt_lcm a c d p x a_pos d_pos h₁,
resolve_left_ineq a c d p x a_pos b_pos h₁ h₂,
resolve_left_dvd₁ a c d p x h₁,
resolve_left_dvd₂ a c d p x h₁ h₃
· rintro k, h₁, h₂, h₃, h₄, h₅
exact resolve_left_inv a p k,
le_mul_resolve_left_inv a p k h₁ h₄,
mul_resolve_left_inv_le a p k a_pos h₃ h₄,
resolve_left_inv_dvd a c d p k a_pos h₄ h₅
/--
Right Cooper resolution of an upper and lower bound with divisibility constraint.
-/
theorem cooper_resolution_dvd_right
{a b c d s p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) (d_pos : 0 < d) :
( x, p a * x b * x q d c * x + s)
( k : Int, 0 k k < lcm b (b * d / gcd (b * d) c)
a * k + b * p a * q
b k - q
b * d (- c) * k + c * q + b * s) := by
have this : x y z : Int, x + -y -z x + z y := by omega
suffices h :
( x, p a * x b * x q d c * x + s)
( k : Int, 0 k k < lcm b (b * d / gcd (b * d) (-c))
a * k + a * (-q) b * (-p)
b k + (-q)
b * d (- c) * k + (-c) * (-q) + b * s) by
simp only [gcd_neg, Int.neg_mul_neg] at h
simp only [Int.mul_neg, this] at h
exact h
constructor
· rintro x, lower, upper, dvd
have h : ( x, -q b * x a * x -p d -c * x + s) :=
-x, Int.mul_neg _ _ Int.neg_le_neg upper, Int.mul_neg _ _ Int.neg_le_neg lower,
by rwa [Int.neg_mul_neg _ _]
replace h := (cooper_resolution_dvd_left b_pos a_pos d_pos).mp h
exact h
· intro h
obtain x, lower, upper, dvd := (cooper_resolution_dvd_left b_pos a_pos d_pos).mpr h
refine -x, ?_, ?_, ?_
· exact Int.mul_neg _ _ Int.le_neg_of_le_neg upper
· exact Int.mul_neg _ _ Int.neg_le_of_neg_le lower
· exact Int.mul_neg _ _ Int.neg_mul _ _ dvd
/--
Left Cooper resolution of an upper and lower bound.
-/
theorem cooper_resolution_left
{a b p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) :
( x, p a * x b * x q)
( k : Int, 0 k k < a b * k + b * p a * q a k + p) := by
have h := cooper_resolution_dvd_left
a_pos b_pos Int.zero_lt_one (c := 1) (s := 0) (p := p) (q := q)
simp only [Int.mul_one, Int.one_mul, Int.mul_zero, Int.add_zero, gcd_one, Int.ofNat_one,
Int.ediv_one, lcm_self, Int.natAbs_of_nonneg (Int.le_of_lt a_pos), Int.one_dvd, and_true,
and_self] at h
exact h
/--
Right Cooper resolution of an upper and lower bound.
-/
theorem cooper_resolution_right
{a b p q : Int} (a_pos : 0 < a) (b_pos : 0 < b) :
( x, p a * x b * x q)
( k : Int, 0 k k < b a * k + b * p a * q b k - q) := by
have h := cooper_resolution_dvd_right
a_pos b_pos Int.zero_lt_one (c := 1) (s := 0) (p := p) (q := q)
have : k : Int, (b -k + q) (b k - q) := by
intro k
rw [ Int.dvd_neg, Int.neg_add, Int.neg_neg, Int.sub_eq_add_neg]
simp only [Int.mul_one, Int.one_mul, Int.mul_zero, Int.add_zero, gcd_one, Int.ofNat_one,
Int.ediv_one, lcm_self, Int.natAbs_of_nonneg (Int.le_of_lt b_pos), Int.one_dvd, and_true,
and_self, Int.neg_eq_neg_one_mul, this] at h
exact h

View File

@@ -1176,35 +1176,29 @@ theorem emod_mul_bmod_congr (x : Int) (n : Nat) : Int.bmod (x%n * y) n = Int.bmo
@[simp]
theorem bmod_add_bmod_congr : Int.bmod (Int.bmod x n + y) n = Int.bmod (x + y) n := by
rw [bmod_def x n]
split
next p =>
simp only [emod_add_bmod_congr]
next p =>
rw [Int.sub_eq_add_neg, Int.add_right_comm, Int.sub_eq_add_neg]
simp
have := (@bmod_add_mul_cancel (Int.bmod x n + y) n (bdiv x n)).symm
rwa [Int.add_right_comm, bmod_add_bdiv] at this
@[simp]
theorem bmod_sub_bmod_congr : Int.bmod (Int.bmod x n - y) n = Int.bmod (x - y) n := by
rw [Int.bmod_def x n]
split
next p =>
simp only [emod_sub_bmod_congr]
next p =>
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.add_right_comm, Int.sub_eq_add_neg, Int.sub_eq_add_neg]
simp [emod_sub_bmod_congr]
theorem bmod_sub_bmod_congr : Int.bmod (Int.bmod x n - y) n = Int.bmod (x - y) n :=
@bmod_add_bmod_congr x n (-y)
theorem add_bmod_eq_add_bmod_right (i : Int)
(H : bmod x n = bmod y n) : bmod (x + i) n = bmod (y + i) n := by
rw [ bmod_add_bmod_congr, @bmod_add_bmod_congr y, H]
theorem bmod_add_cancel_right (i : Int) : bmod (x + i) n = bmod (y + i) n bmod x n = bmod y n :=
fun H => by
have := add_bmod_eq_add_bmod_right (-i) H
rwa [Int.add_neg_cancel_right, Int.add_neg_cancel_right] at this,
fun H => by rw [ bmod_add_bmod_congr, H, bmod_add_bmod_congr]
@[simp] theorem add_bmod_bmod : Int.bmod (x + Int.bmod y n) n = Int.bmod (x + y) n := by
rw [Int.add_comm x, Int.bmod_add_bmod_congr, Int.add_comm y]
@[simp] theorem sub_bmod_bmod : Int.bmod (x - Int.bmod y n) n = Int.bmod (x - y) n := by
rw [Int.bmod_def y n]
split
next p =>
simp [sub_emod_bmod_congr]
next p =>
rw [Int.sub_eq_add_neg, Int.sub_eq_add_neg, Int.neg_add, Int.neg_neg, Int.add_assoc, Int.sub_eq_add_neg]
simp [sub_emod_bmod_congr]
apply (bmod_add_cancel_right (bmod y n)).mp
rw [Int.sub_add_cancel, add_bmod_bmod, Int.sub_add_cancel]
@[simp]
theorem bmod_mul_bmod : Int.bmod (Int.bmod x n * y) n = Int.bmod (x * y) n := by
@@ -1348,3 +1342,8 @@ theorem bmod_natAbs_plus_one (x : Int) (w : 1 < x.natAbs) : bmod x (x.natAbs + 1
all_goals decide
· exact ofNat_nonneg x
· exact succ_ofNat_pos (x + 1)
@[simp]
theorem bmod_neg_bmod : bmod (-(bmod x n)) n = bmod (-x) n := by
apply (bmod_add_cancel_right x).mp
rw [Int.add_left_neg, add_bmod_bmod, Int.add_left_neg]

View File

@@ -361,6 +361,20 @@ theorem foldr_pmap (l : List α) {P : α → Prop} (f : (a : α) → P a → β)
(l.pmap f H).foldr g x = l.attach.foldr (fun a acc => g (f a.1 (H _ a.2)) acc) x := by
rw [pmap_eq_map_attach, foldr_map]
@[simp] theorem foldl_attachWith
(l : List α) {q : α Prop} (H : a, a l q a) {f : β { x // q x} β} {b} :
(l.attachWith q H).foldl f b = l.attach.foldl (fun b a, h => f b a, H _ h) b := by
induction l generalizing b with
| nil => simp
| cons a l ih => simp [ih, foldl_map]
@[simp] theorem foldr_attachWith
(l : List α) {q : α Prop} (H : a, a l q a) {f : { x // q x} β β} {b} :
(l.attachWith q H).foldr f b = l.attach.foldr (fun a acc => f a.1, H _ a.2 acc) b := by
induction l generalizing b with
| nil => simp
| cons a l ih => simp [ih, foldr_map]
/--
If we fold over `l.attach` with a function that ignores the membership predicate,
we get the same results as folding over `l` directly.
@@ -676,7 +690,7 @@ and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldl_subtype {p : α Prop} {l : List { x // p x }}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} :
(hf : b x h, f b x, h = g b x) :
l.foldl f x = l.unattach.foldl g x := by
unfold unattach
induction l generalizing x with
@@ -689,7 +703,7 @@ and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldr_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} :
(hf : x h b, f x, h b = g x b) :
l.foldr f x = l.unattach.foldr g x := by
unfold unattach
induction l generalizing x with
@@ -701,7 +715,7 @@ This lemma identifies maps over lists of subtypes, where the function only depen
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
{f : { x // p x } β} {g : α β} (hf : x h, f x, h = g x) :
l.map f = l.unattach.map g := by
unfold unattach
induction l with
@@ -709,7 +723,7 @@ and simplifies these to the function directly taking the value.
| cons a l ih => simp [ih, hf]
@[simp] theorem filterMap_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
{f : { x // p x } Option β} {g : α Option β} (hf : x h, f x, h = g x) :
l.filterMap f = l.unattach.filterMap g := by
unfold unattach
induction l with
@@ -717,7 +731,7 @@ and simplifies these to the function directly taking the value.
| cons a l ih => simp [ih, hf, filterMap_cons]
@[simp] theorem flatMap_subtype {p : α Prop} {l : List { x // p x }}
{f : { x // p x } List β} {g : α List β} {hf : x h, f x, h = g x} :
{f : { x // p x } List β} {g : α List β} (hf : x h, f x, h = g x) :
(l.flatMap f) = l.unattach.flatMap g := by
unfold unattach
induction l with
@@ -726,6 +740,8 @@ and simplifies these to the function directly taking the value.
@[deprecated flatMap_subtype (since := "2024-10-16")] abbrev bind_subtype := @flatMap_subtype
/-! ### Simp lemmas pushing `unattach` inwards. -/
@[simp] theorem unattach_filter {p : α Prop} {l : List { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
(l.filter f).unattach = l.unattach.filter g := by
@@ -735,8 +751,6 @@ and simplifies these to the function directly taking the value.
simp only [filter_cons, hf, unattach_cons]
split <;> simp [ih]
/-! ### Simp lemmas pushing `unattach` inwards. -/
@[simp] theorem unattach_reverse {p : α Prop} {l : List { x // p x }} :
l.reverse.unattach = l.unattach.reverse := by
simp [unattach, -map_subtype]

View File

@@ -43,7 +43,7 @@ The operations are organized as follow:
`countP`, `count`, and `lookup`.
* Logic: `any`, `all`, `or`, and `and`.
* Zippers: `zipWith`, `zip`, `zipWithAll`, and `unzip`.
* Ranges and enumeration: `range`, `iota`, `enumFrom`, and `enum`.
* Ranges and enumeration: `range`, `zipIdx`.
* Minima and maxima: `min?` and `max?`.
* Other functions: `intersperse`, `intercalate`, `eraseDups`, `eraseReps`, `span`, `splitBy`,
`removeAll`
@@ -74,7 +74,7 @@ namespace List
@[simp] theorem length_nil : length ([] : List α) = 0 :=
rfl
@[simp 1100] theorem length_singleton (a : α) : length [a] = 1 := rfl
@[simp] theorem length_singleton (a : α) : length [a] = 1 := rfl
@[simp] theorem length_cons {α} (a : α) (as : List α) : (cons a as).length = as.length + 1 :=
rfl
@@ -352,8 +352,8 @@ def headD : (as : List α) → (fallback : α) → α
| [], fallback => fallback
| a::_, _ => a
@[simp 1100] theorem headD_nil : @headD α [] d = d := rfl
@[simp 1100] theorem headD_cons : @headD α (a::l) d = a := rfl
@[simp] theorem headD_nil : @headD α [] d = d := rfl
@[simp] theorem headD_cons : @headD α (a::l) d = a := rfl
/-! ### tail -/
@@ -393,8 +393,8 @@ def tailD (list fallback : List α) : List α :=
| [] => fallback
| _ :: tl => tl
@[simp 1100] theorem tailD_nil : @tailD α [] l' = l' := rfl
@[simp 1100] theorem tailD_cons : @tailD α (a::l) l' = l := rfl
@[simp] theorem tailD_nil : @tailD α [] l' = l' := rfl
@[simp] theorem tailD_cons : @tailD α (a::l) l' = l := rfl
/-! ## Basic `List` operations.
@@ -823,6 +823,17 @@ theorem drop_eq_nil_of_le {as : List α} {i : Nat} (h : as.length ≤ i) : as.dr
| _::_, 0 => simp at h
| _::as, i+1 => simp only [length_cons] at h; exact @drop_eq_nil_of_le as i (Nat.le_of_succ_le_succ h)
/-! ### extract -/
/-- `extract l start stop` returns the slice of `l` from indices `start` to `stop` (exclusive). -/
-- This is only an abbreviation for the operation in terms of `drop` and `take`.
-- We do not prove properties of extract itself.
abbrev extract (l : List α) (start : Nat := 0) (stop : Nat := l.length) : List α :=
(l.drop start).take (stop - start)
@[simp] theorem extract_eq_drop_take (l : List α) (start stop : Nat) :
l.extract start stop = (l.drop start).take (stop - start) := rfl
/-! ### takeWhile -/
/--
@@ -1266,24 +1277,61 @@ theorem findSome?_cons {f : α → Option β} :
@[simp] theorem findIdx_nil {α : Type _} (p : α Bool) : [].findIdx p = 0 := rfl
/-! ### indexOf -/
/-! ### idxOf -/
/-- Returns the index of the first element equal to `a`, or the length of the list otherwise. -/
def indexOf [BEq α] (a : α) : List α Nat := findIdx (· == a)
def idxOf [BEq α] (a : α) : List α Nat := findIdx (· == a)
@[simp] theorem indexOf_nil [BEq α] : ([] : List α).indexOf x = 0 := rfl
/-- Returns the index of the first element equal to `a`, or the length of the list otherwise. -/
@[deprecated idxOf (since := "2025-01-29")] abbrev indexOf := @idxOf
@[simp] theorem idxOf_nil [BEq α] : ([] : List α).idxOf x = 0 := rfl
@[deprecated idxOf_nil (since := "2025-01-29")]
theorem indexOf_nil [BEq α] : ([] : List α).idxOf x = 0 := rfl
/-! ### findIdx? -/
/-- Return the index of the first occurrence of an element satisfying `p`. -/
def findIdx? (p : α Bool) : List α (start : Nat := 0) Option Nat
| [], _ => none
| a :: l, i => if p a then some i else findIdx? p l (i + 1)
def findIdx? (p : α Bool) (l : List α) : Option Nat :=
go l 0
where
go : List α Nat Option Nat
| [], _ => none
| a :: l, i => if p a then some i else go l (i + 1)
/-! ### indexOf? -/
/-! ### idxOf? -/
/-- Return the index of the first occurrence of `a` in the list. -/
@[inline] def indexOf? [BEq α] (a : α) : List α Option Nat := findIdx? (· == a)
@[inline] def idxOf? [BEq α] (a : α) : List α Option Nat := findIdx? (· == a)
/-- Return the index of the first occurrence of `a` in the list. -/
@[deprecated idxOf? (since := "2025-01-29")]
abbrev indexOf? := @idxOf?
/-! ### findFinIdx? -/
/-- Return the index of the first occurrence of an element satisfying `p`, as a `Fin l.length`,
or `none` if no such element is found. -/
@[inline] def findFinIdx? (p : α Bool) (l : List α) : Option (Fin l.length) :=
go l 0 (by simp)
where
go : (l' : List α) (i : Nat) (h : l'.length + i = l.length) Option (Fin l.length)
| [], _, _ => none
| a :: l, i, h =>
if p a then
some i, by
simp only [Nat.add_comm _ i, Nat.add_assoc] at h
exact Nat.lt_of_add_right_lt (Nat.lt_of_succ_le (Nat.le_of_eq h))
else
go l (i + 1) (by simp at h; simpa [ Nat.add_assoc, Nat.add_right_comm] using h)
/-! ### finIdxOf? -/
/-- Return the index of the first occurrence of `a`, as a `Fin l.length`,
or `none` if no such element is found. -/
@[inline] def finIdxOf? [BEq α] (a : α) : (l : List α) Option (Fin l.length) :=
findFinIdx? (· == a)
/-! ### countP -/
@@ -1530,28 +1578,51 @@ set_option linter.deprecated false in
set_option linter.deprecated false in
@[simp] theorem iota_succ : iota (i+1) = (i+1) :: iota i := rfl
/-! ### zipIdx -/
/--
`O(|l|)`. `zipIdx l` zips a list with its indices, optionally starting from a given index.
* `zipIdx [a, b, c] = [(a, 0), (b, 1), (c, 2)]`
* `zipIdx [a, b, c] 5 = [(a, 5), (b, 6), (c, 7)]`
-/
def zipIdx : List α (n : Nat := 0) List (α × Nat)
| [], _ => nil
| x :: xs, n => (x, n) :: zipIdx xs (n + 1)
@[simp] theorem zipIdx_nil : ([] : List α).zipIdx i = [] := rfl
@[simp] theorem zipIdx_cons : (a::as).zipIdx i = (a, i) :: as.zipIdx (i+1) := rfl
/-! ### enumFrom -/
/--
`O(|l|)`. `enumFrom n l` is like `enum` but it allows you to specify the initial index.
* `enumFrom 5 [a, b, c] = [(5, a), (6, b), (7, c)]`
-/
@[deprecated "Use `zipIdx` instead; note the signature change." (since := "2025-01-21")]
def enumFrom : Nat List α List (Nat × α)
| _, [] => nil
| n, x :: xs => (n, x) :: enumFrom (n + 1) xs
@[simp] theorem enumFrom_nil : ([] : List α).enumFrom i = [] := rfl
@[simp] theorem enumFrom_cons : (a::as).enumFrom i = (i, a) :: as.enumFrom (i+1) := rfl
set_option linter.deprecated false in
@[deprecated zipIdx_nil (since := "2025-01-21"), simp]
theorem enumFrom_nil : ([] : List α).enumFrom i = [] := rfl
set_option linter.deprecated false in
@[deprecated zipIdx_cons (since := "2025-01-21"), simp]
theorem enumFrom_cons : (a::as).enumFrom i = (i, a) :: as.enumFrom (i+1) := rfl
/-! ### enum -/
set_option linter.deprecated false in
/--
`O(|l|)`. `enum l` pairs up each element with its index in the list.
* `enum [a, b, c] = [(0, a), (1, b), (2, c)]`
-/
@[deprecated "Use `zipIdx` instead; note the signature change." (since := "2025-01-21")]
def enum : List α List (Nat × α) := enumFrom 0
@[simp] theorem enum_nil : ([] : List α).enum = [] := rfl
set_option linter.deprecated false in
@[deprecated zipIdx_nil (since := "2025-01-21"), simp]
theorem enum_nil : ([] : List α).enum = [] := rfl
/-! ## Minima and maxima -/

View File

@@ -98,6 +98,7 @@ def forA {m : Type u → Type v} [Applicative m] {α : Type w} (as : List α) (f
| [] => pure
| a :: as => f a *> forA as f
@[specialize]
def filterAuxM {m : Type Type v} [Monad m] {α : Type} (f : α m Bool) : List α List α m (List α)
| [], acc => pure acc
@@ -136,6 +137,19 @@ def filterMapM {m : Type u → Type v} [Monad m] {α β : Type u} (f : α → m
| some b => loop as (b::bs)
loop as []
/--
Applies the monadic function `f` on every element `x` in the list, left-to-right, and returns the
concatenation of the results.
-/
@[inline]
def flatMapM {m : Type u Type v} [Monad m] {α : Type w} {β : Type u} (f : α m (List β)) (as : List α) : m (List β) :=
let rec @[specialize] loop
| [], bs => pure bs.reverse.flatten
| a :: as, bs => do
let bs' f a
loop as (bs' :: bs)
loop as []
/--
Folds a monadic function over a list from left to right:
```
@@ -270,6 +284,7 @@ instance : ForIn' m (List α) α inferInstance where
-- No separate `ForIn` instance is required because it can be derived from `ForIn'`.
-- We simplify `List.forIn'` to `forIn'`.
@[simp] theorem forIn'_eq_forIn' [Monad m] : @List.forIn' α β m _ = forIn' := rfl
@[simp] theorem forIn'_nil [Monad m] (f : (a : α) a [] β m (ForInStep β)) (b : β) : forIn' [] b f = pure b :=
@@ -281,6 +296,9 @@ instance : ForIn' m (List α) α inferInstance where
instance : ForM m (List α) α where
forM := List.forM
-- We simplify `List.forM` to `forM`.
@[simp] theorem forM_eq_forM [Monad m] : @List.forM m _ α = forM := rfl
@[simp] theorem forM_nil [Monad m] (f : α m PUnit) : forM [] f = pure :=
rfl
@[simp] theorem forM_cons [Monad m] (f : α m PUnit) (a : α) (as : List α) : forM (a::as) f = f a >>= fun _ => forM as f :=

View File

@@ -9,7 +9,7 @@ import Init.Data.List.Pairwise
import Init.Data.List.Find
/-!
# Lemmas about `List.eraseP` and `List.erase`.
# Lemmas about `List.eraseP`, `List.erase`, and `List.eraseIdx`.
-/
namespace List
@@ -34,7 +34,7 @@ theorem eraseP_of_forall_not {l : List α} (h : ∀ a, a ∈ l → ¬p a) : l.er
| nil => rfl
| cons _ _ ih => simp [h _ (.head ..), ih (forall_mem_cons.1 h).2]
@[simp] theorem eraseP_eq_nil {xs : List α} {p : α Bool} : xs.eraseP p = [] xs = [] x, p x xs = [x] := by
@[simp] theorem eraseP_eq_nil_iff {xs : List α} {p : α Bool} : xs.eraseP p = [] xs = [] x, p x xs = [x] := by
induction xs with
| nil => simp
| cons x xs ih =>
@@ -50,9 +50,15 @@ theorem eraseP_of_forall_not {l : List α} (h : ∀ a, a ∈ l → ¬p a) : l.er
rintro x h' rfl
simp_all
theorem eraseP_ne_nil {xs : List α} {p : α Bool} : xs.eraseP p [] xs [] x, p x xs [x] := by
@[deprecated eraseP_eq_nil_iff (since := "2025-01-30")]
abbrev eraseP_eq_nil := @eraseP_eq_nil_iff
theorem eraseP_ne_nil_iff {xs : List α} {p : α Bool} : xs.eraseP p [] xs [] x, p x xs [x] := by
simp
@[deprecated eraseP_ne_nil_iff (since := "2025-01-30")]
abbrev eraseP_ne_nil := @eraseP_ne_nil_iff
theorem exists_of_eraseP : {l : List α} {a} (_ : a l) (_ : p a),
a l₁ l₂, ( b l₁, ¬p b) p a l = l₁ ++ a :: l₂ l.eraseP p = l₁ ++ l₂
| b :: l, _, al, pa =>
@@ -191,6 +197,14 @@ theorem eraseP_replicate (n : Nat) (a : α) (p : α → Bool) :
simp only [replicate_succ, eraseP_cons]
split <;> simp [*]
@[simp] theorem eraseP_replicate_of_pos {n : Nat} {a : α} (h : p a) :
(replicate n a).eraseP p = replicate (n - 1) a := by
cases n <;> simp [replicate_succ, h]
@[simp] theorem eraseP_replicate_of_neg {n : Nat} {a : α} (h : ¬p a) :
(replicate n a).eraseP p = replicate n a := by
rw [eraseP_of_forall_not (by simp_all)]
protected theorem IsPrefix.eraseP (h : l₁ <+: l₂) : l₁.eraseP p <+: l₂.eraseP p := by
rw [IsPrefix] at h
obtain t, rfl := h
@@ -237,14 +251,6 @@ theorem eraseP_eq_iff {p} {l : List α} :
subst p
simp_all
@[simp] theorem eraseP_replicate_of_pos {n : Nat} {a : α} (h : p a) :
(replicate n a).eraseP p = replicate (n - 1) a := by
cases n <;> simp [replicate_succ, h]
@[simp] theorem eraseP_replicate_of_neg {n : Nat} {a : α} (h : ¬p a) :
(replicate n a).eraseP p = replicate n a := by
rw [eraseP_of_forall_not (by simp_all)]
theorem Pairwise.eraseP (q) : Pairwise p l Pairwise p (l.eraseP q) :=
Pairwise.sublist <| eraseP_sublist _
@@ -271,7 +277,22 @@ theorem head_eraseP_mem (xs : List α) (p : α → Bool) (h) : (xs.eraseP p).hea
theorem getLast_eraseP_mem (xs : List α) (p : α Bool) (h) : (xs.eraseP p).getLast h xs :=
(eraseP_sublist xs).getLast_mem h
theorem eraseP_eq_eraseIdx {xs : List α} {p : α Bool} :
xs.eraseP p = match xs.findIdx? p with
| none => xs
| some i => xs.eraseIdx i := by
induction xs with
| nil => rfl
| cons x xs ih =>
rw [eraseP_cons, findIdx?_cons]
by_cases h : p x
· simp [h]
· simp only [h]
rw [ih]
split <;> simp [*]
/-! ### erase -/
section erase
variable [BEq α]
@@ -299,16 +320,22 @@ theorem erase_eq_eraseP [LawfulBEq α] (a : α) : ∀ l : List α, l.erase a =
| b :: l => by
if h : a = b then simp [h] else simp [h, Ne.symm h, erase_eq_eraseP a l]
@[simp] theorem erase_eq_nil [LawfulBEq α] {xs : List α} {a : α} :
@[simp] theorem erase_eq_nil_iff [LawfulBEq α] {xs : List α} {a : α} :
xs.erase a = [] xs = [] xs = [a] := by
rw [erase_eq_eraseP]
simp
theorem erase_ne_nil [LawfulBEq α] {xs : List α} {a : α} :
@[deprecated erase_eq_nil_iff (since := "2025-01-30")]
abbrev erase_eq_nil := @erase_eq_nil_iff
theorem erase_ne_nil_iff [LawfulBEq α] {xs : List α} {a : α} :
xs.erase a [] xs [] xs [a] := by
rw [erase_eq_eraseP]
simp
@[deprecated erase_ne_nil_iff (since := "2025-01-30")]
abbrev erase_ne_nil := @erase_ne_nil_iff
theorem exists_erase_eq [LawfulBEq α] {a : α} {l : List α} (h : a l) :
l₁ l₂, a l₁ l = l₁ ++ a :: l₂ l.erase a = l₁ ++ l₂ := by
let _, l₁, l₂, h₁, e, h₂, h₃ := exists_of_eraseP h (beq_self_eq_true _)
@@ -457,6 +484,19 @@ theorem head_erase_mem (xs : List α) (a : α) (h) : (xs.erase a).head h ∈ xs
theorem getLast_erase_mem (xs : List α) (a : α) (h) : (xs.erase a).getLast h xs :=
(erase_sublist a xs).getLast_mem h
theorem erase_eq_eraseIdx (l : List α) (a : α) :
l.erase a = match l.idxOf? a with
| none => l
| some i => l.eraseIdx i := by
induction l with
| nil => simp
| cons x xs ih =>
rw [erase_cons, idxOf?_cons]
split
· simp
· simp [ih]
split <;> simp [*]
end erase
/-! ### eraseIdx -/
@@ -488,18 +528,24 @@ theorem eraseIdx_eq_take_drop_succ :
-- See `Init.Data.List.Nat.Erase` for `getElem?_eraseIdx` and `getElem_eraseIdx`.
@[simp] theorem eraseIdx_eq_nil {l : List α} {i : Nat} : eraseIdx l i = [] l = [] (length l = 1 i = 0) := by
@[simp] theorem eraseIdx_eq_nil_iff {l : List α} {i : Nat} : eraseIdx l i = [] l = [] (length l = 1 i = 0) := by
match l, i with
| [], _
| a::l, 0
| a::l, i + 1 => simp [Nat.succ_inj']
theorem eraseIdx_ne_nil {l : List α} {i : Nat} : eraseIdx l i [] 2 l.length (l.length = 1 i 0) := by
@[deprecated eraseIdx_eq_nil_iff (since := "2025-01-30")]
abbrev eraseIdx_eq_nil := @eraseIdx_eq_nil_iff
theorem eraseIdx_ne_nil_iff {l : List α} {i : Nat} : eraseIdx l i [] 2 l.length (l.length = 1 i 0) := by
match l with
| []
| [a]
| a::b::l => simp [Nat.succ_inj']
@[deprecated eraseIdx_ne_nil_iff (since := "2025-01-30")]
abbrev eraseIdx_ne_nil := @eraseIdx_ne_nil_iff
theorem eraseIdx_sublist : (l : List α) (k : Nat), eraseIdx l k <+ l
| [], _ => by simp
| a::l, 0 => by simp
@@ -573,7 +619,8 @@ protected theorem IsPrefix.eraseIdx {l l' : List α} (h : l <+: l') (k : Nat) :
-- See also `mem_eraseIdx_iff_getElem` and `mem_eraseIdx_iff_getElem?` in
-- `Init/Data/List/Nat/Basic.lean`.
theorem erase_eq_eraseIdx [BEq α] [LawfulBEq α] (l : List α) (a : α) (i : Nat) (w : l.indexOf a = i) :
theorem erase_eq_eraseIdx_of_idxOf [BEq α] [LawfulBEq α]
(l : List α) (a : α) (i : Nat) (w : l.idxOf a = i) :
l.erase a = l.eraseIdx i := by
subst w
rw [erase_eq_iff]
@@ -581,11 +628,14 @@ theorem erase_eq_eraseIdx [BEq α] [LawfulBEq α] (l : List α) (a : α) (i : Na
· right
obtain as, bs, rfl, h' := eq_append_cons_of_mem h
refine as, bs, h', by simp, ?_
rw [indexOf_append, if_neg h', indexOf_cons_self, eraseIdx_append_of_length_le] <;>
rw [idxOf_append, if_neg h', idxOf_cons_self, eraseIdx_append_of_length_le] <;>
simp
· left
refine h, ?_
rw [eq_comm, eraseIdx_eq_self]
exact Nat.le_of_eq (indexOf_eq_length h).symm
exact Nat.le_of_eq (idxOf_eq_length h).symm
@[deprecated erase_eq_eraseIdx_of_idxOf (since := "2025-01-29")]
abbrev erase_eq_eraseIdx_of_indexOf := @erase_eq_eraseIdx_of_idxOf
end List

View File

@@ -641,29 +641,36 @@ theorem findIdx_le_findIdx {l : List α} {p q : α → Bool} (h : ∀ x ∈ l, p
/-! ### findIdx? -/
@[simp] theorem findIdx?_nil : ([] : List α).findIdx? p i = none := rfl
@[local simp] private theorem findIdx?_go_nil {p : α Bool} {i : Nat} :
findIdx?.go p [] i = none := rfl
@[simp] theorem findIdx?_cons :
(x :: xs).findIdx? p i = if p x then some i else findIdx? p xs (i + 1) := rfl
@[local simp] private theorem findIdx?_go_cons :
findIdx?.go p (x :: xs) i = if p x then some i else findIdx?.go p xs (i + 1) := rfl
theorem findIdx?_succ :
(xs : List α).findIdx? p (i+1) = (xs.findIdx? p i).map fun i => i + 1 := by
private theorem findIdx?_go_succ {p : α Bool} {xs : List α} {i : Nat} :
findIdx?.go p xs (i+1) = (findIdx?.go p xs i).map fun i => i + 1 := by
induction xs generalizing i with simp
| cons _ _ _ => split <;> simp_all
@[simp] theorem findIdx?_start_succ :
(xs : List α).findIdx? p (i+1) = (xs.findIdx? p 0).map fun k => k + (i + 1) := by
private theorem findIdx?_go_eq {p : α Bool} {xs : List α} {i : Nat} :
findIdx?.go p xs (i+1) = (findIdx?.go p xs 0).map fun k => k + (i + 1) := by
induction xs generalizing i with
| nil => simp
| cons _ _ _ =>
simp only [findIdx?_succ, findIdx?_cons, Nat.zero_add]
simp only [findIdx?_go_succ, findIdx?_go_cons, Nat.zero_add]
split
· simp_all
· simp_all only [findIdx?_succ, Bool.not_eq_true, Option.map_map, Nat.zero_add]
· simp_all only [findIdx?_go_succ, Bool.not_eq_true, Option.map_map, Nat.zero_add]
congr
ext
simp only [Nat.add_comm i, Function.comp_apply, Nat.add_assoc]
@[simp] theorem findIdx?_nil : ([] : List α).findIdx? p = none := rfl
@[simp] theorem findIdx?_cons :
(x :: xs).findIdx? p = if p x then some 0 else (xs.findIdx? p).map fun i => i + 1 := by
simp [findIdx?, findIdx?_go_eq]
@[simp]
theorem findIdx?_eq_none_iff {xs : List α} {p : α Bool} :
xs.findIdx? p = none x, x xs p x = false := by
@@ -731,7 +738,7 @@ theorem findIdx?_eq_some_iff_getElem {xs : List α} {p : α → Bool} {i : Nat}
induction xs generalizing i with
| nil => simp
| cons x xs ih =>
simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ]
simp only [findIdx?_cons, Nat.zero_add]
split
· simp only [Option.some.injEq, Bool.not_eq_true, length_cons]
cases i with
@@ -762,7 +769,7 @@ theorem findIdx?_of_eq_some {xs : List α} {p : α → Bool} (w : xs.findIdx? p
induction xs generalizing i with
| nil => simp_all
| cons x xs ih =>
simp_all only [findIdx?_cons, Nat.zero_add, findIdx?_succ]
simp_all only [findIdx?_cons, Nat.zero_add]
split at w <;> cases i <;> simp_all [succ_inj']
theorem findIdx?_of_eq_none {xs : List α} {p : α Bool} (w : xs.findIdx? p = none) :
@@ -771,7 +778,7 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
induction xs generalizing i with
| nil => simp_all
| cons x xs ih =>
simp_all only [Bool.not_eq_true, findIdx?_cons, Nat.zero_add, findIdx?_succ]
simp_all only [Bool.not_eq_true, findIdx?_cons, Nat.zero_add]
cases i with
| zero =>
split at w <;> simp_all
@@ -784,7 +791,7 @@ theorem findIdx?_of_eq_none {xs : List α} {p : α → Bool} (w : xs.findIdx? p
induction l with
| nil => simp
| cons x xs ih =>
simp only [map_cons, findIdx?]
simp only [map_cons, findIdx?_cons]
split <;> simp_all
@[simp] theorem findIdx?_append :
@@ -801,49 +808,44 @@ theorem findIdx?_flatten {l : List (List α)} {p : α → Bool} :
induction l with
| nil => simp
| cons xs l ih =>
simp only [flatten, findIdx?_append, map_take, map_cons, findIdx?, any_eq_true, Nat.zero_add,
findIdx?_succ]
split
· simp only [Option.map_some', take_zero, sum_nil, length_cons, zero_lt_succ,
getElem?_eq_getElem, getElem_cons_zero, Option.getD_some, Nat.zero_add]
rw [Option.or_of_isSome (by simpa [findIdx?_isSome])]
rw [findIdx?_eq_some_of_exists _]
· simp_all only [map_take, not_exists, not_and, Bool.not_eq_true, Option.map_map]
rw [Option.or_of_isNone (by simpa [findIdx?_isNone])]
congr 1
ext i
simp [Nat.add_comm, Nat.add_assoc]
rw [flatten_cons, findIdx?_append, ih, findIdx?_cons]
split <;> rename_i h
· simp only [any_eq_true] at h
rw [Option.or_of_isSome (by simp_all [findIdx?_isSome])]
simp_all [findIdx?_eq_some_of_exists]
· rw [Option.or_of_isNone (by simp_all [findIdx?_isNone])]
simp [Function.comp_def, Nat.add_comm, Nat.add_assoc]
@[simp] theorem findIdx?_replicate :
(replicate n a).findIdx? p = if 0 < n p a then some 0 else none := by
cases n with
| zero => simp
| succ n =>
simp only [replicate, findIdx?_cons, Nat.zero_add, findIdx?_succ, zero_lt_succ, true_and]
simp only [replicate, findIdx?_cons, Nat.zero_add, zero_lt_succ, true_and]
split <;> simp_all
theorem findIdx?_eq_findSome?_enum {xs : List α} {p : α Bool} :
xs.findIdx? p = xs.enum.findSome? fun i, a => if p a then some i else none := by
theorem findIdx?_eq_findSome?_zipIdx {xs : List α} {p : α Bool} :
xs.findIdx? p = xs.zipIdx.findSome? fun a, i => if p a then some i else none := by
induction xs with
| nil => simp
| cons x xs ih =>
simp only [findIdx?_cons, Nat.zero_add, findIdx?_succ, enum]
simp only [findIdx?_cons, Nat.zero_add, zipIdx]
split
· simp_all
· simp_all only [enumFrom_cons, ite_false, Option.isNone_none, findSome?_cons_of_isNone, reduceCtorEq]
simp [Function.comp_def, map_fst_add_enum_eq_enumFrom, findSome?_map]
· simp_all only [zipIdx_cons, ite_false, Option.isNone_none, findSome?_cons_of_isNone, reduceCtorEq]
rw [ map_snd_add_zipIdx_eq_zipIdx (n := 1) (k := 0)]
simp [Function.comp_def, findSome?_map]
theorem findIdx?_eq_fst_find?_enum {xs : List α} {p : α Bool} :
xs.findIdx? p = (xs.enum.find? fun _, x => p x).map (·.1) := by
theorem findIdx?_eq_fst_find?_zipIdx {xs : List α} {p : α Bool} :
xs.findIdx? p = (xs.zipIdx.find? fun x, _ => p x).map (·.2) := by
induction xs with
| nil => simp
| cons x xs ih =>
simp only [findIdx?_cons, Nat.zero_add, findIdx?_start_succ, enum_cons]
simp only [findIdx?_cons, Nat.zero_add, zipIdx_cons]
split
· simp_all
· simp only [Option.map_map, enumFrom_eq_map_enum, Bool.false_eq_true, not_false_eq_true,
find?_cons_of_neg, find?_map, *]
congr
· rw [ih, map_snd_add_zipIdx_eq_zipIdx (n := 1) (k := 0)]
simp [Function.comp_def, *]
-- See also `findIdx_le_findIdx`.
theorem findIdx?_eq_none_of_findIdx?_eq_none {xs : List α} {p q : α Bool} (w : x xs, p x q x) :
@@ -884,59 +886,107 @@ theorem IsInfix.findIdx?_eq_none {l₁ l₂ : List α} {p : α → Bool} (h : l
List.findIdx? p l₂ = none List.findIdx? p l₁ = none :=
h.sublist.findIdx?_eq_none
/-! ### indexOf
theorem findIdx_eq_getD_findIdx? {xs : List α} {p : α Bool} :
xs.findIdx p = (xs.findIdx? p).getD xs.length := by
induction xs with
| nil => simp
| cons x xs ih =>
simp only [findIdx_cons, findIdx?_cons]
split <;> simp_all [ih]
The verification API for `indexOf` is still incomplete.
/-! ### findFinIdx? -/
theorem findIdx?_go_eq_map_findFinIdx?_go_val {xs : List α} {p : α Bool} {i : Nat} {h} :
List.findIdx?.go p xs i =
(List.findFinIdx?.go p l xs i h).map (·.val) := by
unfold findIdx?.go
unfold findFinIdx?.go
split <;> rename_i a xs
· simp_all
· simp only
split
· simp
· rw [findIdx?_go_eq_map_findFinIdx?_go_val]
theorem findIdx?_eq_map_findFinIdx?_val {xs : List α} {p : α Bool} :
xs.findIdx? p = (xs.findFinIdx? p).map (·.val) := by
simp [findIdx?, findFinIdx?]
rw [findIdx?_go_eq_map_findFinIdx?_go_val]
/-! ### idxOf
The verification API for `idxOf` is still incomplete.
The lemmas below should be made consistent with those for `findIdx` (and proved using them).
-/
theorem indexOf_cons [BEq α] :
(x :: xs : List α).indexOf y = bif x == y then 0 else xs.indexOf y + 1 := by
dsimp [indexOf]
theorem idxOf_cons [BEq α] :
(x :: xs : List α).idxOf y = bif x == y then 0 else xs.idxOf y + 1 := by
dsimp [idxOf]
simp [findIdx_cons]
@[simp] theorem indexOf_cons_self [BEq α] [ReflBEq α] {l : List α} : (a :: l).indexOf a = 0 := by
simp [indexOf_cons]
@[deprecated idxOf_cons (since := "2025-01-29")]
abbrev indexOf_cons := @idxOf_cons
theorem indexOf_append [BEq α] [LawfulBEq α] {l l₂ : List α} {a : α} :
(l₁ ++ l₂).indexOf a = if a l₁ then l₁.indexOf a else l₂.indexOf a + l₁.length := by
rw [indexOf, findIdx_append]
@[simp] theorem idxOf_cons_self [BEq α] [ReflBEq α] {l : List α} : (a :: l).idxOf a = 0 := by
simp [idxOf_cons]
@[deprecated idxOf_cons_self (since := "2025-01-29")]
abbrev indexOf_cons_self := @idxOf_cons_self
theorem idxOf_append [BEq α] [LawfulBEq α] {l₁ l₂ : List α} {a : α} :
(l₁ ++ l₂).idxOf a = if a l₁ then l₁.idxOf a else l₂.idxOf a + l₁.length := by
rw [idxOf, findIdx_append]
split <;> rename_i h
· rw [if_pos]
simpa using h
· rw [if_neg]
simpa using h
theorem indexOf_eq_length [BEq α] [LawfulBEq α] {l : List α} (h : a l) : l.indexOf a = l.length := by
@[deprecated idxOf_append (since := "2025-01-29")]
abbrev indexOf_append := @idxOf_append
theorem idxOf_eq_length [BEq α] [LawfulBEq α] {l : List α} (h : a l) : l.idxOf a = l.length := by
induction l with
| nil => rfl
| cons x xs ih =>
simp only [mem_cons, not_or] at h
simp only [indexOf_cons, cond_eq_if, beq_iff_eq]
simp only [idxOf_cons, cond_eq_if, beq_iff_eq]
split <;> simp_all
theorem indexOf_lt_length [BEq α] [LawfulBEq α] {l : List α} (h : a l) : l.indexOf a < l.length := by
@[deprecated idxOf_eq_length (since := "2025-01-29")]
abbrev indexOf_eq_length := @idxOf_eq_length
theorem idxOf_lt_length [BEq α] [LawfulBEq α] {l : List α} (h : a l) : l.idxOf a < l.length := by
induction l with
| nil => simp at h
| cons x xs ih =>
simp only [mem_cons] at h
obtain rfl | h := h
· simp
· simp only [indexOf_cons, cond_eq_if, beq_iff_eq, length_cons]
· simp only [idxOf_cons, cond_eq_if, beq_iff_eq, length_cons]
specialize ih h
split
· exact zero_lt_succ xs.length
· exact Nat.add_lt_add_right ih 1
/-! ### indexOf?
@[deprecated idxOf_lt_length (since := "2025-01-29")]
abbrev indexOf_lt_length := @idxOf_lt_length
The verification API for `indexOf?` is still incomplete.
/-! ### idxOf?
The verification API for `idxOf?` is still incomplete.
The lemmas below should be made consistent with those for `findIdx?` (and proved using them).
-/
@[simp] theorem indexOf?_eq_none_iff [BEq α] [LawfulBEq α] {l : List α} {a : α} :
l.indexOf? a = none a l := by
simp only [indexOf?, findIdx?_eq_none_iff, beq_eq_false_iff_ne, ne_eq]
@[simp] theorem idxOf?_nil [BEq α] : ([] : List α).idxOf? a = none := rfl
theorem idxOf?_cons [BEq α] (a : α) (xs : List α) (b : α) :
(a :: xs).idxOf? b = if a == b then some 0 else (xs.idxOf? b).map (· + 1) := by
simp [idxOf?]
@[simp] theorem idxOf?_eq_none_iff [BEq α] [LawfulBEq α] {l : List α} {a : α} :
l.idxOf? a = none a l := by
simp only [idxOf?, findIdx?_eq_none_iff, beq_eq_false_iff_ne, ne_eq]
constructor
· intro w h
specialize w _ h
@@ -944,6 +994,15 @@ The lemmas below should be made consistent with those for `findIdx?` (and proved
· rintro w x h rfl
contradiction
@[deprecated idxOf?_eq_none_iff (since := "2025-01-29")]
abbrev indexOf?_eq_none_iff := @idxOf?_eq_none_iff
/-! ### finIdxOf? -/
theorem idxOf?_eq_map_finIdxOf?_val [BEq α] {xs : List α} {a : α} :
xs.idxOf? a = (xs.finIdxOf? a).map (·.val) := by
simp [idxOf?, finIdxOf?, findIdx?_eq_map_findFinIdx?_val]
/-! ### lookup -/
section lookup

View File

@@ -316,14 +316,35 @@ theorem insertIdxTR_go_eq : ∀ n l, insertIdxTR.go a n l acc = acc.toList ++ in
/-! ## Ranges and enumeration -/
/-! ### zipIdx -/
/-- Tail recursive version of `List.zipIdx`. -/
def zipIdxTR (l : List α) (n : Nat := 0) : List (α × Nat) :=
let arr := l.toArray
(arr.foldr (fun a (n, acc) => (n-1, (a, n-1) :: acc)) (n + arr.size, [])).2
@[csimp] theorem zipIdx_eq_zipIdxTR : @zipIdx = @zipIdxTR := by
funext α l n; simp [zipIdxTR, -Array.size_toArray]
let f := fun (a : α) (n, acc) => (n-1, (a, n-1) :: acc)
let rec go : l n, l.foldr f (n + l.length, []) = (n, zipIdx l n)
| [], n => rfl
| a::as, n => by
rw [ show _ + as.length = n + (a::as).length from Nat.succ_add .., foldr, go as]
simp [zipIdx, f]
rw [ Array.foldr_toList]
simp +zetaDelta [go]
/-! ### enumFrom -/
/-- Tail recursive version of `List.enumFrom`. -/
@[deprecated zipIdxTR (since := "2025-01-21")]
def enumFromTR (n : Nat) (l : List α) : List (Nat × α) :=
let arr := l.toArray
(arr.foldr (fun a (n, acc) => (n-1, (n-1, a) :: acc)) (n + arr.size, [])).2
@[csimp] theorem enumFrom_eq_enumFromTR : @enumFrom = @enumFromTR := by
set_option linter.deprecated false in
@[deprecated zipIdx_eq_zipIdxTR (since := "2025-01-21"), csimp]
theorem enumFrom_eq_enumFromTR : @enumFrom = @enumFromTR := by
funext α n l; simp [enumFromTR, -Array.size_toArray]
let f := fun (a : α) (n, acc) => (n-1, (n-1, a) :: acc)
let rec go : l n, l.foldr f (n + l.length, []) = (n, enumFrom n l)

View File

@@ -379,7 +379,7 @@ theorem eq_nil_iff_forall_not_mem {l : List α} : l = [] ↔ ∀ a, a ∉ l := b
theorem eq_of_mem_singleton : a [b] a = b
| .head .. => rfl
@[simp 1100] theorem mem_singleton {a b : α} : a [b] a = b :=
@[simp] theorem mem_singleton {a b : α} : a [b] a = b :=
eq_of_mem_singleton, (by simp [·])
theorem forall_mem_cons {p : α Prop} {a : α} {l : List α} :
@@ -436,6 +436,10 @@ theorem getElem?_of_mem {a} {l : List α} (h : a ∈ l) : ∃ i : Nat, l[i]? = s
let n, _, e := getElem_of_mem h
exact n, e getElem?_eq_getElem _
theorem mem_of_getElem {l : List α} {i : Nat} {h} {a : α} (e : l[i] = a) : a l := by
subst e
simp
theorem mem_of_getElem? {l : List α} {i : Nat} {a : α} (e : l[i]? = some a) : a l :=
let _, e := getElem?_eq_some_iff.1 e; e getElem_mem ..
@@ -1046,7 +1050,9 @@ theorem map_id'' {f : αα} (h : ∀ x, f x = x) (l : List α) : map f l =
theorem map_singleton (f : α β) (a : α) : map f [a] = [f a] := rfl
@[simp] theorem mem_map {f : α β} : {l : List α}, b l.map f a, a l f a = b
-- We use a lower priority here as there are more specific lemmas in downstream libraries
-- which should be able to fire first.
@[simp 500] theorem mem_map {f : α β} : {l : List α}, b l.map f a, a l f a = b
| [] => by simp
| _ :: l => by simp [mem_map (l := l), eq_comm (a := b)]
@@ -1556,7 +1562,7 @@ theorem getElem_of_append {l : List α} (eq : l = l₁ ++ a :: l₂) (h : l₁.l
rw [ getElem?_eq_getElem, eq, getElem?_append_right (h Nat.le_refl _), h]
simp
@[simp 1100] theorem singleton_append : [x] ++ l = x :: l := rfl
@[simp] theorem singleton_append : [x] ++ l = x :: l := rfl
theorem append_inj :
{s₁ s₂ t₁ t₂ : List α}, s₁ ++ t₁ = s₂ ++ t₂ length s₁ = length s₂ s₁ = s₂ t₁ = t₂
@@ -2965,7 +2971,7 @@ theorem dropLast_append {l₁ l₂ : List α} :
theorem dropLast_append_cons : dropLast (l₁ ++ b :: l₂) = l₁ ++ dropLast (b :: l₂) := by
simp
@[simp 1100] theorem dropLast_concat : dropLast (l₁ ++ [b]) = l₁ := by simp
@[simp] theorem dropLast_concat : dropLast (l₁ ++ [b]) = l₁ := by simp
@[simp] theorem dropLast_replicate (n) (a : α) : dropLast (replicate n a) = replicate (n - 1) a := by
match n with
@@ -3131,7 +3137,7 @@ variable [LawfulBEq α]
| Or.inr h' => exact h'
else rw [insert_of_not_mem h, mem_cons]
@[simp 1100] theorem mem_insert_self (a : α) (l : List α) : a l.insert a :=
@[simp] theorem mem_insert_self (a : α) (l : List α) : a l.insert a :=
mem_insert_iff.2 (Or.inl rfl)
theorem mem_insert_of_mem {l : List α} (h : a l) : a l.insert b :=

View File

@@ -15,17 +15,15 @@ namespace List
/-! ## Operations using indexes -/
/-! ### mapIdx -/
/--
Given a list `as = [a₀, a₁, ...]` function `f : Fin as.lengthα → β`, returns the list
`[f 0 a₀, f 1 a₁, ...]`.
Given a list `as = [a₀, a₁, ...]` and a function `f : (i : Nat) → α → (h : i < as.length) → β`, returns the list
`[f 0 a₀, f 1 a₁, ...]`.
-/
@[inline] def mapFinIdx (as : List α) (f : (i : Nat) α (h : i < as.length) β) : List β :=
go as #[] (by simp)
where
/-- Auxiliary for `mapFinIdx`:
`mapFinIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀, f 1 a₁, ...]` -/
`mapFinIdx.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀, f 1 a₁, ...]` -/
@[specialize] go : (bs : List α) (acc : Array β) bs.length + acc.size = as.length List β
| [], acc, h => acc.toList
| a :: as, acc, h =>
@@ -42,6 +40,31 @@ Given a function `f : Nat → α → β` and `as : List α`, `as = [a₀, a₁,
| [], acc => acc.toList
| a :: as, acc => go as (acc.push (f acc.size a))
/--
Given a list `as = [a₀, a₁, ...]` and a monadic function `f : (i : Nat) → α → (h : i < as.length) → m β`,
returns the list `[f 0 a₀ ⋯, f 1 a₁ ⋯, ...]`.
-/
@[inline] def mapFinIdxM [Monad m] (as : List α) (f : (i : Nat) α (h : i < as.length) m β) : m (List β) :=
go as #[] (by simp)
where
/-- Auxiliary for `mapFinIdxM`:
`mapFinIdxM.go [a₀, a₁, ...] acc = acc.toList ++ [f 0 a₀ ⋯, f 1 a₁ ⋯, ...]` -/
@[specialize] go : (bs : List α) (acc : Array β) bs.length + acc.size = as.length m (List β)
| [], acc, h => pure acc.toList
| a :: as, acc, h => do
go as (acc.push ( f acc.size a (by simp at h; omega))) (by simp at h ; omega)
/--
Given a monadic function `f : Nat → α → m β` and `as : List α`, `as = [a₀, a₁, ...]`,
returns the list `[f 0 a₀, f 1 a₁, ...]`.
-/
@[inline] def mapIdxM [Monad m] (f : Nat α m β) (as : List α) : m (List β) := go as #[] where
/-- Auxiliary for `mapIdxM`:
`mapIdxM.go [a₀, a₁, ...] acc = acc.toList ++ [f acc.size a₀, f (acc.size + 1) a₁, ...]` -/
@[specialize] go : List α Array β m (List β)
| [], acc => pure acc.toList
| a :: as, acc => do go as (acc.push ( f acc.size a))
/-! ### mapFinIdx -/
@[congr] theorem mapFinIdx_congr {xs ys : List α} (w : xs = ys)
@@ -132,16 +155,19 @@ theorem mapFinIdx_singleton {a : α} {f : (i : Nat) → α → (h : i < 1) →
[a].mapFinIdx f = [f 0 a (by simp)] := by
simp
theorem mapFinIdx_eq_enum_map {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = l.enum.attach.map
fun i, x, m =>
f i x (by rw [mk_mem_enum_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
theorem mapFinIdx_eq_zipIdx_map {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = l.zipIdx.attach.map
fun x, i, m =>
f i x (by rw [mk_mem_zipIdx_iff_getElem?, getElem?_eq_some_iff] at m; exact m.1) := by
apply ext_getElem <;> simp
@[deprecated mapFinIdx_eq_zipIdx_map (since := "2025-01-21")]
abbrev mapFinIdx_eq_zipWithIndex_map := @mapFinIdx_eq_zipIdx_map
@[simp]
theorem mapFinIdx_eq_nil_iff {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f = [] l = [] := by
rw [mapFinIdx_eq_enum_map, map_eq_nil_iff, attach_eq_nil_iff, enum_eq_nil_iff]
rw [mapFinIdx_eq_zipIdx_map, map_eq_nil_iff, attach_eq_nil_iff, zipIdx_eq_nil_iff]
theorem mapFinIdx_ne_nil_iff {l : List α} {f : (i : Nat) α (h : i < l.length) β} :
l.mapFinIdx f [] l [] := by
@@ -149,10 +175,10 @@ theorem mapFinIdx_ne_nil_iff {l : List α} {f : (i : Nat) → α → (h : i < l.
theorem exists_of_mem_mapFinIdx {b : β} {l : List α} {f : (i : Nat) α (h : i < l.length) β}
(h : b l.mapFinIdx f) : (i : Nat) (h : i < l.length), f i l[i] h = b := by
rw [mapFinIdx_eq_enum_map] at h
rw [mapFinIdx_eq_zipIdx_map] at h
replace h := exists_of_mem_map h
simp only [mem_attach, true_and, Subtype.exists, Prod.exists, mk_mem_enum_iff_getElem?] at h
obtain i, b, h, rfl := h
simp only [mem_attach, true_and, Subtype.exists, Prod.exists, mk_mem_zipIdx_iff_getElem?] at h
obtain b, i, h, rfl := h
rw [getElem?_eq_some_iff] at h
obtain h', rfl := h
exact i, h', rfl
@@ -331,17 +357,19 @@ theorem mapIdx_eq_mapFinIdx {l : List α} {f : Nat → α → β} :
l.mapIdx f = l.mapFinIdx (fun i a _ => f i a) := by
simp [mapFinIdx_eq_mapIdx]
theorem mapIdx_eq_enum_map {l : List α} :
l.mapIdx f = l.enum.map (Function.uncurry f) := by
theorem mapIdx_eq_zipIdx_map {l : List α} {f : Nat α β} :
l.mapIdx f = l.zipIdx.map (fun a, i => f i a) := by
ext1 i
simp only [getElem?_mapIdx, Option.map, getElem?_map, getElem?_enum]
simp only [getElem?_mapIdx, Option.map, getElem?_map, getElem?_zipIdx]
split <;> simp
@[deprecated mapIdx_eq_zipIdx_map (since := "2025-01-21")]
abbrev mapIdx_eq_enum_map := @mapIdx_eq_zipIdx_map
@[simp]
theorem mapIdx_cons {l : List α} {a : α} :
mapIdx f (a :: l) = f 0 a :: mapIdx (fun i => f (i + 1)) l := by
simp [mapIdx_eq_enum_map, enum_eq_zip_range, map_uncurry_zip_eq_zipWith,
range_succ_eq_map, zipWith_map_left]
simp [mapIdx_eq_zipIdx_map, List.zipIdx_succ]
theorem mapIdx_append {K L : List α} :
(K ++ L).mapIdx f = K.mapIdx f ++ L.mapIdx fun i => f (i + K.length) := by
@@ -358,7 +386,7 @@ theorem mapIdx_singleton {a : α} : mapIdx f [a] = [f 0 a] := by
@[simp]
theorem mapIdx_eq_nil_iff {l : List α} : List.mapIdx f l = [] l = [] := by
rw [List.mapIdx_eq_enum_map, List.map_eq_nil_iff, List.enum_eq_nil_iff]
rw [List.mapIdx_eq_zipIdx_map, List.map_eq_nil_iff, List.zipIdx_eq_nil_iff]
theorem mapIdx_ne_nil_iff {l : List α} :
List.mapIdx f l [] l [] := by

View File

@@ -28,7 +28,11 @@ attribute [simp] mapA forA filterAuxM firstM anyM allM findM? findSomeM?
/-! ### mapM -/
/-- Alternate (non-tail-recursive) form of mapM for proofs. -/
/-- Alternate (non-tail-recursive) form of mapM for proofs.
Note that we can not have this as the main definition and replace it using a `@[csimp]` lemma,
because they are only equal when `m` is a `LawfulMonad`.
-/
def mapM' [Monad m] (f : α m β) : List α m (List β)
| [] => pure []
| a :: l => return ( f a) :: ( l.mapM' f)
@@ -76,6 +80,63 @@ theorem mapM_eq_reverse_foldlM_cons [Monad m] [LawfulMonad m] (f : α → m β)
reverse_cons, reverse_nil, nil_append, singleton_append]
simp [bind_pure_comp]
/-! ### filterMapM -/
@[simp] theorem filterMapM_nil [Monad m] (f : α m (Option β)) : [].filterMapM f = pure [] := rfl
theorem filterMapM_loop_eq [Monad m] [LawfulMonad m]
(f : α m (Option β)) (l : List α) (acc : List β) :
filterMapM.loop f l acc = (acc.reverse ++ ·) <$> filterMapM.loop f l [] := by
induction l generalizing acc with
| nil => simp [filterMapM.loop]
| cons a l ih =>
simp only [filterMapM.loop, _root_.map_bind]
congr
funext b?
split <;> rename_i b
· apply ih
· rw [ih, ih [b]]
simp
@[simp] theorem filterMapM_cons [Monad m] [LawfulMonad m] (f : α m (Option β)) :
(a :: l).filterMapM f = do
match ( f a) with
| none => filterMapM f l
| some b => return (b :: ( filterMapM f l)) := by
conv => lhs; unfold filterMapM; unfold filterMapM.loop
congr
funext b?
split <;> rename_i b
· simp [filterMapM]
· simp only [bind_pure_comp]
rw [filterMapM_loop_eq, filterMapM]
simp
/-! ### flatMapM -/
@[simp] theorem flatMapM_nil [Monad m] (f : α m (List β)) : [].flatMapM f = pure [] := rfl
theorem flatMapM_loop_eq [Monad m] [LawfulMonad m] (f : α m (List β)) (l : List α) (acc : List (List β)) :
flatMapM.loop f l acc = (acc.reverse.flatten ++ ·) <$> flatMapM.loop f l [] := by
induction l generalizing acc with
| nil => simp [flatMapM.loop]
| cons a l ih =>
simp only [flatMapM.loop, append_nil, _root_.map_bind]
congr
funext bs
rw [ih, ih [bs]]
simp
@[simp] theorem flatMapM_cons [Monad m] [LawfulMonad m] (f : α m (List β)) :
(a :: l).flatMapM f = do
let bs f a
return (bs ++ ( l.flatMapM f)) := by
conv => lhs; unfold flatMapM; unfold flatMapM.loop
congr
funext bs
rw [flatMapM_loop_eq, flatMapM]
simp
/-! ### foldlM and foldrM -/
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : List β₁) (init : α) :
@@ -122,24 +183,36 @@ theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α → Bool) (g : α → β
simp only [filter_cons, foldrM_cons]
split <;> simp [ih]
@[simp] theorem foldlM_attachWith [Monad m]
(l : List α) {q : α Prop} (H : a, a l q a) {f : β { x // q x} m β} {b} :
(l.attachWith q H).foldlM f b = l.attach.foldlM (fun b a, h => f b a, H _ h) b := by
induction l generalizing b with
| nil => simp
| cons a l ih => simp [ih, foldlM_map]
@[simp] theorem foldrM_attachWith [Monad m] [LawfulMonad m]
(l : List α) {q : α Prop} (H : a, a l q a) {f : { x // q x} β m β} {b} :
(l.attachWith q H).foldrM f b = l.attach.foldrM (fun a acc => f a.1, H _ a.2 acc) b := by
induction l generalizing b with
| nil => simp
| cons a l ih => simp [ih, foldrM_map]
/-! ### forM -/
-- We currently use `List.forM` as the simp normal form, rather that `ForM.forM`.
-- (This should probably be revisited.)
-- As such we need to replace `List.forM_nil` and `List.forM_cons`:
@[deprecated forM_nil (since := "2025-01-31")]
theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl
@[simp] theorem forM_nil' [Monad m] : ([] : List α).forM f = (pure .unit : m PUnit) := rfl
@[simp] theorem forM_cons' [Monad m] :
@[deprecated forM_cons (since := "2025-01-31")]
theorem forM_cons' [Monad m] :
(a::as).forM f = (f a >>= fun _ => as.forM f : m PUnit) :=
List.forM_cons _ _ _
@[simp] theorem forM_append [Monad m] [LawfulMonad m] (l₁ l₂ : List α) (f : α m PUnit) :
(l₁ ++ l₂).forM f = (do l₁.forM f; l₂.forM f) := by
forM (l₁ ++ l₂) f = (do forM l₁ f; forM l₂ f) := by
induction l₁ <;> simp [*]
@[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : List α) (g : α β) (f : β m PUnit) :
(l.map g).forM f = l.forM (fun a => f (g a)) := by
forM (l.map g) f = forM l (fun a => f (g a)) := by
induction l <;> simp [*]
/-! ### forIn' -/
@@ -334,4 +407,65 @@ theorem allM_eq_not_anyM_not [Monad m] [LawfulMonad m] (p : α → m Bool) (as :
funext b
split <;> simp_all
/-! ### Recognizing higher order functions using a function that only depends on the value. -/
/--
This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldlM_subtype [Monad m] {p : α Prop} {l : List { x // p x }}
{f : β { x // p x } m β} {g : β α m β} {x : β}
(hf : b x h, f b x, h = g b x) :
l.foldlM f x = l.unattach.foldlM g x := by
unfold unattach
induction l generalizing x with
| nil => simp
| cons a l ih => simp [ih, hf]
/--
This lemma identifies monadic folds over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldrM_subtype [Monad m] [LawfulMonad m]{p : α Prop} {l : List { x // p x }}
{f : { x // p x } β m β} {g : α β m β} {x : β}
(hf : x h b, f x, h b = g x b) :
l.foldrM f x = l.unattach.foldrM g x := by
unfold unattach
induction l generalizing x with
| nil => simp
| cons a l ih =>
simp [ih, hf, foldrM_cons]
congr
funext b
simp [hf]
/--
This lemma identifies monadic maps over lists of subtypes, where the function only depends on the value, not the proposition,
and simplifies these to the function directly taking the value.
-/
@[simp] theorem mapM_subtype [Monad m] [LawfulMonad m] {p : α Prop} {l : List { x // p x }}
{f : { x // p x } m β} {g : α m β} (hf : x h, f x, h = g x) :
l.mapM f = l.unattach.mapM g := by
unfold unattach
simp [ List.mapM'_eq_mapM]
induction l with
| nil => simp
| cons a l ih => simp [ih, hf]
@[simp] theorem filterMapM_subtype [Monad m] [LawfulMonad m] {p : α Prop} {l : List { x // p x }}
{f : { x // p x } m (Option β)} {g : α m (Option β)} (hf : x h, f x, h = g x) :
l.filterMapM f = l.unattach.filterMapM g := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, hf, filterMapM_cons]
@[simp] theorem flatMapM_subtype [Monad m] [LawfulMonad m] {p : α Prop} {l : List { x // p x }}
{f : { x // p x } m (List β)} {g : α m (List β)} (hf : x h, f x, h = g x) :
(l.flatMapM f) = l.unattach.flatMapM g := by
unfold unattach
induction l with
| nil => simp
| cons a l ih => simp [ih, hf]
end List

View File

@@ -65,6 +65,11 @@ theorem getElem_eraseIdx_of_ge (l : List α) (i : Nat) (j : Nat) (h : j < (l.era
rw [getElem_eraseIdx, dif_neg]
omega
theorem eraseIdx_eq_dropLast (l : List α) (i : Nat) (h : i + 1 = l.length) :
l.eraseIdx i = l.dropLast := by
simp [eraseIdx_eq_take_drop_succ, h]
rw [take_eq_dropLast h]
theorem eraseIdx_set_eq {l : List α} {i : Nat} {a : α} :
(l.set i a).eraseIdx i = l.eraseIdx i := by
apply ext_getElem

View File

@@ -37,14 +37,14 @@ theorem find?_eq_some_iff_getElem {xs : List α} {p : α → Bool} {b : α} :
theorem findIdx?_eq_some_le_of_findIdx?_eq_some {xs : List α} {p q : α Bool} (w : x xs, p x q x) {i : Nat}
(h : xs.findIdx? p = some i) : j, j i xs.findIdx? q = some j := by
simp only [findIdx?_eq_findSome?_enum] at h
simp only [findIdx?_eq_findSome?_zipIdx] at h
rw [findSome?_eq_some_iff] at h
simp only [Option.ite_none_right_eq_some, Option.some.injEq, ite_eq_right_iff, reduceCtorEq,
imp_false, Bool.not_eq_true, Prod.forall, exists_and_right, Prod.exists] at h
obtain h, h₁, b, es, h₂, hb, rfl, h₃ := h
rw [enum_eq_enumFrom, enumFrom_eq_append_iff] at h₂
rw [zipIdx_eq_append_iff] at h₂
obtain l₁', l₂', rfl, rfl, h₂ := h₂
rw [eq_comm, enumFrom_eq_cons_iff] at h₂
rw [eq_comm, zipIdx_eq_cons_iff] at h₂
obtain a, as, rfl, h₂, rfl := h₂
simp only [Nat.zero_add, Prod.mk.injEq] at h₂
obtain rfl, rfl := h₂

View File

@@ -76,6 +76,12 @@ theorem eraseIdx_modifyHead_zero {f : αα} {l : List α} :
@[simp] theorem modifyHead_id : modifyHead (id : α α) = id := by funext l; cases l <;> simp
@[simp] theorem modifyHead_dropLast {l : List α} {f : α α} :
l.dropLast.modifyHead f = (l.modifyHead f).dropLast := by
rcases l with _|a, l
· simp
· rcases l with _|b, l <;> simp
/-! ### modifyTailIdx -/
@[simp] theorem modifyTailIdx_id : n (l : List α), l.modifyTailIdx id n = l

View File

@@ -77,12 +77,15 @@ theorem map_sub_range' (a s n : Nat) (h : a ≤ s) :
rw [ map_add_range', map_map, (?_ : __ = _), map_id]
funext x; apply Nat.add_sub_cancel_left
@[simp] theorem range'_eq_singleton {s n a : Nat} : range' s n = [a] s = a n = 1 := by
@[simp] theorem range'_eq_singleton_iff {s n a : Nat} : range' s n = [a] s = a n = 1 := by
rw [range'_eq_cons_iff]
simp only [nil_eq, range'_eq_nil, and_congr_right_iff]
simp only [nil_eq, range'_eq_nil_iff, and_congr_right_iff]
rintro rfl
omega
@[deprecated range'_eq_singleton_iff (since := "2025-01-29")]
abbrev range'_eq_singleton := @range'_eq_singleton_iff
theorem range'_eq_append_iff : range' s n = xs ++ ys k, k n xs = range' s k ys = range' (s + k) (n - k) := by
induction n generalizing s xs ys with
| zero => simp
@@ -174,7 +177,7 @@ theorem pairwise_lt_range (n : Nat) : Pairwise (· < ·) (range n) := by
theorem pairwise_le_range (n : Nat) : Pairwise (· ·) (range n) :=
Pairwise.imp Nat.le_of_lt (pairwise_lt_range _)
theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
@[simp] theorem take_range (m n : Nat) : take m (range n) = range (min m n) := by
apply List.ext_getElem
· simp
· simp +contextual [getElem_take, Nat.lt_min]
@@ -339,25 +342,166 @@ theorem find?_iota_eq_some {n : Nat} {i : Nat} {p : Nat → Bool} :
end
/-! ### enumFrom -/
/-! ### zipIdx -/
@[simp]
theorem zipIdx_singleton (x : α) (k : Nat) : zipIdx [x] k = [(x, k)] :=
rfl
@[simp] theorem head?_zipIdx (l : List α) (k : Nat) :
(zipIdx l k).head? = l.head?.map fun a => (a, k) := by
simp [head?_eq_getElem?]
@[simp] theorem getLast?_zipIdx (l : List α) (k : Nat) :
(zipIdx l k).getLast? = l.getLast?.map fun a => (a, k + l.length - 1) := by
simp [getLast?_eq_getElem?]
cases l <;> simp; omega
theorem mk_add_mem_zipIdx_iff_getElem? {k i : Nat} {x : α} {l : List α} :
(x, k + i) zipIdx l k l[i]? = some x := by
simp [mem_iff_getElem?, and_left_comm]
theorem mk_mem_zipIdx_iff_le_and_getElem?_sub {k i : Nat} {x : α} {l : List α} :
(x, i) zipIdx l k k i l[i - k]? = some x := by
if h : k i then
rcases Nat.exists_eq_add_of_le h with i, rfl
simp [mk_add_mem_zipIdx_iff_getElem?, Nat.add_sub_cancel_left]
else
have : m, k + m i := by rintro _ rfl; simp at h
simp [h, mem_iff_get?, this]
/-- Variant of `mk_mem_zipIdx_iff_le_and_getElem?_sub` specialized at `k = 0`,
to avoid the inequality and the subtraction. -/
theorem mk_mem_zipIdx_iff_getElem? {i : Nat} {x : α} {l : List α} : (x, i) zipIdx l l[i]? = x := by
simp [mk_mem_zipIdx_iff_le_and_getElem?_sub]
theorem mem_zipIdx_iff_le_and_getElem?_sub {x : α × Nat} {l : List α} {k : Nat} :
x zipIdx l k k x.2 l[x.2 - k]? = some x.1 := by
cases x
simp [mk_mem_zipIdx_iff_le_and_getElem?_sub]
/-- Variant of `mem_zipIdx_iff_le_and_getElem?_sub` specialized at `k = 0`,
to avoid the inequality and the subtraction. -/
theorem mem_zipIdx_iff_getElem? {x : α × Nat} {l : List α} : x zipIdx l l[x.2]? = some x.1 := by
cases x
simp [mk_mem_zipIdx_iff_le_and_getElem?_sub]
theorem le_snd_of_mem_zipIdx {x : α × Nat} {k : Nat} {l : List α} (h : x zipIdx l k) :
k x.2 :=
(mk_mem_zipIdx_iff_le_and_getElem?_sub.1 h).1
theorem snd_lt_add_of_mem_zipIdx {x : α × Nat} {l : List α} {k : Nat} (h : x zipIdx l k) :
x.2 < k + length l := by
rcases mem_iff_get.1 h with i, rfl
simpa using i.isLt
theorem snd_lt_of_mem_zipIdx {x : α × Nat} {l : List α} {k : Nat} (h : x l.zipIdx k) : x.2 < l.length + k := by
simpa [Nat.add_comm] using snd_lt_add_of_mem_zipIdx h
theorem map_zipIdx (f : α β) (l : List α) (k : Nat) :
map (Prod.map f id) (zipIdx l k) = zipIdx (l.map f) k := by
induction l generalizing k <;> simp_all
theorem fst_mem_of_mem_zipIdx {x : α × Nat} {l : List α} {k : Nat} (h : x zipIdx l k) : x.1 l :=
zipIdx_map_fst k l mem_map_of_mem _ h
theorem fst_eq_of_mem_zipIdx {x : α × Nat} {l : List α} {k : Nat} (h : x zipIdx l k) :
x.1 = l[x.2 - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) := by
induction l generalizing k with
| nil => cases h
| cons hd tl ih =>
cases h with
| head h => simp
| tail h m =>
specialize ih m
have : x.2 - k = x.2 - (k + 1) + 1 := by
have := le_snd_of_mem_zipIdx m
omega
simp [this, ih]
theorem mem_zipIdx {x : α} {i : Nat} {xs : List α} {k : Nat} (h : (x, i) xs.zipIdx k) :
k i i < k + xs.length
x = xs[i - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
le_snd_of_mem_zipIdx h, snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h
/-- Variant of `mem_zipIdx` specialized at `k = 0`. -/
theorem mem_zipIdx' {x : α} {i : Nat} {xs : List α} (h : (x, i) xs.zipIdx) :
i < xs.length x = xs[i]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
by simpa using snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h
theorem zipIdx_map (l : List α) (k : Nat) (f : α β) :
zipIdx (l.map f) k = (zipIdx l k).map (Prod.map f id) := by
induction l with
| nil => rfl
| cons hd tl IH =>
rw [map_cons, zipIdx_cons', zipIdx_cons', map_cons, map_map, IH, map_map]
rfl
theorem zipIdx_append (xs ys : List α) (k : Nat) :
zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + xs.length) := by
induction xs generalizing ys k with
| nil => simp
| cons x xs IH =>
rw [cons_append, zipIdx_cons, IH, cons_append, zipIdx_cons, length, Nat.add_right_comm,
Nat.add_assoc]
theorem zipIdx_eq_cons_iff {l : List α} {k : Nat} :
zipIdx l k = x :: l' a as, l = a :: as x = (a, k) l' = zipIdx as (k + 1) := by
rw [zipIdx_eq_zip_range', zip_eq_cons_iff]
constructor
· rintro l₁, l₂, rfl, h, rfl
rw [range'_eq_cons_iff] at h
obtain rfl, -, rfl := h
exact x.1, l₁, by simp [zipIdx_eq_zip_range']
· rintro a, as, rfl, rfl, rfl
refine as, range' (k+1) as.length, ?_
simp [zipIdx_eq_zip_range', range'_succ]
theorem zipIdx_eq_append_iff {l : List α} {k : Nat} :
zipIdx l k = l₁ ++ l₂
l₁' l₂', l = l₁' ++ l₂' l₁ = zipIdx l₁' k l₂ = zipIdx l₂' (k + l₁'.length) := by
rw [zipIdx_eq_zip_range', zip_eq_append_iff]
constructor
· rintro w, x, y, z, h, rfl, h', rfl, rfl
rw [range'_eq_append_iff] at h'
obtain k, -, rfl, rfl := h'
simp only [length_range'] at h
obtain rfl := h
refine w, x, rfl, ?_
simp only [zipIdx_eq_zip_range', length_append, true_and]
congr
omega
· rintro l₁', l₂', rfl, rfl, rfl
simp only [zipIdx_eq_zip_range']
refine l₁', l₂', range' k l₁'.length, range' (k + l₁'.length) l₂'.length, ?_
simp [Nat.add_comm]
/-! ### enumFrom -/
section
set_option linter.deprecated false
@[deprecated zipIdx_singleton (since := "2025-01-21"), simp]
theorem enumFrom_singleton (x : α) (n : Nat) : enumFrom n [x] = [(n, x)] :=
rfl
@[simp] theorem head?_enumFrom (n : Nat) (l : List α) :
@[deprecated head?_zipIdx (since := "2025-01-21"), simp]
theorem head?_enumFrom (n : Nat) (l : List α) :
(enumFrom n l).head? = l.head?.map fun a => (n, a) := by
simp [head?_eq_getElem?]
@[simp] theorem getLast?_enumFrom (n : Nat) (l : List α) :
@[deprecated getLast?_zipIdx (since := "2025-01-21"), simp]
theorem getLast?_enumFrom (n : Nat) (l : List α) :
(enumFrom n l).getLast? = l.getLast?.map fun a => (n + l.length - 1, a) := by
simp [getLast?_eq_getElem?]
cases l <;> simp; omega
@[deprecated mk_add_mem_zipIdx_iff_getElem? (since := "2025-01-21")]
theorem mk_add_mem_enumFrom_iff_getElem? {n i : Nat} {x : α} {l : List α} :
(n + i, x) enumFrom n l l[i]? = some x := by
simp [mem_iff_get?]
@[deprecated mk_mem_zipIdx_iff_le_and_getElem?_sub (since := "2025-01-21")]
theorem mk_mem_enumFrom_iff_le_and_getElem?_sub {n i : Nat} {x : α} {l : List α} :
(i, x) enumFrom n l n i l[i - n]? = x := by
if h : n i then
@@ -367,22 +511,27 @@ theorem mk_mem_enumFrom_iff_le_and_getElem?_sub {n i : Nat} {x : α} {l : List
have : k, n + k i := by rintro k rfl; simp at h
simp [h, mem_iff_get?, this]
@[deprecated le_snd_of_mem_zipIdx (since := "2025-01-21")]
theorem le_fst_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x enumFrom n l) :
n x.1 :=
(mk_mem_enumFrom_iff_le_and_getElem?_sub.1 h).1
@[deprecated snd_lt_add_of_mem_zipIdx (since := "2025-01-21")]
theorem fst_lt_add_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x enumFrom n l) :
x.1 < n + length l := by
rcases mem_iff_get.1 h with i, rfl
simpa using i.isLt
@[deprecated map_zipIdx (since := "2025-01-21")]
theorem map_enumFrom (f : α β) (n : Nat) (l : List α) :
map (Prod.map id f) (enumFrom n l) = enumFrom n (map f l) := by
induction l generalizing n <;> simp_all
@[deprecated fst_mem_of_mem_zipIdx (since := "2025-01-21")]
theorem snd_mem_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x enumFrom n l) : x.2 l :=
enumFrom_map_snd n l mem_map_of_mem _ h
@[deprecated fst_eq_of_mem_zipIdx (since := "2025-01-21")]
theorem snd_eq_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x enumFrom n l) :
x.2 = l[x.1 - n]'(by have := le_fst_of_mem_enumFrom h; have := fst_lt_add_of_mem_enumFrom h; omega) := by
induction l generalizing n with
@@ -397,11 +546,13 @@ theorem snd_eq_of_mem_enumFrom {x : Nat × α} {n : Nat} {l : List α} (h : x
omega
simp [this, ih]
@[deprecated mem_zipIdx (since := "2025-01-21")]
theorem mem_enumFrom {x : α} {i j : Nat} {xs : List α} (h : (i, x) xs.enumFrom j) :
j i i < j + xs.length
x = xs[i - j]'(by have := le_fst_of_mem_enumFrom h; have := fst_lt_add_of_mem_enumFrom h; omega) :=
le_fst_of_mem_enumFrom h, fst_lt_add_of_mem_enumFrom h, snd_eq_of_mem_enumFrom h
@[deprecated zipIdx_map (since := "2025-01-21")]
theorem enumFrom_map (n : Nat) (l : List α) (f : α β) :
enumFrom n (l.map f) = (enumFrom n l).map (Prod.map id f) := by
induction l with
@@ -410,6 +561,7 @@ theorem enumFrom_map (n : Nat) (l : List α) (f : α → β) :
rw [map_cons, enumFrom_cons', enumFrom_cons', map_cons, map_map, IH, map_map]
rfl
@[deprecated zipIdx_append (since := "2025-01-21")]
theorem enumFrom_append (xs ys : List α) (n : Nat) :
enumFrom n (xs ++ ys) = enumFrom n xs ++ enumFrom (n + xs.length) ys := by
induction xs generalizing ys n with
@@ -418,6 +570,7 @@ theorem enumFrom_append (xs ys : List α) (n : Nat) :
rw [cons_append, enumFrom_cons, IH, cons_append, enumFrom_cons, length, Nat.add_right_comm,
Nat.add_assoc]
@[deprecated zipIdx_eq_cons_iff (since := "2025-01-21")]
theorem enumFrom_eq_cons_iff {l : List α} {n : Nat} :
l.enumFrom n = x :: l' a as, l = a :: as x = (n, a) l' = enumFrom (n + 1) as := by
rw [enumFrom_eq_zip_range', zip_eq_cons_iff]
@@ -430,6 +583,7 @@ theorem enumFrom_eq_cons_iff {l : List α} {n : Nat} :
refine range' (n+1) as.length, as, ?_
simp [enumFrom_eq_zip_range', range'_succ]
@[deprecated zipIdx_eq_append_iff (since := "2025-01-21")]
theorem enumFrom_eq_append_iff {l : List α} {n : Nat} :
l.enumFrom n = l₁ ++ l₂
l₁' l₂', l = l₁' ++ l₂' l₁ = l₁'.enumFrom n l₂ = l₂'.enumFrom (n + l₁'.length) := by
@@ -449,89 +603,113 @@ theorem enumFrom_eq_append_iff {l : List α} {n : Nat} :
refine range' n l₁'.length, range' (n + l₁'.length) l₂'.length, l₁', l₂', ?_
simp [Nat.add_comm]
end
/-! ### enum -/
@[simp]
section
set_option linter.deprecated false
@[deprecated zipIdx_eq_nil_iff (since := "2025-01-21"), simp]
theorem enum_eq_nil_iff {l : List α} : List.enum l = [] l = [] := enumFrom_eq_nil
@[deprecated enum_eq_nil_iff (since := "2024-11-04")]
@[deprecated zipIdx_eq_nil_iff (since := "2024-11-04")]
theorem enum_eq_nil {l : List α} : List.enum l = [] l = [] := enum_eq_nil_iff
@[simp] theorem enum_singleton (x : α) : enum [x] = [(0, x)] := rfl
@[deprecated zipIdx_singleton (since := "2025-01-21"), simp]
theorem enum_singleton (x : α) : enum [x] = [(0, x)] := rfl
@[simp] theorem enum_length : (enum l).length = l.length :=
@[deprecated length_zipIdx (since := "2025-01-21"), simp]
theorem enum_length : (enum l).length = l.length :=
enumFrom_length
@[simp]
@[deprecated getElem?_zipIdx (since := "2025-01-21"), simp]
theorem getElem?_enum (l : List α) (n : Nat) : (enum l)[n]? = l[n]?.map fun a => (n, a) := by
rw [enum, getElem?_enumFrom, Nat.zero_add]
@[simp]
@[deprecated getElem_zipIdx (since := "2025-01-21"), simp]
theorem getElem_enum (l : List α) (i : Nat) (h : i < l.enum.length) :
l.enum[i] = (i, l[i]'(by simpa [enum_length] using h)) := by
simp [enum]
@[simp] theorem head?_enum (l : List α) :
@[deprecated head?_zipIdx (since := "2025-01-21"), simp] theorem head?_enum (l : List α) :
l.enum.head? = l.head?.map fun a => (0, a) := by
simp [head?_eq_getElem?]
@[simp] theorem getLast?_enum (l : List α) :
@[deprecated getLast?_zipIdx (since := "2025-01-21"), simp]
theorem getLast?_enum (l : List α) :
l.enum.getLast? = l.getLast?.map fun a => (l.length - 1, a) := by
simp [getLast?_eq_getElem?]
@[simp] theorem tail_enum (l : List α) : (enum l).tail = enumFrom 1 l.tail := by
@[deprecated tail_zipIdx (since := "2025-01-21"), simp]
theorem tail_enum (l : List α) : (enum l).tail = enumFrom 1 l.tail := by
simp [enum]
@[deprecated mk_mem_zipIdx_iff_getElem? (since := "2025-01-21")]
theorem mk_mem_enum_iff_getElem? {i : Nat} {x : α} {l : List α} : (i, x) enum l l[i]? = x := by
simp [enum, mk_mem_enumFrom_iff_le_and_getElem?_sub]
@[deprecated mem_zipIdx_iff_getElem? (since := "2025-01-21")]
theorem mem_enum_iff_getElem? {x : Nat × α} {l : List α} : x enum l l[x.1]? = some x.2 :=
mk_mem_enum_iff_getElem?
@[deprecated snd_lt_of_mem_zipIdx (since := "2025-01-21")]
theorem fst_lt_of_mem_enum {x : Nat × α} {l : List α} (h : x enum l) : x.1 < length l := by
simpa using fst_lt_add_of_mem_enumFrom h
@[deprecated fst_mem_of_mem_zipIdx (since := "2025-01-21")]
theorem snd_mem_of_mem_enum {x : Nat × α} {l : List α} (h : x enum l) : x.2 l :=
snd_mem_of_mem_enumFrom h
@[deprecated fst_eq_of_mem_zipIdx (since := "2025-01-21")]
theorem snd_eq_of_mem_enum {x : Nat × α} {l : List α} (h : x enum l) :
x.2 = l[x.1]'(fst_lt_of_mem_enum h) :=
snd_eq_of_mem_enumFrom h
@[deprecated mem_zipIdx (since := "2025-01-21")]
theorem mem_enum {x : α} {i : Nat} {xs : List α} (h : (i, x) xs.enum) :
i < xs.length x = xs[i]'(fst_lt_of_mem_enum h) :=
by simpa using mem_enumFrom h
@[deprecated map_zipIdx (since := "2025-01-21")]
theorem map_enum (f : α β) (l : List α) : map (Prod.map id f) (enum l) = enum (map f l) :=
map_enumFrom f 0 l
@[simp] theorem enum_map_fst (l : List α) : map Prod.fst (enum l) = range l.length := by
@[deprecated zipIdx_map_snd (since := "2025-01-21"), simp]
theorem enum_map_fst (l : List α) : map Prod.fst (enum l) = range l.length := by
simp only [enum, enumFrom_map_fst, range_eq_range']
@[simp]
@[deprecated zipIdx_map_fst (since := "2025-01-21"), simp]
theorem enum_map_snd (l : List α) : map Prod.snd (enum l) = l :=
enumFrom_map_snd _ _
@[deprecated zipIdx_map (since := "2025-01-21")]
theorem enum_map (l : List α) (f : α β) : (l.map f).enum = l.enum.map (Prod.map id f) :=
enumFrom_map _ _ _
@[deprecated zipIdx_append (since := "2025-01-21")]
theorem enum_append (xs ys : List α) : enum (xs ++ ys) = enum xs ++ enumFrom xs.length ys := by
simp [enum, enumFrom_append]
@[deprecated zipIdx_eq_zip_range' (since := "2025-01-21")]
theorem enum_eq_zip_range (l : List α) : l.enum = (range l.length).zip l :=
zip_of_prod (enum_map_fst _) (enum_map_snd _)
@[simp]
@[deprecated unzip_zipIdx_eq_prod (since := "2025-01-21"), simp]
theorem unzip_enum_eq_prod (l : List α) : l.enum.unzip = (range l.length, l) := by
simp only [enum_eq_zip_range, unzip_zip, length_range]
@[deprecated zipIdx_eq_cons_iff (since := "2025-01-21")]
theorem enum_eq_cons_iff {l : List α} :
l.enum = x :: l' a as, l = a :: as x = (0, a) l' = enumFrom 1 as := by
rw [enum, enumFrom_eq_cons_iff]
@[deprecated zipIdx_eq_append_iff (since := "2025-01-21")]
theorem enum_eq_append_iff {l : List α} :
l.enum = l₁ ++ l₂
l₁' l₂', l = l₁' ++ l₂' l₁ = l₁'.enum l₂ = l₂'.enumFrom l₁'.length := by
simp [enum, enumFrom_eq_append_iff]
end
end List

View File

@@ -171,6 +171,20 @@ theorem dropLast_take {n : Nat} {l : List α} (h : n < l.length) :
@[deprecated map_eq_append_iff (since := "2024-09-05")] abbrev map_eq_append_split := @map_eq_append_iff
theorem take_eq_dropLast {l : List α} {i : Nat} (h : i + 1 = l.length) :
l.take i = l.dropLast := by
induction l generalizing i with
| nil => simp
| cons a as ih =>
cases i
· simp_all
· cases as with
| nil => simp_all
| cons b bs =>
simp only [take_succ_cons, dropLast_cons₂]
rw [ih]
simpa using h
theorem take_prefix_take_left (l : List α) {m n : Nat} (h : m n) : take m l <+: take n l := by
rw [isPrefix_iff]
intro i w

View File

@@ -68,6 +68,15 @@ theorem ofFn_succ {n} (f : Fin (n + 1) → α) : ofFn f = f 0 :: ofFn fun i => f
theorem ofFn_eq_nil_iff {f : Fin n α} : ofFn f = [] n = 0 := by
cases n <;> simp only [ofFn_zero, ofFn_succ, eq_self_iff_true, Nat.succ_ne_zero, reduceCtorEq]
@[simp 500]
theorem mem_ofFn {n} (f : Fin n α) (a : α) : a ofFn f i, f i = a := by
constructor
· intro w
obtain i, h, rfl := getElem_of_mem w
exact i, by simpa using h, by simp
· rintro i, rfl
apply mem_of_getElem (i := i) <;> simp
theorem head_ofFn {n} (f : Fin n α) (h : ofFn f []) :
(ofFn f).head h = f 0, Nat.pos_of_ne_zero (mt ofFn_eq_nil_iff.2 h) := by
rw [ getElem_zero (length_ofFn _ Nat.pos_of_ne_zero (mt ofFn_eq_nil_iff.2 h)),

View File

@@ -8,7 +8,7 @@ import Init.Data.List.Pairwise
import Init.Data.List.Zip
/-!
# Lemmas about `List.range` and `List.enum`
# Lemmas about `List.range` and `List.zipIdx`
Most of the results are deferred to `Data.Init.List.Nat.Range`, where more results about
natural arithmetic are available.
@@ -29,12 +29,16 @@ theorem range'_succ (s n step) : range' s (n + 1) step = s :: range' (s + step)
| 0 => rfl
| _ + 1 => congrArg succ (length_range' _ _ _)
@[simp] theorem range'_eq_nil : range' s n step = [] n = 0 := by
@[simp] theorem range'_eq_nil_iff : range' s n step = [] n = 0 := by
rw [ length_eq_zero, length_range']
theorem range'_ne_nil (s : Nat) {n : Nat} : range' s n [] n 0 := by
@[deprecated range'_eq_nil_iff (since := "2025-01-29")] abbrev range'_eq_nil := @range'_eq_nil_iff
theorem range'_ne_nil_iff (s : Nat) {n step : Nat} : range' s n step [] n 0 := by
cases n <;> simp
@[deprecated range'_ne_nil_iff (since := "2025-01-29")] abbrev range'_ne_nil := @range'_ne_nil_iff
@[simp] theorem range'_zero : range' s 0 step = [] := by
simp
@@ -94,18 +98,18 @@ theorem range'_succ_left : range' (s + 1) n step = (range' s n step).map (· + 1
· simp [Nat.add_right_comm]
theorem range'_append : s m n step : Nat,
range' s m step ++ range' (s + step * m) n step = range' s (n + m) step
| _, 0, _, _ => rfl
range' s m step ++ range' (s + step * m) n step = range' s (m + n) step
| _, 0, _, _ => by simp
| s, m + 1, n, step => by
simpa [range', Nat.mul_succ, Nat.add_assoc, Nat.add_comm]
using range'_append (s + step) m n step
@[simp] theorem range'_append_1 (s m n : Nat) :
range' s m ++ range' (s + m) n = range' s (n + m) := by simpa using range'_append s m n 1
range' s m ++ range' (s + m) n = range' s (m + n) := by simpa using range'_append s m n 1
theorem range'_sublist_right {s m n : Nat} : range' s m step <+ range' s n step m n :=
fun h => by simpa only [length_range'] using h.length_le,
fun h => by rw [ Nat.sub_add_cancel h, range'_append]; apply sublist_append_left
fun h => by rw [ add_sub_of_le h, range'_append]; apply sublist_append_left
theorem range'_subset_right {s m n : Nat} (step0 : 0 < step) :
range' s m step range' s n step m n := by
@@ -117,7 +121,7 @@ theorem range'_subset_right_1 {s m n : Nat} : range' s m ⊆ range' s n ↔ m
range'_subset_right (by decide)
theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ [s + step * n] := by
rw [Nat.add_comm n 1]; exact (range'_append s n 1 step).symm
exact (range'_append s n 1 step).symm
theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ [s + n] := by
simp [range'_concat]
@@ -204,17 +208,97 @@ theorem getLast?_range (n : Nat) : (range n).getLast? = if n = 0 then none else
| zero => simp at h
| succ n => simp [getLast?_range, getLast_eq_iff_getLast_eq_some]
/-! ### enumFrom -/
/-! ### zipIdx -/
@[simp]
theorem zipIdx_eq_nil_iff {l : List α} {n : Nat} : List.zipIdx l n = [] l = [] := by
cases l <;> simp
@[simp] theorem length_zipIdx : {l : List α} {n}, (zipIdx l n).length = l.length
| [], _ => rfl
| _ :: _, _ => congrArg Nat.succ length_zipIdx
@[simp]
theorem getElem?_zipIdx :
(l : List α) n m, (zipIdx l n)[m]? = l[m]?.map fun a => (a, n + m)
| [], _, _ => rfl
| _ :: _, _, 0 => by simp
| _ :: l, n, m + 1 => by
simp only [zipIdx_cons, getElem?_cons_succ]
exact (getElem?_zipIdx l (n + 1) m).trans <| by rw [Nat.add_right_comm]; rfl
@[simp]
theorem getElem_zipIdx (l : List α) (n) (i : Nat) (h : i < (l.zipIdx n).length) :
(l.zipIdx n)[i] = (l[i]'(by simpa [length_zipIdx] using h), n + i) := by
simp only [length_zipIdx] at h
rw [getElem_eq_getElem?_get]
simp only [getElem?_zipIdx, getElem?_eq_getElem h]
simp
@[simp]
theorem tail_zipIdx (l : List α) (n : Nat) : (zipIdx l n).tail = zipIdx l.tail (n + 1) := by
induction l generalizing n with
| nil => simp
| cons _ l ih => simp [ih, zipIdx_cons]
theorem map_snd_add_zipIdx_eq_zipIdx (l : List α) (n k : Nat) :
map (Prod.map id (· + n)) (zipIdx l k) = zipIdx l (n + k) :=
ext_getElem? fun i by simp [(· ·), Nat.add_comm, Nat.add_left_comm]; rfl
theorem zipIdx_cons' (n : Nat) (x : α) (xs : List α) :
zipIdx (x :: xs) n = (x, n) :: (zipIdx xs n).map (Prod.map id (· + 1)) := by
rw [zipIdx_cons, Nat.add_comm, map_snd_add_zipIdx_eq_zipIdx]
@[simp]
theorem zipIdx_map_snd (n) :
(l : List α), map Prod.snd (zipIdx l n) = range' n l.length
| [] => rfl
| _ :: _ => congrArg (cons _) (zipIdx_map_snd _ _)
@[simp]
theorem zipIdx_map_fst : (n) (l : List α), map Prod.fst (zipIdx l n) = l
| _, [] => rfl
| _, _ :: _ => congrArg (cons _) (zipIdx_map_fst _ _)
theorem zipIdx_eq_zip_range' (l : List α) {n : Nat} : l.zipIdx n = l.zip (range' n l.length) :=
zip_of_prod (zipIdx_map_fst _ _) (zipIdx_map_snd _ _)
@[simp]
theorem unzip_zipIdx_eq_prod (l : List α) {n : Nat} :
(l.zipIdx n).unzip = (l, range' n l.length) := by
simp only [zipIdx_eq_zip_range', unzip_zip, length_range']
/-- Replace `zipIdx` with a starting index `n+1` with `zipIdx` starting from `n`,
followed by a `map` increasing the indices by one. -/
theorem zipIdx_succ (l : List α) (n : Nat) :
l.zipIdx (n + 1) = (l.zipIdx n).map (fun a, i => (a, i + 1)) := by
induction l generalizing n with
| nil => rfl
| cons _ _ ih => simp only [zipIdx_cons, ih (n + 1), map_cons]
/-- Replace `zipIdx` with a starting index with `zipIdx` starting from 0,
followed by a `map` increasing the indices. -/
theorem zipIdx_eq_map_add (l : List α) (n : Nat) :
l.zipIdx n = l.zipIdx.map (fun a, i => (a, n + i)) := by
induction l generalizing n with
| nil => rfl
| cons _ _ ih => simp [ih (n+1), zipIdx_succ, Nat.add_assoc, Nat.add_comm 1]
/-! ### enumFrom -/
section
set_option linter.deprecated false
@[deprecated zipIdx_eq_nil_iff (since := "2025-01-21"), simp]
theorem enumFrom_eq_nil {n : Nat} {l : List α} : List.enumFrom n l = [] l = [] := by
cases l <;> simp
@[simp] theorem enumFrom_length : {n} {l : List α}, (enumFrom n l).length = l.length
@[deprecated length_zipIdx (since := "2025-01-21"), simp]
theorem enumFrom_length : {n} {l : List α}, (enumFrom n l).length = l.length
| _, [] => rfl
| _, _ :: _ => congrArg Nat.succ enumFrom_length
@[simp]
@[deprecated getElem?_zipIdx (since := "2025-01-21"), simp]
theorem getElem?_enumFrom :
n (l : List α) m, (enumFrom n l)[m]? = l[m]?.map fun a => (n + m, a)
| _, [], _ => rfl
@@ -223,7 +307,7 @@ theorem getElem?_enumFrom :
simp only [enumFrom_cons, getElem?_cons_succ]
exact (getElem?_enumFrom (n + 1) l m).trans <| by rw [Nat.add_right_comm]; rfl
@[simp]
@[deprecated getElem_zipIdx (since := "2025-01-21"), simp]
theorem getElem_enumFrom (l : List α) (n) (i : Nat) (h : i < (l.enumFrom n).length) :
(l.enumFrom n)[i] = (n + i, l[i]'(by simpa [enumFrom_length] using h)) := by
simp only [enumFrom_length] at h
@@ -231,53 +315,66 @@ theorem getElem_enumFrom (l : List α) (n) (i : Nat) (h : i < (l.enumFrom n).len
simp only [getElem?_enumFrom, getElem?_eq_getElem h]
simp
@[simp]
@[deprecated tail_zipIdx (since := "2025-01-21"), simp]
theorem tail_enumFrom (l : List α) (n : Nat) : (enumFrom n l).tail = enumFrom (n + 1) l.tail := by
induction l generalizing n with
| nil => simp
| cons _ l ih => simp [ih, enumFrom_cons]
@[deprecated map_snd_add_zipIdx_eq_zipIdx (since := "2025-01-21"), simp]
theorem map_fst_add_enumFrom_eq_enumFrom (l : List α) (n k : Nat) :
map (Prod.map (· + n) id) (enumFrom k l) = enumFrom (n + k) l :=
ext_getElem? fun i by simp [(· ·), Nat.add_comm, Nat.add_left_comm]; rfl
@[deprecated map_snd_add_zipIdx_eq_zipIdx (since := "2025-01-21"), simp]
theorem map_fst_add_enum_eq_enumFrom (l : List α) (n : Nat) :
map (Prod.map (· + n) id) (enum l) = enumFrom n l :=
map_fst_add_enumFrom_eq_enumFrom l _ _
@[deprecated zipIdx_cons' (since := "2025-01-21"), simp]
theorem enumFrom_cons' (n : Nat) (x : α) (xs : List α) :
enumFrom n (x :: xs) = (n, x) :: (enumFrom n xs).map (Prod.map (· + 1) id) := by
rw [enumFrom_cons, Nat.add_comm, map_fst_add_enumFrom_eq_enumFrom]
@[simp]
@[deprecated zipIdx_map_snd (since := "2025-01-21"), simp]
theorem enumFrom_map_fst (n) :
(l : List α), map Prod.fst (enumFrom n l) = range' n l.length
| [] => rfl
| _ :: _ => congrArg (cons _) (enumFrom_map_fst _ _)
@[simp]
@[deprecated zipIdx_map_fst (since := "2025-01-21"), simp]
theorem enumFrom_map_snd : (n) (l : List α), map Prod.snd (enumFrom n l) = l
| _, [] => rfl
| _, _ :: _ => congrArg (cons _) (enumFrom_map_snd _ _)
@[deprecated zipIdx_eq_zip_range' (since := "2025-01-21")]
theorem enumFrom_eq_zip_range' (l : List α) {n : Nat} : l.enumFrom n = (range' n l.length).zip l :=
zip_of_prod (enumFrom_map_fst _ _) (enumFrom_map_snd _ _)
@[simp]
@[deprecated unzip_zipIdx_eq_prod (since := "2025-01-21"), simp]
theorem unzip_enumFrom_eq_prod (l : List α) {n : Nat} :
(l.enumFrom n).unzip = (range' n l.length, l) := by
simp only [enumFrom_eq_zip_range', unzip_zip, length_range']
end
/-! ### enum -/
section
set_option linter.deprecated false
@[deprecated zipIdx_cons (since := "2025-01-21")]
theorem enum_cons : (a::as).enum = (0, a) :: as.enumFrom 1 := rfl
@[deprecated zipIdx_cons (since := "2025-01-21")]
theorem enum_cons' (x : α) (xs : List α) :
enum (x :: xs) = (0, x) :: (enum xs).map (Prod.map (· + 1) id) :=
enumFrom_cons' _ _ _
@[deprecated "These are now both `l.zipIdx 0`" (since := "2025-01-21")]
theorem enum_eq_enumFrom {l : List α} : l.enum = l.enumFrom 0 := rfl
@[deprecated "Use the reverse direction of `map_snd_add_zipIdx_eq_zipIdx` instead" (since := "2025-01-21")]
theorem enumFrom_eq_map_enum (l : List α) (n : Nat) :
enumFrom n l = (enum l).map (Prod.map (· + n) id) := by
induction l generalizing n with
@@ -288,4 +385,6 @@ theorem enumFrom_eq_map_enum (l : List α) (n : Nat) :
intro a b _
exact (succ_add a n).symm
end
end List

View File

@@ -73,14 +73,14 @@ termination_by xs => xs.length
/--
Given an ordering relation `le : αα → Bool`,
construct the reverse lexicographic ordering on `Nat × α`.
which first compares the second components using `le`,
construct the lexicographic ordering on `α × Nat`.
which first compares the first components using `le`,
but if these are equivalent (in the sense `le a.2 b.2 && le b.2 a.2`)
then compares the first components using `≤`.
then compares the second components using `≤`.
This function is only used in stating the stability properties of `mergeSort`.
-/
def enumLE (le : α α Bool) (a b : Nat × α) : Bool :=
if le a.2 b.2 then if le b.2 a.2 then a.1 b.1 else true else false
def zipIdxLE (le : α α Bool) (a b : α × Nat) : Bool :=
if le a.1 b.1 then if le b.1 a.1 then a.2 b.2 else true else false
end List

View File

@@ -38,35 +38,35 @@ namespace MergeSort.Internal
theorem splitInTwo_fst_append_splitInTwo_snd (l : { l : List α // l.length = n }) : (splitInTwo l).1.1 ++ (splitInTwo l).2.1 = l.1 := by
simp
theorem splitInTwo_cons_cons_enumFrom_fst (i : Nat) (l : List α) :
(splitInTwo (i, a) :: (i+1, b) :: l.enumFrom (i+2), rfl).1.1 =
(splitInTwo a :: b :: l, rfl).1.1.enumFrom i := by
simp only [length_cons, splitInTwo_fst, enumFrom_length]
theorem splitInTwo_cons_cons_zipIdx_fst (i : Nat) (l : List α) :
(splitInTwo (a, i) :: (b, i+1) :: l.zipIdx (i+2), rfl).1.1 =
(splitInTwo a :: b :: l, rfl).1.1.zipIdx i := by
simp only [length_cons, splitInTwo_fst, length_zipIdx]
ext1 j
rw [getElem?_take, getElem?_enumFrom, getElem?_take]
rw [getElem?_take, getElem?_zipIdx, getElem?_take]
split
· rw [getElem?_cons, getElem?_cons, getElem?_cons, getElem?_cons]
split
· simp; omega
· split
· simp; omega
· simp only [getElem?_enumFrom]
· simp only [getElem?_zipIdx]
congr
ext <;> simp; omega
· simp
theorem splitInTwo_cons_cons_enumFrom_snd (i : Nat) (l : List α) :
(splitInTwo (i, a) :: (i+1, b) :: l.enumFrom (i+2), rfl).2.1 =
(splitInTwo a :: b :: l, rfl).2.1.enumFrom (i+(l.length+3)/2) := by
simp only [length_cons, splitInTwo_snd, enumFrom_length]
theorem splitInTwo_cons_cons_zipIdx_snd (i : Nat) (l : List α) :
(splitInTwo (a, i) :: (b, i+1) :: l.zipIdx (i+2), rfl).2.1 =
(splitInTwo a :: b :: l, rfl).2.1.zipIdx (i+(l.length+3)/2) := by
simp only [length_cons, splitInTwo_snd, length_zipIdx]
ext1 j
rw [getElem?_drop, getElem?_enumFrom, getElem?_drop]
rw [getElem?_drop, getElem?_zipIdx, getElem?_drop]
rw [getElem?_cons, getElem?_cons, getElem?_cons, getElem?_cons]
split
· simp; omega
· split
· simp; omega
· simp only [getElem?_enumFrom]
· simp only [getElem?_zipIdx]
congr
ext <;> simp; omega
@@ -88,13 +88,13 @@ end MergeSort.Internal
open MergeSort.Internal
/-! ### enumLE -/
/-! ### zipIdxLE -/
variable {le : α α Bool}
theorem enumLE_trans (trans : a b c, le a b le b c le a c)
(a b c : Nat × α) : enumLE le a b enumLE le b c enumLE le a c := by
simp only [enumLE]
theorem zipIdxLE_trans (trans : a b c, le a b le b c le a c)
(a b c : α × Nat) : zipIdxLE le a b zipIdxLE le b c zipIdxLE le a c := by
simp only [zipIdxLE]
split <;> split <;> split <;> rename_i ab₂ ba₂ bc₂
· simp_all
intro ab₁
@@ -120,14 +120,14 @@ theorem enumLE_trans (trans : ∀ a b c, le a b → le b c → le a c)
· simp_all
· simp_all
theorem enumLE_total (total : a b, le a b || le b a)
(a b : Nat × α) : enumLE le a b || enumLE le b a := by
simp only [enumLE]
theorem zipIdxLE_total (total : a b, le a b || le b a)
(a b : α × Nat) : zipIdxLE le a b || zipIdxLE le b a := by
simp only [zipIdxLE]
split <;> split
· simpa using Nat.le_total a.fst b.fst
· simpa using Nat.le_total a.2 b.2
· simp
· simp
· have := total a.2 b.2
· have := total a.1 b.1
simp_all
/-! ### merge -/
@@ -179,12 +179,12 @@ theorem mem_merge_left (s : αα → Bool) (h : x ∈ l) : x ∈ merge l r
theorem mem_merge_right (s : α α Bool) (h : x r) : x merge l r s :=
mem_merge.2 <| .inr h
theorem merge_stable : (xs ys) (_ : x y, x xs y ys x.1 y.1),
(merge xs ys (enumLE le)).map (·.2) = merge (xs.map (·.2)) (ys.map (·.2)) le
theorem merge_stable : (xs ys) (_ : x y, x xs y ys x.2 y.2),
(merge xs ys (zipIdxLE le)).map (·.1) = merge (xs.map (·.1)) (ys.map (·.1)) le
| [], ys, _ => by simp [merge]
| xs, [], _ => by simp [merge]
| (i, x) :: xs, (j, y) :: ys, h => by
simp only [merge, enumLE, map_cons]
simp only [merge, zipIdxLE, map_cons]
split <;> rename_i w
· rw [if_pos (by simp [h _ _ (mem_cons_self ..) (mem_cons_self ..)])]
simp only [map_cons, cons.injEq, true_and]
@@ -331,57 +331,59 @@ See also:
* `sublist_mergeSort`: if `c <+ l` and `c.Pairwise le`, then `c <+ mergeSort le l`.
* `pair_sublist_mergeSort`: if `[a, b] <+ l` and `le a b`, then `[a, b] <+ mergeSort le l`)
-/
theorem mergeSort_enum {l : List α} :
(mergeSort (l.enum) (enumLE le)).map (·.2) = mergeSort l le :=
theorem mergeSort_zipIdx {l : List α} :
(mergeSort (l.zipIdx) (zipIdxLE le)).map (·.1) = mergeSort l le :=
go 0 l
where go : (i : Nat) (l : List α),
(mergeSort (l.enumFrom i) (enumLE le)).map (·.2) = mergeSort l le
(mergeSort (l.zipIdx i) (zipIdxLE le)).map (·.1) = mergeSort l le
| _, []
| _, [a] => by simp [mergeSort]
| _, a :: b :: xs => by
have : (splitInTwo a :: b :: xs, rfl).1.1.length < xs.length + 1 + 1 := by simp [splitInTwo_fst]; omega
have : (splitInTwo a :: b :: xs, rfl).2.1.length < xs.length + 1 + 1 := by simp [splitInTwo_snd]; omega
simp only [mergeSort, enumFrom]
rw [splitInTwo_cons_cons_enumFrom_fst]
rw [splitInTwo_cons_cons_enumFrom_snd]
simp only [mergeSort, zipIdx]
rw [splitInTwo_cons_cons_zipIdx_fst]
rw [splitInTwo_cons_cons_zipIdx_snd]
rw [merge_stable]
· rw [go, go]
· simp only [mem_mergeSort, Prod.forall]
intros j x k y mx my
have := mem_enumFrom mx
have := mem_enumFrom my
have := mem_zipIdx mx
have := mem_zipIdx my
simp_all
omega
termination_by _ l => l.length
@[deprecated mergeSort_zipIdx (since := "2025-01-21")] abbrev mergeSort_enum := @mergeSort_zipIdx
theorem mergeSort_cons {le : α α Bool}
(trans : (a b c : α), le a b le b c le a c)
(total : (a b : α), le a b || le b a)
(a : α) (l : List α) :
l₁ l₂, mergeSort (a :: l) le = l₁ ++ a :: l₂ mergeSort l le = l₁ ++ l₂
b, b l₁ !le a b := by
rw [ mergeSort_enum]
rw [enum_cons]
have nd : Nodup ((a :: l).enum.map (·.1)) := by rw [enum_map_fst]; exact nodup_range _
have m₁ : (0, a) mergeSort ((a :: l).enum) (enumLE le) :=
rw [ mergeSort_zipIdx]
rw [zipIdx_cons]
have nd : Nodup ((a :: l).zipIdx.map (·.2)) := by rw [zipIdx_map_snd]; exact nodup_range' _ _
have m₁ : (a, 0) mergeSort ((a :: l).zipIdx) (zipIdxLE le) :=
mem_mergeSort.mpr (mem_cons_self _ _)
obtain l₁, l₂, h := append_of_mem m₁
have s := sorted_mergeSort (enumLE_trans trans) (enumLE_total total) ((a :: l).enum)
have s := sorted_mergeSort (zipIdxLE_trans trans) (zipIdxLE_total total) ((a :: l).zipIdx)
rw [h] at s
have p := mergeSort_perm ((a :: l).enum) (enumLE le)
have p := mergeSort_perm ((a :: l).zipIdx) (zipIdxLE le)
rw [h] at p
refine l₁.map (·.2), l₂.map (·.2), ?_, ?_, ?_
· simpa using congrArg (·.map (·.2)) h
· rw [ mergeSort_enum.go 1, map_append]
refine l₁.map (·.1), l₂.map (·.1), ?_, ?_, ?_
· simpa using congrArg (·.map (·.1)) h
· rw [ mergeSort_zipIdx.go 1, map_append]
congr 1
have q : mergeSort (enumFrom 1 l) (enumLE le) ~ l₁ ++ l₂ :=
(mergeSort_perm (enumFrom 1 l) (enumLE le)).trans
have q : mergeSort (l.zipIdx 1) (zipIdxLE le) ~ l₁ ++ l₂ :=
(mergeSort_perm (l.zipIdx 1) (zipIdxLE le)).trans
(p.symm.trans perm_middle).cons_inv
apply Perm.eq_of_sorted (le := enumLE le)
· rintro i, a j, b ha hb
apply Perm.eq_of_sorted (le := zipIdxLE le)
· rintro a, i b, j ha hb
simp only [mem_mergeSort] at ha
simp only [ q.mem_iff, mem_mergeSort] at hb
simp only [enumLE]
simp only [zipIdxLE]
simp only [Bool.if_false_right, Bool.and_eq_true, Prod.mk.injEq, and_imp]
intro ab h ba h'
simp only [Bool.decide_eq_true] at ba
@@ -389,24 +391,24 @@ theorem mergeSort_cons {le : αα → Bool}
replace h' : j i := by simpa [ab, ba] using h'
cases Nat.le_antisymm h h'
constructor
· rfl
· have := mem_enumFrom ha
have := mem_enumFrom hb
· have := mem_zipIdx ha
have := mem_zipIdx hb
simp_all
· exact sorted_mergeSort (enumLE_trans trans) (enumLE_total total) ..
· exact s.sublist ((sublist_cons_self (0, a) l₂).append_left l₁)
· rfl
· exact sorted_mergeSort (zipIdxLE_trans trans) (zipIdxLE_total total) ..
· exact s.sublist ((sublist_cons_self (a, 0) l₂).append_left l₁)
· exact q
· intro b m
simp only [mem_map, Prod.exists, exists_eq_right] at m
obtain j, m := m
replace p := p.map (·.1)
simp only [mem_map, Prod.exists] at m
obtain j, _, m, rfl := m
replace p := p.map (·.2)
have nd' := nd.perm p.symm
rw [map_append] at nd'
have j0 := nd'.rel_of_mem_append
(mem_map_of_mem (·.1) m) (mem_map_of_mem _ (mem_cons_self _ _))
(mem_map_of_mem (·.2) m) (mem_map_of_mem _ (mem_cons_self _ _))
simp only [ne_eq] at j0
have r := s.rel_of_mem_append m (mem_cons_self _ _)
simp_all [enumLE]
simp_all [zipIdxLE]
/--
Another statement of stability of merge sort.

View File

@@ -13,6 +13,21 @@ import Init.Data.Array.Lex.Basic
We prefer to pull `List.toArray` outwards past `Array` operations.
-/
namespace Array
@[simp] theorem toList_set (a : Array α) (i x h) :
(a.set i x).toList = a.toList.set i x := rfl
theorem swap_def (a : Array α) (i j : Nat) (hi hj) :
a.swap i j hi hj = (a.set i a[j]).set j a[i] (by simpa using hj) := by
simp [swap]
@[simp] theorem toList_swap (a : Array α) (i j : Nat) (hi hj) :
(a.swap i j hi hj).toList = (a.toList.set i a[j]).set j a[i] := by simp [swap_def]
end Array
namespace List
open Array
@@ -125,9 +140,10 @@ theorem foldl_toArray (f : β → α → β) (init : β) (l : List α) :
simp only [size_toArray, foldlM_toArray']
induction l <;> simp_all
@[simp]
theorem forM_toArray [Monad m] (l : List α) (f : α m PUnit) :
(l.toArray.forM f) = l.forM f := by
simp
(forM l.toArray f) = l.forM f :=
forM_toArray' l f rfl
/-- Variant of `foldr_toArray` with a side condition for the `start` argument. -/
@[simp] theorem foldr_toArray' (f : α β β) (init : β) (l : List α)
@@ -297,7 +313,7 @@ theorem zipWithAux_toArray_zero (f : α → β → γ) (as : List α) (bs : List
simp [zipWith_cons_cons, zipWithAux_toArray_succ', zipWithAux_toArray_zero, push_append_toArray]
@[simp] theorem zipWith_toArray (as : List α) (bs : List β) (f : α β γ) :
Array.zipWith as.toArray bs.toArray f = (List.zipWith f as bs).toArray := by
Array.zipWith f as.toArray bs.toArray = (List.zipWith f as bs).toArray := by
rw [Array.zipWith]
simp [zipWithAux_toArray_zero]
@@ -340,7 +356,7 @@ theorem zipWithAll_go_toArray (as : List α) (bs : List β) (f : Option α → O
decreasing_by simp_wf; decreasing_trivial_pre_omega
@[simp] theorem zipWithAll_toArray (f : Option α Option β γ) (as : List α) (bs : List β) :
Array.zipWithAll as.toArray bs.toArray f = (List.zipWithAll f as bs).toArray := by
Array.zipWithAll f as.toArray bs.toArray = (List.zipWithAll f as bs).toArray := by
simp [Array.zipWithAll, zipWithAll_go_toArray]
@[simp] theorem toArray_appendList (l₁ l₂ : List α) :
@@ -417,4 +433,123 @@ theorem flatMap_toArray_cons {β} (f : α → Array β) (a : α) (as : List α)
apply ext'
simp [ih, flatMap_toArray_cons]
@[simp] theorem swap_toArray (l : List α) (i j : Nat) {hi hj}:
l.toArray.swap i j hi hj = ((l.set i l[j]).set j l[i]).toArray := by
apply ext'
simp
@[simp] theorem eraseIdx_toArray (l : List α) (i : Nat) (h : i < l.toArray.size) :
l.toArray.eraseIdx i h = (l.eraseIdx i).toArray := by
rw [Array.eraseIdx]
split <;> rename_i h'
· rw [eraseIdx_toArray]
simp only [swap_toArray, Fin.getElem_fin, toList_toArray, mk.injEq]
rw [eraseIdx_set_gt (by simp), eraseIdx_set_eq]
simp
· simp at h h'
have t : i = l.length - 1 := by omega
simp [t]
termination_by l.length - i
decreasing_by
rename_i h
simp at h
simp
omega
@[simp] theorem eraseIdxIfInBounds_toArray (l : List α) (i : Nat) :
l.toArray.eraseIdxIfInBounds i = (l.eraseIdx i).toArray := by
rw [Array.eraseIdxIfInBounds]
split
· simp
· simp_all [eraseIdx_eq_self.2]
@[simp] theorem findIdx?_toArray {as : List α} {p : α Bool} :
as.toArray.findIdx? p = as.findIdx? p := by
unfold Array.findIdx?
suffices i, i as.length
Array.findIdx?.loop p as.toArray (as.length - i) =
(findIdx? p (as.drop (as.length - i))).map fun j => j + (as.length - i) by
specialize this as.length
simpa
intro i
induction i with
| zero => simp [findIdx?.loop]
| succ i ih =>
unfold findIdx?.loop
simp only [size_toArray, getElem_toArray]
split <;> rename_i h
· rw [drop_eq_getElem_cons h]
rw [findIdx?_cons]
split <;> rename_i h'
· simp
· intro w
have : as.length - (i + 1) + 1 = as.length - i := by omega
specialize ih (by omega)
simp only [Option.map_map, this, ih]
congr
ext
simp
omega
· have : as.length = 0 := by omega
simp_all
@[simp] theorem findFinIdx?_toArray {as : List α} {p : α Bool} :
as.toArray.findFinIdx? p = as.findFinIdx? p := by
have h := findIdx?_toArray (as := as) (p := p)
rw [findIdx?_eq_map_findFinIdx?_val, Array.findIdx?_eq_map_findFinIdx?_val] at h
rwa [Option.map_inj_right] at h
rintro x, hx y, hy rfl
simp
theorem findFinIdx?_go_beq_eq_idxOfAux_toArray [BEq α]
{xs as : List α} {a : α} {i : Nat} {h} (w : as = xs.drop i) :
findFinIdx?.go (fun x => x == a) xs as i h =
xs.toArray.idxOfAux a i := by
unfold findFinIdx?.go
unfold idxOfAux
split <;> rename_i b as
· simp at h
simp [h]
· simp at h
rw [dif_pos (by simp; omega)]
simp only [getElem_toArray]
erw [getElem_drop' (j := 0)]
simp only [ w, getElem_cons_zero]
have : xs.length - (i + 1) < xs.length - i := by omega
rw [findFinIdx?_go_beq_eq_idxOfAux_toArray]
rw [ drop_drop, w]
simp
termination_by xs.length - i
@[simp] theorem finIdxOf?_toArray [BEq α] {as : List α} {a : α} :
as.toArray.finIdxOf? a = as.finIdxOf? a := by
unfold Array.finIdxOf?
unfold finIdxOf?
unfold findFinIdx?
rw [findFinIdx?_go_beq_eq_idxOfAux_toArray]
simp
@[simp] theorem findIdx_toArray [BEq α] {as : List α} {p : α Bool} :
as.toArray.findIdx p = as.findIdx p := by
rw [Array.findIdx, findIdx?_toArray, findIdx_eq_getD_findIdx?]
@[simp] theorem idxOf?_toArray [BEq α] {as : List α} {a : α} :
as.toArray.idxOf? a = as.idxOf? a := by
rw [Array.idxOf?, finIdxOf?_toArray, idxOf?_eq_map_finIdxOf?_val]
@[simp] theorem idxOf_toArray [BEq α] {as : List α} {a : α} :
as.toArray.idxOf a = as.idxOf a := by
rw [Array.idxOf, findIdx_toArray, idxOf]
@[simp] theorem eraseP_toArray {as : List α} {p : α Bool} :
as.toArray.eraseP p = (as.eraseP p).toArray := by
rw [Array.eraseP, List.eraseP_eq_eraseIdx, findFinIdx?_toArray]
split <;> simp [*, findIdx?_eq_map_findFinIdx?_val]
@[simp] theorem erase_toArray [BEq α] {as : List α} {a : α} :
as.toArray.erase a = (as.erase a).toArray := by
rw [Array.erase, finIdxOf?_toArray, List.erase_eq_eraseIdx]
rw [idxOf?_eq_map_finIdxOf?_val]
split <;> simp_all
end List

View File

@@ -31,16 +31,18 @@ theorem zipWith_comm_of_comm (f : αα → β) (comm : ∀ x y : α, f x y
simp only [comm]
@[simp]
theorem zipWith_same (f : α α δ) : l : List α, zipWith f l l = l.map fun a => f a a
theorem zipWith_self (f : α α δ) : l : List α, zipWith f l l = l.map fun a => f a a
| [] => rfl
| _ :: xs => congrArg _ (zipWith_same f xs)
| _ :: xs => congrArg _ (zipWith_self f xs)
@[deprecated zipWith_self (since := "2025-01-29")] abbrev zipWith_same := @zipWith_self
/--
See also `getElem?_zipWith'` for a variant
using `Option.map` and `Option.bind` rather than a `match`.
-/
theorem getElem?_zipWith {f : α β γ} {i : Nat} :
(List.zipWith f as bs)[i]? = match as[i]?, bs[i]? with
(zipWith f as bs)[i]? = match as[i]?, bs[i]? with
| some a, some b => some (f a b) | _, _ => none := by
induction as generalizing bs i with
| nil => cases bs with
@@ -238,6 +240,14 @@ theorem map_uncurry_zip_eq_zipWith (f : α → β → γ) (l : List α) (l' : Li
| cons hl tl ih =>
cases l' <;> simp [ih]
theorem map_zip_eq_zipWith (f : α × β γ) (l : List α) (l' : List β) :
map f (l.zip l') = zipWith (Function.curry f) l l' := by
rw [zip]
induction l generalizing l' with
| nil => simp
| cons hl tl ih =>
cases l' <;> simp [ih]
/-! ### zip -/
theorem zip_eq_zipWith : (l₁ : List α) (l₂ : List β), zip l₁ l₂ = zipWith Prod.mk l₁ l₂
@@ -249,8 +259,7 @@ theorem zip_map (f : αγ) (g : β → δ) :
(l₁ : List α) (l₂ : List β), zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g)
| [], _ => rfl
| _, [] => by simp only [map, zip_nil_right]
| _ :: _, _ :: _ => by
simp only [map, zip_cons_cons, zip_map, Prod.map]; try constructor -- TODO: remove try constructor after update stage0
| _ :: _, _ :: _ => by simp only [map, zip_cons_cons, zip_map, Prod.map]
theorem zip_map_left (f : α γ) (l₁ : List α) (l₂ : List β) :
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [ zip_map, map_id]

View File

@@ -57,11 +57,11 @@ theorem mod_mul_right_div_self (m n k : Nat) : m % (n * k) / n = m / n % k := by
theorem mod_mul_left_div_self (m n k : Nat) : m % (k * n) / n = m / n % k := by
rw [Nat.mul_comm k n, mod_mul_right_div_self]
@[simp 1100]
@[simp]
theorem mod_mul_right_mod (a b c : Nat) : a % (b * c) % b = a % b :=
Nat.mod_mod_of_dvd a (Nat.dvd_mul_right b c)
@[simp 1100]
@[simp]
theorem mod_mul_left_mod (a b c : Nat) : a % (b * c) % c = a % c :=
Nat.mod_mod_of_dvd a (Nat.mul_comm _ _ Nat.dvd_mul_left c b)

View File

@@ -224,17 +224,17 @@ This lemma identifies maps over lists of subtypes, where the function only depen
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
{f : { x // p x } β} {g : α β} (hf : x h, f x, h = g x) :
o.map f = o.unattach.map g := by
cases o <;> simp [hf]
@[simp] theorem bind_subtype {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } Option β} {g : α Option β} {hf : x h, f x, h = g x} :
{f : { x // p x } Option β} {g : α Option β} (hf : x h, f x, h = g x) :
(o.bind f) = o.unattach.bind g := by
cases o <;> simp [hf]
@[simp] theorem unattach_filter {p : α Prop} {o : Option { x // p x }}
{f : { x // p x } Bool} {g : α Bool} {hf : x h, f x, h = g x} :
{f : { x // p x } Bool} {g : α Bool} (hf : x h, f x, h = g x) :
(o.filter f).unattach = o.unattach.filter g := by
cases o
· simp

View File

@@ -34,7 +34,7 @@ theorem get_mem : ∀ {o : Option α} (h : isSome o), o.get h ∈ o
theorem get_of_mem : {o : Option α} (h : isSome o), a o o.get h = a
| _, _, rfl => rfl
theorem not_mem_none (a : α) : a (none : Option α) := nofun
@[simp] theorem not_mem_none (a : α) : a (none : Option α) := nofun
theorem getD_of_ne_none {x : Option α} (hx : x none) (y : α) : some (x.getD y) = x := by
cases x; {contradiction}; rw [getD_some]
@@ -655,4 +655,10 @@ theorem map_pmap {p : α → Prop} (g : β → γ) (f : ∀ a, p a → β) (o H)
@[simp] theorem pelim_eq_elim : pelim o b (fun a _ => f a) = o.elim b f := by
cases o <;> simp
@[simp] theorem elim_pmap {p : α Prop} (f : (a : α) p a β) (o : Option α)
(H : (a : α), a o p a) (g : γ) (g' : β γ) :
(o.pmap f H).elim g g' =
o.pelim g (fun a h => g' (f a (H a h))) := by
cases o <;> simp
end Option

View File

@@ -10,12 +10,10 @@ import Init.Data.Array.Basic
inductive Ordering where
| lt | eq | gt
deriving Inhabited, BEq
deriving Inhabited, DecidableEq
namespace Ordering
deriving instance DecidableEq for Ordering
/-- Swaps less and greater ordering results -/
def swap : Ordering Ordering
| .lt => .gt
@@ -40,9 +38,10 @@ the same name by age (in descending order). (If all fields are sorted ascending
order as they are listed in the structure, you can also use `deriving Ord` on the structure
definition for the same effect.)
-/
@[macro_inline] def «then» : Ordering Ordering Ordering
| .eq, f => f
| o, _ => o
@[macro_inline] def «then» (a b : Ordering) : Ordering :=
match a with
| .eq => b
| a => a
/--
Check whether the ordering is 'equal'.
@@ -86,6 +85,181 @@ def isGE : Ordering → Bool
| lt => false
| _ => true
section Lemmas
@[simp]
theorem isLT_lt : lt.isLT := rfl
@[simp]
theorem isLE_lt : lt.isLE := rfl
@[simp]
theorem isEq_lt : lt.isEq = false := rfl
@[simp]
theorem isNe_lt : lt.isNe = true := rfl
@[simp]
theorem isGE_lt : lt.isGE = false := rfl
@[simp]
theorem isGT_lt : lt.isGT = false := rfl
@[simp]
theorem isLT_eq : eq.isLT = false := rfl
@[simp]
theorem isLE_eq : eq.isLE := rfl
@[simp]
theorem isEq_eq : eq.isEq := rfl
@[simp]
theorem isNe_eq : eq.isNe = false := rfl
@[simp]
theorem isGE_eq : eq.isGE := rfl
@[simp]
theorem isGT_eq : eq.isGT = false := rfl
@[simp]
theorem isLT_gt : gt.isLT = false := rfl
@[simp]
theorem isLE_gt : gt.isLE = false := rfl
@[simp]
theorem isEq_gt : gt.isEq = false := rfl
@[simp]
theorem isNe_gt : gt.isNe = true := rfl
@[simp]
theorem isGE_gt : gt.isGE := rfl
@[simp]
theorem isGT_gt : gt.isGT := rfl
@[simp]
theorem swap_lt : lt.swap = .gt := rfl
@[simp]
theorem swap_eq : eq.swap = .eq := rfl
@[simp]
theorem swap_gt : gt.swap = .lt := rfl
theorem eq_eq_of_isLE_of_isLE_swap {o : Ordering} : o.isLE o.swap.isLE o = .eq := by
cases o <;> simp
theorem eq_eq_of_isGE_of_isGE_swap {o : Ordering} : o.isGE o.swap.isGE o = .eq := by
cases o <;> simp
theorem eq_eq_of_isLE_of_isGE {o : Ordering} : o.isLE o.isGE o = .eq := by
cases o <;> simp
theorem eq_swap_iff_eq_eq {o : Ordering} : o = o.swap o = .eq := by
cases o <;> simp
theorem eq_eq_of_eq_swap {o : Ordering} : o = o.swap o = .eq :=
eq_swap_iff_eq_eq.mp
@[simp]
theorem isLE_eq_false {o : Ordering} : o.isLE = false o = .gt := by
cases o <;> simp
@[simp]
theorem isGE_eq_false {o : Ordering} : o.isGE = false o = .lt := by
cases o <;> simp
@[simp]
theorem swap_eq_gt {o : Ordering} : o.swap = .gt o = .lt := by
cases o <;> simp
@[simp]
theorem swap_eq_lt {o : Ordering} : o.swap = .lt o = .gt := by
cases o <;> simp
@[simp]
theorem swap_eq_eq {o : Ordering} : o.swap = .eq o = .eq := by
cases o <;> simp
@[simp]
theorem isLT_swap {o : Ordering} : o.swap.isLT = o.isGT := by
cases o <;> simp
@[simp]
theorem isLE_swap {o : Ordering} : o.swap.isLE = o.isGE := by
cases o <;> simp
@[simp]
theorem isEq_swap {o : Ordering} : o.swap.isEq = o.isEq := by
cases o <;> simp
@[simp]
theorem isNe_swap {o : Ordering} : o.swap.isNe = o.isNe := by
cases o <;> simp
@[simp]
theorem isGE_swap {o : Ordering} : o.swap.isGE = o.isLE := by
cases o <;> simp
@[simp]
theorem isGT_swap {o : Ordering} : o.swap.isGT = o.isLT := by
cases o <;> simp
theorem isLT_iff_eq_lt {o : Ordering} : o.isLT o = .lt := by
cases o <;> simp
theorem isLE_iff_eq_lt_or_eq_eq {o : Ordering} : o.isLE o = .lt o = .eq := by
cases o <;> simp
theorem isLE_of_eq_lt {o : Ordering} : o = .lt o.isLE := by
rintro rfl; rfl
theorem isLE_of_eq_eq {o : Ordering} : o = .eq o.isLE := by
rintro rfl; rfl
theorem isEq_iff_eq_eq {o : Ordering} : o.isEq o = .eq := by
cases o <;> simp
theorem isNe_iff_ne_eq {o : Ordering} : o.isNe o .eq := by
cases o <;> simp
theorem isGE_iff_eq_gt_or_eq_eq {o : Ordering} : o.isGE o = .gt o = .eq := by
cases o <;> simp
theorem isGE_of_eq_gt {o : Ordering} : o = .gt o.isGE := by
rintro rfl; rfl
theorem isGE_of_eq_eq {o : Ordering} : o = .eq o.isGE := by
rintro rfl; rfl
theorem isGT_iff_eq_gt {o : Ordering} : o.isGT o = .gt := by
cases o <;> simp
@[simp]
theorem swap_swap {o : Ordering} : o.swap.swap = o := by
cases o <;> simp
@[simp] theorem swap_inj {o₁ o₂ : Ordering} : o₁.swap = o₂.swap o₁ = o₂ :=
fun h => by simpa using congrArg swap h, congrArg _
theorem swap_then (o₁ o₂ : Ordering) : (o₁.then o₂).swap = o₁.swap.then o₂.swap := by
cases o₁ <;> rfl
theorem then_eq_lt {o₁ o₂ : Ordering} : o₁.then o₂ = lt o₁ = lt o₁ = eq o₂ = lt := by
cases o₁ <;> cases o₂ <;> decide
theorem then_eq_eq {o₁ o₂ : Ordering} : o₁.then o₂ = eq o₁ = eq o₂ = eq := by
cases o₁ <;> simp [«then»]
theorem then_eq_gt {o₁ o₂ : Ordering} : o₁.then o₂ = gt o₁ = gt o₁ = eq o₂ = gt := by
cases o₁ <;> cases o₂ <;> decide
end Lemmas
end Ordering
/--

View File

@@ -9,3 +9,9 @@ import Init.Data.Vector.Lemmas
import Init.Data.Vector.Lex
import Init.Data.Vector.MapIdx
import Init.Data.Vector.Count
import Init.Data.Vector.DecidableEq
import Init.Data.Vector.Zip
import Init.Data.Vector.OfFn
import Init.Data.Vector.Range
import Init.Data.Vector.Erase
import Init.Data.Vector.Monadic

View File

@@ -494,7 +494,7 @@ and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldl_subtype {p : α Prop} {l : Vector { x // p x } n}
{f : β { x // p x } β} {g : β α β} {x : β}
{hf : b x h, f b x, h = g b x} :
(hf : b x h, f b x, h = g b x) :
l.foldl f x = l.unattach.foldl g x := by
rcases l with l, rfl
simp [Array.foldl_subtype (hf := hf)]
@@ -505,7 +505,7 @@ and simplifies these to the function directly taking the value.
-/
@[simp] theorem foldr_subtype {p : α Prop} {l : Vector { x // p x } n}
{f : { x // p x } β β} {g : α β β} {x : β}
{hf : x h b, f x, h b = g x b} :
(hf : x h b, f x, h b = g x b) :
l.foldr f x = l.unattach.foldr g x := by
rcases l with l, rfl
simp [Array.foldr_subtype (hf := hf)]
@@ -515,7 +515,7 @@ This lemma identifies maps over arrays of subtypes, where the function only depe
and simplifies these to the function directly taking the value.
-/
@[simp] theorem map_subtype {p : α Prop} {l : Vector { x // p x } n}
{f : { x // p x } β} {g : α β} {hf : x h, f x, h = g x} :
{f : { x // p x } β} {g : α β} (hf : x h, f x, h = g x) :
l.map f = l.unattach.map g := by
rcases l with l, rfl
simp [Array.map_subtype (hf := hf)]

View File

@@ -8,6 +8,7 @@ prelude
import Init.Data.Array.Lemmas
import Init.Data.Array.MapIdx
import Init.Data.Range
import Init.Data.Stream
/-!
# Vectors
@@ -55,6 +56,9 @@ def elimAsList {motive : Vector α n → Sort u}
/-- Makes a vector of size `n` with all cells containing `v`. -/
@[inline] def mkVector (n) (v : α) : Vector α n := mkArray n v, by simp
instance : Nonempty (Vector α 0) := #v[]
instance [Nonempty α] : Nonempty (Vector α n) := mkVector _ Classical.ofNonempty
/-- Returns a vector of size `1` with element `v`. -/
@[inline] def singleton (v : α) : Vector α 1 := #[v], rfl
@@ -162,9 +166,36 @@ instance : HAppend (Vector α n) (Vector α m) (Vector α (n + m)) where
Extracts the slice of a vector from indices `start` to `stop` (exclusive). If `start ≥ stop`, the
result is empty. If `stop` is greater than the size of the vector, the size is used instead.
-/
@[inline] def extract (v : Vector α n) (start stop : Nat) : Vector α (min stop n - start) :=
@[inline] def extract (v : Vector α n) (start : Nat := 0) (stop : Nat := n) : Vector α (min stop n - start) :=
v.toArray.extract start stop, by simp
/--
Extract the first `m` elements of a vector. If `m` is greater than or equal to the size of the
vector then the vector is returned unchanged.
-/
@[inline] def take (v : Vector α n) (m : Nat) : Vector α (min m n) :=
v.toArray.take m, by simp
@[simp] theorem take_eq_extract (v : Vector α n) (m : Nat) : v.take m = v.extract 0 m := rfl
/--
Deletes the first `m` elements of a vector. If `m` is greater than or equal to the size of the
vector then the empty vector is returned.
-/
@[inline] def drop (v : Vector α n) (m : Nat) : Vector α (n - m) :=
v.toArray.drop m, by simp
@[simp] theorem drop_eq_cast_extract (v : Vector α n) (m : Nat) :
v.drop m = (v.extract m n).cast (by simp) := by
simp [drop, extract, Vector.cast]
/-- Shrinks a vector to the first `m` elements, by repeatedly popping the last element. -/
@[inline] def shrink (v : Vector α n) (m : Nat) : Vector α (min m n) :=
v.toArray.shrink m, by simp
@[simp] theorem shrink_eq_take (v : Vector α n) (m : Nat) : v.shrink m = v.take m := by
simp [shrink, take]
/-- Maps elements of a vector using the function `f`. -/
@[inline] def map (f : α β) (v : Vector α n) : Vector β n :=
v.toArray.map f, by simp
@@ -178,6 +209,50 @@ which also receives the index of the element, and the fact that the index is les
@[inline] def mapFinIdx (v : Vector α n) (f : (i : Nat) α (h : i < n) β) : Vector β n :=
v.toArray.mapFinIdx (fun i a h => f i a (by simpa [v.size_toArray] using h)), by simp
/-- Map a monadic function over a vector. -/
@[inline] def mapM [Monad m] (f : α m β) (v : Vector α n) : m (Vector β n) := do
go 0 (Nat.zero_le n) #v[]
where
go (i : Nat) (h : i n) (r : Vector β i) : m (Vector β n) := do
if h' : i < n then
go (i+1) (by omega) (r.push ( f v[i]))
else
return r.cast (by omega)
@[inline] protected def forM [Monad m] (v : Vector α n) (f : α m PUnit) : m PUnit :=
v.toArray.forM f
@[inline] def flatMapM [Monad m] (v : Vector α n) (f : α m (Vector β k)) : m (Vector β (n * k)) := do
go 0 (Nat.zero_le n) (#v[].cast (by omega))
where
go (i : Nat) (h : i n) (r : Vector β (i * k)) : m (Vector β (n * k)) := do
if h' : i < n then
go (i+1) (by omega) ((r ++ ( f v[i])).cast (Nat.succ_mul i k).symm)
else
return r.cast (by congr; omega)
/-- Variant of `mapIdxM` which receives the index `i` along with the bound `i < n. -/
@[inline]
def mapFinIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m]
(as : Vector α n) (f : (i : Nat) α (h : i < n) m β) : m (Vector β n) :=
let rec @[specialize] map (i : Nat) (j : Nat) (inv : i + j = n) (bs : Vector β (n - i)) : m (Vector β n) := do
match i, inv with
| 0, _ => pure bs
| i+1, inv =>
have j_lt : j < n := by
rw [ inv, Nat.add_assoc, Nat.add_comm 1 j, Nat.add_comm]
apply Nat.le_add_right
have : i + (j + 1) = n := by rw [ inv, Nat.add_comm j 1, Nat.add_assoc]
map i (j+1) this ((bs.push ( f j as[j] j_lt)).cast (by omega))
map n 0 rfl (#v[].cast (by simp))
@[inline]
def mapIdxM {α : Type u} {β : Type v} {m : Type v Type w} [Monad m] (f : Nat α m β) (as : Vector α n) : m (Vector β n) :=
as.mapFinIdxM fun i a _ => f i a
@[inline] def firstM {α : Type u} {m : Type v Type w} [Alternative m] (f : α m β) (as : Vector α n) : m β :=
as.toArray.firstM f
@[inline] def flatten (v : Vector (Vector α n) m) : Vector α (m * n) :=
(v.toArray.map Vector.toArray).flatten,
by rcases v; simp_all [Function.comp_def, Array.map_const']
@@ -185,12 +260,21 @@ which also receives the index of the element, and the fact that the index is les
@[inline] def flatMap (v : Vector α n) (f : α Vector β m) : Vector β (n * m) :=
v.toArray.flatMap fun a => (f a).toArray, by simp [Array.map_const']
@[inline] def zipWithIndex (v : Vector α n) : Vector (α × Nat) n :=
v.toArray.zipWithIndex, by simp
@[inline] def zipIdx (v : Vector α n) (k : Nat := 0) : Vector (α × Nat) n :=
v.toArray.zipIdx k, by simp
@[deprecated zipIdx (since := "2025-01-21")]
abbrev zipWithIndex := @zipIdx
@[inline] def zip (v : Vector α n) (w : Vector β n) : Vector (α × β) n :=
v.toArray.zip w.toArray, by simp
/-- Maps corresponding elements of two vectors of equal size using the function `f`. -/
@[inline] def zipWith (a : Vector α n) (b : Vector β n) (f : α β φ) : Vector φ n :=
Array.zipWith a.toArray b.toArray f, by simp
@[inline] def zipWith (f : α β φ) (a : Vector α n) (b : Vector β n) : Vector φ n :=
Array.zipWith f a.toArray b.toArray, by simp
@[inline] def unzip (v : Vector (α × β) n) : Vector α n × Vector β n :=
v.toArray.unzip.1, by simp, v.toArray.unzip.2, by simp
/-- The vector of length `n` whose `i`-th element is `f i`. -/
@[inline] def ofFn (f : Fin n α) : Vector α n :=
@@ -234,22 +318,12 @@ This will perform the update destructively provided that the vector has a refere
let a := v.toArray.swapAt! i x
a.fst, a.snd, by simp [a]
/-- The vector `#v[0,1,2,...,n-1]`. -/
/-- The vector `#v[0, 1, 2, ..., n-1]`. -/
@[inline] def range (n : Nat) : Vector Nat n := Array.range n, by simp
/--
Extract the first `m` elements of a vector. If `m` is greater than or equal to the size of the
vector then the vector is returned unchanged.
-/
@[inline] def take (v : Vector α n) (m : Nat) : Vector α (min m n) :=
v.toArray.take m, by simp
/--
Deletes the first `m` elements of a vector. If `m` is greater than or equal to the size of the
vector then the empty vector is returned.
-/
@[inline] def drop (v : Vector α n) (m : Nat) : Vector α (n - m) :=
v.toArray.extract m v.size, by simp
/-- The vector `#v[start, start + step, start + 2 * step, ..., start + (size - 1) * step]`. -/
@[inline] def range' (start size : Nat) (step : Nat := 1) : Vector Nat size :=
Array.range' start size step, by simp
/--
Compares two vectors of the same size using a given boolean relation `r`. `isEqv v w r` returns
@@ -289,8 +363,26 @@ instance [BEq α] : BEq (Vector α n) where
Finds the first index of a given value in a vector using `==` for comparison. Returns `none` if the
no element of the index matches the given value.
-/
@[inline] def indexOf? [BEq α] (v : Vector α n) (x : α) : Option (Fin n) :=
(v.toArray.indexOf? x).map (Fin.cast v.size_toArray)
@[inline] def finIdxOf? [BEq α] (v : Vector α n) (x : α) : Option (Fin n) :=
(v.toArray.finIdxOf? x).map (Fin.cast v.size_toArray)
@[deprecated finIdxOf? (since := "2025-01-29")]
abbrev indexOf? := @finIdxOf?
/-- Finds the first index of a given value in a vector using a predicate. Returns `none` if the
no element of the index matches the given value. -/
@[inline] def findFinIdx? (v : Vector α n) (p : α Bool) : Option (Fin n) :=
(v.toArray.findFinIdx? p).map (Fin.cast v.size_toArray)
/--
Note that the universe level is contrained to `Type` here,
to avoid having to have the predicate live in `p : α → m (ULift Bool)`.
-/
@[inline] def findM? {α : Type} {m : Type Type} [Monad m] (f : α m Bool) (as : Vector α n) : m (Option α) :=
as.toArray.findM? f
@[inline] def findSomeM? [Monad m] (f : α m (Option β)) (as : Vector α n) : m (Option β) :=
as.toArray.findSomeM? f
/-- Returns `true` when `v` is a prefix of the vector `w`. -/
@[inline] def isPrefixOf [BEq α] (v : Vector α m) (w : Vector α n) : Bool :=
@@ -320,6 +412,28 @@ no element of the index matches the given value.
@[inline] def count [BEq α] (a : α) (v : Vector α n) : Nat :=
v.toArray.count a
/-! ### ForIn instance -/
@[simp] theorem mem_toArray_iff (a : α) (v : Vector α n) : a v.toArray a v :=
fun h => h, fun h => h
instance : ForIn' m (Vector α n) α inferInstance where
forIn' v b f := Array.forIn' v.toArray b (fun a h b => f a (by simpa using h) b)
/-! ### ForM instance -/
instance : ForM m (Vector α n) α where
forM := Vector.forM
-- We simplify `Vector.forM` to `forM`.
@[simp] theorem forM_eq_forM [Monad m] (f : α m PUnit) :
Vector.forM v f = forM v f := rfl
/-! ### ToStream instance -/
instance : ToStream (Vector α n) (Subarray α) where
toStream v := v.toArray[:n]
/-! ### Lexicographic ordering -/
instance instLT [LT α] : LT (Vector α n) := fun v w => v.toArray < w.toArray

View File

@@ -71,7 +71,7 @@ theorem countP_le_size {l : Vector α n} : countP p l ≤ n := by
theorem countP_mkVector (p : α Bool) (a : α) (n : Nat) :
countP p (mkVector n a) = if p a then n else 0 := by
simp only [mkVector_eq_toVector_mkArray, countP_cast, countP_mk]
simp only [mkVector_eq_mk_mkArray, countP_cast, countP_mk]
simp [Array.countP_mkArray]
theorem boole_getElem_le_countP (p : α Bool) (l : Vector α n) (i : Nat) (h : i < n) :
@@ -213,11 +213,11 @@ theorem count_eq_size {l : Vector α n} : count a l = l.size ↔ ∀ b ∈ l, a
simp [Array.count_eq_size]
@[simp] theorem count_mkVector_self (a : α) (n : Nat) : count a (mkVector n a) = n := by
simp only [mkVector_eq_toVector_mkArray, count_cast, count_mk]
simp only [mkVector_eq_mk_mkArray, count_cast, count_mk]
simp
theorem count_mkVector (a b : α) (n : Nat) : count a (mkVector n b) = if b == a then n else 0 := by
simp only [mkVector_eq_toVector_mkArray, count_cast, count_mk]
simp only [mkVector_eq_mk_mkArray, count_cast, count_mk]
simp [Array.count_mkArray]
theorem count_le_count_map [DecidableEq β] (l : Vector α n) (f : α β) (x : α) :

View File

@@ -0,0 +1,58 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.DecidableEq
import Init.Data.Vector.Lemmas
namespace Vector
theorem isEqv_iff_rel {a b : Vector α n} {r} :
Vector.isEqv a b r (i : Nat) (h' : i < n), r a[i] b[i] := by
rcases a with a, rfl
rcases b with b, h
simp [Array.isEqv_iff_rel, h]
theorem isEqv_eq_decide (a b : Vector α n) (r) :
Vector.isEqv a b r = decide ( (i : Nat) (h' : i < n), r a[i] b[i]) := by
rcases a with a, rfl
rcases b with b, h
simp [Array.isEqv_eq_decide, h]
@[simp] theorem isEqv_toArray [BEq α] (a b : Vector α n) : (a.toArray.isEqv b.toArray r) = (a.isEqv b r) := by
simp [isEqv_eq_decide, Array.isEqv_eq_decide]
theorem eq_of_isEqv [DecidableEq α] (a b : Vector α n) (h : Vector.isEqv a b (fun x y => x = y)) : a = b := by
rcases a with a, rfl
rcases b with b, h
rw [ Vector.toArray_inj]
apply Array.eq_of_isEqv
simp_all
theorem isEqv_self_beq [BEq α] [ReflBEq α] (a : Vector α n) : Vector.isEqv a a (· == ·) = true := by
rcases a with a, rfl
simp [Array.isEqv_self_beq]
theorem isEqv_self [DecidableEq α] (a : Vector α n) : Vector.isEqv a a (· = ·) = true := by
rcases a with a, rfl
simp [Array.isEqv_self]
instance [DecidableEq α] : DecidableEq (Vector α n) :=
fun a b =>
match h:isEqv a b (fun a b => a = b) with
| true => isTrue (eq_of_isEqv a b h)
| false => isFalse fun h' => by subst h'; rw [isEqv_self] at h; contradiction
theorem beq_eq_decide [BEq α] (a b : Vector α n) :
(a == b) = decide ( (i : Nat) (h' : i < n), a[i] == b[i]) := by
simp [BEq.beq, isEqv_eq_decide]
@[simp] theorem beq_toArray [BEq α] (a b : Vector α n) : (a.toArray == b.toArray) = (a == b) := by
simp [beq_eq_decide, Array.beq_eq_decide]
@[simp] theorem beq_toList [BEq α] (a b : Vector α n) : (a.toList == b.toList) = (a == b) := by
simp [beq_eq_decide, List.beq_eq_decide]
end Vector

View File

@@ -0,0 +1,113 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Vector.Lemmas
import Init.Data.Array.Erase
/-!
# Lemmas about `Vector.eraseIdx`.
-/
namespace Vector
open Nat
/-! ### eraseIdx -/
theorem eraseIdx_eq_take_drop_succ (l : Vector α n) (i : Nat) (h) :
l.eraseIdx i = (l.take i ++ l.drop (i + 1)).cast (by omega) := by
rcases l with l, rfl
simp [Array.eraseIdx_eq_take_drop_succ, *]
theorem getElem?_eraseIdx (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) :
(l.eraseIdx i)[j]? = if j < i then l[j]? else l[j + 1]? := by
rcases l with l, rfl
simp [Array.getElem?_eraseIdx]
theorem getElem?_eraseIdx_of_lt (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) (h' : j < i) :
(l.eraseIdx i)[j]? = l[j]? := by
rw [getElem?_eraseIdx]
simp [h']
theorem getElem?_eraseIdx_of_ge (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) (h' : i j) :
(l.eraseIdx i)[j]? = l[j + 1]? := by
rw [getElem?_eraseIdx]
simp only [dite_eq_ite, ite_eq_right_iff]
intro h'
omega
theorem getElem_eraseIdx (l : Vector α n) (i : Nat) (h : i < n) (j : Nat) (h' : j < n - 1) :
(l.eraseIdx i)[j] = if h'' : j < i then l[j] else l[j + 1] := by
apply Option.some.inj
rw [ getElem?_eq_getElem, getElem?_eraseIdx]
split <;> simp
theorem mem_of_mem_eraseIdx {l : Vector α n} {i : Nat} {h} {a : α} (h : a l.eraseIdx i) : a l := by
rcases l with l, rfl
simpa using Array.mem_of_mem_eraseIdx (by simpa using h)
theorem eraseIdx_append_of_lt_size {l : Vector α n} {k : Nat} (hk : k < n) (l' : Vector α n) (h) :
eraseIdx (l ++ l') k = (eraseIdx l k ++ l').cast (by omega) := by
rcases l with l
rcases l' with l'
simp [Array.eraseIdx_append_of_lt_size, *]
theorem eraseIdx_append_of_length_le {l : Vector α n} {k : Nat} (hk : n k) (l' : Vector α n) (h) :
eraseIdx (l ++ l') k = (l ++ eraseIdx l' (k - n)).cast (by omega) := by
rcases l with l
rcases l' with l'
simp [Array.eraseIdx_append_of_length_le, *]
theorem eraseIdx_cast {l : Vector α n} {k : Nat} (h : k < m) :
eraseIdx (l.cast w) k h = (eraseIdx l k).cast (by omega) := by
rcases l with l, rfl
simp
theorem eraseIdx_mkVector {n : Nat} {a : α} {k : Nat} {h} :
(mkVector n a).eraseIdx k = mkVector (n - 1) a := by
rw [mkVector_eq_mk_mkArray, eraseIdx_mk]
simp [Array.eraseIdx_mkArray, *]
theorem mem_eraseIdx_iff_getElem {x : α} {l : Vector α n} {k} {h} : x eraseIdx l k h i w, i k l[i]'w = x := by
rcases l with l, rfl
simp [Array.mem_eraseIdx_iff_getElem, *]
theorem mem_eraseIdx_iff_getElem? {x : α} {l : Vector α n} {k} {h} : x eraseIdx l k h i k, l[i]? = some x := by
rcases l with l, rfl
simp [Array.mem_eraseIdx_iff_getElem?, *]
theorem getElem_eraseIdx_of_lt (l : Vector α n) (i : Nat) (w : i < n) (j : Nat) (h : j < n - 1) (h' : j < i) :
(l.eraseIdx i)[j] = l[j] := by
rcases l with l, rfl
simp [Array.getElem_eraseIdx_of_lt, *]
theorem getElem_eraseIdx_of_ge (l : Vector α n) (i : Nat) (w : i < n) (j : Nat) (h : j < n - 1) (h' : i j) :
(l.eraseIdx i)[j] = l[j + 1] := by
rcases l with l, rfl
simp [Array.getElem_eraseIdx_of_ge, *]
theorem eraseIdx_set_eq {l : Vector α n} {i : Nat} {a : α} {h : i < n} :
(l.set i a).eraseIdx i = l.eraseIdx i := by
rcases l with l, rfl
simp [Array.eraseIdx_set_eq, *]
theorem eraseIdx_set_lt {l : Vector α n} {i : Nat} {w : i < n} {j : Nat} {a : α} (h : j < i) :
(l.set i a).eraseIdx j = (l.eraseIdx j).set (i - 1) a := by
rcases l with l, rfl
simp [Array.eraseIdx_set_lt, *]
theorem eraseIdx_set_gt {l : Vector α n} {i : Nat} {j : Nat} {a : α} (h : i < j) {w : j < n} :
(l.set i a).eraseIdx j = (l.eraseIdx j).set i a := by
rcases l with l, rfl
simp [Array.eraseIdx_set_gt, *]
@[simp] theorem set_getElem_succ_eraseIdx_succ
{l : Vector α n} {i : Nat} (h : i + 1 < n) :
(l.eraseIdx (i + 1)).set i l[i + 1] = l.eraseIdx i := by
rcases l with l, rfl
simp [List.set_getElem_succ_eraseIdx_succ, *]
end Vector

View File

@@ -101,8 +101,17 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
@[simp] theorem extract_mk (a : Array α) (h : a.size = n) (start stop) :
(Vector.mk a h).extract start stop = Vector.mk (a.extract start stop) (by simp [h]) := rfl
@[simp] theorem indexOf?_mk [BEq α] (a : Array α) (h : a.size = n) (x : α) :
(Vector.mk a h).indexOf? x = (a.indexOf? x).map (Fin.cast h) := rfl
@[simp] theorem finIdxOf?_mk [BEq α] (a : Array α) (h : a.size = n) (x : α) :
(Vector.mk a h).finIdxOf? x = (a.finIdxOf? x).map (Fin.cast h) := rfl
@[deprecated finIdxOf?_mk (since := "2025-01-29")]
abbrev indexOf?_mk := @finIdxOf?_mk
@[simp] theorem findM?_mk [Monad m] (a : Array α) (h : a.size = n) (f : α m Bool) :
(Vector.mk a h).findM? f = a.findM? f := rfl
@[simp] theorem findSomeM?_mk [Monad m] (a : Array α) (h : a.size = n) (f : α m (Option β)) :
(Vector.mk a h).findSomeM? f = a.findSomeM? f := rfl
@[simp] theorem mk_isEqv_mk (r : α α Bool) (a b : Array α) (ha : a.size = n) (hb : b.size = n) :
Vector.isEqv (Vector.mk a ha) (Vector.mk b hb) r = Array.isEqv a b r := by
@@ -121,6 +130,25 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
(Vector.mk a h).mapFinIdx f =
Vector.mk (a.mapFinIdx fun i a h' => f i a (by simpa [h] using h')) (by simp [h]) := rfl
@[simp] theorem forM_mk [Monad m] (f : α m PUnit) (a : Array α) (h : a.size = n) :
forM (Vector.mk a h) f = forM a f := rfl
@[simp] theorem forIn'_mk [Monad m]
(xs : Array α) (h : xs.size = n) (b : β)
(f : (a : α) a Vector.mk xs h β m (ForInStep β)) :
forIn' (Vector.mk xs h) b f = forIn' xs b (fun a m b => f a (by simpa using m) b) := rfl
@[simp] theorem forIn_mk [Monad m]
(xs : Array α) (h : xs.size = n) (b : β) (f : (a : α) β m (ForInStep β)) :
forIn (Vector.mk xs h) b f = forIn xs b f := rfl
@[simp] theorem flatMap_mk (f : α Vector β m) (a : Array α) (h : a.size = n) :
(Vector.mk a h).flatMap f =
Vector.mk (a.flatMap (fun a => (f a).toArray)) (by simp [h, Array.map_const']) := rfl
@[simp] theorem firstM_mk [Alternative m] (f : α m β) (a : Array α) (h : a.size = n) :
(Vector.mk a h).firstM f = a.firstM f := rfl
@[simp] theorem reverse_mk (a : Array α) (h : a.size = n) :
(Vector.mk a h).reverse = Vector.mk a.reverse (by simp [h]) := rfl
@@ -151,12 +179,21 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
@[simp] theorem take_mk (a : Array α) (h : a.size = n) (m) :
(Vector.mk a h).take m = Vector.mk (a.take m) (by simp [h]) := rfl
@[simp] theorem zipWithIndex_mk (a : Array α) (h : a.size = n) :
(Vector.mk a h).zipWithIndex = Vector.mk (a.zipWithIndex) (by simp [h]) := rfl
@[simp] theorem zipIdx_mk (a : Array α) (h : a.size = n) (k : Nat := 0) :
(Vector.mk a h).zipIdx k = Vector.mk (a.zipIdx k) (by simp [h]) := rfl
@[deprecated zipIdx_mk (since := "2025-01-21")]
abbrev zipWithIndex_mk := @zipIdx_mk
@[simp] theorem mk_zipWith_mk (f : α β γ) (a : Array α) (b : Array β)
(ha : a.size = n) (hb : b.size = n) : zipWith (Vector.mk a ha) (Vector.mk b hb) f =
Vector.mk (Array.zipWith a b f) (by simp [ha, hb]) := rfl
(ha : a.size = n) (hb : b.size = n) : zipWith f (Vector.mk a ha) (Vector.mk b hb) =
Vector.mk (Array.zipWith f a b) (by simp [ha, hb]) := rfl
@[simp] theorem mk_zip_mk (a : Array α) (b : Array β) (ha : a.size = n) (hb : b.size = n) :
zip (Vector.mk a ha) (Vector.mk b hb) = Vector.mk (Array.zip a b) (by simp [ha, hb]) := rfl
@[simp] theorem unzip_mk (a : Array (α × β)) (h : a.size = n) :
(Vector.mk a h).unzip = (Vector.mk a.unzip.1 (by simp_all), Vector.mk a.unzip.2 (by simp_all)) := rfl
@[simp] theorem anyM_mk [Monad m] (p : α m Bool) (a : Array α) (h : a.size = n) :
(Vector.mk a h).anyM p = a.anyM p := rfl
@@ -231,6 +268,26 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
v.toArray.mapFinIdx (fun i a h => f i a (by simpa [v.size_toArray] using h)) :=
rfl
theorem toArray_mapM_go [Monad m] [LawfulMonad m] (f : α m β) (v : Vector α n) (i h r) :
toArray <$> mapM.go f v i h r = Array.mapM.map f v.toArray i r.toArray := by
unfold mapM.go
unfold Array.mapM.map
simp only [v.size_toArray, getElem_toArray]
split
· simp only [map_bind]
congr
funext b
rw [toArray_mapM_go]
rfl
· simp
@[simp] theorem toArray_mapM [Monad m] [LawfulMonad m] (f : α m β) (a : Vector α n) :
toArray <$> a.mapM f = a.toArray.mapM f := by
rcases a with a, rfl
unfold mapM
rw [toArray_mapM_go]
rfl
@[simp] theorem toArray_ofFn (f : Fin n α) : (Vector.ofFn f).toArray = Array.ofFn f := rfl
@[simp] theorem toArray_pop (a : Vector α n) : a.pop.toArray = a.toArray.pop := rfl
@@ -273,11 +330,11 @@ theorem toArray_mk (a : Array α) (h : a.size = n) : (Vector.mk a h).toArray = a
@[simp] theorem toArray_take (a : Vector α n) (m) : (a.take m).toArray = a.toArray.take m := rfl
@[simp] theorem toArray_zipWithIndex (a : Vector α n) :
(a.zipWithIndex).toArray = a.toArray.zipWithIndex := rfl
@[simp] theorem toArray_zipIdx (a : Vector α n) (k : Nat := 0) :
(a.zipIdx k).toArray = a.toArray.zipIdx k := rfl
@[simp] theorem toArray_zipWith (f : α β γ) (a : Vector α n) (b : Vector β n) :
(Vector.zipWith a b f).toArray = Array.zipWith a.toArray b.toArray f := rfl
(Vector.zipWith f a b).toArray = Array.zipWith f a.toArray b.toArray := rfl
@[simp] theorem anyM_toArray [Monad m] (p : α m Bool) (v : Vector α n) :
v.toArray.anyM p = v.anyM p := by
@@ -333,9 +390,6 @@ protected theorem ext {a b : Vector α n} (h : (i : Nat) → (_ : i < n) → a[i
rcases v with v, h
exact by rintro rfl; simp_all, by rintro rfl; simpa using h
@[simp] theorem mem_toArray_iff (a : α) (v : Vector α n) : a v.toArray a v :=
fun h => h, fun h => h
/-! ### toList -/
theorem toArray_toList (a : Vector α n) : a.toArray.toList = a.toList := rfl
@@ -417,7 +471,7 @@ theorem toList_swap (a : Vector α n) (i j) (hi hj) :
simp [List.take_of_length_le]
@[simp] theorem toList_zipWith (f : α β γ) (a : Vector α n) (b : Vector β n) :
(Vector.zipWith a b f).toArray = Array.zipWith a.toArray b.toArray f := rfl
(Vector.zipWith f a b).toArray = Array.zipWith f a.toArray b.toArray := rfl
@[simp] theorem anyM_toList [Monad m] (p : α m Bool) (v : Vector α n) :
v.toList.anyM p = v.anyM p := by
@@ -564,11 +618,11 @@ theorem mkVector_succ : mkVector (n + 1) a = (mkVector n a).push a := by
@[simp] theorem mkVector_inj : mkVector n a = mkVector n b n = 0 a = b := by
simp [ toArray_inj, toArray_mkVector, Array.mkArray_inj]
@[simp] theorem _root_.Array.toVector_mkArray (a : α) (n : Nat) :
(Array.mkArray n a).toVector = (mkVector n a).cast (by simp) := rfl
@[simp] theorem _root_.Array.mk_mkArray (a : α) (n : Nat) (h : (mkArray n a).size = m) :
mk (Array.mkArray n a) h = (mkVector n a).cast (by simpa using h) := rfl
theorem mkVector_eq_toVector_mkArray (a : α) (n : Nat) :
mkVector n a = (Array.mkArray n a).toVector.cast (by simp) := by
theorem mkVector_eq_mk_mkArray (a : α) (n : Nat) :
mkVector n a = mk (mkArray n a) (by simp) := by
simp
/-! ## L[i] and L[i]? -/
@@ -776,6 +830,10 @@ theorem getElem_of_mem {a} {l : Vector α n} (h : a ∈ l) : ∃ (i : Nat) (h :
theorem getElem?_of_mem {a} {l : Vector α n} (h : a l) : i : Nat, l[i]? = some a :=
let n, _, e := getElem_of_mem h; n, e getElem?_eq_getElem _
theorem mem_of_getElem {l : Vector α n} {i : Nat} {h} {a : α} (e : l[i] = a) : a l := by
subst e
simp
theorem mem_of_getElem? {l : Vector α n} {i : Nat} {a : α} (e : l[i]? = some a) : a l :=
let _, e := getElem?_eq_some_iff.1 e; e getElem_mem ..
@@ -1131,7 +1189,7 @@ theorem mem_setIfInBounds (v : Vector α n) (i : Nat) (hi : i < n) (a : α) :
constructor
· rintro a, ha b, hb h
simp at h
obtain hs, hi := Array.rel_of_isEqv h
obtain hs, hi := Array.isEqv_iff_rel.mp h
ext i h
· simpa using hi _ (by omega)
· rintro a, ha
@@ -1188,7 +1246,9 @@ theorem map_id'' {f : αα} (h : ∀ x, f x = x) (l : Vector α n) : map f
theorem map_singleton (f : α β) (a : α) : map f #v[a] = #v[f a] := rfl
@[simp] theorem mem_map {f : α β} {l : Vector α n} : b l.map f a, a l f a = b := by
-- We use a lower priority here as there are more specific lemmas in downstream libraries
-- which should be able to fire first.
@[simp 500] theorem mem_map {f : α β} {l : Vector α n} : b l.map f a, a l f a = b := by
cases l
simp
@@ -1415,7 +1475,7 @@ theorem getElem_of_append {l : Vector α n} {l₁ : Vector α m} {l₂ : Vector
rw [ getElem?_eq_getElem, eq, getElem?_cast, getElem?_append_left (by simp)]
simp
@[simp 1100] theorem append_singleton {a : α} {as : Vector α n} : as ++ #v[a] = as.push a := by
@[simp] theorem append_singleton {a : α} {as : Vector α n} : as ++ #v[a] = as.push a := by
cases as
simp
@@ -1650,11 +1710,6 @@ theorem eq_iff_flatten_eq {L L' : Vector (Vector α n) m} :
/-! ### flatMap -/
@[simp] theorem flatMap_mk (l : Array α) (h : l.size = m) (f : α Vector β n) :
(mk l h).flatMap f =
mk (l.flatMap (fun a => (f a).toArray)) (by simp [Array.map_const', h]) := by
simp [flatMap]
@[simp] theorem flatMap_toArray (l : Vector α n) (f : α Vector β m) :
l.toArray.flatMap (fun a => (f a).toArray) = (l.flatMap f).toArray := by
rcases l with l, rfl
@@ -1744,6 +1799,7 @@ theorem mkVector_succ' : mkVector (n + 1) a = (#v[a] ++ mkVector n a).cast (by o
@[simp] theorem mem_mkVector {a b : α} {n} : b mkVector n a n 0 b = a := by
unfold mkVector
simp only [mem_mk]
simp
theorem eq_of_mem_mkVector {a b : α} {n} (h : b mkVector n a) : b = a := (mem_mkVector.1 h).2
@@ -1753,7 +1809,8 @@ theorem forall_mem_mkVector {p : α → Prop} {a : α} {n} :
cases n <;> simp [mem_mkVector]
@[simp] theorem getElem_mkVector (a : α) (n i : Nat) (h : i < n) : (mkVector n a)[i] = a := by
simp [mkVector]
rw [mkVector_eq_mk_mkArray, getElem_mk]
simp
theorem getElem?_mkVector (a : α) (n i : Nat) : (mkVector n a)[i]? = if i < n then some a else none := by
simp [getElem?_def]
@@ -2134,10 +2191,6 @@ theorem foldr_rel {l : Array α} {f g : α → β → β} {a b : β} (r : β →
/-! Content below this point has not yet been aligned with `List` and `Array`. -/
@[simp] theorem getElem_ofFn {α n} (f : Fin n α) (i : Nat) (h : i < n) :
(Vector.ofFn f)[i] = f i, by simpa using h := by
simp [ofFn]
@[simp] theorem getElem_push_last {v : Vector α n} {x : α} : (v.push x)[n] = x := by
rcases v with data, rfl
simp
@@ -2165,7 +2218,7 @@ defeq issues in the implicit size argument.
/-! ### zipWith -/
@[simp] theorem getElem_zipWith (f : α β γ) (a : Vector α n) (b : Vector β n) (i : Nat)
(hi : i < n) : (zipWith a b f)[i] = f a[i] b[i] := by
(hi : i < n) : (zipWith f a b)[i] = f a[i] b[i] := by
cases a
cases b
simp

View File

@@ -51,30 +51,60 @@ end Array
namespace Vector
/-! ### zipWithIndex -/
/-! ### zipIdx -/
@[simp] theorem toList_zipWithIndex (a : Vector α n) :
a.zipWithIndex.toList = a.toList.enum.map (fun (i, a) => (a, i)) := by
@[simp] theorem toList_zipIdx (a : Vector α n) (k : Nat := 0) :
(a.zipIdx k).toList = a.toList.zipIdx k := by
rcases a with a, rfl
simp
@[simp] theorem getElem_zipWithIndex (a : Vector α n) (i : Nat) (h : i < n) :
(a.zipWithIndex)[i] = (a[i]'(by simp_all), i) := by
@[simp] theorem getElem_zipIdx (a : Vector α n) (i : Nat) (h : i < n) :
(a.zipIdx k)[i] = (a[i]'(by simp_all), k + i) := by
rcases a with a, rfl
simp
@[simp] theorem zipWithIndex_toVector {l : Array α} :
l.toVector.zipWithIndex = l.zipWithIndex.toVector.cast (by simp) := by
@[simp] theorem zipIdx_toVector {l : Array α} {k : Nat} :
l.toVector.zipIdx k = (l.zipIdx k).toVector.cast (by simp) := by
ext <;> simp
theorem mk_mem_zipWithIndex_iff_getElem? {x : α} {i : Nat} {l : Vector α n} :
(x, i) l.zipWithIndex l[i]? = x := by
theorem mk_mem_zipIdx_iff_le_and_getElem?_sub {x : α} {i : Nat} {l : Vector α n} {k : Nat} :
(x, i) l.zipIdx k k i l[i - k]? = x := by
rcases l with l, rfl
simp [Array.mk_mem_zipWithIndex_iff_getElem?]
simp [Array.mk_mem_zipIdx_iff_le_and_getElem?_sub]
theorem mem_enum_iff_getElem? {x : α × Nat} {l : Vector α n} :
x l.zipWithIndex l[x.2]? = some x.1 :=
mk_mem_zipWithIndex_iff_getElem?
/-- Variant of `mk_mem_zipIdx_iff_le_and_getElem?_sub` specialized at `k = 0`,
to avoid the inequality and the subtraction. -/
theorem mk_mem_zipIdx_iff_getElem? {x : α} {i : Nat} {l : Vector α n} :
(x, i) l.zipIdx l[i]? = x := by
rcases l with l, rfl
simp [Array.mk_mem_zipIdx_iff_le_and_getElem?_sub]
theorem mem_zipIdx_iff_le_and_getElem?_sub {x : α × Nat} {l : Vector α n} {k : Nat} :
x zipIdx l k k x.2 l[x.2 - k]? = some x.1 := by
cases x
simp [mk_mem_zipIdx_iff_le_and_getElem?_sub]
/-- Variant of `mem_zipIdx_iff_le_and_getElem?_sub` specialized at `k = 0`,
to avoid the inequality and the subtraction. -/
theorem mem_zipIdx_iff_getElem? {x : α × Nat} {l : Vector α n} :
x l.zipIdx l[x.2]? = some x.1 := by
rcases l with l, rfl
simp [Array.mem_zipIdx_iff_getElem?]
@[deprecated toList_zipIdx (since := "2025-01-27")]
abbrev toList_zipWithIndex := @toList_zipIdx
@[deprecated getElem_zipIdx (since := "2025-01-27")]
abbrev getElem_zipWithIndex := @getElem_zipIdx
@[deprecated zipIdx_toVector (since := "2025-01-27")]
abbrev zipWithIndex_toVector := @zipIdx_toVector
@[deprecated mk_mem_zipIdx_iff_le_and_getElem?_sub (since := "2025-01-27")]
abbrev mk_mem_zipWithIndex_iff_le_and_getElem?_sub := @mk_mem_zipIdx_iff_le_and_getElem?_sub
@[deprecated mk_mem_zipIdx_iff_getElem? (since := "2025-01-27")]
abbrev mk_mem_zipWithIndex_iff_getElem? := @mk_mem_zipIdx_iff_getElem?
@[deprecated mem_zipIdx_iff_le_and_getElem?_sub (since := "2025-01-27")]
abbrev mem_zipWithIndex_iff_le_and_getElem?_sub := @mem_zipIdx_iff_le_and_getElem?_sub
@[deprecated mem_zipIdx_iff_getElem? (since := "2025-01-27")]
abbrev mem_zipWithIndex_iff_getElem? := @mem_zipIdx_iff_getElem?
/-! ### mapFinIdx -/
@@ -215,10 +245,13 @@ theorem mapIdx_eq_mapFinIdx {l : Vector α n} {f : Nat → α → β} :
l.mapIdx f = l.mapFinIdx (fun i a _ => f i a) := by
simp [mapFinIdx_eq_mapIdx]
theorem mapIdx_eq_zipWithIndex_map {l : Vector α n} {f : Nat α β} :
l.mapIdx f = l.zipWithIndex.map fun a, i => f i a := by
theorem mapIdx_eq_zipIdx_map {l : Vector α n} {f : Nat α β} :
l.mapIdx f = l.zipIdx.map fun a, i => f i a := by
ext <;> simp
@[deprecated mapIdx_eq_zipIdx_map (since := "2025-01-27")]
abbrev mapIdx_eq_zipWithIndex_map := @mapIdx_eq_zipIdx_map
theorem mapIdx_append {K : Vector α n} {L : Vector α m} :
(K ++ L).mapIdx f = K.mapIdx f ++ L.mapIdx fun i => f (i + K.size) := by
rcases K with K, rfl

View File

@@ -0,0 +1,217 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Vector.Lemmas
import Init.Data.Vector.Attach
import Init.Data.Array.Monadic
import Init.Control.Lawful.Lemmas
/-!
# Lemmas about `Vector.forIn'` and `Vector.forIn`.
-/
namespace Vector
open Nat
/-! ## Monadic operations -/
theorem map_toArray_inj [Monad m] [LawfulMonad m] [Nonempty α]
{v₁ : m (Vector α n)} {v₂ : m (Vector α n)} (w : toArray <$> v₁ = toArray <$> v₂) :
v₁ = v₂ := by
apply map_inj_of_inj ?_ w
simp
/-! ### mapM -/
@[congr] theorem mapM_congr [Monad m] {as bs : Vector α n} (w : as = bs)
{f : α m β} :
as.mapM f = bs.mapM f := by
subst w
simp
@[simp] theorem mapM_mk_empty [Monad m] (f : α m β) :
(mk #[] rfl).mapM f = pure #v[] := by
unfold mapM
unfold mapM.go
simp
-- The `[Nonempty β]` hypothesis should be avoidable by unfolding `mapM` directly.
@[simp] theorem mapM_append [Monad m] [LawfulMonad m] [Nonempty β]
(f : α m β) {l₁ : Vector α n} {l₂ : Vector α n'} :
(l₁ ++ l₂).mapM f = (return ( l₁.mapM f) ++ ( l₂.mapM f)) := by
apply map_toArray_inj
suffices toArray <$> (l₁ ++ l₂).mapM f = (return ( toArray <$> l₁.mapM f) ++ ( toArray <$> l₂.mapM f)) by
rw [this]
simp only [bind_pure_comp, Functor.map_map, bind_map_left, map_bind, toArray_append]
simp
/-! ### foldlM and foldrM -/
theorem foldlM_map [Monad m] (f : β₁ β₂) (g : α β₂ m α) (l : Vector β₁ n) (init : α) :
(l.map f).foldlM g init = l.foldlM (fun x y => g x (f y)) init := by
rcases l with l, rfl
simp [Array.foldlM_map]
theorem foldrM_map [Monad m] [LawfulMonad m] (f : β₁ β₂) (g : β₂ α m α) (l : Vector β₁ n)
(init : α) : (l.map f).foldrM g init = l.foldrM (fun x y => g (f x) y) init := by
rcases l with l, rfl
simp [Array.foldrM_map]
theorem foldlM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : γ β m γ) (l : Vector α n) (init : γ) :
(l.filterMap f).foldlM g init =
l.foldlM (fun x y => match f y with | some b => g x b | none => pure x) init := by
rcases l with l, rfl
simp [Array.foldlM_filterMap]
rfl
theorem foldrM_filterMap [Monad m] [LawfulMonad m] (f : α Option β) (g : β γ m γ) (l : Vector α n) (init : γ) :
(l.filterMap f).foldrM g init =
l.foldrM (fun x y => match f x with | some b => g b y | none => pure y) init := by
rcases l with l, rfl
simp [Array.foldrM_filterMap]
rfl
theorem foldlM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : β α m β) (l : Vector α n) (init : β) :
(l.filter p).foldlM g init =
l.foldlM (fun x y => if p y then g x y else pure x) init := by
rcases l with l, rfl
simp [Array.foldlM_filter]
theorem foldrM_filter [Monad m] [LawfulMonad m] (p : α Bool) (g : α β m β) (l : Vector α n) (init : β) :
(l.filter p).foldrM g init =
l.foldrM (fun x y => if p x then g x y else pure y) init := by
rcases l with l, rfl
simp [Array.foldrM_filter]
@[simp] theorem foldlM_attachWith [Monad m]
(l : Vector α n) {q : α Prop} (H : a, a l q a) {f : β { x // q x} m β} {b} :
(l.attachWith q H).foldlM f b = l.attach.foldlM (fun b a, h => f b a, H _ h) b := by
rcases l with l, rfl
simp [Array.foldlM_map]
@[simp] theorem foldrM_attachWith [Monad m] [LawfulMonad m]
(l : Vector α n) {q : α Prop} (H : a, a l q a) {f : { x // q x} β m β} {b} :
(l.attachWith q H).foldrM f b = l.attach.foldrM (fun a acc => f a.1, H _ a.2 acc) b := by
rcases l with l, rfl
simp [Array.foldrM_map]
/-! ### forM -/
@[congr] theorem forM_congr [Monad m] {as bs : Vector α n} (w : as = bs)
{f : α m PUnit} :
forM as f = forM bs f := by
cases as <;> cases bs
simp_all
@[simp] theorem forM_append [Monad m] [LawfulMonad m] (l₁ : Vector α n) (l₂ : Vector α n') (f : α m PUnit) :
forM (l₁ ++ l₂) f = (do forM l₁ f; forM l₂ f) := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, rfl
simp
@[simp] theorem forM_map [Monad m] [LawfulMonad m] (l : Vector α n) (g : α β) (f : β m PUnit) :
forM (l.map g) f = forM l (fun a => f (g a)) := by
cases l
simp
/-! ### forIn' -/
@[congr] theorem forIn'_congr [Monad m] {as bs : Vector α n} (w : as = bs)
{b b' : β} (hb : b = b')
{f : (a' : α) a' as β m (ForInStep β)}
{g : (a' : α) a' bs β m (ForInStep β)}
(h : a m b, f a (by simpa [w] using m) b = g a m b) :
forIn' as b f = forIn' bs b' g := by
cases as <;> cases bs
simp only [eq_mk, mem_mk, forIn'_mk] at w h
exact Array.forIn'_congr w hb h
/--
We can express a for loop over a vector as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn'_eq_foldlM [Monad m] [LawfulMonad m]
(l : Vector α n) (f : (a : α) a l β m (ForInStep β)) (init : β) :
forIn' l init f = ForInStep.value <$>
l.attach.foldlM (fun b a, m => match b with
| .yield b => f a m b
| .done b => pure (.done b)) (ForInStep.yield init) := by
rcases l with l, rfl
simp [Array.forIn'_eq_foldlM]
rfl
/-- We can express a for loop over a vector which always yields as a fold. -/
@[simp] theorem forIn'_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Vector α n) (f : (a : α) a l β m γ) (g : (a : α) a l β γ β) (init : β) :
forIn' l init (fun a m b => (fun c => .yield (g a m b c)) <$> f a m b) =
l.attach.foldlM (fun b a, m => g a m b <$> f a m b) init := by
rcases l with l, rfl
simp
theorem forIn'_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Vector α n) (f : (a : α) a l β β) (init : β) :
forIn' l init (fun a m b => pure (.yield (f a m b))) =
pure (f := m) (l.attach.foldl (fun b a, h => f a h b) init) := by
rcases l with l, rfl
simp [Array.forIn'_pure_yield_eq_foldl, Array.foldl_map]
@[simp] theorem forIn'_yield_eq_foldl
(l : Vector α n) (f : (a : α) a l β β) (init : β) :
forIn' (m := Id) l init (fun a m b => .yield (f a m b)) =
l.attach.foldl (fun b a, h => f a h b) init := by
cases l
simp [List.foldl_map]
@[simp] theorem forIn'_map [Monad m] [LawfulMonad m]
(l : Vector α n) (g : α β) (f : (b : β) b l.map g γ m (ForInStep γ)) :
forIn' (l.map g) init f = forIn' l init fun a h y => f (g a) (mem_map_of_mem g h) y := by
cases l
simp
/--
We can express a for loop over a vector as a fold,
in which whenever we reach `.done b` we keep that value through the rest of the fold.
-/
theorem forIn_eq_foldlM [Monad m] [LawfulMonad m]
(f : α β m (ForInStep β)) (init : β) (l : Vector α n) :
forIn l init f = ForInStep.value <$>
l.foldlM (fun b a => match b with
| .yield b => f a b
| .done b => pure (.done b)) (ForInStep.yield init) := by
rcases l with l, rfl
simp [Array.forIn_eq_foldlM]
rfl
/-- We can express a for loop over a vector which always yields as a fold. -/
@[simp] theorem forIn_yield_eq_foldlM [Monad m] [LawfulMonad m]
(l : Vector α n) (f : α β m γ) (g : α β γ β) (init : β) :
forIn l init (fun a b => (fun c => .yield (g a b c)) <$> f a b) =
l.foldlM (fun b a => g a b <$> f a b) init := by
cases l
simp
theorem forIn_pure_yield_eq_foldl [Monad m] [LawfulMonad m]
(l : Vector α n) (f : α β β) (init : β) :
forIn l init (fun a b => pure (.yield (f a b))) =
pure (f := m) (l.foldl (fun b a => f a b) init) := by
rcases l with l, rfl
simp [Array.forIn_pure_yield_eq_foldl, Array.foldl_map]
@[simp] theorem forIn_yield_eq_foldl
(l : Vector α n) (f : α β β) (init : β) :
forIn (m := Id) l init (fun a b => .yield (f a b)) =
l.foldl (fun b a => f a b) init := by
cases l
simp
@[simp] theorem forIn_map [Monad m] [LawfulMonad m]
(l : Vector α n) (g : α β) (f : β γ m (ForInStep γ)) :
forIn (l.map g) init f = forIn l init fun a y => f (g a) y := by
cases l
simp
end Vector

View File

@@ -0,0 +1,37 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Vector.Lemmas
import Init.Data.Array.OfFn
/-!
# Theorems about `Vector.ofFn`
-/
namespace Vector
@[simp] theorem getElem_ofFn {α n} (f : Fin n α) (i : Nat) (h : i < n) :
(Vector.ofFn f)[i] = f i, by simpa using h := by
simp [ofFn]
theorem getElem?_ofFn (f : Fin n α) (i : Nat) :
(ofFn f)[i]? = if h : i < n then some (f i, h) else none := by
simp [getElem?_def]
@[simp 500]
theorem mem_ofFn {n} (f : Fin n α) (a : α) : a ofFn f i, f i = a := by
constructor
· intro w
obtain i, h, rfl := getElem_of_mem w
exact i, by simpa using h, by simp
· rintro i, rfl
apply mem_of_getElem (i := i) <;> simp
theorem back_ofFn {n} [NeZero n](f : Fin n α) :
(ofFn f).back = f n - 1, by have := NeZero.ne n; omega := by
simp [back]
end Vector

View File

@@ -0,0 +1,271 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Vector.Lemmas
import Init.Data.Vector.Zip
import Init.Data.Vector.MapIdx
import Init.Data.Array.Range
/-!
# Lemmas about `Vector.range'`, `Vector.range`, and `Vector.zipIdx`
-/
namespace Vector
open Nat
/-! ## Ranges and enumeration -/
/-! ### range' -/
@[simp] theorem toArray_range' (start size step) :
(range' start size step).toArray = Array.range' start size step := by
rfl
theorem range'_eq_mk_range' (start size step) :
range' start size step = Vector.mk (Array.range' start size step) (by simp) := by
rfl
@[simp] theorem getElem_range' (start size step i) (h : i < size) :
(range' start size step)[i] = start + step * i := by
simp [range', h]
@[simp] theorem getElem?_range' (start size step i) :
(range' start size step)[i]? = if i < size then some (start + step * i) else none := by
simp [getElem?_def, range']
theorem range'_succ (s n step) :
range' s (n + 1) step = (#v[s] ++ range' (s + step) n step).cast (by omega) := by
rw [ toArray_inj]
simp [Array.range'_succ]
theorem range'_zero : range' s 0 step = #v[] := by
simp
@[simp] theorem range'_one {s step : Nat} : range' s 1 step = #v[s] := rfl
@[simp] theorem range'_inj : range' s n = range' s' n (n = 0 s = s') := by
rw [ toArray_inj]
simp [List.range'_inj]
theorem mem_range' {n} : m range' s n step i < n, m = s + step * i := by
simp [range', Array.mem_range']
theorem pop_range' : (range' s n step).pop = range' s (n - 1) step := by
ext <;> simp
theorem map_add_range' (a) (s n step) : map (a + ·) (range' s n step) = range' (a + s) n step := by
ext <;> simp <;> omega
theorem range'_succ_left : range' (s + 1) n step = (range' s n step).map (· + 1) := by
ext <;> simp <;> omega
theorem range'_append (s m n step : Nat) :
range' s m step ++ range' (s + step * m) n step = range' s (m + n) step := by
rw [ toArray_inj]
simp [Array.range'_append]
@[simp] theorem range'_append_1 (s m n : Nat) :
range' s m ++ range' (s + m) n = range' s (m + n) := by simpa using range'_append s m n 1
theorem range'_concat (s n : Nat) : range' s (n + 1) step = range' s n step ++ #v[s + step * n] := by
exact (range'_append s n 1 step).symm
theorem range'_1_concat (s n : Nat) : range' s (n + 1) = range' s n ++ #v[s + n] := by
simp [range'_concat]
@[simp] theorem mem_range'_1 : m range' s n s m m < s + n := by
simp [mem_range']; exact
fun i, h, e => e Nat.le_add_right .., Nat.add_lt_add_left h _,
fun h₁, h₂ => m - s, Nat.sub_lt_left_of_lt_add h₁ h₂, (Nat.add_sub_cancel' h₁).symm
theorem map_sub_range' (a s n : Nat) (h : a s) :
map (· - a) (range' s n step) = range' (s - a) n step := by
conv => lhs; rw [ Nat.add_sub_cancel' h]
rw [ map_add_range', map_map, (?_ : __ = _), map_id]
funext x; apply Nat.add_sub_cancel_left
theorem range'_eq_append_iff : range' s (n + m) = xs ++ ys xs = range' s n ys = range' (s + n) m := by
simp only [ toArray_inj, toArray_range', toArray_append, Array.range'_eq_append_iff]
constructor
· rintro k, hk, h₁, h₂
have w : k = n := by
replace h₁ := congrArg Array.size h₁
simp_all
subst w
simp_all
omega
· rintro h₁, h₂
exact n, by omega, by simp_all; omega
@[simp] theorem find?_range'_eq_some {s n : Nat} {i : Nat} {p : Nat Bool} :
(range' s n).find? p = some i p i i range' s n j, s j j < i !p j := by
simp [range'_eq_mk_range']
@[simp] theorem find?_range'_eq_none {s n : Nat} {p : Nat Bool} :
(range' s n).find? p = none i, s i i < s + n !p i := by
simp [range'_eq_mk_range']
/-! ### range -/
theorem range_eq_range' (n : Nat) : range n = range' 0 n := by
simp [range, range', Array.range_eq_range']
theorem range_succ_eq_map (n : Nat) : range (n + 1) =
(#v[0] ++ map succ (range n)).cast (by omega) := by
rw [ toArray_inj]
simp [Array.range_succ_eq_map]
theorem range'_eq_map_range (s n : Nat) : range' s n = map (s + ·) (range n) := by
rw [range_eq_range', map_add_range']; rfl
theorem range_succ (n : Nat) : range (succ n) = range n ++ #v[n] := by
rw [ toArray_inj]
simp [Array.range_succ]
theorem range_add (a b : Nat) : range (a + b) = range a ++ (range b).map (a + ·) := by
rw [ range'_eq_map_range]
simpa [range_eq_range', Nat.add_comm] using (range'_append_1 0 a b).symm
theorem reverse_range' (s n : Nat) : reverse (range' s n) = map (s + n - 1 - ·) (range n) := by
simp [ toList_inj, List.reverse_range']
@[simp]
theorem mem_range {m n : Nat} : m range n m < n := by
simp only [range_eq_range', mem_range'_1, Nat.zero_le, true_and, Nat.zero_add]
theorem not_mem_range_self {n : Nat} : n range n := by simp
theorem self_mem_range_succ (n : Nat) : n range (n + 1) := by simp
@[simp] theorem take_range (m n : Nat) : take (range n) m = range (min m n) := by
ext <;> simp
erw [getElem_extract] -- Why is an `erw` needed here? This should be by simp!
simp
@[simp] theorem find?_range_eq_some {n : Nat} {i : Nat} {p : Nat Bool} :
(range n).find? p = some i p i i range n j, j < i !p j := by
simp [range_eq_range']
@[simp] theorem find?_range_eq_none {n : Nat} {p : Nat Bool} :
(range n).find? p = none i, i < n !p i := by
simp [range_eq_range']
/-! ### zipIdx -/
@[simp]
theorem getElem?_zipIdx (l : Vector α n) (n m) : (zipIdx l n)[m]? = l[m]?.map fun a => (a, n + m) := by
simp [getElem?_def]
theorem map_snd_add_zipIdx_eq_zipIdx (l : Vector α n) (m k : Nat) :
map (Prod.map id (· + m)) (zipIdx l k) = zipIdx l (m + k) := by
ext <;> simp <;> omega
@[simp]
theorem zipIdx_map_snd (m) (l : Vector α n) : map Prod.snd (zipIdx l m) = range' m n := by
rcases l with l, rfl
simp [Array.zipIdx_map_snd]
@[simp]
theorem zipIdx_map_fst (m) (l : Vector α n) : map Prod.fst (zipIdx l m) = l := by
rcases l with l, rfl
simp [Array.zipIdx_map_fst]
theorem zipIdx_eq_zip_range' (l : Vector α n) : l.zipIdx m = l.zip (range' m n) := by
simp [zip_of_prod (zipIdx_map_fst _ _) (zipIdx_map_snd _ _)]
@[simp]
theorem unzip_zipIdx_eq_prod (l : Vector α n) {m : Nat} :
(l.zipIdx m).unzip = (l, range' m n) := by
simp only [zipIdx_eq_zip_range', unzip_zip]
/-- Replace `zipIdx` with a starting index `m+1` with `zipIdx` starting from `m`,
followed by a `map` increasing the indices by one. -/
theorem zipIdx_succ (l : Vector α n) (m : Nat) :
l.zipIdx (m + 1) = (l.zipIdx m).map (fun a, i => (a, i + 1)) := by
rcases l with l, rfl
simp [Array.zipIdx_succ]
/-- Replace `zipIdx` with a starting index with `zipIdx` starting from 0,
followed by a `map` increasing the indices. -/
theorem zipIdx_eq_map_add (l : Vector α n) (m : Nat) :
l.zipIdx m = l.zipIdx.map (fun a, i => (a, m + i)) := by
rcases l with l, rfl
simp only [zipIdx_mk, map_mk, eq_mk]
rw [Array.zipIdx_eq_map_add]
@[simp]
theorem zipIdx_singleton (x : α) (k : Nat) : zipIdx #v[x] k = #v[(x, k)] :=
rfl
theorem mk_add_mem_zipIdx_iff_getElem? {k i : Nat} {x : α} {l : Vector α n} :
(x, k + i) zipIdx l k l[i]? = some x := by
simp [mem_iff_getElem?, and_left_comm]
theorem le_snd_of_mem_zipIdx {x : α × Nat} {k : Nat} {l : Vector α n} (h : x zipIdx l k) :
k x.2 :=
(mk_mem_zipIdx_iff_le_and_getElem?_sub.1 h).1
theorem snd_lt_add_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x zipIdx l k) :
x.2 < k + n := by
rcases mem_iff_getElem.1 h with i, h', rfl
simpa using h'
theorem snd_lt_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x l.zipIdx k) :
x.2 < n + k := by
simpa [Nat.add_comm] using snd_lt_add_of_mem_zipIdx h
theorem map_zipIdx (f : α β) (l : Vector α n) (k : Nat) :
map (Prod.map f id) (zipIdx l k) = zipIdx (l.map f) k := by
cases l
simp [Array.map_zipIdx]
theorem fst_mem_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x zipIdx l k) : x.1 l :=
zipIdx_map_fst k l mem_map_of_mem _ h
theorem fst_eq_of_mem_zipIdx {x : α × Nat} {l : Vector α n} {k : Nat} (h : x zipIdx l k) :
x.1 = l[x.2 - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) := by
cases l
exact Array.fst_eq_of_mem_zipIdx (by simpa using h)
theorem mem_zipIdx {x : α} {i : Nat} {xs : Vector α n} {k : Nat} (h : (x, i) xs.zipIdx k) :
k i i < k + n
x = xs[i - k]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
le_snd_of_mem_zipIdx h, snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h
/-- Variant of `mem_zipIdx` specialized at `k = 0`. -/
theorem mem_zipIdx' {x : α} {i : Nat} {xs : Vector α n} (h : (x, i) xs.zipIdx) :
i < n x = xs[i]'(by have := le_snd_of_mem_zipIdx h; have := snd_lt_add_of_mem_zipIdx h; omega) :=
by simpa using snd_lt_add_of_mem_zipIdx h, fst_eq_of_mem_zipIdx h
theorem zipIdx_map (l : Vector α n) (k : Nat) (f : α β) :
zipIdx (l.map f) k = (zipIdx l k).map (Prod.map f id) := by
cases l
simp [Array.zipIdx_map]
theorem zipIdx_append (xs : Vector α n) (ys : Vector α m) (k : Nat) :
zipIdx (xs ++ ys) k = zipIdx xs k ++ zipIdx ys (k + n) := by
rcases xs with xs, rfl
rcases ys with ys, rfl
simp [Array.zipIdx_append]
theorem zipIdx_eq_append_iff {l : Vector α (n + m)} {k : Nat} :
zipIdx l k = l₁ ++ l₂
(l₁' : Vector α n) (l₂' : Vector α m),
l = l₁' ++ l₂' l₁ = zipIdx l₁' k l₂ = zipIdx l₂' (k + n) := by
rcases l with l, h
rcases l₁ with l₁, rfl
rcases l₂ with l₂, rfl
simp only [zipIdx_mk, mk_append_mk, eq_mk, Array.zipIdx_eq_append_iff, mk_eq, toArray_append,
toArray_zipIdx]
constructor
· rintro l₁', l₂', rfl, rfl, rfl
exact l₁', by simp, l₂', by simp, by simp
· rintro l₁', h₁, l₂', h₂, rfl, w₁, w₂
exact l₁', l₂', by simp, w₁, by simp [h₁, w₂]
end Vector

View File

@@ -0,0 +1,287 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kim Morrison
-/
prelude
import Init.Data.Array.Zip
import Init.Data.Vector.Lemmas
/-!
# Lemmas about `Vector.zip`, `Vector.zipWith`, `Vector.zipWithAll`, and `Vector.unzip`.
-/
namespace Vector
open Nat
/-! ## Zippers -/
/-! ### zipWith -/
theorem zipWith_comm (f : α β γ) (la : Vector α n) (lb : Vector β n) :
zipWith f la lb = zipWith (fun b a => f a b) lb la := by
rcases la with la, rfl
rcases lb with lb, h
simpa using Array.zipWith_comm _ _ _
theorem zipWith_comm_of_comm (f : α α β) (comm : x y : α, f x y = f y x) (l l' : Vector α n) :
zipWith f l l' = zipWith f l' l := by
rw [zipWith_comm]
simp only [comm]
@[simp]
theorem zipWith_self (f : α α δ) (l : Vector α n) : zipWith f l l = l.map fun a => f a a := by
cases l
simp
/--
See also `getElem?_zipWith'` for a variant
using `Option.map` and `Option.bind` rather than a `match`.
-/
theorem getElem?_zipWith {f : α β γ} {i : Nat} :
(zipWith f as bs)[i]? = match as[i]?, bs[i]? with
| some a, some b => some (f a b) | _, _ => none := by
cases as
cases bs
simp [Array.getElem?_zipWith]
rfl
/-- Variant of `getElem?_zipWith` using `Option.map` and `Option.bind` rather than a `match`. -/
theorem getElem?_zipWith' {f : α β γ} {i : Nat} :
(zipWith f l₁ l₂)[i]? = (l₁[i]?.map f).bind fun g => l₂[i]?.map g := by
cases l₁
cases l₂
simp [Array.getElem?_zipWith']
theorem getElem?_zipWith_eq_some {f : α β γ} {l₁ : Vector α n} {l₂ : Vector β n} {z : γ} {i : Nat} :
(zipWith f l₁ l₂)[i]? = some z
x y, l₁[i]? = some x l₂[i]? = some y f x y = z := by
cases l₁
cases l₂
simp [Array.getElem?_zipWith_eq_some]
theorem getElem?_zip_eq_some {l₁ : Vector α n} {l₂ : Vector β n} {z : α × β} {i : Nat} :
(zip l₁ l₂)[i]? = some z l₁[i]? = some z.1 l₂[i]? = some z.2 := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.getElem?_zip_eq_some]
@[simp]
theorem zipWith_map {μ} (f : γ δ μ) (g : α γ) (h : β δ) (l₁ : Vector α n) (l₂ : Vector β n) :
zipWith f (l₁.map g) (l₂.map h) = zipWith (fun a b => f (g a) (h b)) l₁ l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.zipWith_map]
theorem zipWith_map_left (l₁ : Vector α n) (l₂ : Vector β n) (f : α α') (g : α' β γ) :
zipWith g (l₁.map f) l₂ = zipWith (fun a b => g (f a) b) l₁ l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.zipWith_map_left]
theorem zipWith_map_right (l₁ : Vector α n) (l₂ : Vector β n) (f : β β') (g : α β' γ) :
zipWith g l₁ (l₂.map f) = zipWith (fun a b => g a (f b)) l₁ l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.zipWith_map_right]
theorem zipWith_foldr_eq_zip_foldr {f : α β γ} (i : δ):
(zipWith f l₁ l₂).foldr g i = (zip l₁ l₂).foldr (fun p r => g (f p.1 p.2) r) i := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simpa using Array.zipWith_foldr_eq_zip_foldr _
theorem zipWith_foldl_eq_zip_foldl {f : α β γ} (i : δ):
(zipWith f l₁ l₂).foldl g i = (zip l₁ l₂).foldl (fun r p => g r (f p.1 p.2)) i := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simpa using Array.zipWith_foldl_eq_zip_foldl _
theorem map_zipWith {δ : Type _} (f : α β) (g : γ δ α) (l : Vector γ n) (l' : Vector δ n) :
map f (zipWith g l l') = zipWith (fun x y => f (g x y)) l l' := by
rcases l with l, rfl
rcases l' with l', h
simp [Array.map_zipWith]
theorem take_zipWith : (zipWith f l l').take n = zipWith f (l.take n) (l'.take n) := by
rcases l with l, rfl
rcases l' with l', h
simp [Array.take_zipWith]
theorem extract_zipWith : (zipWith f l l').extract m n = zipWith f (l.extract m n) (l'.extract m n) := by
rcases l with l, rfl
rcases l' with l', h
simp [Array.extract_zipWith]
theorem zipWith_append (f : α β γ)
(l : Vector α n) (la : Vector α m) (l' : Vector β n) (lb : Vector β m) :
zipWith f (l ++ la) (l' ++ lb) = zipWith f l l' ++ zipWith f la lb := by
rcases l with l, rfl
rcases l' with l', h
rcases la with la, rfl
rcases lb with lb, h'
simp [Array.zipWith_append, *]
theorem zipWith_eq_append_iff {f : α β γ} {l₁ : Vector α (n + m)} {l₂ : Vector β (n + m)} :
zipWith f l₁ l₂ = l₁' ++ l₂'
w x y z, l₁ = w ++ x l₂ = y ++ z l₁' = zipWith f w y l₂' = zipWith f x z := by
rcases l₁ with l₁, h₁
rcases l₂ with l₂, h₂
rcases l₁' with l₁', rfl
rcases l₂' with l₂', rfl
simp only [mk_zipWith_mk, mk_append_mk, eq_mk, Array.zipWith_eq_append_iff,
mk_eq, toArray_append, toArray_zipWith]
constructor
· rintro w, x, y, z, h, rfl, rfl, rfl, rfl
simp only [Array.size_append, Array.size_zipWith] at h₁ h₂
exact mk w (by simp; omega), mk x (by simp; omega), mk y (by simp; omega), mk z (by simp; omega), by simp
· rintro w, hw, x, hx, y, hy, z, hz, rfl, rfl, w₁, w₂
simp only at w₁ w₂
exact w, x, y, z, by simpa [hw, hy] using w₁, w₂
@[simp] theorem zipWith_mkVector {a : α} {b : β} {n : Nat} :
zipWith f (mkVector n a) (mkVector n b) = mkVector n (f a b) := by
ext
simp
theorem map_uncurry_zip_eq_zipWith (f : α β γ) (l : Vector α n) (l' : Vector β n) :
map (Function.uncurry f) (l.zip l') = zipWith f l l' := by
rcases l with l, rfl
rcases l' with l', h
simp [Array.map_uncurry_zip_eq_zipWith]
theorem map_zip_eq_zipWith (f : α × β γ) (l : Vector α n) (l' : Vector β n) :
map f (l.zip l') = zipWith (Function.curry f) l l' := by
rcases l with l, rfl
rcases l' with l', h
simp [Array.map_zip_eq_zipWith]
theorem reverse_zipWith :
(zipWith f l l').reverse = zipWith f l.reverse l'.reverse := by
rcases l with l, rfl
rcases l' with l', h
simp [Array.reverse_zipWith, h]
/-! ### zip -/
@[simp]
theorem getElem_zip {l : Vector α n} {l' : Vector β n} {i : Nat} {h : i < n} :
(zip l l')[i] = (l[i], l'[i]) :=
getElem_zipWith ..
theorem zip_eq_zipWith (l₁ : Vector α n) (l₂ : Vector β n) : zip l₁ l₂ = zipWith Prod.mk l₁ l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.zip_eq_zipWith, h]
theorem zip_map (f : α γ) (g : β δ) (l₁ : Vector α n) (l₂ : Vector β n) :
zip (l₁.map f) (l₂.map g) = (zip l₁ l₂).map (Prod.map f g) := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.zip_map, h]
theorem zip_map_left (f : α γ) (l₁ : Vector α n) (l₂ : Vector β n) :
zip (l₁.map f) l₂ = (zip l₁ l₂).map (Prod.map f id) := by rw [ zip_map, map_id]
theorem zip_map_right (f : β γ) (l₁ : Vector α n) (l₂ : Vector β n) :
zip l₁ (l₂.map f) = (zip l₁ l₂).map (Prod.map id f) := by rw [ zip_map, map_id]
theorem zip_append {l₁ : Vector α n} {l₂ : Vector β n} {r₁ : Vector α m} {r₂ : Vector β m} :
zip (l₁ ++ r₁) (l₂ ++ r₂) = zip l₁ l₂ ++ zip r₁ r₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
rcases r₁ with r₁, rfl
rcases r₂ with r₂, h'
simp [Array.zip_append, h, h']
theorem zip_map' (f : α β) (g : α γ) (l : Vector α n) :
zip (l.map f) (l.map g) = l.map fun a => (f a, g a) := by
rcases l with l, rfl
simp [Array.zip_map']
theorem of_mem_zip {a b} {l₁ : Vector α n} {l₂ : Vector β n} : (a, b) zip l₁ l₂ a l₁ b l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simpa using Array.of_mem_zip
theorem map_fst_zip (l₁ : Vector α n) (l₂ : Vector β n) :
map Prod.fst (zip l₁ l₂) = l₁ := by
cases l₁
cases l₂
simp_all [Array.map_fst_zip]
theorem map_snd_zip (l₁ : Vector α n) (l₂ : Vector β n) :
map Prod.snd (zip l₁ l₂) = l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.map_snd_zip, h]
theorem map_prod_left_eq_zip {l : Vector α n} (f : α β) :
(l.map fun x => (x, f x)) = l.zip (l.map f) := by
rcases l with l, rfl
rw [ zip_map']
congr
simp
theorem map_prod_right_eq_zip {l : Vector α n} (f : α β) :
(l.map fun x => (f x, x)) = (l.map f).zip l := by
rcases l with l, rfl
rw [ zip_map']
congr
simp
theorem zip_eq_append_iff {l₁ : Vector α (n + m)} {l₂ : Vector β (n + m)} {l₁' : Vector (α × β) n} {l₂' : Vector (α × β) m} :
zip l₁ l₂ = l₁' ++ l₂'
w x y z, l₁ = w ++ x l₂ = y ++ z l₁' = zip w y l₂' = zip x z := by
simp [zip_eq_zipWith, zipWith_eq_append_iff]
@[simp] theorem zip_mkVector {a : α} {b : β} {n : Nat} :
zip (mkVector n a) (mkVector n b) = mkVector n (a, b) := by
ext <;> simp
/-! ### unzip -/
@[simp] theorem unzip_fst : (unzip l).fst = l.map Prod.fst := by
induction l <;> simp_all
@[simp] theorem unzip_snd : (unzip l).snd = l.map Prod.snd := by
induction l <;> simp_all
theorem unzip_eq_map (l : Vector (α × β) n) : unzip l = (l.map Prod.fst, l.map Prod.snd) := by
cases l
simp [List.unzip_eq_map]
theorem zip_unzip (l : Vector (α × β) n) : zip (unzip l).1 (unzip l).2 = l := by
rcases l with l, rfl
simp only [unzip_mk, mk_zip_mk, Array.zip_unzip]
theorem unzip_zip_left {l₁ : Vector α n} {l₂ : Vector β n} :
(unzip (zip l₁ l₂)).1 = l₁ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.unzip_zip_left, h, Array.map_fst_zip]
theorem unzip_zip_right {l₁ : Vector α n} {l₂ : Vector β n} :
(unzip (zip l₁ l₂)).2 = l₂ := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.unzip_zip_right, h, Array.map_snd_zip]
theorem unzip_zip {l₁ : Vector α n} {l₂ : Vector β n} :
unzip (zip l₁ l₂) = (l₁, l₂) := by
rcases l₁ with l₁, rfl
rcases l₂ with l₂, h
simp [Array.unzip_zip, h, Array.map_fst_zip, Array.map_snd_zip]
theorem zip_of_prod {l : Vector α n} {l' : Vector β n} {lp : Vector (α × β) n} (hl : lp.map Prod.fst = l)
(hr : lp.map Prod.snd = l') : lp = l.zip l' := by
rw [ hl, hr, zip_unzip lp, unzip_fst, unzip_snd, zip_unzip, zip_unzip]
@[simp] theorem unzip_mkVector {n : Nat} {a : α} {b : β} :
unzip (mkVector n (a, b)) = (mkVector n a, mkVector n b) := by
ext1 <;> simp
end Vector

View File

@@ -69,6 +69,37 @@ theorem eq_eq_of_eq_true_right {a b : Prop} (h : b = True) : (a = b) = a := by s
theorem eq_congr {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = a₂) (h₂ : b₁ = b₂) : (a₁ = b₁) = (a₂ = b₂) := by simp [*]
theorem eq_congr' {α : Sort u} {a₁ b₁ a₂ b₂ : α} (h₁ : a₁ = b₂) (h₂ : b₁ = a₂) : (a₁ = b₁) = (a₂ = b₂) := by rw [h₁, h₂, Eq.comm (a := a₂)]
/-! Bool.and -/
theorem Bool.and_eq_of_eq_true_left {a b : Bool} (h : a = true) : (a && b) = b := by simp [h]
theorem Bool.and_eq_of_eq_true_right {a b : Bool} (h : b = true) : (a && b) = a := by simp [h]
theorem Bool.and_eq_of_eq_false_left {a b : Bool} (h : a = false) : (a && b) = false := by simp [h]
theorem Bool.and_eq_of_eq_false_right {a b : Bool} (h : b = false) : (a && b) = false := by simp [h]
theorem Bool.eq_true_of_and_eq_true_left {a b : Bool} (h : (a && b) = true) : a = true := by simp_all
theorem Bool.eq_true_of_and_eq_true_right {a b : Bool} (h : (a && b) = true) : b = true := by simp_all
/-! Bool.or -/
theorem Bool.or_eq_of_eq_true_left {a b : Bool} (h : a = true) : (a || b) = true := by simp [h]
theorem Bool.or_eq_of_eq_true_right {a b : Bool} (h : b = true) : (a || b) = true := by simp [h]
theorem Bool.or_eq_of_eq_false_left {a b : Bool} (h : a = false) : (a || b) = b := by simp [h]
theorem Bool.or_eq_of_eq_false_right {a b : Bool} (h : b = false) : (a || b) = a := by simp [h]
theorem Bool.eq_false_of_or_eq_false_left {a b : Bool} (h : (a || b) = false) : a = false := by
cases a <;> simp_all
theorem Bool.eq_false_of_or_eq_false_right {a b : Bool} (h : (a || b) = false) : b = false := by
cases a <;> simp_all
/-! Bool.not -/
theorem Bool.not_eq_of_eq_true {a : Bool} (h : a = true) : (!a) = false := by simp [h]
theorem Bool.not_eq_of_eq_false {a : Bool} (h : a = false) : (!a) = true := by simp [h]
theorem Bool.eq_false_of_not_eq_true {a : Bool} (h : (!a) = true) : a = false := by simp_all
theorem Bool.eq_true_of_not_eq_false {a : Bool} (h : (!a) = false) : a = true := by simp_all
theorem Bool.false_of_not_eq_self {a : Bool} (h : (!a) = a) : False := by
by_cases a <;> simp_all
/- The following two helper theorems are used to case-split `a = b` representing `iff`. -/
theorem of_eq_eq_true {a b : Prop} (h : (a = b) = True) : (¬a b) (¬b a) := by
by_cases a <;> by_cases b <;> simp_all
@@ -106,4 +137,11 @@ theorem eqNDRec_heq.{u_1, u_2} {α : Sort u_2} {a : α}
: HEq (@Eq.ndrec α a motive v b h) v := by
subst h; rfl
/-! decide -/
theorem of_decide_eq_true {p : Prop} {_ : Decidable p} : decide p = true p = True := by simp
theorem of_decide_eq_false {p : Prop} {_ : Decidable p} : decide p = false p = False := by simp
theorem decide_eq_true {p : Prop} {_ : Decidable p} : p = True decide p = true := by simp
theorem decide_eq_false {p : Prop} {_ : Decidable p} : p = False decide p = false := by simp
end Lean.Grind

View File

@@ -61,6 +61,14 @@ theorem Int.lt_eq (a b : Int) : (a < b) = (a + 1 ≤ b) := by
theorem ge_eq [LE α] (a b : α) : (a b) = (b a) := rfl
theorem gt_eq [LT α] (a b : α) : (a > b) = (b < a) := rfl
theorem beq_eq_decide_eq {_ : BEq α} [LawfulBEq α] [DecidableEq α] (a b : α) : (a == b) = (decide (a = b)) := by
by_cases a = b
next h => simp [h]
next h => simp [beq_eq_false_iff_ne.mpr h, decide_eq_false h]
theorem bne_eq_decide_not_eq {_ : BEq α} [LawfulBEq α] [DecidableEq α] (a b : α) : (a != b) = (decide (¬ a = b)) := by
by_cases a = b <;> simp [*]
init_grind_norm
/- Pre theorems -/
not_and not_or not_ite not_forall not_exists
@@ -95,9 +103,9 @@ init_grind_norm
-- Bool not
Bool.not_not
-- beq
beq_iff_eq
beq_iff_eq beq_eq_decide_eq
-- bne
bne_iff_ne
bne_iff_ne bne_eq_decide_not_eq
-- Bool not eq true/false
Bool.not_eq_true Bool.not_eq_false
-- decide

View File

@@ -6,23 +6,29 @@ Authors: Leonardo de Moura
prelude
import Init.Tactics
namespace Lean.Parser.Attr
syntax grindEq := "="
syntax grindEqBoth := atomic("_" "=" "_")
syntax grindEqRhs := atomic("=" "_")
syntax grindEqBwd := atomic("" "=")
syntax grindBwd := ""
syntax grindFwd := ""
syntax grindUsr := &"usr"
syntax grindCases := &"cases"
syntax grindCasesEager := atomic(&"cases" &"eager")
syntax grindMod := grindEqBoth <|> grindEqRhs <|> grindEq <|> grindEqBwd <|> grindBwd <|> grindFwd <|> grindUsr <|> grindCasesEager <|> grindCases
namespace Lean.Parser
/--
Reset all `grind` attributes. This command is intended for testing purposes only and should not be used in applications.
-/
syntax (name := resetGrindAttrs) "%reset_grind_attrs" : command
namespace Attr
syntax grindEq := "= "
syntax grindEqBoth := atomic("_" "=" "_ ")
syntax grindEqRhs := atomic("=" "_ ")
syntax grindEqBwd := atomic("" "= ") <|> atomic("<-" "= ")
syntax grindBwd := "" <|> "-> "
syntax grindFwd := "" <|> "<- "
syntax grindRL := "" <|> "<= "
syntax grindLR := "" <|> "=> "
syntax grindUsr := &"usr "
syntax grindCases := &"cases "
syntax grindCasesEager := atomic(&"cases" &"eager ")
syntax grindIntro := &"intro "
syntax grindMod := grindEqBoth <|> grindEqRhs <|> grindEq <|> grindEqBwd <|> grindBwd <|> grindFwd <|> grindRL <|> grindLR <|> grindUsr <|> grindCasesEager <|> grindCases <|> grindIntro
syntax (name := grind) "grind" (grindMod)? : attr
end Lean.Parser.Attr
end Attr
end Lean.Parser
namespace Lean.Grind
/--
@@ -30,6 +36,8 @@ The configuration for `grind`.
Passed to `grind` using, for example, the `grind (config := { matchEqs := true })` syntax.
-/
structure Config where
/-- If `trace` is `true`, `grind` records used E-matching theorems and case-splits. -/
trace : Bool := false
/-- Maximum number of case-splits in a proof search branch. It does not include splits performed during normalization. -/
splits : Nat := 8
/-- Maximum number of E-matching (aka heuristic theorem instantiation) rounds before each case split. -/
@@ -57,6 +65,8 @@ structure Config where
canonHeartbeats : Nat := 1000
/-- If `ext` is `true`, `grind` uses extensionality theorems available in the environment. -/
ext : Bool := true
/-- If `verbose` is `false`, additional diagnostics information is not collected. -/
verbose : Bool := true
deriving Inhabited, BEq
end Lean.Grind

View File

@@ -41,4 +41,29 @@ def MatchCond (p : Prop) : Prop := p
theorem nestedProof_congr (p q : Prop) (h : p = q) (hp : p) (hq : q) : HEq (@nestedProof p hp) (@nestedProof q hq) := by
subst h; apply HEq.refl
@[app_unexpander nestedProof]
def nestedProofUnexpander : PrettyPrinter.Unexpander := fun stx => do
match stx with
| `($_ $p:term) => `($p)
| _ => throw ()
@[app_unexpander MatchCond]
def matchCondUnexpander : PrettyPrinter.Unexpander := fun stx => do
match stx with
| `($_ $p:term) => `($p)
| _ => throw ()
@[app_unexpander EqMatch]
def eqMatchUnexpander : PrettyPrinter.Unexpander := fun stx => do
match stx with
| `($_ $lhs:term $rhs:term) => `($lhs = $rhs)
| _ => throw ()
@[app_unexpander offset]
def offsetUnexpander : PrettyPrinter.Unexpander := fun stx => do
match stx with
| `($_ $lhs:term $rhs:term) => `($lhs + $rhs)
| _ => throw ()
end Lean.Grind

View File

@@ -59,7 +59,7 @@ end PartialOrder
section CCPO
/--
A chain-complete partial order (CCPO) is a partial order where every chain a least upper bound.
A chain-complete partial order (CCPO) is a partial order where every chain has a least upper bound.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/
@@ -104,7 +104,7 @@ variable {α : Sort u} [PartialOrder α]
variable {β : Sort v} [PartialOrder β]
/--
A function is monotone if it maps related elements to releated elements.
A function is monotone if it maps related elements to related elements.
This is intended to be used in the construction of `partial_fixpoint`, and not meant to be used otherwise.
-/

View File

@@ -67,9 +67,7 @@ abbrev leading (xs : Coeffs) : Int := IntList.leading xs
abbrev map (f : Int Int) (xs : Coeffs) : Coeffs := List.map f xs
/-- Shim for `.enum.find?`. -/
abbrev findIdx? (f : Int Bool) (xs : Coeffs) : Option Nat :=
-- List.findIdx? f xs
-- We could avoid `Batteries.Data.List.Basic` by using the less efficient:
xs.enum.find? (f ·.2) |>.map (·.1)
List.findIdx? f xs
/-- Shim for `IntList.bmod`. -/
abbrev bmod (x : Coeffs) (m : Nat) : Coeffs := IntList.bmod x m
/-- Shim for `IntList.bmod_dot_sub_dot_bmod`. -/

View File

@@ -28,7 +28,7 @@ namespace LinearCombo
instance : ToString LinearCombo where
toString lc :=
s!"{lc.const}{String.join <| lc.coeffs.toList.enum.map fun ⟨i, c⟩ => s!" + {c} * x{i+1}"}"
s!"{lc.const}{String.join <| lc.coeffs.toList.zipIdx.map fun ⟨c, i⟩ => s!" + {c} * x{i+1}"}"
instance : Inhabited LinearCombo := {const := 1}

View File

@@ -1222,7 +1222,7 @@ class HDiv (α : Type u) (β : Type v) (γ : outParam (Type w)) where
It is implemented as `Int.ediv`, the unique function satisfying
`a % b + b * (a / b) = a` and `0 ≤ a % b < natAbs b` for `b ≠ 0`.
Other rounding conventions are available using the functions
`Int.fdiv` (floor rounding) and `Int.div` (truncation rounding).
`Int.fdiv` (floor rounding) and `Int.tdiv` (truncation rounding).
* For `Float`, `a / 0` follows the IEEE 754 semantics for division,
usually resulting in `inf` or `nan`. -/
hDiv : α β γ
@@ -1551,7 +1551,7 @@ instance instAddNat : Add Nat where
/- We mark the following definitions as pattern to make sure they can be used in recursive equations,
and reduced by the equation Compiler. -/
attribute [match_pattern] Nat.add Add.add HAdd.hAdd Neg.neg
attribute [match_pattern] Nat.add Add.add HAdd.hAdd Neg.neg Mul.mul HMul.hMul
set_option bootstrap.genMatcherCode false in
/--
@@ -2706,7 +2706,7 @@ protected def Array.appendCore {α : Type u} (as : Array α) (bs : Array α) :
If `start` is greater or equal to `stop`, the result is empty.
If `stop` is greater than the length of `as`, the length is used instead. -/
-- NOTE: used in the quotation elaborator output
def Array.extract (as : Array α) (start stop : Nat) : Array α :=
def Array.extract (as : Array α) (start : Nat := 0) (stop : Nat := as.size) : Array α :=
let rec loop (i : Nat) (j : Nat) (bs : Array α) : Array α :=
dite (LT.lt j as.size)
(fun hlt =>

30
src/Init/Try.lean Normal file
View File

@@ -0,0 +1,30 @@
/-
Copyright (c) 2025 Amazon.com, Inc. or its affiliates. All Rights Reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Tactics
namespace Lean.Try
/--
Configuration for `try?`.
-/
structure Config where
/-- If `main` is `true`, all functions in the current module are considered for function induction, unfolding, etc. -/
main := true
/-- If `name` is `true`, all functions in the same namespace are considere for function induction, unfolding, etc. -/
name := true
/-- If `lib` is `true`, uses `libSearch` results. -/
lib := true
/-- If `targetOnly` is `true`, `try?` collects information using the goal target only. -/
targetOnly := false
deriving Inhabited
end Lean.Try
namespace Lean.Parser.Tactic
syntax (name := tryTrace) "try?" optConfig : tactic
end Lean.Parser.Tactic

View File

@@ -80,7 +80,7 @@ partial def merge (v1 v2 : Value) : Value :=
| top, _ | _, top => top
| ctor i1 vs1, ctor i2 vs2 =>
if i1 == i2 then
ctor i1 (vs1.zipWith vs2 merge)
ctor i1 (Array.zipWith merge vs1 vs2)
else
choice [v1, v2]
| choice vs1, choice vs2 =>

View File

@@ -46,7 +46,7 @@ partial def withCheckpoint (x : PullM Code) : PullM Code := do
else
return c
let (c, keep) := go toPullSizeSaved ( read).included |>.run #[]
modify fun s => { s with toPull := s.toPull.take toPullSizeSaved ++ keep }
modify fun s => { s with toPull := s.toPull.shrink toPullSizeSaved ++ keep }
return c
def attachToPull (c : Code) : PullM Code := do

View File

@@ -186,7 +186,7 @@ def saveSpecParamInfo (decls : Array Decl) : CompilerM Unit := do
let mut paramsInfo := declsInfo[i]!
let some mask := m.find? decl.name | unreachable!
trace[Compiler.specialize.info] "{decl.name} {mask}"
paramsInfo := paramsInfo.zipWith mask fun info fixed => if fixed || info matches .user then info else .other
paramsInfo := Array.zipWith (fun info fixed => if fixed || info matches .user then info else .other) paramsInfo mask
for j in [:paramsInfo.size] do
let mut info := paramsInfo[j]!
if info matches .fixedNeutral && !hasFwdDeps decl paramsInfo j then

View File

@@ -80,7 +80,7 @@ List of types that have builtin runtime support
def builtinRuntimeTypes : List Name := [
``String,
``UInt8, ``UInt16, ``UInt32, ``UInt64, ``USize,
``Float,
``Float, ``Float32,
``Thunk, ``Task,
``Array, ``ByteArray, ``FloatArray,
``Nat, ``Int

View File

@@ -33,7 +33,7 @@ private def elabSpecArgs (declName : Name) (args : Array Syntax) : MetaM (Array
result := result.push idx
else
let argName := arg.getId
if let some idx := argNames.indexOf? argName then
if let some idx := argNames.idxOf? argName then
if result.contains idx then throwErrorAt arg "invalid specialization argument name `{argName}`, it has already been specified as a specialization candidate"
result := result.push idx
else

View File

@@ -231,7 +231,7 @@ def isUnaryNode : Node α β → Option (α × β)
partial def eraseAux [BEq α] : Node α β USize α Node α β
| n@(Node.collision keys vals heq), _, k =>
match keys.indexOf? k with
match keys.finIdxOf? k with
| some idx =>
let keys' := keys.eraseIdx idx
have keq := keys.size_eraseIdx idx _

View File

@@ -478,6 +478,10 @@ def isCtor : ConstantInfo → Bool
| .ctorInfo _ => true
| _ => false
def isAxiom : ConstantInfo Bool
| .axiomInfo _ => true
| _ => false
def isInductive : ConstantInfo Bool
| .inductInfo _ => true
| _ => false

View File

@@ -800,7 +800,7 @@ def getElabElimExprInfo (elimExpr : Expr) : MetaM ElabElimInfo := do
throwError "unexpected number of arguments at motive type{indentExpr motiveType}"
unless motiveResultType.isSort do
throwError "motive result type must be a sort{indentExpr motiveType}"
let some motivePos pure (xs.indexOf? motive) |
let some motivePos pure (xs.idxOf? motive) |
throwError "unexpected eliminator type{indentExpr elimType}"
/-
Compute transitive closure of fvars appearing in arguments to the motive.

View File

@@ -496,8 +496,8 @@ partial def elabCommand (stx : Syntax) : CommandElabM Unit := do
newStx := stxNew
newNextMacroScope := nextMacroScope
hasTraces
next := cmdPromises.zipWith cmds fun cmdPromise cmd =>
{ range? := cmd.getRange?, task := cmdPromise.result }
next := Array.zipWith (fun cmdPromise cmd =>
{ range? := cmd.getRange?, task := cmdPromise.result }) cmdPromises cmds
: MacroExpandedSnapshot
}
-- After the first command whose syntax tree changed, we must disable

View File

@@ -182,7 +182,7 @@ partial def moduleIdent (runtimeOnly : Bool) : Parser := fun input s =>
let s := p input s
match s.error? with
| none => many p input s
| some _ => { pos, error? := none, imports := s.imports.take size }
| some _ => { pos, error? := none, imports := s.imports.shrink size }
@[inline] partial def preludeOpt (k : String) : Parser :=
keywordCore k (fun _ s => s.pushModule `Init false) (fun _ s => s)

View File

@@ -308,6 +308,115 @@ def whnfReducibleLHS? (mvarId : MVarId) : MetaM (Option MVarId) := mvarId.withCo
def tryContradiction (mvarId : MVarId) : MetaM Bool := do
mvarId.contradictionCore { genDiseq := true }
/--
Returns the type of the unfold theorem, as the starting point for calculating the equational
types.
-/
private def unfoldThmType (declName : Name) : MetaM Expr := do
if let some unfoldThm getUnfoldEqnFor? declName (nonRec := false) then
let info getConstInfo unfoldThm
pure info.type
else
let info getConstInfoDefn declName
let us := info.levelParams.map mkLevelParam
lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
let type mkEq (mkAppN (Lean.mkConst declName us) xs) body
mkForallFVars xs type
private def unfoldLHS (declName : Name) (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
if let some unfoldThm getUnfoldEqnFor? declName (nonRec := false) then
-- Recursive definition: Use unfolding lemma
let mut mvarId := mvarId
let target mvarId.getType'
let some (_, lhs, rhs) := target.eq? | throwError "unfoldLHS: Unexpected target {target}"
unless lhs.isAppOf declName do throwError "unfoldLHS: Unexpected LHS {lhs}"
let h := mkAppN (.const unfoldThm lhs.getAppFn.constLevels!) lhs.getAppArgs
let some (_, _, lhsNew) := ( inferType h).eq? | unreachable!
let targetNew mkEq lhsNew rhs
let mvarNew mkFreshExprSyntheticOpaqueMVar targetNew
mvarId.assign ( mkEqTrans h mvarNew)
return mvarNew.mvarId!
else
-- Else use delta reduction
deltaLHS mvarId
private partial def mkEqnProof (declName : Name) (type : Expr) : MetaM Expr := do
trace[Elab.definition.eqns] "proving: {type}"
withNewMCtxDepth do
let main mkFreshExprSyntheticOpaqueMVar type
let (_, mvarId) main.mvarId!.intros
-- Try rfl before deltaLHS to avoid `id` checkpoints in the proof, which would make
-- the lemma ineligible for dsimp
unless withAtLeastTransparency .all (tryURefl mvarId) do
go ( unfoldLHS declName mvarId)
instantiateMVars main
where
/--
The core loop of proving an equation. Assumes that the function call on the left-hand side has
already been unfolded, using whatever method applies to the current function definition strategy.
Currently used for non-recursive functions and partial fixpoints; maybe later well-founded
recursion and structural recursion can and should use this too.
-/
go (mvarId : MVarId) : MetaM Unit := do
trace[Elab.definition.eqns] "step\n{MessageData.ofGoal mvarId}"
if withAtLeastTransparency .all (tryURefl mvarId) then
return ()
else if ( tryContradiction mvarId) then
return ()
else if let some mvarId simpMatch? mvarId then
go mvarId
else if let some mvarId simpIf? mvarId then
go mvarId
else if let some mvarId whnfReducibleLHS? mvarId then
go mvarId
else
let ctx Simp.mkContext (config := { dsimp := false })
match ( simpTargetStar mvarId ctx (simprocs := {})).1 with
| TacticResultCNM.closed => return ()
| TacticResultCNM.modified mvarId => go mvarId
| TacticResultCNM.noChange =>
if let some mvarIds casesOnStuckLHS? mvarId then
mvarIds.forM go
else if let some mvarIds splitTarget? mvarId then
mvarIds.forM go
else
throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
/--
Generate equations for `declName`.
This unfolds the function application on the LHS (using an unfold theorem, if present, or else by
delta-reduction), calculates the types for the equational theorems using `mkEqnTypes`, and then
proves them using `mkEqnProof`.
This is currently used for non-recursive functions and for functions defined by partial_fixpoint.
-/
def mkEqns (declName : Name) : MetaM (Array Name) := do
let info getConstInfoDefn declName
let us := info.levelParams.map mkLevelParam
withOptions (tactic.hygienic.set · false) do
let target unfoldThmType declName
let eqnTypes withNewMCtxDepth <|
forallTelescope (cleanupAnnotations := true) target fun xs target => do
let goal mkFreshExprSyntheticOpaqueMVar target
withReducible do
mkEqnTypes #[] goal.mvarId!
let mut thmNames := #[]
for h : i in [: eqnTypes.size] do
let type := eqnTypes[i]
trace[Elab.definition.eqns] "eqnType[{i}]: {eqnTypes[i]}"
let name := (Name.str declName eqnThmSuffixBase).appendIndexAfter (i+1)
thmNames := thmNames.push name
let value mkEqnProof declName type
let (type, value) removeUnusedEqnHypotheses type value
addDecl <| Declaration.thmDecl {
name, type, value
levelParams := info.levelParams
}
return thmNames
/--
Auxiliary method for `mkUnfoldEq`. The structure is based on `mkEqnTypes`.
`mvarId` is the goal to be proved. It is a goal of the form

View File

@@ -33,71 +33,12 @@ private def mkSimpleEqThm (declName : Name) (suffix := Name.mkSimple unfoldThmSu
else
return none
private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
trace[Elab.definition.eqns] "proving: {type}"
withNewMCtxDepth do
let main mkFreshExprSyntheticOpaqueMVar type
let (_, mvarId) main.mvarId!.intros
let rec go (mvarId : MVarId) : MetaM Unit := do
trace[Elab.definition.eqns] "step\n{MessageData.ofGoal mvarId}"
if withAtLeastTransparency .all (tryURefl mvarId) then
return ()
else if ( tryContradiction mvarId) then
return ()
else if let some mvarId simpMatch? mvarId then
go mvarId
else if let some mvarId simpIf? mvarId then
go mvarId
else if let some mvarId whnfReducibleLHS? mvarId then
go mvarId
else
let ctx Simp.mkContext (config := { dsimp := false })
match ( simpTargetStar mvarId ctx (simprocs := {})).1 with
| TacticResultCNM.closed => return ()
| TacticResultCNM.modified mvarId => go mvarId
| TacticResultCNM.noChange =>
if let some mvarIds casesOnStuckLHS? mvarId then
mvarIds.forM go
else if let some mvarIds splitTarget? mvarId then
mvarIds.forM go
else
throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
-- Try rfl before deltaLHS to avoid `id` checkpoints in the proof, which would make
-- the lemma ineligible for dsimp
unless withAtLeastTransparency .all (tryURefl mvarId) do
go ( deltaLHS mvarId)
instantiateMVars main
def mkEqns (declName : Name) (info : DefinitionVal) : MetaM (Array Name) :=
withOptions (tactic.hygienic.set · false) do
let baseName := declName
let eqnTypes withNewMCtxDepth <| lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
let us := info.levelParams.map mkLevelParam
let target mkEq (mkAppN (Lean.mkConst declName us) xs) body
let goal mkFreshExprSyntheticOpaqueMVar target
withReducible do
mkEqnTypes #[] goal.mvarId!
let mut thmNames := #[]
for h : i in [: eqnTypes.size] do
let type := eqnTypes[i]
trace[Elab.definition.eqns] "eqnType[{i}]: {eqnTypes[i]}"
let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
thmNames := thmNames.push name
let value mkProof declName type
let (type, value) removeUnusedEqnHypotheses type value
addDecl <| Declaration.thmDecl {
name, type, value
levelParams := info.levelParams
}
return thmNames
def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
if ( isRecursiveDefinition declName) then
return none
if let some (.defnInfo info) := ( getEnv).find? declName then
if ( getEnv).contains declName then
if backward.eqns.nonrecursive.get ( getOptions) then
mkEqns declName info
mkEqns declName
else
let o mkSimpleEqThm declName
return o.map (#[·])

View File

@@ -23,6 +23,18 @@ structure EqnInfo extends EqnInfoCore where
fixedPrefixSize : Nat
deriving Inhabited
builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo mkMapDeclarationExtension
def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fixedPrefixSize : Nat) : MetaM Unit := do
preDefs.forM fun preDef => ensureEqnReservedNamesAvailable preDef.declName
unless preDefs.all fun p => p.kind.isTheorem do
unless ( preDefs.allM fun p => isProp p.type) do
let declNames := preDefs.map (·.declName)
modifyEnv fun env =>
preDefs.foldl (init := env) fun env preDef =>
eqnInfoExt.insert env preDef.declName { preDef with
declNames, declNameNonRec, fixedPrefixSize }
private def deltaLHSUntilFix (declName declNameNonRec : Name) (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
let target mvarId.getType'
let some (_, lhs, rhs) := target.eq? | throwTacticEx `deltaLHSUntilFix mvarId "equality expected"
@@ -53,62 +65,50 @@ private def rwFixEq (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
mvarId.assign ( mkEqTrans h mvarNew)
return mvarNew.mvarId!
private partial def mkProof (declName : Name) (declNameNonRec : Name) (type : Expr) : MetaM Expr := do
trace[Elab.definition.partialFixpoint] "proving: {type}"
withNewMCtxDepth do
let main mkFreshExprSyntheticOpaqueMVar type
let (_, mvarId) main.mvarId!.intros
let mvarId deltaLHSUntilFix declName declNameNonRec mvarId
let mvarId rwFixEq mvarId
if withAtLeastTransparency .all (tryURefl mvarId) then
instantiateMVars main
else
throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
/-- Generate the "unfold" lemma for `declName`. -/
def mkUnfoldEq (declName : Name) (info : EqnInfo) : MetaM Name := withLCtx {} {} do
withOptions (tactic.hygienic.set · false) do
let baseName := declName
let eqnTypes withNewMCtxDepth <| lambdaTelescope (cleanupAnnotations := true) info.value fun xs body => do
let us := info.levelParams.map mkLevelParam
let target mkEq (mkAppN (Lean.mkConst declName us) xs) body
let goal mkFreshExprSyntheticOpaqueMVar target
withReducible do
mkEqnTypes info.declNames goal.mvarId!
let mut thmNames := #[]
for h : i in [: eqnTypes.size] do
let type := eqnTypes[i]
trace[Elab.definition.partialFixpoint] "{eqnTypes[i]}"
let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
thmNames := thmNames.push name
let value mkProof declName info.declNameNonRec type
let (type, value) removeUnusedEqnHypotheses type value
addDecl <| Declaration.thmDecl {
name, type, value
levelParams := info.levelParams
}
return thmNames
builtin_initialize eqnInfoExt : MapDeclarationExtension EqnInfo mkMapDeclarationExtension
def registerEqnsInfo (preDefs : Array PreDefinition) (declNameNonRec : Name) (fixedPrefixSize : Nat) : MetaM Unit := do
preDefs.forM fun preDef => ensureEqnReservedNamesAvailable preDef.declName
unless preDefs.all fun p => p.kind.isTheorem do
unless ( preDefs.allM fun p => isProp p.type) do
let declNames := preDefs.map (·.declName)
modifyEnv fun env =>
preDefs.foldl (init := env) fun env preDef =>
eqnInfoExt.insert env preDef.declName { preDef with
declNames, declNameNonRec, fixedPrefixSize }
def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
if let some info := eqnInfoExt.find? ( getEnv) declName then
mkEqns declName info
else
return none
let baseName := declName
lambdaTelescope info.value fun xs body => do
let us := info.levelParams.map mkLevelParam
let type mkEq (mkAppN (Lean.mkConst declName us) xs) body
let goal withNewMCtxDepth do
try
let goal mkFreshExprSyntheticOpaqueMVar type
let mvarId := goal.mvarId!
trace[Elab.definition.partialFixpoint] "mkUnfoldEq start:{mvarId}"
let mvarId deltaLHSUntilFix declName info.declNameNonRec mvarId
trace[Elab.definition.partialFixpoint] "mkUnfoldEq after deltaLHS:{mvarId}"
let mvarId rwFixEq mvarId
trace[Elab.definition.partialFixpoint] "mkUnfoldEq after rwFixEq:{mvarId}"
withAtLeastTransparency .all <|
withOptions (smartUnfolding.set · false) <|
mvarId.refl
trace[Elab.definition.partialFixpoint] "mkUnfoldEq rfl succeeded"
instantiateMVars goal
catch e =>
throwError "failed to generate unfold theorem for '{declName}':\n{e.toMessageData}"
let type mkForallFVars xs type
let value mkLambdaFVars xs goal
let name := Name.str baseName unfoldThmSuffix
addDecl <| Declaration.thmDecl {
name, type, value
levelParams := info.levelParams
}
return name
def getUnfoldFor? (declName : Name) : MetaM (Option Name) := do
let name := Name.str declName unfoldThmSuffix
let env getEnv
Eqns.getUnfoldFor? declName fun _ => eqnInfoExt.find? env declName |>.map (·.toEqnInfoCore)
if env.contains name then return name
let some info := eqnInfoExt.find? env declName | return none
return some ( mkUnfoldEq declName info)
def getEqnsFor? (declName : Name) : MetaM (Option (Array Name)) := do
if let some _ := eqnInfoExt.find? ( getEnv) declName then
mkEqns declName
else
return none
builtin_initialize
registerGetEqnsFn getEqnsFor?

View File

@@ -292,7 +292,7 @@ def mkBrecOnApp (positions : Positions) (fnIdx : Nat) (brecOnConst : Nat → Exp
let packedFTypes inferArgumentTypesN positions.size brecOn
let packedFArgs positions.mapMwith PProdN.mkLambdas packedFTypes FArgs
let brecOn := mkAppN brecOn packedFArgs
let some (size, idx) := positions.findSome? fun pos => (pos.size, ·) <$> pos.indexOf? fnIdx
let some (size, idx) := positions.findSome? fun pos => (pos.size, ·) <$> pos.finIdxOf? fnIdx
| throwError "mkBrecOnApp: Could not find {fnIdx} in {positions}"
let brecOn PProdN.projM size idx brecOn
mkLambdaFVars ys (mkAppN brecOn otherArgs)

View File

@@ -32,8 +32,8 @@ def prettyParameterSet (fnNames : Array Name) (xs : Array Expr) (values : Array
private def getIndexMinPos (xs : Array Expr) (indices : Array Expr) : Nat := Id.run do
let mut minPos := xs.size
for index in indices do
match xs.indexOf? index with
| some pos => if pos.val < minPos then minPos := pos.val
match xs.idxOf? index with
| some pos => if pos < minPos then minPos := pos
| _ => pure ()
return minPos
@@ -91,8 +91,8 @@ def getRecArgInfo (fnName : Name) (numFixed : Nat) (xs : Array Expr) (i : Nat) :
throwError "its type is an inductive datatype{indentExpr xType}\nand the datatype parameter{indentExpr indParam}\ndepends on the function parameter{indentExpr y}\nwhich does not come before the varying parameters and before the indices of the recursion parameter."
| none =>
let indAll := indInfo.all.toArray
let .some indIdx := indAll.indexOf? indInfo.name | panic! "{indInfo.name} not in {indInfo.all}"
let indicesPos := indIndices.map fun index => match xs.indexOf? index with | some i => i.val | none => unreachable!
let .some indIdx := indAll.idxOf? indInfo.name | panic! "{indInfo.name} not in {indInfo.all}"
let indicesPos := indIndices.map fun index => match xs.idxOf? index with | some i => i | none => unreachable!
let indGroupInst := {
IndGroupInfo.ofInductiveVal indInfo with
levels := us
@@ -208,7 +208,7 @@ def argsInGroup (group : IndGroupInst) (xs : Array Expr) (value : Expr)
if let some (_index, _y) hasBadIndexDep? ys indIndices then
-- throwError "its type {indInfo.name} is an inductive family{indentExpr xType}\nand index{indentExpr index}\ndepends on the non index{indentExpr y}"
continue
let indicesPos := indIndices.map fun index => match (xs++ys).indexOf? index with | some i => i.val | none => unreachable!
let indicesPos := indIndices.map fun index => match (xs++ys).idxOf? index with | some i => i | none => unreachable!
return .some
{ fnName := recArgInfo.fnName
numFixed := recArgInfo.numFixed

View File

@@ -90,7 +90,7 @@ def TerminationMeasure.elab (funName : Name) (type : Expr) (arity extraParams :
def TerminationMeasure.structuralArg (measure : TerminationMeasure) : MetaM Nat := do
assert! measure.structural
lambdaTelescope measure.fn fun ys e => do
let .some idx := ys.indexOf? e
let .some idx := ys.idxOf? e
| panic! "TerminationMeasure.structuralArg: body not one of the parameters"
return idx

View File

@@ -10,7 +10,6 @@ import Lean.Elab.PreDefinition.Basic
import Lean.Elab.PreDefinition.Eqns
import Lean.Meta.ArgsPacker.Basic
import Init.Data.Array.Basic
import Init.Internal.Order.Basic
namespace Lean.Elab.WF
open Meta
@@ -23,35 +22,33 @@ structure EqnInfo extends EqnInfoCore where
argsPacker : ArgsPacker
deriving Inhabited
private partial def deltaLHSUntilFix (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
let target mvarId.getType'
let some (_, lhs, _) := target.eq? | throwTacticEx `deltaLHSUntilFix mvarId "equality expected"
if lhs.isAppOf ``WellFounded.fix then
return mvarId
else if lhs.isAppOf ``Order.fix then
return mvarId
else
deltaLHSUntilFix ( deltaLHS mvarId)
private def rwFixEq (mvarId : MVarId) : MetaM MVarId := mvarId.withContext do
let target mvarId.getType'
let some (_, lhs, rhs) := target.eq? | unreachable!
let h
if lhs.isAppOf ``WellFounded.fix then
pure <| mkAppN (mkConst ``WellFounded.fix_eq lhs.getAppFn.constLevels!) lhs.getAppArgs
else if lhs.isAppOf ``Order.fix then
let x := lhs.getAppArgs.back!
let args := lhs.getAppArgs.pop
mkAppM ``congrFun #[mkAppN (mkConst ``Order.fix_eq lhs.getAppFn.constLevels!) args, x]
else
throwTacticEx `rwFixEq mvarId "expected fixed-point application"
let some (_, _, lhsNew) := ( inferType h).eq? | unreachable!
-- lhs should be an application of the declNameNonrec, which unfolds to an
-- application of fix in one step
let some lhs' delta? lhs | throwError "rwFixEq: cannot delta-reduce {lhs}"
let_expr WellFounded.fix _α _C _r _hwf F x := lhs'
| throwTacticEx `rwFixEq mvarId "expected saturated fixed-point application in {lhs'}"
let h := mkAppN (mkConst ``WellFounded.fix_eq lhs'.getAppFn.constLevels!) lhs'.getAppArgs
-- We used to just rewrite with `fix_eq` and continue with whatever RHS that produces, but that
-- would include more copies of `fix` resulting in large and confusing terms.
-- Instead we manually construct the new term in terms of the current functions,
-- which should be headed by the `declNameNonRec`, and should be defeq to the expected type
-- if lhs == e x and lhs' == fix .., then lhsNew := e x = F x (fun y _ => e y)
let ftype := ( inferType (mkApp F x)).bindingDomain!
let f' forallBoundedTelescope ftype (some 2) fun ys _ => do
mkLambdaFVars ys (.app lhs.appFn! ys[0]!)
let lhsNew := mkApp2 F x f'
let targetNew mkEq lhsNew rhs
let mvarNew mkFreshExprSyntheticOpaqueMVar targetNew
mvarId.assign ( mkEqTrans h mvarNew)
return mvarNew.mvarId!
private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
private partial def mkProof (declName declNameNonRec : Name) (type : Expr) : MetaM Expr := do
trace[Elab.definition.wf.eqns] "proving: {type}"
withNewMCtxDepth do
let main mkFreshExprSyntheticOpaqueMVar type
@@ -59,31 +56,43 @@ private partial def mkProof (declName : Name) (type : Expr) : MetaM Expr := do
let rec go (mvarId : MVarId) : MetaM Unit := do
trace[Elab.definition.wf.eqns] "step\n{MessageData.ofGoal mvarId}"
if withAtLeastTransparency .all (tryURefl mvarId) then
trace[Elab.definition.wf.eqns] "refl!"
return ()
else if ( tryContradiction mvarId) then
trace[Elab.definition.wf.eqns] "contradiction!"
return ()
else if let some mvarId simpMatch? mvarId then
trace[Elab.definition.wf.eqns] "simpMatch!"
go mvarId
else if let some mvarId simpIf? mvarId then
trace[Elab.definition.wf.eqns] "simpIf!"
go mvarId
else if let some mvarId whnfReducibleLHS? mvarId then
trace[Elab.definition.wf.eqns] "whnfReducibleLHS!"
go mvarId
else
let ctx Simp.mkContext (config := { dsimp := false })
let ctx Simp.mkContext (config := { dsimp := false, etaStruct := .none })
match ( simpTargetStar mvarId ctx (simprocs := {})).1 with
| TacticResultCNM.closed => return ()
| TacticResultCNM.modified mvarId => go mvarId
| TacticResultCNM.modified mvarId =>
trace[Elab.definition.wf.eqns] "simp only!"
go mvarId
| TacticResultCNM.noChange =>
if let some mvarIds casesOnStuckLHS? mvarId then
trace[Elab.definition.wf.eqns] "case split into {mvarIds.size} goals"
mvarIds.forM go
else if let some mvarIds splitTarget? mvarId then
trace[Elab.definition.wf.eqns] "splitTarget into {mvarIds.length} goals"
mvarIds.forM go
else
-- At some point in the past, we looked for occurrences of Wf.fix to fold on the
-- LHS (introduced in 096e4eb), but it seems that code path was never used,
-- so #3133 removed it again (and can be recovered from there if this was premature).
throwError "failed to generate equational theorem for '{declName}'\n{MessageData.ofGoal mvarId}"
go ( rwFixEq ( deltaLHSUntilFix mvarId))
let mvarId if declName != declNameNonRec then deltaLHS mvarId else pure mvarId
let mvarId rwFixEq mvarId
go mvarId
instantiateMVars main
def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
@@ -101,7 +110,7 @@ def mkEqns (declName : Name) (info : EqnInfo) : MetaM (Array Name) :=
trace[Elab.definition.wf.eqns] "{eqnTypes[i]}"
let name := (Name.str baseName eqnThmSuffixBase).appendIndexAfter (i+1)
thmNames := thmNames.push name
let value mkProof declName type
let value mkProof declName info.declNameNonRec type
let (type, value) removeUnusedEqnHypotheses type value
addDecl <| Declaration.thmDecl {
name, type, value

View File

@@ -790,7 +790,7 @@ def guessLex (preDefs : Array PreDefinition) (unaryPreDef : PreDefinition)
-- (One for each non-forbiddend arg)
let basicMeassures₁ simpleMeasures preDefs fixedPrefixSize userVarNamess
let basicMeassures₂ complexMeasures preDefs fixedPrefixSize userVarNamess recCalls
let basicMeasures := Array.zipWith basicMeassures₁ basicMeassures₂ (· ++ ·)
let basicMeasures := Array.zipWith (· ++ ·) basicMeassures₁ basicMeassures₂
-- The list of measures, including the measures that order functions.
-- The function ordering measures come last

View File

@@ -48,7 +48,7 @@ def packCalls (fixedPrefix : Nat) (argsPacker : ArgsPacker) (funNames : Array Na
let f := e.getAppFn
if !f.isConst then
return TransformStep.done e
if let some fidx := funNames.indexOf? f.constName! then
if let some fidx := funNames.idxOf? f.constName! then
let arity := fixedPrefix + argsPacker.varNamess[fidx]!.size
let e' withAppN arity e fun args => do
let packedArg argsPacker.pack domain fidx args[fixedPrefix:]

View File

@@ -120,7 +120,7 @@ Expands fields.
let fields? fields.mapM expandStructInstField
if fields?.all (·.isNone) then
Macro.throwUnsupported
let fields := fields?.zipWith fields Option.getD
let fields := Array.zipWith Option.getD fields? fields
let structInstFields := structInstFields.setArg 0 <| Syntax.mkSep fields (mkAtomFrom stx ", ")
return stx.setArg 2 structInstFields

View File

@@ -46,3 +46,4 @@ import Lean.Elab.Tactic.BoolToPropSimps
import Lean.Elab.Tactic.Classical
import Lean.Elab.Tactic.Grind
import Lean.Elab.Tactic.Monotonicity
import Lean.Elab.Tactic.Try

View File

@@ -148,15 +148,26 @@ Diagnose spurious counter examples, currently this checks:
-/
def diagnose : DiagnosisM Unit := do
for (expr, _) in equations do
match_expr expr with
| BitVec.ofBool x =>
match x with
| .fvar fvarId => checkRelevantHypsUsed fvarId
| _ => addUninterpretedSymbol expr
| _ =>
match expr with
| .fvar fvarId => checkRelevantHypsUsed fvarId
| _ => addUninterpretedSymbol expr
match findRelevantFVar expr with
| some fvarId => checkRelevantHypsUsed fvarId
| none => addUninterpretedSymbol expr
where
findRelevantFVar (expr : Expr) : Option FVarId :=
match fvarId? expr with
| some fvarId => some fvarId
| none =>
match_expr expr with
| BitVec.ofBool x => fvarId? x
| UInt8.toBitVec x => fvarId? x
| UInt16.toBitVec x => fvarId? x
| UInt32.toBitVec x => fvarId? x
| UInt64.toBitVec x => fvarId? x
| _ => none
fvarId? (expr : Expr) : Option FVarId :=
match expr with
| .fvar fvarId => some fvarId
| _ => none
end DiagnosisM

View File

@@ -54,7 +54,7 @@ def TacticContext.new (lratPath : System.FilePath) (config : BVDecideConfig) :
config
}
where
determineSolver : Lean.Elab.TermElabM System.FilePath := do
determineSolver : CoreM System.FilePath := do
let opts getOptions
let option := sat.solver.get opts
if option == "" then
@@ -96,7 +96,7 @@ instance : ToExpr LRAT.IntAction where
mkApp3 (mkConst ``LRAT.Action.del [.zero, .zero]) beta alpha (toExpr ids)
toTypeExpr := mkConst ``LRAT.IntAction
def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM LratCert := do
def LratCert.load (lratPath : System.FilePath) (trimProofs : Bool) : CoreM (Array LRAT.IntAction) := do
let proofInput IO.FS.readBinFile lratPath
let proof
withTraceNode `sat (fun _ => return s!"Parsing LRAT file") do
@@ -118,6 +118,10 @@ def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM Lra
pure proof
trace[Meta.Tactic.sat] s!"LRAT proof has {proof.size} steps after trimming"
return proof
def LratCert.ofFile (lratPath : System.FilePath) (trimProofs : Bool) : CoreM LratCert := do
let proof LratCert.load lratPath trimProofs
-- This is necessary because the proof might be in the binary format in which case we cannot
-- store it as a string in the environment (yet) due to missing support for binary literals.

View File

@@ -12,6 +12,7 @@ import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AndFlatten
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.EmbeddedConstraint
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.AC
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Structures
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.IntToBitVec
/-!
This module contains the implementation of `bv_normalize`, the preprocessing tactic for `bv_decide`.
@@ -54,6 +55,10 @@ where
let some g' structuresPass.run g | return none
g := g'
if cfg.fixedInt then
let some g' intToBitVecPass.run g | return none
g := g'
trace[Meta.Tactic.bv] m!"Running fixpoint pipeline on:\n{g}"
let pipeline passPipeline
Pass.fixpointPipeline pipeline g

View File

@@ -31,8 +31,7 @@ def getConfig : PreProcessM BVDecideConfig := read
@[inline]
def checkRewritten (fvar : FVarId) : PreProcessM Bool := do
let val := ( get).rewriteCache.contains fvar
return val
return ( get).rewriteCache.contains fvar
@[inline]
def rewriteFinished (fvar : FVarId) : PreProcessM Unit := do

View File

@@ -0,0 +1,169 @@
/-
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
prelude
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Elab.Tactic.BVDecide.Frontend.Attr
import Lean.Elab.Tactic.Simp
/-!
This module contains the implementation of the pre processing pass for reducing `UIntX`/`IntX` to
`BitVec` and thus allow `bv_decide` to reason about them.
It:
1. runs the `int_toBitVec` simp set
2. If `USize.toBitVec` is used anywhere looks for equations of the form
`System.Platform.numBits = constant` (or flipped) and uses them to convert the system back to
fixed width.
-/
namespace Lean.Elab.Tactic.BVDecide
namespace Frontend.Normalize
open Lean.Meta
/--
Contains information for the `USize` elimination pass.
-/
structure USizeState where
/--
Contains terms of the form `USize.toBitVec e` that we will translate to constant width `BitVec`.
-/
relevantTerms : Std.HashSet Expr := {}
/--
Contains all hypotheses that contain terms from `relevantTerms`
-/
relevantHyps : Std.HashSet FVarId := {}
private abbrev M := StateRefT USizeState MetaM
namespace M
@[inline]
def addUSizeTerm (e : Expr) : M Unit := do
modify fun s => { s with relevantTerms := s.relevantTerms.insert e }
@[inline]
def addUSizeHyp (f : FVarId) : M Unit := do
modify fun s => { s with relevantHyps := s.relevantHyps.insert f }
end M
def intToBitVecPass : Pass where
name := `intToBitVec
run' goal := do
let intToBvThms intToBitVecExt.getTheorems
let cfg PreProcessM.getConfig
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, zetaDelta := true, maxSteps := cfg.maxSteps })
(simpTheorems := #[intToBvThms])
(congrTheorems := ( getSimpCongrTheorems))
let hyps goal.getNondepPropHyps
let result?, _ simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := hyps)
let some (_, goal) := result? | return none
handleUSize goal |>.run' {}
where
handleUSize (goal : MVarId) : M MVarId := do
if detectUSize goal then
replaceUSize goal
else
return goal
detectUSize (goal : MVarId) : M Bool := do
goal.withContext do
for hyp in getPropHyps do
( hyp.getType).forEachWhere
(stopWhenVisited := true)
(·.isAppOfArity ``USize.toBitVec 1)
fun e => do
M.addUSizeTerm e
M.addUSizeHyp hyp
return !( get).relevantTerms.isEmpty
/--
Turn `goal` into a goal containing `BitVec const` instead of `USize`.
-/
replaceUSize (goal : MVarId) : M MVarId := do
if let some (numBits, numBitsEq) findNumBitsEq goal then
goal.withContext do
let relevantHyps := ( get).relevantHyps.toArray.map mkFVar
let relevantTerms := ( get).relevantTerms.toArray
let (app, abstractedHyps) liftMkBindingM <| MetavarContext.revert relevantHyps goal true
let newMVar := app.getAppFn.mvarId!
let targetType newMVar.getType
/-
newMVar has type : h1 → h2 → ... → False`
This code computes a motive of the form:
```
fun z _ => ∀ (x_1 : BitVec z) (x_2 : BitVec z) ..., h1 → h2 → ... → False
```
Where:
- all terms from `relevantTerms` in the implication are substituted by `x_1`, ...
- all occurences of `numBits` are substituted by `z`
Additionally we compute a new metavariable with type:
```
∀ (x_1 : BitVec const) (x_2 : BitVec const) ..., h1 → h2 → ... → False
```
with all occurences of `numBits` substituted by const. This meta variable is going to become
the next goal
-/
let (motive, newGoalType)
withLocalDeclD `z (mkConst ``Nat) fun z => do
let otherArgType := mkApp3 (mkConst ``Eq [1]) (mkConst ``Nat) (toExpr numBits) z
withLocalDeclD `h otherArgType fun other => do
let argType := mkApp (mkConst ``BitVec) z
let argTypes := relevantTerms.map (fun _ => (`x, argType))
let innerMotiveType
withLocalDeclsDND argTypes fun args => do
let mut subst : Std.HashMap Expr Expr := Std.HashMap.empty (args.size + 1)
subst := subst.insert (mkConst ``System.Platform.numBits) z
for term in relevantTerms, arg in args do
subst := subst.insert term arg
let motiveType := targetType.replace subst.get?
mkForallFVars args motiveType
let newGoalType := innerMotiveType.replaceFVar z (toExpr numBits)
let motive mkLambdaFVars #[z, other] innerMotiveType
return (motive, newGoalType)
let mut newGoal := ( mkFreshExprMVar newGoalType).mvarId!
let casesOn := mkApp6 (mkConst ``Eq.casesOn [0, 1])
(mkConst ``Nat)
(toExpr numBits)
motive
(mkConst ``System.Platform.numBits)
numBitsEq
(mkMVar newGoal)
goal.assign <| mkAppN casesOn (relevantTerms ++ abstractedHyps)
-- remove all of the hold hypotheses about USize.toBitVec to prevent false counter examples
(newGoal, _) newGoal.tryClearMany' (abstractedHyps.map Expr.fvarId!)
-- intro both the new `BitVec const` as well as all hypotheses about them
(_, newGoal) newGoal.introN (relevantTerms.size + abstractedHyps.size)
return newGoal
else
logWarning m!"Detected USize in the goal but no hypothesis about System.Platform.numBits, consider case splitting on {mkConst ``System.Platform.numBits_eq}"
return goal
/--
Builds an expression of type: `const = System.Platform.numBits` from the hypotheses in the context
if possible.
-/
findNumBitsEq (goal : MVarId) : MetaM (Option (Nat × Expr)) := do
goal.withContext do
for hyp in getPropHyps do
match_expr hyp.getType with
| Eq eqTyp lhs rhs =>
if lhs.isConstOf ``System.Platform.numBits then
let some val getNatValue? rhs | return none
return some (val, mkApp4 (mkConst ``Eq.symm [1]) eqTyp lhs rhs (mkFVar hyp))
else if rhs.isConstOf ``System.Platform.numBits then
let some val getNatValue? lhs | return none
return some (val, mkFVar hyp)
| _ => continue
return none
end Frontend.Normalize
end Lean.Elab.Tactic.BVDecide

View File

@@ -6,6 +6,8 @@ Authors: Henrik Böving
prelude
import Lean.Elab.Tactic.BVDecide.Frontend.Normalize.Basic
import Lean.Meta.Tactic.Cases
import Lean.Meta.Tactic.Simp
import Lean.Meta.Injective
/-!
This module contains the implementation of the pre processing pass for automatically splitting up
@@ -16,6 +18,8 @@ it is a non recursive structure and at least one of the following conditions hol
- it contains something of type `BitVec`/`UIntX`/`Bool`
- it is parametrized by an interesting type
- it contains another interesting type
Afterwards we also apply relevant `injEq` theorems to support at least equality for these types out
of the box.
-/
namespace Lean.Elab.Tactic.BVDecide
@@ -28,7 +32,8 @@ Contains a cache for interesting and uninteresting types such that we don't dupl
structures pass.
-/
structure InterestingStructures where
interesting : Std.HashMap Name Bool := {}
interesting : Std.HashSet Name := {}
uninteresting : Std.HashSet Name := {}
private abbrev M := StateRefT InterestingStructures MetaM
@@ -37,15 +42,20 @@ namespace M
@[inline]
def lookup (n : Name) : M (Option Bool) := do
let s get
return s.interesting.get? n
if s.uninteresting.contains n then
return some false
else if s.interesting.contains n then
return some true
else
return none
@[inline]
def markInteresting (n : Name) : M Unit := do
modify (fun s => {s with interesting := s.interesting.insert n true})
modify (fun s => {s with interesting := s.interesting.insert n })
@[inline]
def markUninteresting (n : Name) : M Unit := do
modify (fun s => {s with interesting := s.interesting.insert n false})
modify (fun s => {s with uninteresting := s.uninteresting.insert n })
end M
@@ -59,11 +69,31 @@ partial def structuresPass : Pass where
return false
else
let some const := decl.type.getAppFn.constName? | return false
return interesting.getD const false
return interesting.contains const
match goals with
| [goal] => return goal
| [goal] => postprocess goal interesting
| _ => throwError "structures preprocessor generated more than 1 goal"
where
postprocess (goal : MVarId) (interesting : Std.HashSet Name) : PreProcessM (Option MVarId) := do
goal.withContext do
let mut relevantLemmas : SimpTheoremsArray := #[]
for const in interesting do
let constInfo getConstInfoInduct const
let ctorName := ( getConstInfoCtor constInfo.ctors.head!).name
let lemmaName := mkInjectiveEqTheoremNameFor ctorName
if ( getEnv).find? lemmaName |>.isSome then
trace[Meta.Tactic.bv] m!"Using injEq lemma: {lemmaName}"
let statement mkConstWithLevelParams lemmaName
relevantLemmas relevantLemmas.addTheorem (.decl lemmaName) statement
let cfg PreProcessM.getConfig
let simpCtx Simp.mkContext
(config := { failIfUnchanged := false, maxSteps := cfg.maxSteps })
(simpTheorems := relevantLemmas)
(congrTheorems := getSimpCongrTheorems)
let result?, _ simpGoal goal (ctx := simpCtx) (fvarIdsToSimp := getPropHyps)
let some (_, newGoal) := result? | return none
return newGoal
checkContext (goal : MVarId) : M Unit := do
goal.withContext do
for decl in getLCtx do
@@ -86,7 +116,7 @@ where
let env getEnv
if !isStructure env n then
return false
let constInfo := ( getConstInfoInduct n)
let constInfo getConstInfoInduct n
if constInfo.isRec then
return false

View File

@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
prelude
import Init.Grind.Tactics
import Lean.Meta.Tactic.Grind
import Lean.Meta.Tactic.TryThis
import Lean.Elab.Command
import Lean.Elab.Tactic.Basic
import Lean.Elab.Tactic.Config
@@ -34,6 +35,12 @@ def elabGrindPattern : CommandElab := fun stx => do
Grind.addEMatchTheorem declName xs.size patterns.toList .user
| _ => throwUnsupportedSyntax
open Command in
@[builtin_command_elab Lean.Parser.resetGrindAttrs]
def elabResetGrindAttrs : CommandElab := fun _ => liftTermElabM do
Grind.resetCasesExt
Grind.resetEMatchTheoremsExt
open Command Term in
@[builtin_command_elab Lean.Parser.Command.initGrindNorm]
def elabInitGrindNorm : CommandElab := fun stx =>
@@ -51,7 +58,8 @@ def elabGrindParams (params : Grind.Params) (ps : TSyntaxArray ``Parser.Tactic.
match p with
| `(Parser.Tactic.grindParam| - $id:ident) =>
let declName realizeGlobalConstNoOverloadWithInfo id
if ( Grind.isCasesAttrCandidate declName false) then
if let some declName Grind.isCasesAttrCandidate? declName false then
Grind.ensureNotBuiltinCases declName
params := { params with casesTypes := ( params.casesTypes.eraseDecl declName) }
else
params := { params with ematch := ( params.ematch.eraseDecl declName) }
@@ -74,18 +82,29 @@ def elabGrindParams (params : Grind.Params) (ps : TSyntaxArray ``Parser.Tactic.
| .cases eager =>
withRef p <| Grind.validateCasesAttr declName eager
params := { params with casesTypes := params.casesTypes.insert declName eager }
| .intro =>
if let some info Grind.isCasesAttrPredicateCandidate? declName false then
for ctor in info.ctors do
params withRef p <| addEMatchTheorem params ctor .default
else
throwError "invalid use of `intro` modifier, `{declName}` is not an inductive predicate"
| .infer =>
if ( Grind.isCasesAttrCandidate declName false) then
if let some declName Grind.isCasesAttrCandidate? declName false then
params := { params with casesTypes := params.casesTypes.insert declName false }
if let some info isInductivePredicate? declName then
-- If it is an inductive predicate,
-- we also add the contructors (intro rules) as E-matching rules
for ctor in info.ctors do
params withRef p <| addEMatchTheorem params ctor .default
else
params withRef p <| addEMatchTheorem params declName .default
| _ => throwError "unexpected `grind` parameter{indentD p}"
return params
where
addEMatchTheorem (params : Grind.Params) (declName : Name) (kind : Grind.TheoremKind) : MetaM Grind.Params := do
addEMatchTheorem (params : Grind.Params) (declName : Name) (kind : Grind.EMatchTheoremKind) : MetaM Grind.Params := do
let info getConstInfo declName
match info with
| .thmInfo _ =>
| .thmInfo _ | .axiomInfo _ | .ctorInfo _ =>
if kind == .eqBoth then
let params := { params with extra := params.extra.push ( Grind.mkEMatchTheoremForDecl declName .eqLhs) }
return { params with extra := params.extra.push ( Grind.mkEMatchTheoremForDecl declName .eqRhs) }
@@ -113,11 +132,12 @@ def grind
(mvarId : MVarId) (config : Grind.Config)
(only : Bool)
(ps : TSyntaxArray ``Parser.Tactic.grindParam)
(mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Unit := do
(mainDeclName : Name) (fallback : Grind.Fallback) : MetaM Grind.Trace := do
let params mkGrindParams config only ps
let result Grind.main mvarId params mainDeclName fallback
if result.hasFailures then
throwError "`grind` failed\n{← result.toMessageData}"
return result.trace
private def elabFallback (fallback? : Option Term) : TermElabM (Grind.GoalM Unit) := do
let some fallback := fallback? | return (pure ())
@@ -142,26 +162,84 @@ private def evalGrindCore
(only : Option Syntax)
(params : Option (Syntax.TSepArray `Lean.Parser.Tactic.grindParam ","))
(fallback? : Option Term)
(_trace : Bool) -- TODO
: TacticM Unit := do
(trace : Bool)
: TacticM Grind.Trace := do
let fallback elabFallback fallback?
let only := only.isSome
let params := if let some params := params then params.getElems else #[]
logWarningAt ref "The `grind` tactic is experimental and still under development. Avoid using it in production projects"
if Grind.grind.warning.get ( getOptions) then
logWarningAt ref "The `grind` tactic is experimental and still under development. Avoid using it in production projects"
let declName := ( Term.getDeclName?).getD `_grind
let config elabGrindConfig config
withMainContext do liftMetaFinishingTactic (grind · config only params declName fallback)
let mut config elabGrindConfig config
if trace then
config := { config with trace }
withMainContext do
let result grind ( getMainGoal) config only params declName fallback
replaceMainGoal []
return result
private def mkGrindOnly
(config : TSyntax `Lean.Parser.Tactic.optConfig)
(fallback? : Option Term)
(trace : Grind.Trace)
: MetaM (TSyntax `tactic) := do
let mut params := #[]
let mut foundFns : NameSet := {}
for { origin, kind } in trace.thms.toList do
if let .decl declName := origin then
unless Match.isMatchEqnTheorem ( getEnv) declName do
if let some declName isEqnThm? declName then
unless foundFns.contains declName do
foundFns := foundFns.insert declName
let decl : Ident := mkIdent ( unresolveNameGlobalAvoidingLocals declName)
let param `(Parser.Tactic.grindParam| $decl:ident)
params := params.push param
else
let decl : Ident := mkIdent ( unresolveNameGlobalAvoidingLocals declName)
let param match kind with
| .eqLhs => `(Parser.Tactic.grindParam| = $decl)
| .eqRhs => `(Parser.Tactic.grindParam| =_ $decl)
| .eqBoth => `(Parser.Tactic.grindParam| _=_ $decl)
| .eqBwd => `(Parser.Tactic.grindParam| = $decl)
| .bwd => `(Parser.Tactic.grindParam| $decl)
| .fwd => `(Parser.Tactic.grindParam| $decl)
| .leftRight => `(Parser.Tactic.grindParam| => $decl)
| .rightLeft => `(Parser.Tactic.grindParam| <= $decl)
| .user => `(Parser.Tactic.grindParam| usr $decl)
| .default => `(Parser.Tactic.grindParam| $decl:ident)
params := params.push param
for declName in trace.eagerCases.toList do
unless Grind.isBuiltinEagerCases declName do
let decl : Ident := mkIdent ( unresolveNameGlobalAvoidingLocals declName)
let param `(Parser.Tactic.grindParam| cases eager $decl)
params := params.push param
for declName in trace.cases.toList do
unless trace.eagerCases.contains declName || Grind.isBuiltinEagerCases declName do
let decl : Ident := mkIdent ( unresolveNameGlobalAvoidingLocals declName)
let param `(Parser.Tactic.grindParam| cases $decl)
params := params.push param
let result if let some fallback := fallback? then
`(tactic| grind $config:optConfig only on_failure $fallback)
else
`(tactic| grind $config:optConfig only)
if params.isEmpty then
return result
else
let paramsStx := #[mkAtom "[", (mkAtom ",").mkSep params, mkAtom "]"]
return result.raw.setArg 3 (mkNullNode paramsStx)
@[builtin_tactic Lean.Parser.Tactic.grind] def evalGrind : Tactic := fun stx => do
match stx with
| `(tactic| grind $config:optConfig $[only%$only]? $[ [$params:grindParam,*] ]? $[on_failure $fallback?]?) =>
evalGrindCore stx config only params fallback? false
discard <| evalGrindCore stx config only params fallback? false
| _ => throwUnsupportedSyntax
@[builtin_tactic Lean.Parser.Tactic.grindTrace] def evalGrindTrace : Tactic := fun stx => do
match stx with
| `(tactic| grind? $config:optConfig $[only%$only]? $[ [$params:grindParam,*] ]? $[on_failure $fallback?]?) =>
evalGrindCore stx config only params fallback? true
| `(tactic| grind?%$tk $config:optConfig $[only%$only]? $[ [$params:grindParam,*] ]? $[on_failure $fallback?]?) =>
let trace evalGrindCore stx config only params fallback? true
let stx mkGrindOnly config fallback? trace
Tactic.TryThis.addSuggestion tk stx (origSpan? := getRef)
| _ => throwUnsupportedSyntax
end Lean.Elab.Tactic

View File

@@ -286,8 +286,9 @@ where
diagnostics := .empty
inner? := none
finished := { range? := none, task := finished.result }
next := altStxs.zipWith altPromises fun stx prom =>
{ range? := stx.getRange?, task := prom.result }
next := Array.zipWith
(fun stx prom => { range? := stx.getRange?, task := prom.result })
altStxs altPromises
}
goWithIncremental <| altPromises.mapIdx fun i prom => {
old? := do

View File

@@ -585,10 +585,9 @@ where
s!"{x} ≤ {e} ≤ {y}"
prettyCoeffs (names : Array String) (coeffs : Coeffs) : String :=
coeffs.toList.enum
|>.filter (fun (_,c) => c 0)
|>.enum
|>.map (fun (j, (i,c)) =>
coeffs.toList.zipIdx
|>.filter (fun (c,_) => c 0)
|>.mapIdx (fun j (c,i) =>
(if j > 0 then if c > 0 then " + " else " - " else if c > 0 then "" else "- ") ++
(if Int.natAbs c = 1 then names[i]! else s!"{c.natAbs}*{names[i]!}"))
|> String.join
@@ -596,13 +595,13 @@ where
mentioned (atoms : Array Expr) (constraints : Std.HashMap Coeffs Fact) : MetaM (Array Bool) := do
let initMask := Array.mkArray atoms.size false
return constraints.fold (init := initMask) fun mask coeffs _ =>
coeffs.enum.foldl (init := mask) fun mask (i, c) =>
coeffs.zipIdx.foldl (init := mask) fun mask (c, i) =>
if c = 0 then mask else mask.set! i true
prettyAtoms (names : Array String) (atoms : Array Expr) (mask : Array Bool) : MessageData :=
(Array.zip names atoms).toList.enum
|>.filter (fun (i, _) => mask.getD i false)
|>.map (fun (_, (n, a)) => m!" {n} := {a}")
(Array.zip names atoms).toList.zipIdx
|>.filter (fun (_, i) => mask.getD i false)
|>.map (fun ((n, a),_) => m!" {n} := {a}")
|> m!"\n".joinSep
mutual

Some files were not shown because too many files have changed in this diff Show More