Theory BMSSP_Bucketed_Partition_Internal

theory BMSSP_Bucketed_Partition_Internal
  imports BMSSP_Partition_Interface
    "HOL-Library.Discrete_Functions"
    "HOL-Library.Landau_Symbols"
begin

section ‹Bucketed Partition Data Structure›

text ‹
  This is the main data-structure theory for the paper-faithful partition
  layer.  The BMSSP paper uses a bucketed structure whose operation bounds are
  expressed in terms of the ratio between the number of inserted elements and
  the block size.  That ratio is the essential distinction from a sorted-list
  model: Insert must pay for a search over buckets, not for a search over all
  stored elements.

  The formal model is functional.  A partition state contains a block size, an
  upper bound, a list of buckets, and a value memory.  Each bucket has a marker
  and an unsorted list of key/value entries.  The marker is a lower bound for
  the values in the bucket, and adjacent markers delimit the value ranges used
  by Pull.  The list-level operations below first establish a simple exact
  model, then a lazy model that permits buckets to grow up to the split
  threshold before they are rebuilt.

  The theory has three layers.  The first layer defines the functional state,
  invariants, Insert, BatchPrepend, and Pull, and proves that their views refine
  the abstract partition interface.  The second layer adds primitive step
  counters and a potential function for lazy splitting.  The third layer names
  the paper-facing operations and proves the three exported cost bounds:
  Insert at the ratio-log budget, BatchPrepend at the matching batched budget,
  and Pull at an amortized linear-in-M› budget.  The baseline sorted-list
  partition state used by the recurrence proofs is not used here.

  The amortized analysis uses a scaled credit potential
  Φ(P) = 4 ⋅ ∑b max 0 (length (bp_bucket_entries b) - bp_block_size P)›,
  summed over the buckets of P›.  The factor of four is the constant that
  absorbs the per-Insert charge: each Insert raises Φ› by at most four credits,
  which is exactly the budget that pays for the O(M)› rebucket work performed
  during a Pull when a bucket has overflowed past the lazy split threshold.  This
  bookkeeping is what makes the bound paper-tight rather than merely
  amortized-but-loose: an Insert that does not split the bucket pays only for
  the bucket walk O(log (N / M))›, an Insert that triggers a rebucket pays
  the same physical cost plus a refund of credits to Φ›, and Pull discharges
  the credits accumulated by its bucket's prior Inserts to fund the rebucket
  step.  Without the factor four the per-Insert charge would not cover the
  rebucket, and the resulting Insert bound would degrade to O(N / M)›; with
  the factor four it stays at the paper rate.
›

record 'k bp_bucket =
  bp_marker :: real
  bp_bucket_entries :: "('k × real) list"

record 'k bucketed_partition =
  bp_block_size :: nat
  bp_upper_bound :: real
  bp_buckets :: "'k bp_bucket list"
  bp_values :: "'k  real"

definition bp_bucket_entries_flat :: "'k bp_bucket list  ('k × real) list" where
  "bp_bucket_entries_flat bs = concat (map bp_bucket_entries bs)"

definition bp_entries :: "'k bucketed_partition  ('k × real) list" where
  "bp_entries P = bp_bucket_entries_flat (bp_buckets P)"

definition bp_entry_keys :: "('k × real) list  'k set" where
  "bp_entry_keys xs = fst ` set xs"

definition bp_bucket_keys :: "'k bp_bucket  'k set" where
  "bp_bucket_keys b = bp_entry_keys (bp_bucket_entries b)"

definition bp_view :: "'k bucketed_partition  'k partition_view" where
  "bp_view P =
      keys_of = bp_entry_keys (bp_entries P),
       value_of = bp_values P "

definition bp_bucket_sizes_ok :: "'k bucketed_partition  bool" where
  "bp_bucket_sizes_ok P 
     (bset (bp_buckets P).
       length (bp_bucket_entries b)  bp_block_size P)"

definition bp_lazy_bucket_sizes_ok :: "'k bucketed_partition  bool" where
  "bp_lazy_bucket_sizes_ok P 
     (bset (bp_buckets P).
       length (bp_bucket_entries b)  2 * bp_block_size P)"

definition bp_bucket_markers_sorted :: "'k bucketed_partition  bool" where
  "bp_bucket_markers_sorted P 
     sorted_wrt (λb c. bp_marker b  bp_marker c) (bp_buckets P)"

definition bp_bucket_markers_lower_bound :: "'k bucketed_partition  bool" where
  "bp_bucket_markers_lower_bound P 
     (bset (bp_buckets P).
       pset (bp_bucket_entries b). bp_marker b  snd p)"

definition bp_values_consistent :: "'k bucketed_partition  bool" where
  "bp_values_consistent P 
     (pset (bp_entries P). bp_values P (fst p) = snd p)"

definition bp_distinct_keys :: "'k bucketed_partition  bool" where
  "bp_distinct_keys P  distinct (map fst (bp_entries P))"

fun bp_bucket_boundaries_ok :: "'k bp_bucket list  bool" where
  "bp_bucket_boundaries_ok []  True"
| "bp_bucket_boundaries_ok [b]  True"
| "bp_bucket_boundaries_ok (b # c # bs) 
     (pset (bp_bucket_entries b). snd p  bp_marker c) 
     bp_bucket_boundaries_ok (c # bs)"

definition bp_bucket_boundaries_state_ok ::
  "'k bucketed_partition  bool" where
  "bp_bucket_boundaries_state_ok P 
     bp_bucket_boundaries_ok (bp_buckets P)"

definition bp_invariant :: "'k bucketed_partition  bool" where
  "bp_invariant P 
     0 < bp_block_size P 
     bp_distinct_keys P 
     bp_bucket_sizes_ok P 
     bp_bucket_markers_sorted P 
     bp_bucket_markers_lower_bound P 
     bp_values_consistent P"

definition bp_ordered_invariant :: "'k bucketed_partition  bool" where
  "bp_ordered_invariant P 
     bp_invariant P  bp_bucket_boundaries_state_ok P"

definition bp_lazy_invariant :: "'k bucketed_partition  bool" where
  "bp_lazy_invariant P 
     0 < bp_block_size P 
     bp_distinct_keys P 
     bp_lazy_bucket_sizes_ok P 
     bp_bucket_markers_sorted P 
     bp_bucket_markers_lower_bound P 
     bp_values_consistent P"

definition bp_lazy_ordered_invariant :: "'k bucketed_partition  bool" where
  "bp_lazy_ordered_invariant P 
     bp_lazy_invariant P  bp_bucket_boundaries_state_ok P"

text ‹
  The invariant vocabulary separates three concerns.  The basic view of a
  state is @{const bp_view}: it exposes only the key set and the value memory
  required by the abstract partition interface.  The structural invariant
  @{const bp_invariant} says that the block size is positive, keys are unique,
  strict bucket sizes are at most @{const bp_block_size}, markers are sorted,
  markers are lower bounds for their entries, and the stored value memory
  agrees with the bucket entries.  The ordered invariant
  @{const bp_ordered_invariant} adds the boundary condition between adjacent
  buckets, which is what makes a first-bucket Pull sound.

  The lazy variants are used for the amortized Insert proof.  In
  @{const bp_lazy_invariant}, buckets may temporarily contain up to twice the
  block size.  This slack is exactly what lets Insert avoid rebuilding on every
  operation.  Once a bucket crosses the lazy threshold, the state is rebuilt
  into strict buckets and the potential drops enough to pay for the split.
›

definition bp_empty :: "nat  real  'k bucketed_partition" where
  "bp_empty M B =
      bp_block_size = M,
       bp_upper_bound = B,
       bp_buckets = [],
       bp_values = (λ_. B) "

definition bp_singleton_bucket :: "'k × real  'k bp_bucket" where
  "bp_singleton_bucket p =
      bp_marker = snd p, bp_bucket_entries = [p] "

lemma bp_singleton_bucket_simps [simp]:
  "bp_marker (bp_singleton_bucket p) = snd p"
  "bp_bucket_entries (bp_singleton_bucket p) = [p]"
  unfolding bp_singleton_bucket_def by simp_all

definition bp_make_bucket :: "('k × real) list  'k bp_bucket" where
  "bp_make_bucket xs =
      bp_marker = snd (hd xs), bp_bucket_entries = xs "

fun bp_bucketize_sorted_entries_aux ::
  "nat  nat  ('k × real) list  'k bp_bucket list" where
  "bp_bucketize_sorted_entries_aux 0 M xs = []"
| "bp_bucketize_sorted_entries_aux (Suc fuel) M xs =
     (if M = 0  xs = []
      then []
      else bp_make_bucket (take M xs) #
        bp_bucketize_sorted_entries_aux fuel M (drop M xs))"

definition bp_bucketize_sorted_entries ::
  "nat  ('k × real) list  'k bp_bucket list" where
  "bp_bucketize_sorted_entries M xs =
     bp_bucketize_sorted_entries_aux (length xs) M xs"

definition bp_bucketize_entries ::
  "nat  ('k × real) list  'k bp_bucket list" where
  "bp_bucketize_entries M xs = bp_bucketize_sorted_entries M (sort_key snd xs)"

lemma bp_bucketize_sorted_entries_aux_empty [simp]:
  "bp_bucketize_sorted_entries_aux fuel M [] = []"
  by (cases fuel) simp_all

definition bp_rebucket :: "'k bucketed_partition  'k bucketed_partition" where
  "bp_rebucket P =
     Pbp_buckets := bp_bucketize_entries (bp_block_size P) (bp_entries P)"

fun bp_local_insert_bucket ::
  "nat  'k × real  'k bp_bucket list  'k bp_bucket list" where
  "bp_local_insert_bucket M p [] = bp_bucketize_entries M [p]"
| "bp_local_insert_bucket M p [b] =
     (if snd p < bp_marker b
      then bp_bucketize_entries M [p] @ [b]
      else bp_bucketize_entries M (p # bp_bucket_entries b))"
| "bp_local_insert_bucket M p (b # c # bs) =
     (if snd p < bp_marker b
      then bp_bucketize_entries M [p] @ b # c # bs
      else if snd p < bp_marker c
        then bp_bucketize_entries M (p # bp_bucket_entries b) @ c # bs
        else b # bp_local_insert_bucket M p (c # bs))"

definition bp_lazy_bucket_insert_entries ::
  "nat  'k × real  'k bp_bucket  'k bp_bucket list" where
  "bp_lazy_bucket_insert_entries M p b =
     (if length (bp_bucket_entries b) < 2 * M
      then [bbp_bucket_entries := p # bp_bucket_entries b]
      else bp_bucketize_entries M (p # bp_bucket_entries b))"

fun bp_lazy_insert_bucket ::
  "nat  'k × real  'k bp_bucket list  'k bp_bucket list" where
  "bp_lazy_insert_bucket M p [] = bp_bucketize_entries M [p]"
| "bp_lazy_insert_bucket M p [b] =
     (if snd p < bp_marker b
      then bp_bucketize_entries M [p] @ [b]
      else bp_lazy_bucket_insert_entries M p b)"
| "bp_lazy_insert_bucket M p (b # c # bs) =
     (if snd p < bp_marker b
      then bp_bucketize_entries M [p] @ b # c # bs
      else if snd p < bp_marker c
        then bp_lazy_bucket_insert_entries M p b @ c # bs
        else b # bp_lazy_insert_bucket M p (c # bs))"

fun bp_insert_bucket :: "'k × real  'k bp_bucket list  'k bp_bucket list" where
  "bp_insert_bucket p [] = [bp_singleton_bucket p]"
| "bp_insert_bucket p (b # bs) =
     (if snd p  bp_marker b
      then bp_singleton_bucket p # b # bs
      else b # bp_insert_bucket p bs)"

definition bp_delete_key_from_bucket :: "'k  'k bp_bucket  'k bp_bucket" where
  "bp_delete_key_from_bucket x b =
     bbp_bucket_entries := filter (λp. fst p  x) (bp_bucket_entries b)"

definition bp_delete_key :: "'k  'k bucketed_partition  'k bucketed_partition" where
  "bp_delete_key x P =
     Pbp_buckets := map (bp_delete_key_from_bucket x) (bp_buckets P)"

definition bp_insert ::
  "'k  real  'k bucketed_partition  'k bucketed_partition" where
  "bp_insert x b P =
     (let b' = (if x  bp_entry_keys (bp_entries P)
          then min (bp_values P x) b else b);
        P0 = bp_delete_key x P
      in P0bp_buckets := bp_insert_bucket (x, b') (bp_buckets P0),
             bp_values := (bp_values P)(x := b'))"

definition bp_local_insert_state ::
  "'k  real  'k bucketed_partition  'k bucketed_partition" where
  "bp_local_insert_state x b P =
     (let b' = (if x  bp_entry_keys (bp_entries P)
          then min (bp_values P x) b else b);
        P0 = bp_delete_key x P
      in P0bp_buckets :=
             bp_local_insert_bucket (bp_block_size P0) (x, b') (bp_buckets P0),
             bp_values := (bp_values P)(x := b'))"

definition bp_lazy_insert_state ::
  "'k  real  'k bucketed_partition  'k bucketed_partition" where
  "bp_lazy_insert_state x b P =
     (let b' = (if x  bp_entry_keys (bp_entries P)
          then min (bp_values P x) b else b);
        P0 = bp_delete_key x P
      in P0bp_buckets :=
             bp_lazy_insert_bucket (bp_block_size P0) (x, b') (bp_buckets P0),
             bp_values := (bp_values P)(x := b'))"

definition bp_batch_prepend ::
  "('k × real) list  'k bucketed_partition  'k bucketed_partition" where
  "bp_batch_prepend xs P =
     fold (λ(x, b) P'. bp_insert x b P') xs P"

fun bp_batch_value_update ::
  "('k × real) list  ('k  real)  'k  real" where
  "bp_batch_value_update [] f = f"
| "bp_batch_value_update ((x, b) # xs) f =
     bp_batch_value_update xs (f(x := b))"

fun bp_batch_max_value :: "real  ('k × real) list  real" where
  "bp_batch_max_value beta [] = beta"
| "bp_batch_max_value beta ((x, b) # xs) =
     bp_batch_max_value (max beta b) xs"

fun bp_rebase_first_bucket_marker ::
  "real  'k bp_bucket list  'k bp_bucket list" where
  "bp_rebase_first_bucket_marker beta [] = []"
| "bp_rebase_first_bucket_marker beta (b # bs) =
     bbp_marker := beta # bs"

fun bp_drop_empty_prefix :: "'k bp_bucket list  'k bp_bucket list" where
  "bp_drop_empty_prefix [] = []"
| "bp_drop_empty_prefix (b # bs) =
     (if bp_bucket_entries b = [] then bp_drop_empty_prefix bs else b # bs)"

definition bp_bucketed_batch_prepend_state ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition" where
  "bp_bucketed_batch_prepend_state xs P =
     (case xs of
        []  P
      | p # ps 
          (let beta = bp_batch_max_value (snd p) ps;
             new = bp_bucketize_entries (bp_block_size P) xs;
             old = bp_rebase_first_bucket_marker beta
               (bp_drop_empty_prefix (bp_buckets P))
           in Pbp_buckets := new @ old,
                bp_values := bp_batch_value_update xs (bp_values P)))"

definition bp_delete_keys_from_bucket :: "'k set  'k bp_bucket  'k bp_bucket" where
  "bp_delete_keys_from_bucket S b =
     bbp_bucket_entries := filter (λp. fst p  S) (bp_bucket_entries b)"

definition bp_delete_keys :: "'k set  'k bucketed_partition  'k bucketed_partition" where
  "bp_delete_keys S P =
     Pbp_buckets := map (bp_delete_keys_from_bucket S) (bp_buckets P)"

fun bp_min_value :: "real  ('k × real) list  real" where
  "bp_min_value B [] = B"
| "bp_min_value B ((x, b) # xs) = min b (bp_min_value B xs)"

definition bp_bucket_below_bound :: "'k bp_bucket  real  bool" where
  "bp_bucket_below_bound b beta 
     (pset (bp_bucket_entries b). snd p < beta)"

definition bp_first_bucket_pull ::
  "nat  real  'k bucketed_partition 
    'k set × real × 'k bucketed_partition" where
  "bp_first_bucket_pull M B P =
     (case bp_buckets P of
        b # c # bs 
          (let S = bp_bucket_keys b
           in (S, bp_marker c, bp_delete_keys S P))
      | _  ({}, B, P))"

definition bp_pull_set :: "nat  'k bucketed_partition  'k set" where
  "bp_pull_set M P =
     (if length (bp_entries P)  M
      then bp_entry_keys (bp_entries P)
      else {})"

definition bp_pull_bound :: "nat  real  'k bucketed_partition  real" where
  "bp_pull_bound M B P =
     (if length (bp_entries P)  M
      then B
      else bp_min_value B (bp_entries P))"

definition bp_conservative_pull ::
  "nat  real  'k bucketed_partition 
    'k set × real × 'k bucketed_partition" where
  "bp_conservative_pull M B P =
     (let S = bp_pull_set M P;
        beta = bp_pull_bound M B P
      in (S, beta, bp_delete_keys S P))"

definition bp_can_first_bucket_pull ::
  "nat  'k bucketed_partition  bool" where
  "bp_can_first_bucket_pull M P 
     (case bp_buckets P of
        b # c # bs 
          length (bp_entries P) > M 
          length (bp_bucket_entries b)  M 
          bp_bucket_below_bound b (bp_marker c) 
          bp_bucket_entries_flat (c # bs)  []
      | _  False)"

definition bp_pull ::
  "nat  real  'k bucketed_partition 
    'k set × real × 'k bucketed_partition" where
  "bp_pull M B P =
     (if bp_can_first_bucket_pull M P
      then bp_first_bucket_pull M B P
      else bp_conservative_pull M B P)"

lemma bp_can_first_bucket_pullE:
  assumes "bp_can_first_bucket_pull M P"
  obtains b c bs where
    "bp_buckets P = b # c # bs"
    "length (bp_entries P) > M"
    "length (bp_bucket_entries b)  M"
    "bp_bucket_below_bound b (bp_marker c)"
    "bp_bucket_entries_flat (c # bs)  []"
  using assms
proof (cases "bp_buckets P")
  case Nil
  then show ?thesis
    using assms unfolding bp_can_first_bucket_pull_def by simp
next
  case (Cons b rest)
  note buckets_outer = Cons
  then show ?thesis
  proof (cases rest)
    case Nil
    then show ?thesis
      using assms buckets_outer unfolding bp_can_first_bucket_pull_def by simp
  next
    case (Cons c bs)
    have buckets: "bp_buckets P = b # c # bs"
      using buckets_outer Cons by simp
    have len_entries: "length (bp_entries P) > M"
      using assms buckets unfolding bp_can_first_bucket_pull_def by simp
    have len_b: "length (bp_bucket_entries b)  M"
      using assms buckets unfolding bp_can_first_bucket_pull_def by simp
    have below: "bp_bucket_below_bound b (bp_marker c)"
      using assms buckets unfolding bp_can_first_bucket_pull_def by simp
    have tail_nonempty: "bp_bucket_entries_flat (c # bs)  []"
      using assms buckets unfolding bp_can_first_bucket_pull_def by simp
    show ?thesis
      by (rule that[OF buckets len_entries len_b below tail_nonempty])
  qed
qed

lemma bp_entry_keys_filter_neq [simp]:
  "bp_entry_keys (filter (λp. fst p  x) xs) = bp_entry_keys xs - {x}"
  unfolding bp_entry_keys_def by auto

lemma bp_entry_keys_filter_notin [simp]:
  "bp_entry_keys (filter (λp. fst p  S) xs) = bp_entry_keys xs - S"
  unfolding bp_entry_keys_def by auto

lemma bp_bucket_keys_alt [simp]:
  "bp_bucket_keys b = fst ` set (bp_bucket_entries b)"
  unfolding bp_bucket_keys_def bp_entry_keys_def by simp

lemma bp_entries_empty [simp]:
  "bp_entries (bp_empty M B) = []"
  unfolding bp_entries_def bp_empty_def bp_bucket_entries_flat_def by simp

lemma bp_bucket_entries_flat_append [simp]:
  "bp_bucket_entries_flat (bs @ cs) =
    bp_bucket_entries_flat bs @ bp_bucket_entries_flat cs"
  unfolding bp_bucket_entries_flat_def by simp

lemma bp_bucket_entries_flat_rebase_first_bucket_marker [simp]:
  "bp_bucket_entries_flat (bp_rebase_first_bucket_marker beta bs) =
    bp_bucket_entries_flat bs"
  by (cases bs) (simp_all add: bp_bucket_entries_flat_def)

lemma bp_bucket_entries_flat_drop_empty_prefix [simp]:
  "bp_bucket_entries_flat (bp_drop_empty_prefix bs) =
    bp_bucket_entries_flat bs"
  by (induction bs) (simp_all add: bp_bucket_entries_flat_def)

lemma length_bp_rebase_first_bucket_marker [simp]:
  "length (bp_rebase_first_bucket_marker beta bs) = length bs"
  by (cases bs) simp_all

lemma length_bp_drop_empty_prefix_le [simp]:
  "length (bp_drop_empty_prefix bs)  length bs"
  by (induction bs) auto

lemma bp_entry_keys_rebase_first_bucket_marker [simp]:
  "bp_entry_keys
    (bp_bucket_entries_flat (bp_rebase_first_bucket_marker beta bs)) =
    bp_entry_keys (bp_bucket_entries_flat bs)"
  by simp

lemma bp_entry_keys_drop_empty_prefix [simp]:
  "bp_entry_keys (bp_bucket_entries_flat (bp_drop_empty_prefix bs)) =
    bp_entry_keys (bp_bucket_entries_flat bs)"
  by simp

lemma bp_drop_empty_prefix_set_subset:
  "set (bp_drop_empty_prefix bs)  set bs"
  by (induction bs) auto

lemma bp_drop_empty_prefix_head_nonempty:
  assumes "bp_drop_empty_prefix bs = b # bs'"
  shows "bp_bucket_entries b  []"
  using assms
proof (induction bs)
  case Nil
  then show ?case by simp
next
  case (Cons a bs)
  show ?case
  proof (cases "bp_bucket_entries a = []")
    case True
    then show ?thesis
      using Cons.IH Cons.prems by simp
  next
    case False
    then have "a = b"
      using Cons.prems by simp
    then show ?thesis
      using False by simp
  qed
qed

lemma bp_bucket_boundaries_ok_drop_empty_prefix:
  assumes "bp_bucket_boundaries_ok bs"
  shows "bp_bucket_boundaries_ok (bp_drop_empty_prefix bs)"
  using assms
proof (induction bs)
  case Nil
  then show ?case by simp
next
  case (Cons b bs)
  show ?case
  proof (cases "bp_bucket_entries b = []")
    case True
    have "bp_bucket_boundaries_ok bs"
      using Cons.prems by (cases bs) simp_all
    then show ?thesis
      using True Cons.IH by simp
  next
    case False
    then show ?thesis
      using Cons.prems by simp
  qed
qed

lemma bp_bucket_markers_sorted_drop_empty_prefix:
  assumes "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_drop_empty_prefix bs)"
  using assms
proof (induction bs)
  case Nil
  then show ?case by simp
next
  case (Cons b bs)
  show ?case
  proof (cases "bp_bucket_entries b = []")
    case True
    have "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
      using Cons.prems by simp
    then show ?thesis
      using True Cons.IH by simp
  next
    case False
    then show ?thesis
      using Cons.prems by simp
  qed
qed

lemma bp_bucket_boundaries_ok_rebase_first_bucket_marker [simp]:
  "bp_bucket_boundaries_ok (bp_rebase_first_bucket_marker beta bs) =
    bp_bucket_boundaries_ok bs"
proof (cases bs)
  case Nil
  then show ?thesis by simp
next
  case (Cons b rest)
  then show ?thesis
    by (cases rest) simp_all
qed

lemma bp_batch_value_update_notin:
  assumes "x  fst ` set xs"
  shows "bp_batch_value_update xs f x = f x"
  using assms by (induction xs arbitrary: f) auto

lemma bp_batch_value_update_in_set_distinct:
  assumes distinct: "distinct (map fst xs)"
    and member: "(x, b)  set xs"
  shows "bp_batch_value_update xs f x = b"
  using assms
proof (induction xs arbitrary: f)
  case Nil
  then show ?case by simp
next
  case (Cons p xs)
  obtain y c where p_def: "p = (y, c)"
    by force
  show ?case
  proof (cases "x = y")
    case True
    have x_not_tail: "x  fst ` set xs"
      using True Cons.prems p_def by auto
    then have "(x, b)  set xs"
      by force
    then have "(x, b) = (y, c)"
      using Cons.prems p_def by auto
    then have bc: "b = c"
      by simp
    have y_not_tail: "y  fst ` set xs"
      using x_not_tail True by simp
    have unchanged:
      "bp_batch_value_update xs (f(y := c)) y = c"
      using bp_batch_value_update_notin[OF y_not_tail, of "f(y := c)"]
      by simp
    then show ?thesis
      unfolding p_def True bc
      by simp
  next
    case False
    then have "(x, b)  set xs"
      using Cons.prems p_def by auto
    moreover have "distinct (map fst xs)"
      using Cons.prems p_def by simp
    ultimately show ?thesis
      unfolding p_def by (simp add: Cons.IH)
  qed
qed

lemma batch_min_update_value_distinct_disjoint:
  assumes distinct: "distinct (map fst xs)"
    and disjoint: "fst ` set xs  keys_of D = {}"
  shows "value_of (batch_min_update D xs) =
    bp_batch_value_update xs (value_of D)"
  using distinct disjoint
proof (induction xs arbitrary: D)
  case Nil
  then show ?case
    unfolding batch_min_update_def by simp
next
  case (Cons p xs)
  obtain x b where p_def: "p = (x, b)"
    by force
  have distinct_tail: "distinct (map fst xs)"
    using Cons.prems p_def by simp
  have x_not_tail: "x  fst ` set xs"
    using Cons.prems p_def by auto
  have x_not_D: "x  keys_of D"
    using Cons.prems p_def by auto
  have disjoint_tail:
    "fst ` set xs  keys_of (min_update D x b) = {}"
    using Cons.prems x_not_tail p_def
    unfolding min_update_def by auto
  have tail:
    "value_of (batch_min_update (min_update D x b) xs) =
      bp_batch_value_update xs (value_of (min_update D x b))"
    by (rule Cons.IH[OF distinct_tail disjoint_tail])
  have fold_tail:
    "value_of
      (fold (λ(x, b) D'. min_update D' x b) xs (min_update D x b)) =
      bp_batch_value_update xs (value_of (min_update D x b))"
    using tail unfolding batch_min_update_def .
  have step_values:
    "value_of (min_update D x b) = (value_of D)(x := b)"
    using x_not_D unfolding min_update_def by simp
  show ?case
    unfolding p_def
    by (simp add: batch_min_update_def fold_tail step_values)
qed

lemma bp_batch_max_value_upper:
  assumes "p. p  set xs  snd p  gamma"
    and "beta  gamma"
  shows "bp_batch_max_value beta xs  gamma"
  using assms
proof (induction xs arbitrary: beta)
  case Nil
  then show ?case by simp
next
  case (Cons p xs)
  obtain x b where p_def: "p = (x, b)"
    by force
  have head_le: "b  gamma"
    using Cons.prems(1)[of p] p_def by simp
  have max_le: "max beta b  gamma"
    using Cons.prems(2) head_le by simp
  have "bp_batch_max_value (max beta (snd p)) xs  gamma"
  proof (rule Cons.IH)
    fix q
    assume "q  set xs"
    then show "snd q  gamma"
      using Cons.prems by simp
  qed (use max_le p_def in simp)
  then show ?case
    unfolding p_def by simp
qed

lemma bp_batch_max_value_ge_initial:
  "beta  bp_batch_max_value beta xs"
proof (induction xs arbitrary: beta)
  case Nil
  then show ?case by simp
next
  case (Cons p xs)
  obtain x b where p_def: "p = (x, b)"
    by force
  have "beta  max beta b"
    by simp
  moreover have "max beta b  bp_batch_max_value (max beta b) xs"
    by (rule Cons.IH)
  ultimately have "beta  bp_batch_max_value (max beta b) xs"
    by linarith
  then show ?case
    unfolding p_def by simp
qed

lemma bp_batch_max_value_ge_member:
  assumes "p  set xs"
  shows "snd p  bp_batch_max_value beta xs"
  using assms
proof (induction xs arbitrary: beta)
  case Nil
  then show ?case by simp
next
  case (Cons q xs)
  obtain y c where q_def: "q = (y, c)"
    by force
  show ?case
  proof (cases "p = q")
    case True
    have "snd p  max beta c"
      using True q_def by simp
    moreover have "max beta c  bp_batch_max_value (max beta c) xs"
      by (rule bp_batch_max_value_ge_initial)
    ultimately have "snd p  bp_batch_max_value (max beta c) xs"
      by linarith
    then show ?thesis
      unfolding q_def by simp
  next
    case False
    then have "p  set xs"
      using Cons.prems by simp
    then show ?thesis
      unfolding q_def by (simp add: Cons.IH)
  qed
qed

lemma bp_batch_max_value_ge_member_Cons:
  assumes "q  set (p # ps)"
  shows "snd q  bp_batch_max_value (snd p) ps"
  using assms
  by (cases "q = p")
    (simp_all add: bp_batch_max_value_ge_initial bp_batch_max_value_ge_member)

lemma bp_bucket_entries_flat_bucketize_sorted_entries_aux:
  assumes "0 < M"
    and "length xs  fuel"
  shows "bp_bucket_entries_flat
      (bp_bucketize_sorted_entries_aux fuel M xs) = xs"
  using assms
proof (induction fuel arbitrary: xs)
  case 0
  then have "xs = []"
    by simp
  then show ?case
    by (simp add: bp_bucket_entries_flat_def)
next
  case (Suc fuel)
  show ?case
  proof (cases "xs = []")
    case True
    then show ?thesis
      by (simp add: bp_bucket_entries_flat_def)
  next
    case False
    have len_drop: "length (drop M xs)  fuel"
      using Suc.prems False by (cases M) auto
    have tail:
      "bp_bucket_entries_flat
        (bp_bucketize_sorted_entries_aux fuel M (drop M xs)) =
       drop M xs"
      by (rule Suc.IH[OF Suc.prems(1) len_drop])
    show ?thesis
      using Suc.prems False tail
      by (simp add: bp_bucket_entries_flat_def bp_make_bucket_def)
  qed
qed

lemma bp_bucket_entries_flat_bucketize_sorted_entries:
  assumes "0 < M"
  shows "bp_bucket_entries_flat (bp_bucketize_sorted_entries M xs) = xs"
  using assms
  unfolding bp_bucketize_sorted_entries_def
  by (simp add: bp_bucket_entries_flat_bucketize_sorted_entries_aux)

lemma bp_bucket_entries_flat_bucketize_entries:
  assumes "0 < M"
  shows "bp_bucket_entries_flat (bp_bucketize_entries M xs) = sort_key snd xs"
  using assms
  unfolding bp_bucketize_entries_def
  by (simp add: bp_bucket_entries_flat_bucketize_sorted_entries)

lemma set_bp_bucket_entries_flat_bucketize_entries:
  assumes "0 < M"
  shows "set (bp_bucket_entries_flat (bp_bucketize_entries M xs)) = set xs"
  using assms
  by (simp add: bp_bucket_entries_flat_bucketize_entries)

lemma bp_entry_keys_bucketize_entries [simp]:
  assumes "0 < M"
  shows "bp_entry_keys (bp_bucket_entries_flat (bp_bucketize_entries M xs)) =
    bp_entry_keys xs"
  using assms
  unfolding bp_entry_keys_def
  by (simp add: set_bp_bucket_entries_flat_bucketize_entries)

lemma bp_bucketize_sorted_entries_aux_sizes_ok:
  assumes "0 < M"
  shows "bset (bp_bucketize_sorted_entries_aux fuel M xs).
    length (bp_bucket_entries b)  M"
  using assms
  by (induction fuel arbitrary: xs) (auto simp: bp_make_bucket_def)

lemma bp_bucketize_sorted_entries_sizes_ok:
  assumes "0 < M"
  shows "bset (bp_bucketize_sorted_entries M xs).
    length (bp_bucket_entries b)  M"
  using assms
  unfolding bp_bucketize_sorted_entries_def
  by (rule bp_bucketize_sorted_entries_aux_sizes_ok)

lemma bp_bucketize_entries_sizes_ok:
  assumes "0 < M"
  shows "bset (bp_bucketize_entries M xs).
    length (bp_bucket_entries b)  M"
  using assms
  unfolding bp_bucketize_entries_def
  by (rule bp_bucketize_sorted_entries_sizes_ok)

lemma bp_sorted_wrt_snd_sort_key [simp]:
  "sorted_wrt (λp q. snd p  snd q) (sort_key snd xs)"
proof -
  have "sorted (map snd (sort_key snd xs))"
    by (rule sorted_sort_key)
  then show ?thesis
    by (simp add: sorted_map)
qed

lemma sorted_wrt_hd_snd_le:
  fixes xs :: "('k × real) list"
  assumes sorted: "sorted_wrt (λp q. snd p  snd q) xs"
    and xs: "xs  []"
    and p: "p  set xs"
  shows "snd (hd xs)  snd p"
proof (cases xs)
  case Nil
  then show ?thesis
    using xs by simp
next
  case (Cons q qs)
  show ?thesis
  proof (cases "p = q")
    case True
    have "snd (hd xs) = snd p"
      using Cons True by simp
    then show ?thesis
      by simp
  next
    case False
    then have "p  set qs"
      using p Cons by simp
    moreover have "rset qs. snd q  snd r"
      using sorted Cons by simp
    ultimately show ?thesis
      using Cons by simp
  qed
qed

lemma sorted_wrt_snd_take_drop_le:
  fixes xs :: "('k × real) list"
  assumes sorted: "sorted_wrt (λp q. snd p  snd q) xs"
    and p: "p  set (take n xs)"
    and q: "q  set (drop n xs)"
  shows "snd p  snd q"
proof -
  have "sorted_wrt (λp q. snd p  snd q) (take n xs @ drop n xs)"
    using sorted by simp
  then have "pset (take n xs). qset (drop n xs). snd p  snd q"
    unfolding sorted_wrt_append by blast
  then show ?thesis
    using p q by blast
qed

lemma bp_bucketize_sorted_entries_aux_marker_in_set:
  assumes "b  set (bp_bucketize_sorted_entries_aux fuel M xs)"
  shows "pset xs. bp_marker b = snd p"
  using assms
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by simp
next
  case (Suc fuel)
  show ?case
  proof (cases "M = 0  xs = []")
    case True
    then show ?thesis
      using Suc.prems by simp
  next
    case False
    have M_pos: "0 < M"
      using False by simp
    have xs_nonempty: "xs  []"
      using False by simp
    from Suc.prems have b_cases:
      "b = bp_make_bucket (take M xs) 
       b  set (bp_bucketize_sorted_entries_aux fuel M (drop M xs))"
      using False by simp
    from b_cases show ?thesis
    proof
      assume b_def: "b = bp_make_bucket (take M xs)"
      have "hd (take M xs)  set xs"
        using M_pos xs_nonempty by (cases xs) auto
      then show ?thesis
        unfolding b_def bp_make_bucket_def by auto
    next
      assume b_tail:
        "b  set (bp_bucketize_sorted_entries_aux fuel M (drop M xs))"
      obtain p where p_drop: "p  set (drop M xs)"
        and marker: "bp_marker b = snd p"
        using Suc.IH[OF b_tail] by auto
      have "p  set xs"
        by (meson in_set_dropD p_drop)
      then show ?thesis
        using marker by auto
    qed
  qed
qed

lemma bp_bucketize_sorted_entries_aux_markers_lower_bound:
  fixes xs :: "('k × real) list"
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λp q. snd p  snd q) xs"
  shows "bset (bp_bucketize_sorted_entries_aux fuel M xs).
    pset (bp_bucket_entries b). bp_marker b  snd p"
  using M_pos sorted
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by simp
next
  case (Suc fuel)
  show ?case
  proof (cases "xs = []")
    case True
    then show ?thesis
      by simp
  next
    case False
    have current:
      "pset (bp_bucket_entries (bp_make_bucket (take M xs))).
        bp_marker (bp_make_bucket (take M xs))  snd p"
    proof
      fix p
      assume p: "p  set (bp_bucket_entries (bp_make_bucket (take M xs)))"
      then have p_take: "p  set (take M xs)"
        unfolding bp_make_bucket_def by simp
      have sorted_take: "sorted_wrt (λp q. snd p  snd q) (take M xs)"
        using Suc.prems by simp
      have take_nonempty: "take M xs  []"
        using p_take by (cases "take M xs") auto
      have "snd (hd (take M xs))  snd p"
        by (rule sorted_wrt_hd_snd_le[OF sorted_take take_nonempty p_take])
      then show "bp_marker (bp_make_bucket (take M xs))  snd p"
        unfolding bp_make_bucket_def by simp
    qed
    have tail:
      "bset (bp_bucketize_sorted_entries_aux fuel M (drop M xs)).
        pset (bp_bucket_entries b). bp_marker b  snd p"
      by (rule Suc.IH) (use Suc.prems in simp_all)
    show ?thesis
      using False current tail Suc.prems by simp
  qed
qed

lemma bp_bucketize_sorted_entries_markers_lower_bound:
  fixes xs :: "('k × real) list"
  assumes "0 < M"
    and "sorted_wrt (λp q. snd p  snd q) xs"
  shows "bset (bp_bucketize_sorted_entries M xs).
    pset (bp_bucket_entries b). bp_marker b  snd p"
  using assms
  unfolding bp_bucketize_sorted_entries_def
  by (rule bp_bucketize_sorted_entries_aux_markers_lower_bound)

lemma bp_bucketize_entries_markers_lower_bound:
  assumes "0 < M"
  shows "bset (bp_bucketize_entries M xs).
    pset (bp_bucket_entries b). bp_marker b  snd p"
  using assms
  unfolding bp_bucketize_entries_def
  by (rule bp_bucketize_sorted_entries_markers_lower_bound) simp

lemma bp_bucketize_sorted_entries_aux_markers_sorted:
  fixes xs :: "('k × real) list"
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λp q. snd p  snd q) xs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_bucketize_sorted_entries_aux fuel M xs)"
  using M_pos sorted
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by simp
next
  case (Suc fuel)
  show ?case
  proof (cases "xs = []")
    case True
    then show ?thesis
      by simp
  next
    case False
    let ?tail = "bp_bucketize_sorted_entries_aux fuel M (drop M xs)"
    have tail_sorted:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) ?tail"
      by (rule Suc.IH) (use Suc.prems in simp_all)
    have current_le_tail:
      "cset ?tail.
        bp_marker (bp_make_bucket (take M xs))  bp_marker c"
    proof
      fix c
      assume c: "c  set ?tail"
      obtain p where p_drop: "p  set (drop M xs)"
        and c_marker: "bp_marker c = snd p"
        using bp_bucketize_sorted_entries_aux_marker_in_set[OF c] by auto
      have p_xs: "p  set xs"
        by (meson in_set_dropD p_drop)
      have head_le: "snd (hd xs)  snd p"
        by (rule sorted_wrt_hd_snd_le[OF Suc.prems(2) False p_xs])
      have marker_eq: "bp_marker (bp_make_bucket (take M xs)) = snd (hd xs)"
        using Suc.prems False by (cases xs) (auto simp: bp_make_bucket_def)
      show "bp_marker (bp_make_bucket (take M xs))  bp_marker c"
        using head_le marker_eq c_marker by simp
    qed
    show ?thesis
      using False tail_sorted current_le_tail Suc.prems by simp
  qed
qed

lemma bp_bucketize_sorted_entries_markers_sorted:
  fixes xs :: "('k × real) list"
  assumes "0 < M"
    and "sorted_wrt (λp q. snd p  snd q) xs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_bucketize_sorted_entries M xs)"
  using assms
  unfolding bp_bucketize_sorted_entries_def
  by (rule bp_bucketize_sorted_entries_aux_markers_sorted)

lemma bp_bucketize_entries_markers_sorted:
  assumes "0 < M"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_bucketize_entries M xs)"
  using assms
  unfolding bp_bucketize_entries_def
  by (rule bp_bucketize_sorted_entries_markers_sorted) simp

lemma bp_bucketize_entries_marker_in_set:
  assumes "b  set (bp_bucketize_entries M xs)"
  shows "pset xs. bp_marker b = snd p"
proof -
  obtain p where p_sort: "p  set (sort_key snd xs)"
    and marker: "bp_marker b = snd p"
    using assms
    unfolding bp_bucketize_entries_def bp_bucketize_sorted_entries_def
    by (auto dest: bp_bucketize_sorted_entries_aux_marker_in_set)
  then have "p  set xs"
    by simp
  then show ?thesis
    using marker by auto
qed

lemma bp_bucketize_sorted_entries_aux_boundaries_ok:
  fixes xs :: "('k × real) list"
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λp q. snd p  snd q) xs"
  shows "bp_bucket_boundaries_ok
    (bp_bucketize_sorted_entries_aux fuel M xs)"
  using M_pos sorted
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by simp
next
  case (Suc fuel)
  show ?case
  proof (cases "xs = []")
    case True
    then show ?thesis
      by simp
  next
    case False
    let ?tail = "bp_bucketize_sorted_entries_aux fuel M (drop M xs)"
    have tail_boundaries: "bp_bucket_boundaries_ok ?tail"
      by (rule Suc.IH) (use Suc.prems in simp_all)
    show ?thesis
    proof (cases ?tail)
      case Nil
      then show ?thesis
        using False Suc.prems by simp
    next
      case (Cons c cs)
      have c_in: "c  set ?tail"
        using Cons by simp
      obtain q where q_drop: "q  set (drop M xs)"
        and c_marker: "bp_marker c = snd q"
        using bp_bucketize_sorted_entries_aux_marker_in_set[OF c_in] by auto
      have current_before_c:
        "pset (bp_bucket_entries (bp_make_bucket (take M xs))).
          snd p  bp_marker c"
      proof
        fix p
        assume p:
          "p  set (bp_bucket_entries (bp_make_bucket (take M xs)))"
        then have p_take: "p  set (take M xs)"
          unfolding bp_make_bucket_def by simp
        have "snd p  snd q"
          by (rule sorted_wrt_snd_take_drop_le[OF Suc.prems(2) p_take q_drop])
        then show "snd p  bp_marker c"
          using c_marker by simp
      qed
      show ?thesis
        using False Cons tail_boundaries current_before_c Suc.prems by simp
    qed
  qed
qed

lemma bp_bucketize_sorted_entries_boundaries_ok:
  fixes xs :: "('k × real) list"
  assumes "0 < M"
    and "sorted_wrt (λp q. snd p  snd q) xs"
  shows "bp_bucket_boundaries_ok (bp_bucketize_sorted_entries M xs)"
  using assms
  unfolding bp_bucketize_sorted_entries_def
  by (rule bp_bucketize_sorted_entries_aux_boundaries_ok)

lemma bp_bucketize_entries_boundaries_ok:
  assumes "0 < M"
  shows "bp_bucket_boundaries_ok (bp_bucketize_entries M xs)"
  using assms
  unfolding bp_bucketize_entries_def
  by (rule bp_bucketize_sorted_entries_boundaries_ok) simp

lemma distinct_map_fst_sort_key:
  assumes "distinct (map fst xs)"
  shows "distinct (map fst (sort_key f xs))"
proof -
  have distinct_sort: "distinct (sort_key f xs)"
    using assms unfolding distinct_map by simp
  have inj: "inj_on fst (set (sort_key f xs))"
    using assms unfolding distinct_map by simp
  show ?thesis
    unfolding distinct_map using distinct_sort inj by simp
qed

lemma bp_rebucket_view [simp]:
  assumes "0 < bp_block_size P"
  shows "bp_view (bp_rebucket P) = bp_view P"
  using assms
  unfolding bp_rebucket_def bp_view_def bp_entries_def
  by simp

lemma bp_rebucket_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_invariant (bp_rebucket P)"
proof -
  let ?M = "bp_block_size P"
  let ?xs = "bp_entries P"
  have M_pos: "0 < ?M"
    using inv unfolding bp_invariant_def by blast
  have distinct_xs: "distinct (map fst ?xs)"
    using inv unfolding bp_invariant_def bp_distinct_keys_def by blast
  have vals:
    "pset ?xs. bp_values P (fst p) = snd p"
    using inv unfolding bp_invariant_def bp_values_consistent_def by blast
  have flat:
    "bp_bucket_entries_flat (bp_bucketize_entries ?M ?xs) = sort_key snd ?xs"
    by (rule bp_bucket_entries_flat_bucketize_entries[OF M_pos])
  have flat_rebucket:
    "bp_entries (bp_rebucket P) = sort_key snd ?xs"
    using flat unfolding bp_rebucket_def bp_entries_def by simp
  have sizes_ok:
    "bset (bp_bucketize_entries ?M ?xs).
      length (bp_bucket_entries b)  ?M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  have markers_sorted:
    "sorted_wrt (λb c. bp_marker b  bp_marker c)
      (bp_bucketize_entries ?M ?xs)"
    by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
  have markers_lower:
    "bset (bp_bucketize_entries ?M ?xs).
      pset (bp_bucket_entries b). bp_marker b  snd p"
    by (rule bp_bucketize_entries_markers_lower_bound[OF M_pos])
  have set_flat:
    "set (bp_bucket_entries_flat (bp_bucketize_entries ?M ?xs)) = set ?xs"
    by (rule set_bp_bucket_entries_flat_bucketize_entries[OF M_pos])
  show ?thesis
    unfolding bp_invariant_def
  proof (intro conjI)
    show "0 < bp_block_size (bp_rebucket P)"
      using M_pos unfolding bp_rebucket_def by simp
    show "bp_distinct_keys (bp_rebucket P)"
      using distinct_map_fst_sort_key[OF distinct_xs, of snd]
      unfolding bp_distinct_keys_def flat_rebucket by simp
    show "bp_bucket_sizes_ok (bp_rebucket P)"
      using sizes_ok
      unfolding bp_rebucket_def bp_bucket_sizes_ok_def by simp
    show "bp_bucket_markers_sorted (bp_rebucket P)"
      using markers_sorted
      unfolding bp_rebucket_def bp_bucket_markers_sorted_def by simp
    show "bp_bucket_markers_lower_bound (bp_rebucket P)"
      using markers_lower
      unfolding bp_rebucket_def bp_bucket_markers_lower_bound_def by simp
    show "bp_values_consistent (bp_rebucket P)"
      using vals set_flat
      unfolding bp_rebucket_def bp_values_consistent_def bp_entries_def
        bp_entry_keys_def
      by auto
  qed
qed

lemma bp_rebucket_boundaries_state_ok:
  assumes inv: "bp_invariant P"
  shows "bp_bucket_boundaries_state_ok (bp_rebucket P)"
proof -
  have M_pos: "0 < bp_block_size P"
    using inv unfolding bp_invariant_def by blast
  show ?thesis
    using bp_bucketize_entries_boundaries_ok[OF M_pos, of "bp_entries P"]
    unfolding bp_bucket_boundaries_state_ok_def bp_rebucket_def by simp
qed

lemma bp_rebucket_ordered_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_ordered_invariant (bp_rebucket P)"
  unfolding bp_ordered_invariant_def
  using bp_rebucket_invariant[OF inv] bp_rebucket_boundaries_state_ok[OF inv]
  by blast

text ‹
  Rebucketing is the canonical repair operation.  It sorts the flat entry list
  by value, chunks it into blocks of size @{const bp_block_size}, and rebuilds
  markers from the first entry of each block.  The view theorem
  @{thm bp_rebucket_view} says this repair is observationally invisible at the
  abstract partition interface: keys and remembered values do not change.
  The invariant theorems above then show that rebucketing restores strict
  bucket sizes, sorted markers, lower-bound markers, and adjacent bucket
  boundaries.  Later regularized operations use this fact when a lazy step has
  accumulated enough debt to warrant a rebuild.
›

lemma bp_ordered_invariant_invariant:
  assumes "bp_ordered_invariant P"
  shows "bp_invariant P"
  using assms unfolding bp_ordered_invariant_def by blast

lemma bp_ordered_invariant_boundaries_state_ok:
  assumes "bp_ordered_invariant P"
  shows "bp_bucket_boundaries_state_ok P"
  using assms unfolding bp_ordered_invariant_def by blast

lemma bp_invariant_lazy_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_lazy_invariant P"
proof -
  have lazy_sizes: "bp_lazy_bucket_sizes_ok P"
  proof -
    have "bset (bp_buckets P).
      length (bp_bucket_entries b)  2 * bp_block_size P"
      using inv unfolding bp_invariant_def bp_bucket_sizes_ok_def
      by auto
    then show ?thesis
      unfolding bp_lazy_bucket_sizes_ok_def .
  qed
  show ?thesis
    using inv lazy_sizes
    unfolding bp_invariant_def bp_lazy_invariant_def
    by blast
qed

lemma bp_ordered_invariant_lazy_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_lazy_ordered_invariant P"
  using bp_invariant_lazy_invariant[OF bp_ordered_invariant_invariant[OF ord]]
    bp_ordered_invariant_boundaries_state_ok[OF ord]
  unfolding bp_lazy_ordered_invariant_def by blast

lemma bp_lazy_ordered_invariant_lazy_invariant:
  assumes "bp_lazy_ordered_invariant P"
  shows "bp_lazy_invariant P"
  using assms unfolding bp_lazy_ordered_invariant_def by blast

lemma bp_lazy_ordered_invariant_boundaries_state_ok:
  assumes "bp_lazy_ordered_invariant P"
  shows "bp_bucket_boundaries_state_ok P"
  using assms unfolding bp_lazy_ordered_invariant_def by blast

lemma bp_rebucket_invariant_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_invariant (bp_rebucket P)"
proof -
  let ?M = "bp_block_size P"
  let ?xs = "bp_entries P"
  have M_pos: "0 < ?M"
    using inv unfolding bp_lazy_invariant_def by blast
  have distinct_xs: "distinct (map fst ?xs)"
    using inv unfolding bp_lazy_invariant_def bp_distinct_keys_def by blast
  have vals:
    "pset ?xs. bp_values P (fst p) = snd p"
    using inv unfolding bp_lazy_invariant_def bp_values_consistent_def
    by blast
  have flat:
    "bp_bucket_entries_flat (bp_bucketize_entries ?M ?xs) = sort_key snd ?xs"
    by (rule bp_bucket_entries_flat_bucketize_entries[OF M_pos])
  have flat_rebucket:
    "bp_entries (bp_rebucket P) = sort_key snd ?xs"
    using flat unfolding bp_rebucket_def bp_entries_def by simp
  have sizes_ok:
    "bset (bp_bucketize_entries ?M ?xs).
      length (bp_bucket_entries b)  ?M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  have markers_sorted:
    "sorted_wrt (λb c. bp_marker b  bp_marker c)
      (bp_bucketize_entries ?M ?xs)"
    by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
  have markers_lower:
    "bset (bp_bucketize_entries ?M ?xs).
      pset (bp_bucket_entries b). bp_marker b  snd p"
    by (rule bp_bucketize_entries_markers_lower_bound[OF M_pos])
  have set_flat:
    "set (bp_bucket_entries_flat (bp_bucketize_entries ?M ?xs)) = set ?xs"
    by (rule set_bp_bucket_entries_flat_bucketize_entries[OF M_pos])
  show ?thesis
    unfolding bp_invariant_def
  proof (intro conjI)
    show "0 < bp_block_size (bp_rebucket P)"
      using M_pos unfolding bp_rebucket_def by simp
    show "bp_distinct_keys (bp_rebucket P)"
      using distinct_map_fst_sort_key[OF distinct_xs, of snd]
      unfolding bp_distinct_keys_def flat_rebucket by simp
    show "bp_bucket_sizes_ok (bp_rebucket P)"
      using sizes_ok
      unfolding bp_rebucket_def bp_bucket_sizes_ok_def by simp
    show "bp_bucket_markers_sorted (bp_rebucket P)"
      using markers_sorted
      unfolding bp_rebucket_def bp_bucket_markers_sorted_def by simp
    show "bp_bucket_markers_lower_bound (bp_rebucket P)"
      using markers_lower
      unfolding bp_rebucket_def bp_bucket_markers_lower_bound_def by simp
    show "bp_values_consistent (bp_rebucket P)"
      using vals set_flat
      unfolding bp_rebucket_def bp_values_consistent_def bp_entries_def
        bp_entry_keys_def
      by auto
  qed
qed

lemma bp_rebucket_boundaries_state_ok_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_bucket_boundaries_state_ok (bp_rebucket P)"
proof -
  have M_pos: "0 < bp_block_size P"
    using inv unfolding bp_lazy_invariant_def by blast
  show ?thesis
    using bp_bucketize_entries_boundaries_ok[OF M_pos, of "bp_entries P"]
    unfolding bp_bucket_boundaries_state_ok_def bp_rebucket_def by simp
qed

lemma bp_rebucket_ordered_invariant_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_ordered_invariant (bp_rebucket P)"
  unfolding bp_ordered_invariant_def
  using bp_rebucket_invariant_from_lazy[OF inv]
    bp_rebucket_boundaries_state_ok_from_lazy[OF inv]
  by blast

lemma set_bp_bucket_entries_flat_local_insert_bucket:
  assumes "0 < M"
  shows "set (bp_bucket_entries_flat (bp_local_insert_bucket M p bs)) =
    insert p (set (bp_bucket_entries_flat bs))"
  using assms
proof (induction bs arbitrary: p)
  case Nil
  have "set (bp_bucket_entries_flat (bp_bucketize_entries M [p])) = set [p]"
    by (rule set_bp_bucket_entries_flat_bucketize_entries[OF Nil.prems])
  then show ?case
    by (simp add: bp_bucket_entries_flat_def)
next
  case (Cons b bs)
  note IH = Cons.IH
  note prems = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    have single:
      "set (bp_bucket_entries_flat (bp_bucketize_entries M [p])) = {p}"
      using set_bp_bucket_entries_flat_bucketize_entries[OF prems, of "[p]"]
      by simp
    have inserted:
      "set (bp_bucket_entries_flat
        (bp_bucketize_entries M (p # bp_bucket_entries b))) =
       insert p (set (bp_bucket_entries b))"
      using set_bp_bucket_entries_flat_bucketize_entries
        [OF prems, of "p # bp_bucket_entries b"]
      by simp
    then show ?thesis
      using Nil single inserted
      by (auto simp: bp_bucket_entries_flat_def)
  next
    case (Cons c cs)
    have single:
      "set (bp_bucket_entries_flat (bp_bucketize_entries M [p])) = {p}"
      using set_bp_bucket_entries_flat_bucketize_entries[OF prems, of "[p]"]
      by simp
    have inserted:
      "set (bp_bucket_entries_flat
        (bp_bucketize_entries M (p # bp_bucket_entries b))) =
       insert p (set (bp_bucket_entries b))"
      using set_bp_bucket_entries_flat_bucketize_entries
        [OF prems, of "p # bp_bucket_entries b"]
      by simp
    have tail:
      "set (bp_bucket_entries_flat (bp_local_insert_bucket M p bs)) =
       insert p (set (bp_bucket_entries_flat bs))"
      by (rule IH[OF prems])
    then show ?thesis
      using Cons single inserted tail
      by (auto simp: bp_bucket_entries_flat_def)
  qed
qed

lemma set_bp_bucket_entries_flat_lazy_bucket_insert_entries:
  assumes "0 < M"
  shows "set (bp_bucket_entries_flat
      (bp_lazy_bucket_insert_entries M p b)) =
    insert p (set (bp_bucket_entries b))"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    unfolding bp_lazy_bucket_insert_entries_def bp_bucket_entries_flat_def
    by simp
next
  case False
  have "set (bp_bucket_entries_flat
      (bp_bucketize_entries M (p # bp_bucket_entries b))) =
    set (p # bp_bucket_entries b)"
    by (rule set_bp_bucket_entries_flat_bucketize_entries[OF assms])
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma set_bp_bucket_entries_flat_lazy_insert_bucket:
  assumes "0 < M"
  shows "set (bp_bucket_entries_flat (bp_lazy_insert_bucket M p bs)) =
    insert p (set (bp_bucket_entries_flat bs))"
  using assms
proof (induction bs arbitrary: p)
  case Nil
  have "set (bp_bucket_entries_flat (bp_bucketize_entries M [p])) = set [p]"
    by (rule set_bp_bucket_entries_flat_bucketize_entries[OF Nil.prems])
  then show ?case
    by (simp add: bp_bucket_entries_flat_def)
next
  case (Cons b bs)
  note IH = Cons.IH
  note M_pos = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    have single:
      "set (bp_bucket_entries_flat (bp_bucketize_entries M [p])) = {p}"
      using set_bp_bucket_entries_flat_bucketize_entries[OF M_pos, of "[p]"]
      by simp
    have inserted:
      "set (bp_bucket_entries_flat
        (bp_lazy_bucket_insert_entries M p b)) =
       insert p (set (bp_bucket_entries b))"
      by (rule set_bp_bucket_entries_flat_lazy_bucket_insert_entries
          [OF M_pos])
    show ?thesis
      using Nil single inserted by (auto simp: bp_bucket_entries_flat_def)
  next
    case (Cons c cs)
    have single:
      "set (bp_bucket_entries_flat (bp_bucketize_entries M [p])) = {p}"
      using set_bp_bucket_entries_flat_bucketize_entries[OF M_pos, of "[p]"]
      by simp
    have inserted:
      "set (bp_bucket_entries_flat
        (bp_lazy_bucket_insert_entries M p b)) =
       insert p (set (bp_bucket_entries b))"
      by (rule set_bp_bucket_entries_flat_lazy_bucket_insert_entries
          [OF M_pos])
    have tail:
      "set (bp_bucket_entries_flat (bp_lazy_insert_bucket M p bs)) =
       insert p (set (bp_bucket_entries_flat bs))"
      by (rule IH[OF M_pos])
    show ?thesis
      using Cons single inserted tail
      by (auto simp: bp_bucket_entries_flat_def)
  qed
qed

lemma length_bp_bucket_entries_flat_lazy_bucket_insert_entries [simp]:
  assumes "0 < M"
  shows "length (bp_bucket_entries_flat
      (bp_lazy_bucket_insert_entries M p b)) =
    Suc (length (bp_bucket_entries b))"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    unfolding bp_lazy_bucket_insert_entries_def bp_bucket_entries_flat_def
    by simp
next
  case False
  have "length (bp_bucket_entries_flat
      (bp_bucketize_entries M (p # bp_bucket_entries b))) =
    length (p # bp_bucket_entries b)"
    using bp_bucket_entries_flat_bucketize_entries
      [OF assms, of "p # bp_bucket_entries b"]
    by simp
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma length_bp_bucket_entries_flat_lazy_insert_bucket [simp]:
  assumes "0 < M"
  shows "length (bp_bucket_entries_flat (bp_lazy_insert_bucket M p bs)) =
    Suc (length (bp_bucket_entries_flat bs))"
  using assms
proof (induction bs arbitrary: p)
  case Nil
  have len:
    "length (bp_bucket_entries_flat (bp_bucketize_entries M [p])) =
      length [p]"
    using bp_bucket_entries_flat_bucketize_entries[OF Nil.prems, of "[p]"]
    by simp
  show ?case
    using len by (simp add: bp_bucket_entries_flat_def)
next
  case (Cons b bs)
  note IH = Cons.IH
  note M_pos = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    have len_single:
      "length (bp_bucket_entries_flat (bp_bucketize_entries M [p])) =
        length [p]"
      using bp_bucket_entries_flat_bucketize_entries[OF M_pos, of "[p]"]
      by simp
    have len_inserted:
      "length (bp_bucket_entries_flat
          (bp_lazy_bucket_insert_entries M p b)) =
        Suc (length (bp_bucket_entries b))"
      by (rule length_bp_bucket_entries_flat_lazy_bucket_insert_entries
          [OF M_pos])
    show ?thesis
      using Nil len_single len_inserted
      by (auto simp: bp_bucket_entries_flat_def)
  next
    case (Cons c cs)
    have len_single:
      "length (bp_bucket_entries_flat (bp_bucketize_entries M [p])) =
        length [p]"
      using bp_bucket_entries_flat_bucketize_entries[OF M_pos, of "[p]"]
      by simp
    have len_inserted:
      "length (bp_bucket_entries_flat
          (bp_lazy_bucket_insert_entries M p b)) =
        Suc (length (bp_bucket_entries b))"
      by (rule length_bp_bucket_entries_flat_lazy_bucket_insert_entries
          [OF M_pos])
    have tail_len:
      "length (bp_bucket_entries_flat
          (bp_lazy_insert_bucket M p (c # cs))) =
        Suc (length (bp_bucket_entries_flat (c # cs)))"
      using IH[OF M_pos, of p] Cons by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using Cons len_single by (simp add: bp_bucket_entries_flat_def)
    next
      case False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        then show ?thesis
          using Cons False len_inserted
          by (simp add: bp_bucket_entries_flat_def)
      next
        case False
        then show ?thesis
          using Cons ¬ snd p < bp_marker b tail_len
          by (simp add: bp_bucket_entries_flat_def)
      qed
    qed
  qed
qed

lemma bp_lazy_insert_bucket_distinct_keys:
  assumes M_pos: "0 < M"
    and distinct: "distinct (map fst (bp_bucket_entries_flat bs))"
    and fresh: "fst p  bp_entry_keys (bp_bucket_entries_flat bs)"
  shows "distinct
    (map fst (bp_bucket_entries_flat (bp_lazy_insert_bucket M p bs)))"
proof (rule card_distinct)
  let ?old = "map fst (bp_bucket_entries_flat bs)"
  let ?new =
    "map fst (bp_bucket_entries_flat (bp_lazy_insert_bucket M p bs))"
  have set_new: "set ?new = insert (fst p) (set ?old)"
    using set_bp_bucket_entries_flat_lazy_insert_bucket[OF M_pos, of p bs]
    by auto
  have fresh_set: "fst p  set ?old"
    using fresh unfolding bp_entry_keys_def by simp
  have "card (set ?new) = Suc (card (set ?old))"
    unfolding set_new using fresh_set by simp
  also have " = Suc (length ?old)"
    using distinct_card[OF distinct] by simp
  also have " = length ?new"
    using length_bp_bucket_entries_flat_lazy_insert_bucket[OF M_pos, of p bs]
    by simp
  finally show "card (set ?new) = length ?new" .
qed

lemma bp_lazy_bucket_insert_entries_sizes_ok:
  assumes M_pos: "0 < M"
    and size: "length (bp_bucket_entries b)  2 * M"
  shows "cset (bp_lazy_bucket_insert_entries M p b).
    length (bp_bucket_entries c)  2 * M"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then have "length (p # bp_bucket_entries b)  2 * M"
    by simp
  then show ?thesis
    using True unfolding bp_lazy_bucket_insert_entries_def by simp
next
  case False
  have strict_sizes:
    "cset (bp_bucketize_entries M (p # bp_bucket_entries b)).
      length (bp_bucket_entries c)  M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  have "cset (bp_bucketize_entries M (p # bp_bucket_entries b)).
      length (bp_bucket_entries c)  2 * M"
    using strict_sizes by auto
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma bp_lazy_insert_bucket_sizes_ok:
  assumes M_pos: "0 < M"
    and sizes: "bset bs. length (bp_bucket_entries b)  2 * M"
  shows "bset (bp_lazy_insert_bucket M p bs).
    length (bp_bucket_entries b)  2 * M"
  using sizes
proof (induction bs arbitrary: p)
  case Nil
  have strict:
    "bset (bp_bucketize_entries M [p]).
      length (bp_bucket_entries b)  M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  then show ?case
    using M_pos by auto
next
  case (Cons b bs)
  note IH = Cons.IH
  note prems = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    have single:
      "bset (bp_bucketize_entries M [p]).
        length (bp_bucket_entries b)  2 * M"
      using bp_bucketize_entries_sizes_ok[OF M_pos, of "[p]"] by auto
    have inserted:
      "cset (bp_lazy_bucket_insert_entries M p b).
        length (bp_bucket_entries c)  2 * M"
      by (rule bp_lazy_bucket_insert_entries_sizes_ok[OF M_pos])
        (use prems Nil in simp)
    have b_size: "length (bp_bucket_entries b)  2 * M"
      using prems by simp
    then show ?thesis
      using Nil single inserted b_size by auto
  next
    case (Cons c cs)
    have tail_sizes:
      "bset bs. length (bp_bucket_entries b)  2 * M"
      using prems by simp
    have single:
      "bset (bp_bucketize_entries M [p]).
        length (bp_bucket_entries b)  2 * M"
      using bp_bucketize_entries_sizes_ok[OF M_pos, of "[p]"] by auto
    have inserted:
      "dset (bp_lazy_bucket_insert_entries M p b).
        length (bp_bucket_entries d)  2 * M"
      by (rule bp_lazy_bucket_insert_entries_sizes_ok[OF M_pos])
        (use prems Cons in simp)
    show ?thesis
      using IH[of p, OF tail_sizes] prems Cons single inserted by auto
  qed
qed

lemma bp_local_insert_bucket_sizes_ok:
  assumes M_pos: "0 < M"
    and sizes: "bset bs. length (bp_bucket_entries b)  M"
  shows "bset (bp_local_insert_bucket M p bs).
    length (bp_bucket_entries b)  M"
  using sizes
proof (induction bs arbitrary: p)
  case Nil
  have "bset (bp_bucketize_entries M [p]).
    length (bp_bucket_entries b)  M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  then show ?case
    by simp
next
  case (Cons b bs)
  note IH = Cons.IH
  note prems = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    then show ?thesis
      using prems bp_bucketize_entries_sizes_ok[OF M_pos, of "[p]"]
        bp_bucketize_entries_sizes_ok[OF M_pos, of "p # bp_bucket_entries b"]
      by auto
  next
    case (Cons c cs)
    have tail_sizes:
      "bset bs. length (bp_bucket_entries b)  M"
      using prems by simp
    show ?thesis
      using IH[of p, OF tail_sizes] prems Cons
        bp_bucketize_entries_sizes_ok[OF M_pos, of "[p]"]
        bp_bucketize_entries_sizes_ok[OF M_pos, of "p # bp_bucket_entries b"]
      by auto
  qed
qed

lemma bp_local_insert_bucket_markers_lower_bound:
  assumes M_pos: "0 < M"
    and lower: "bset bs. pset (bp_bucket_entries b).
      bp_marker b  snd p"
  shows "bset (bp_local_insert_bucket M p bs).
    qset (bp_bucket_entries b). bp_marker b  snd q"
  using lower
proof (induction bs arbitrary: p)
  case Nil
  have "bset (bp_bucketize_entries M [p]).
    qset (bp_bucket_entries b). bp_marker b  snd q"
    by (rule bp_bucketize_entries_markers_lower_bound[OF M_pos])
  then show ?case
    by simp
next
  case (Cons b bs)
  note IH = Cons.IH
  note prems = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    then show ?thesis
      using prems bp_bucketize_entries_markers_lower_bound[OF M_pos, of "[p]"]
        bp_bucketize_entries_markers_lower_bound
          [OF M_pos, of "p # bp_bucket_entries b"]
      by auto
  next
    case (Cons c cs)
    have tail_lower:
      "bset bs. pset (bp_bucket_entries b).
        bp_marker b  snd p"
      using prems by simp
    show ?thesis
      using IH[of p, OF tail_lower] prems Cons
        bp_bucketize_entries_markers_lower_bound[OF M_pos, of "[p]"]
        bp_bucketize_entries_markers_lower_bound
          [OF M_pos, of "p # bp_bucket_entries b"]
      by auto
  qed
qed

lemma bp_lazy_bucket_insert_entries_markers_lower_bound:
  assumes M_pos: "0 < M"
    and lower: "qset (bp_bucket_entries b). bp_marker b  snd q"
    and p_ge: "bp_marker b  snd p"
  shows "cset (bp_lazy_bucket_insert_entries M p b).
    qset (bp_bucket_entries c). bp_marker c  snd q"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    using lower p_ge unfolding bp_lazy_bucket_insert_entries_def by auto
next
  case False
  have "cset (bp_bucketize_entries M (p # bp_bucket_entries b)).
    qset (bp_bucket_entries c). bp_marker c  snd q"
    by (rule bp_bucketize_entries_markers_lower_bound[OF M_pos])
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma bp_lazy_insert_bucket_markers_lower_bound:
  assumes M_pos: "0 < M"
    and lower: "bset bs. pset (bp_bucket_entries b).
      bp_marker b  snd p"
  shows "bset (bp_lazy_insert_bucket M p bs).
    qset (bp_bucket_entries b). bp_marker b  snd q"
  using lower
proof (induction bs arbitrary: p)
  case Nil
  show ?case
    by (simp add: bp_bucketize_entries_markers_lower_bound[OF M_pos])
next
  case (Cons b bs)
  note IH = Cons.IH
  note prems = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    have single:
      "bset (bp_bucketize_entries M [p]).
        qset (bp_bucket_entries b). bp_marker b  snd q"
      by (rule bp_bucketize_entries_markers_lower_bound[OF M_pos])
    have b_lower:
      "qset (bp_bucket_entries b). bp_marker b  snd q"
      using prems by simp
    have inserted:
      "bp_marker b  snd p 
        cset (bp_lazy_bucket_insert_entries M p b).
          qset (bp_bucket_entries c). bp_marker c  snd q"
      by (rule bp_lazy_bucket_insert_entries_markers_lower_bound
          [OF M_pos b_lower])
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      show ?thesis
        using Nil True single b_lower by auto
    next
      case False
      have p_ge_b: "bp_marker b  snd p"
        using False by simp
      show ?thesis
        using Nil False inserted[OF p_ge_b] by simp
    qed
  next
    case (Cons c cs)
    have tail_lower:
      "bset bs. pset (bp_bucket_entries b).
        bp_marker b  snd p"
      using prems by simp
    have single:
      "bset (bp_bucketize_entries M [p]).
        qset (bp_bucket_entries b). bp_marker b  snd q"
      by (rule bp_bucketize_entries_markers_lower_bound[OF M_pos])
    have b_lower:
      "qset (bp_bucket_entries b). bp_marker b  snd q"
      using prems by simp
    have inserted:
      "bp_marker b  snd p 
        dset (bp_lazy_bucket_insert_entries M p b).
          qset (bp_bucket_entries d). bp_marker d  snd q"
      by (rule bp_lazy_bucket_insert_entries_markers_lower_bound
          [OF M_pos b_lower])
    have tail: "bset (bp_lazy_insert_bucket M p bs).
        qset (bp_bucket_entries b). bp_marker b  snd q"
      by (rule IH[OF tail_lower])
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have result:
        "bp_lazy_insert_bucket M p (b # bs) =
          bp_bucketize_entries M [p] @ b # bs"
        using True Cons by simp
      show ?thesis
        unfolding result
        using single prems Cons by auto
    next
      case False
      have p_ge_b: "bp_marker b  snd p"
        using False by simp
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have result:
        "bp_lazy_insert_bucket M p (b # bs) =
            bp_lazy_bucket_insert_entries M p b @ bs"
          using False True Cons by simp
        show ?thesis
          unfolding result
          using inserted[OF p_ge_b] prems Cons by auto
      next
        case False
        have result:
          "bp_lazy_insert_bucket M p (b # bs) =
            b # bp_lazy_insert_bucket M p bs"
          using ¬ snd p < bp_marker b False Cons by simp
        show ?thesis
          unfolding result
          using tail prems Cons by auto
      qed
    qed
  qed
qed

lemma bp_bucketize_entries_markers_le:
  fixes beta :: real
  assumes "qset xs. snd q  beta"
  shows "bset (bp_bucketize_entries M xs). bp_marker b  beta"
proof
  fix b
  assume b: "b  set (bp_bucketize_entries M xs)"
  obtain q where q: "q  set xs" and marker: "bp_marker b = snd q"
    using bp_bucketize_entries_marker_in_set[OF b] by auto
  have "snd q  beta"
    using assms q by blast
  show "bp_marker b  beta"
    using marker snd q  beta by simp
qed

lemma bp_bucketize_entries_markers_ge:
  fixes alpha :: real
  assumes "qset xs. alpha  snd q"
  shows "bset (bp_bucketize_entries M xs). alpha  bp_marker b"
proof
  fix b
  assume b: "b  set (bp_bucketize_entries M xs)"
  obtain q where q: "q  set xs" and marker: "bp_marker b = snd q"
    using bp_bucketize_entries_marker_in_set[OF b] by auto
  have "alpha  snd q"
    using assms q by blast
  show "alpha  bp_marker b"
    using marker alpha  snd q by simp
qed

lemma bp_bucketize_entries_entry_in_source:
  assumes M_pos: "0 < M"
    and b: "b  set (bp_bucketize_entries M xs)"
    and q: "q  set (bp_bucket_entries b)"
  shows "q  set xs"
proof -
  have "q  set (bp_bucket_entries_flat (bp_bucketize_entries M xs))"
    using b q unfolding bp_bucket_entries_flat_def by auto
  then show ?thesis
    using set_bp_bucket_entries_flat_bucketize_entries[OF M_pos, of xs]
    by simp
qed

lemma bp_bucketize_entries_nonempty:
  assumes "0 < M" and "xs  []"
  shows "bp_bucketize_entries M xs  []"
proof
  assume empty: "bp_bucketize_entries M xs = []"
  have "set (bp_bucket_entries_flat (bp_bucketize_entries M xs)) = set xs"
    by (rule set_bp_bucket_entries_flat_bucketize_entries[OF assms(1)])
  then have "set xs = {}"
    using empty unfolding bp_bucket_entries_flat_def by simp
  then show False
    using assms(2) by auto
qed

lemma bp_local_insert_bucket_nonempty:
  assumes "0 < M"
  shows "bp_local_insert_bucket M p bs  []"
  using assms
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by (simp add: bp_bucketize_entries_nonempty)
next
  case (Cons b bs)
  then show ?case
  proof (cases bs)
    case Nil
    then show ?thesis
      using Cons.prems by (simp add: bp_bucketize_entries_nonempty)
  next
    case (Cons c cs)
    then show ?thesis
      using Cons by (simp add: bp_bucketize_entries_nonempty)
  qed
qed

lemma bp_bucket_boundaries_ok_append:
  assumes left: "bp_bucket_boundaries_ok xs"
    and right: "bp_bucket_boundaries_ok ys"
    and cross: "ys  [] 
      bset xs. pset (bp_bucket_entries b).
        snd p  bp_marker (hd ys)"
  shows "bp_bucket_boundaries_ok (xs @ ys)"
  using left cross
proof (induction xs)
  case Nil
  then show ?case
    using right by simp
next
  case (Cons b xs)
  note outer_left = Cons.prems(1)
  note outer_cross = Cons.prems(2)
  note outer_IH = Cons.IH
  show ?case
  proof (cases xs)
    case Nil
    show ?thesis
    proof (cases ys)
      case Nil
      then show ?thesis
        using xs = [] by simp
    next
      case (Cons c cs)
      have cross_all:
        "dset (b # xs). pset (bp_bucket_entries d).
          snd p  bp_marker (hd ys)"
        using outer_cross Cons by simp
      have "pset (bp_bucket_entries b). snd p  bp_marker c"
        using cross_all Cons unfolding xs = [] by simp
      then show ?thesis
        using right Cons xs = [] by simp
    qed
  next
    case (Cons c cs)
    have head_boundary:
      "pset (bp_bucket_entries b). snd p  bp_marker c"
      using outer_left Cons by simp
    have tail_boundaries: "bp_bucket_boundaries_ok (xs @ ys)"
    proof (rule outer_IH)
      show "bp_bucket_boundaries_ok xs"
        using outer_left Cons by simp
      show "ys  [] 
        bset xs. pset (bp_bucket_entries b).
          snd p  bp_marker (hd ys)"
        using outer_cross by simp
    qed
    show ?thesis
      using Cons head_boundary tail_boundaries by simp
  qed
qed

lemma bp_bucket_boundaries_ok_bucketize_append_Cons:
  assumes M_pos: "0 < M"
    and tail: "bp_bucket_boundaries_ok (c # bs)"
    and upper: "qset xs. snd q  bp_marker c"
  shows "bp_bucket_boundaries_ok (bp_bucketize_entries M xs @ c # bs)"
proof (rule bp_bucket_boundaries_ok_append)
  show "bp_bucket_boundaries_ok (bp_bucketize_entries M xs)"
    by (rule bp_bucketize_entries_boundaries_ok[OF M_pos])
  show "bp_bucket_boundaries_ok (c # bs)"
    by (rule tail)
  show "c # bs  [] 
    bset (bp_bucketize_entries M xs).
      pset (bp_bucket_entries b). snd p  bp_marker (hd (c # bs))"
  proof
    fix b
    assume b: "b  set (bp_bucketize_entries M xs)"
    show "pset (bp_bucket_entries b). snd p  bp_marker (hd (c # bs))"
    proof
      fix p
      assume p: "p  set (bp_bucket_entries b)"
      have "p  set xs"
        by (rule bp_bucketize_entries_entry_in_source[OF M_pos b p])
      then show "snd p  bp_marker (hd (c # bs))"
        using upper by simp
    qed
  qed
qed

lemma bp_lazy_bucket_insert_entries_nonempty:
  assumes M_pos: "0 < M"
  shows "bp_lazy_bucket_insert_entries M p b  []"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    unfolding bp_lazy_bucket_insert_entries_def by simp
next
  case False
  have "bp_bucketize_entries M (p # bp_bucket_entries b)  []"
    by (rule bp_bucketize_entries_nonempty[OF M_pos]) simp
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma bp_lazy_insert_bucket_nonempty:
  assumes M_pos: "0 < M"
  shows "bp_lazy_insert_bucket M p bs  []"
  using assms
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by (simp add: bp_bucketize_entries_nonempty)
next
  case (Cons b bs)
  note IH = Cons.IH
  note M_pos = Cons.prems
  show ?case
  proof (cases bs)
    case Nil
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using Nil by (simp add: bp_bucketize_entries_nonempty[OF M_pos])
    next
      case False
      then show ?thesis
        using Nil bp_lazy_bucket_insert_entries_nonempty[OF M_pos, of p b]
        by simp
    qed
  next
    case (Cons c cs)
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using Cons by (simp add: bp_bucketize_entries_nonempty[OF M_pos])
    next
      case False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        then show ?thesis
          using Cons False bp_lazy_bucket_insert_entries_nonempty
            [OF M_pos, of p b]
          by simp
      next
        case False
        then show ?thesis
          using Cons ¬ snd p < bp_marker b IH[OF M_pos, of p]
          by simp
      qed
    qed
  qed
qed

lemma bp_lazy_bucket_insert_entries_markers_sorted:
  assumes M_pos: "0 < M"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_lazy_bucket_insert_entries M p b)"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    unfolding bp_lazy_bucket_insert_entries_def by simp
next
  case False
  have "sorted_wrt (λb c. bp_marker b  bp_marker c)
      (bp_bucketize_entries M (p # bp_bucket_entries b))"
    by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma bp_lazy_bucket_insert_entries_markers_ge:
  fixes alpha :: real
  assumes M_pos: "0 < M"
    and lower: "qset (bp_bucket_entries b). bp_marker b  snd q"
    and p_ge: "bp_marker b  snd p"
    and alpha_le: "alpha  bp_marker b"
  shows "cset (bp_lazy_bucket_insert_entries M p b).
    alpha  bp_marker c"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    using alpha_le unfolding bp_lazy_bucket_insert_entries_def by simp
next
  case False
  have entries_ge:
    "qset (p # bp_bucket_entries b). alpha  snd q"
    using lower p_ge alpha_le by auto
  have "cset (bp_bucketize_entries M (p # bp_bucket_entries b)).
    alpha  bp_marker c"
    by (rule bp_bucketize_entries_markers_ge[OF entries_ge])
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma bp_lazy_bucket_insert_entries_markers_le:
  fixes beta :: real
  assumes M_pos: "0 < M"
    and marker_le: "bp_marker b  beta"
    and upper: "qset (p # bp_bucket_entries b). snd q  beta"
  shows "cset (bp_lazy_bucket_insert_entries M p b).
    bp_marker c  beta"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    using marker_le unfolding bp_lazy_bucket_insert_entries_def by simp
next
  case False
  have "cset (bp_bucketize_entries M (p # bp_bucket_entries b)).
    bp_marker c  beta"
    by (rule bp_bucketize_entries_markers_le[OF upper])
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma bp_lazy_bucket_insert_entries_entries_le:
  fixes beta :: real
  assumes M_pos: "0 < M"
    and upper: "qset (p # bp_bucket_entries b). snd q  beta"
  shows "cset (bp_lazy_bucket_insert_entries M p b).
    qset (bp_bucket_entries c). snd q  beta"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  show ?thesis
  proof
    fix c
    assume c: "c  set (bp_lazy_bucket_insert_entries M p b)"
    show "qset (bp_bucket_entries c). snd q  beta"
    proof
      fix q
      assume q: "q  set (bp_bucket_entries c)"
      have "q  set (p # bp_bucket_entries b)"
        using True c q unfolding bp_lazy_bucket_insert_entries_def by auto
      then show "snd q  beta"
        using upper by blast
    qed
  qed
next
  case False
  show ?thesis
  proof
    fix c
    assume c:
      "c  set (bp_lazy_bucket_insert_entries M p b)"
    show "qset (bp_bucket_entries c). snd q  beta"
    proof
      fix q
      assume q: "q  set (bp_bucket_entries c)"
      have c_bucketize:
        "c  set (bp_bucketize_entries M (p # bp_bucket_entries b))"
        using c False unfolding bp_lazy_bucket_insert_entries_def by simp
      have "q  set (p # bp_bucket_entries b)"
        by (rule bp_bucketize_entries_entry_in_source
            [OF M_pos c_bucketize q])
      then show "snd q  beta"
        using upper by blast
    qed
  qed
qed

lemma bp_lazy_bucket_insert_entries_boundaries_ok:
  assumes M_pos: "0 < M"
  shows "bp_bucket_boundaries_ok (bp_lazy_bucket_insert_entries M p b)"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    unfolding bp_lazy_bucket_insert_entries_def by simp
next
  case False
  have "bp_bucket_boundaries_ok
      (bp_bucketize_entries M (p # bp_bucket_entries b))"
    by (rule bp_bucketize_entries_boundaries_ok[OF M_pos])
  then show ?thesis
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma bp_lazy_insert_bucket_markers_ge_hd:
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and nonempty: "bs  []"
    and p_ge: "bp_marker (hd bs)  snd p"
  shows "bset (bp_lazy_insert_bucket M p bs).
    bp_marker (hd bs)  bp_marker b"
  using sorted lower nonempty p_ge
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by simp
next
  case (Cons b bs)
  note IH = Cons.IH
  note sorted = Cons.prems(1)
  note lower = Cons.prems(2)
  note p_ge = Cons.prems(4)
  show ?case
  proof (cases bs)
    case Nil
    have p_ge_b: "bp_marker b  snd p"
      using p_ge by simp
    have inserted_ge:
      "cset (bp_lazy_bucket_insert_entries M p b).
        bp_marker b  bp_marker c"
    proof (rule bp_lazy_bucket_insert_entries_markers_ge
        [where alpha = "bp_marker b", OF M_pos _ p_ge_b])
      show "qset (bp_bucket_entries b). bp_marker b  snd q"
        using lower Nil by simp
      show "bp_marker b  bp_marker b"
        by simp
    qed
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using p_ge by simp
    next
      case False
      then show ?thesis
        using Nil inserted_ge by simp
    qed
  next
    case (Cons c cs)
    have sorted_tail:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
      using sorted Cons by simp
    have lower_tail:
      "bset (c # cs). qset (bp_bucket_entries b).
        bp_marker b  snd q"
      using lower Cons by simp
    have b_le_c: "bp_marker b  bp_marker c"
      using sorted Cons by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using p_ge by simp
    next
      case False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have p_ge_b: "bp_marker b  snd p"
          using False by simp
        have inserted_ge:
          "dset (bp_lazy_bucket_insert_entries M p b).
            bp_marker b  bp_marker d"
        proof (rule bp_lazy_bucket_insert_entries_markers_ge
            [where alpha = "bp_marker b", OF M_pos])
          show "qset (bp_bucket_entries b). bp_marker b  snd q"
            using lower Cons by simp
          show "bp_marker b  snd p"
            by (rule p_ge_b)
          show "bp_marker b  bp_marker b"
            by simp
        qed
        have tail_ge:
          "dset (c # cs). bp_marker b  bp_marker d"
          using sorted Cons by auto
        show ?thesis
          using Cons False True inserted_ge tail_ge by auto
      next
        case False
        have p_ge_c: "bp_marker c  snd p"
          using False by simp
        have tail_ge_c:
          "dset (bp_lazy_insert_bucket M p (c # cs)).
            bp_marker c  bp_marker d"
          using IH[of p] sorted_tail lower_tail p_ge_c Cons by auto
        have tail_ge_b:
          "dset (bp_lazy_insert_bucket M p (c # cs)).
            bp_marker b  bp_marker d"
          using b_le_c tail_ge_c by force
        show ?thesis
          using Cons ¬ snd p < bp_marker b False tail_ge_b by simp
      qed
    qed
  qed
qed

lemma bp_lazy_insert_bucket_markers_sorted:
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and boundaries: "bp_bucket_boundaries_ok bs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_lazy_insert_bucket M p bs)"
  using sorted lower boundaries
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by (simp add: bp_bucketize_entries_markers_sorted[OF M_pos])
next
  case (Cons b bs)
  note IH = Cons.IH
  note sorted = Cons.prems(1)
  note lower = Cons.prems(2)
  note boundaries = Cons.prems(3)
  show ?case
  proof (cases bs)
    case Nil
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have left_sorted:
        "sorted_wrt (λb c. bp_marker b  bp_marker c)
          (bp_bucketize_entries M [p])"
        by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
      have left_le_b:
        "xset (bp_bucketize_entries M [p]).
          bp_marker x  bp_marker b"
        by (rule bp_bucketize_entries_markers_le) (use True in simp)
      show ?thesis
        using Nil True left_sorted left_le_b
        by (simp add: sorted_wrt_append)
    next
      case False
      show ?thesis
        using Nil False
          bp_lazy_bucket_insert_entries_markers_sorted[OF M_pos, of p b]
        by simp
    qed
  next
    case (Cons c cs)
    have sorted_tail:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
      using sorted Cons by simp
    have lower_tail:
      "bset (c # cs). qset (bp_bucket_entries b).
        bp_marker b  snd q"
      using lower Cons by simp
    have boundaries_tail: "bp_bucket_boundaries_ok (c # cs)"
      using boundaries Cons by simp
    have b_le_c: "bp_marker b  bp_marker c"
      using sorted Cons by simp
    have b_le_all:
      "dset (b # c # cs). bp_marker b  bp_marker d"
      using sorted Cons by auto
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have left_sorted:
        "sorted_wrt (λb c. bp_marker b  bp_marker c)
          (bp_bucketize_entries M [p])"
        by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
      have right_sorted:
        "sorted_wrt (λb c. bp_marker b  bp_marker c) (b # c # cs)"
        using sorted Cons by simp
      have left_le_b:
        "xset (bp_bucketize_entries M [p]).
          bp_marker x  bp_marker b"
        by (rule bp_bucketize_entries_markers_le) (use True in simp)
      have cross:
        "xset (bp_bucketize_entries M [p]).
          yset (b # c # cs). bp_marker x  bp_marker y"
        using left_le_b b_le_all by force
      show ?thesis
        using Cons True left_sorted right_sorted cross
        by (simp add: sorted_wrt_append)
    next
      case False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have left_sorted:
          "sorted_wrt (λb c. bp_marker b  bp_marker c)
            (bp_lazy_bucket_insert_entries M p b)"
          by (rule bp_lazy_bucket_insert_entries_markers_sorted[OF M_pos])
        have left_le_c:
          "xset (bp_lazy_bucket_insert_entries M p b).
            bp_marker x  bp_marker c"
        proof (rule bp_lazy_bucket_insert_entries_markers_le
            [OF M_pos b_le_c])
          show "qset (p # bp_bucket_entries b).
            snd q  bp_marker c"
            using boundaries Cons True by auto
        qed
        have c_le_all:
          "dset (c # cs). bp_marker c  bp_marker d"
          using sorted_tail by auto
        have cross:
          "xset (bp_lazy_bucket_insert_entries M p b).
            yset (c # cs). bp_marker x  bp_marker y"
          using left_le_c c_le_all by force
        show ?thesis
          using Cons False True left_sorted sorted_tail cross
          by (simp add: sorted_wrt_append)
      next
        case False
        have p_ge_c: "bp_marker c  snd p"
          using False by simp
        have tail_sorted_result:
          "sorted_wrt (λb c. bp_marker b  bp_marker c)
            (bp_lazy_insert_bucket M p (c # cs))"
          using IH[of p] sorted_tail lower_tail boundaries_tail Cons by auto
        have tail_ge_hd:
          "dset (bp_lazy_insert_bucket M p (c # cs)).
            bp_marker (hd (c # cs))  bp_marker d"
        proof (rule bp_lazy_insert_bucket_markers_ge_hd
            [where bs = "c # cs" and p = p and M = M])
          show "0 < M"
            by (rule M_pos)
          show "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
            by (rule sorted_tail)
          show "bset (c # cs). qset (bp_bucket_entries b).
            bp_marker b  snd q"
            by (rule lower_tail)
          show "c # cs  []"
            by simp
          show "bp_marker (hd (c # cs))  snd p"
            using p_ge_c by simp
        qed
        have tail_ge_c:
          "dset (bp_lazy_insert_bucket M p (c # cs)).
            bp_marker c  bp_marker d"
          using tail_ge_hd by simp
        have tail_ge_b:
          "dset (bp_lazy_insert_bucket M p (c # cs)).
            bp_marker b  bp_marker d"
          using b_le_c tail_ge_c by force
        show ?thesis
          using Cons ¬ snd p < bp_marker b False
            tail_sorted_result tail_ge_b by simp
      qed
    qed
  qed
qed

lemma bp_lazy_insert_bucket_boundaries_ok:
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and boundaries: "bp_bucket_boundaries_ok bs"
  shows "bp_bucket_boundaries_ok (bp_lazy_insert_bucket M p bs)"
  using sorted lower boundaries
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by (simp add: bp_bucketize_entries_boundaries_ok[OF M_pos])
next
  case (Cons b bs)
  note IH = Cons.IH
  note sorted = Cons.prems(1)
  note lower = Cons.prems(2)
  note boundaries = Cons.prems(3)
  show ?case
  proof (cases bs)
    case Nil
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have tail: "bp_bucket_boundaries_ok [b]"
        by simp
      have upper: "qset [p]. snd q  bp_marker b"
        using True by simp
      show ?thesis
        using Nil True
        by (simp add: bp_bucket_boundaries_ok_bucketize_append_Cons
            [OF M_pos tail upper])
    next
      case False
      show ?thesis
        using Nil False
          bp_lazy_bucket_insert_entries_boundaries_ok[OF M_pos, of p b]
        by simp
    qed
  next
    case (Cons c cs)
    have sorted_tail:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
      using sorted Cons by simp
    have lower_tail:
      "bset (c # cs). qset (bp_bucket_entries b).
        bp_marker b  snd q"
      using lower Cons by simp
    have boundaries_tail: "bp_bucket_boundaries_ok (c # cs)"
      using boundaries Cons by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have tail_all: "bp_bucket_boundaries_ok (b # c # cs)"
        using boundaries Cons by simp
      have upper: "qset [p]. snd q  bp_marker b"
        using True by simp
      show ?thesis
        using Cons True
        by (simp add: bp_bucket_boundaries_ok_bucketize_append_Cons
            [where c = b and bs = "c # cs" and xs = "[p]",
              OF M_pos tail_all upper])
    next
      case False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have upper:
          "qset (p # bp_bucket_entries b). snd q  bp_marker c"
          using boundaries Cons True by auto
        have left_boundaries:
          "bp_bucket_boundaries_ok (bp_lazy_bucket_insert_entries M p b)"
          by (rule bp_lazy_bucket_insert_entries_boundaries_ok[OF M_pos])
        have cross_entries:
          "dset (bp_lazy_bucket_insert_entries M p b).
            qset (bp_bucket_entries d). snd q  bp_marker c"
          by (rule bp_lazy_bucket_insert_entries_entries_le
              [OF M_pos upper])
        have append_ok:
          "bp_bucket_boundaries_ok
            (bp_lazy_bucket_insert_entries M p b @ c # cs)"
        proof (rule bp_bucket_boundaries_ok_append)
          show "bp_bucket_boundaries_ok
              (bp_lazy_bucket_insert_entries M p b)"
            by (rule left_boundaries)
          show "bp_bucket_boundaries_ok (c # cs)"
            by (rule boundaries_tail)
          show "c # cs  [] 
            bset (bp_lazy_bucket_insert_entries M p b).
              pset (bp_bucket_entries b).
                snd p  bp_marker (hd (c # cs))"
            using cross_entries by simp
        qed
        show ?thesis
          using Cons False True append_ok by simp
      next
        case False
        have p_ge_c: "bp_marker c  snd p"
          using False by simp
        have tail_boundaries:
          "bp_bucket_boundaries_ok (bp_lazy_insert_bucket M p (c # cs))"
          using IH[of p] sorted_tail lower_tail boundaries_tail Cons by auto
        have tail_ge_hd:
          "dset (bp_lazy_insert_bucket M p (c # cs)).
            bp_marker (hd (c # cs))  bp_marker d"
        proof (rule bp_lazy_insert_bucket_markers_ge_hd
            [where bs = "c # cs" and p = p and M = M])
          show "0 < M"
            by (rule M_pos)
          show "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
            by (rule sorted_tail)
          show "bset (c # cs). qset (bp_bucket_entries b).
            bp_marker b  snd q"
            by (rule lower_tail)
          show "c # cs  []"
            by simp
          show "bp_marker (hd (c # cs))  snd p"
            using p_ge_c by simp
        qed
        have tail_ge_c:
          "dset (bp_lazy_insert_bucket M p (c # cs)).
            bp_marker c  bp_marker d"
          using tail_ge_hd by simp
        have tail_nonempty_result:
          "bp_lazy_insert_bucket M p (c # cs)  []"
          by (rule bp_lazy_insert_bucket_nonempty[OF M_pos])
        obtain d ds where tail_eq:
          "bp_lazy_insert_bucket M p (c # cs) = d # ds"
          using tail_nonempty_result
          by (cases "bp_lazy_insert_bucket M p (c # cs)") auto
        have c_le_d: "bp_marker c  bp_marker d"
          using tail_ge_c tail_eq by simp
        have head_boundary:
          "qset (bp_bucket_entries b). snd q  bp_marker d"
        proof
          fix q
          assume q: "q  set (bp_bucket_entries b)"
          have "snd q  bp_marker c"
            using boundaries Cons q by auto
          then show "snd q  bp_marker d"
            using c_le_d by linarith
        qed
        show ?thesis
          using Cons ¬ snd p < bp_marker b False tail_eq
            tail_boundaries head_boundary by simp
      qed
    qed
  qed
qed

lemma bp_lazy_insert_bucket_preserves_bucket_shape:
  assumes M_pos: "0 < M"
    and sizes: "bset bs. length (bp_bucket_entries b)  2 * M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and boundaries: "bp_bucket_boundaries_ok bs"
  shows "(bset (bp_lazy_insert_bucket M p bs).
      length (bp_bucket_entries b)  2 * M) 
    sorted_wrt (λb c. bp_marker b  bp_marker c)
      (bp_lazy_insert_bucket M p bs) 
    (bset (bp_lazy_insert_bucket M p bs).
      qset (bp_bucket_entries b). bp_marker b  snd q) 
    bp_bucket_boundaries_ok (bp_lazy_insert_bucket M p bs)"
  using bp_lazy_insert_bucket_sizes_ok[OF M_pos sizes, of p]
    bp_lazy_insert_bucket_markers_sorted
      [OF M_pos sorted lower boundaries, of p]
    bp_lazy_insert_bucket_markers_lower_bound[OF M_pos lower, of p]
    bp_lazy_insert_bucket_boundaries_ok
      [OF M_pos sorted lower boundaries, of p]
  by blast

lemma bp_local_insert_bucket_markers_ge_hd:
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and nonempty: "bs  []"
    and p_ge: "bp_marker (hd bs)  snd p"
  shows "bset (bp_local_insert_bucket M p bs).
    bp_marker (hd bs)  bp_marker b"
  using sorted lower nonempty p_ge
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by simp
next
  case (Cons b bs)
  note IH = Cons.IH
  note sorted = Cons.prems(1)
  note lower = Cons.prems(2)
  note p_ge = Cons.prems(4)
  show ?case
  proof (cases bs)
    case Nil
    have markers_ge:
      "cset (bp_bucketize_entries M (p # bp_bucket_entries b)).
        bp_marker b  bp_marker c"
    proof (rule bp_bucketize_entries_markers_ge)
      show "qset (p # bp_bucket_entries b). bp_marker b  snd q"
        using lower p_ge by auto
    qed
    show ?thesis
      using Nil p_ge markers_ge by auto
  next
    case (Cons c cs)
    have sorted_tail:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
      using sorted Cons by simp
    have lower_tail:
      "bset (c # cs). qset (bp_bucket_entries b).
        bp_marker b  snd q"
      using lower Cons by simp
    have b_le_c: "bp_marker b  bp_marker c"
      using sorted Cons by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using p_ge by simp
    next
      case False
      note not_before_b = False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have markers_ge:
          "dset (bp_bucketize_entries M (p # bp_bucket_entries b)).
            bp_marker b  bp_marker d"
        proof (rule bp_bucketize_entries_markers_ge)
          show "qset (p # bp_bucket_entries b). bp_marker b  snd q"
            using lower p_ge by auto
        qed
        have tail_ge:
          "dset (c # cs). bp_marker b  bp_marker d"
          using sorted Cons by auto
        show ?thesis
          using Cons False True markers_ge tail_ge by auto
      next
        case False
        have p_ge_c: "bp_marker c  snd p"
          using False by simp
        have tail_ge_c:
          "dset (bp_local_insert_bucket M p (c # cs)).
            bp_marker c  bp_marker d"
          using IH[of p] sorted_tail lower_tail p_ge_c Cons by auto
        show ?thesis
          using Cons False b_le_c tail_ge_c by auto
      qed
    qed
  qed
qed

lemma bp_local_insert_bucket_markers_sorted:
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and boundaries: "bp_bucket_boundaries_ok bs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_local_insert_bucket M p bs)"
  using sorted lower boundaries
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by (simp add: bp_bucketize_entries_markers_sorted[OF M_pos])
next
  case (Cons b bs)
  note IH = Cons.IH
  note sorted = Cons.prems(1)
  note lower = Cons.prems(2)
  note boundaries = Cons.prems(3)
  show ?case
  proof (cases bs)
    case Nil
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have left_sorted:
        "sorted_wrt (λb c. bp_marker b  bp_marker c)
          (bp_bucketize_entries M [p])"
        by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
      have left_le_b:
        "xset (bp_bucketize_entries M [p]).
          bp_marker x  bp_marker b"
      proof (rule bp_bucketize_entries_markers_le)
        show "qset [p]. snd q  bp_marker b"
          using True by simp
      qed
      show ?thesis
        using Nil True left_sorted left_le_b
        by (simp add: sorted_wrt_append)
    next
      case False
      show ?thesis
        using Nil False
        by (simp add: bp_bucketize_entries_markers_sorted[OF M_pos])
    qed
  next
    case (Cons c cs)
    have sorted_tail:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
      using sorted Cons by simp
    have lower_tail:
      "bset (c # cs). qset (bp_bucket_entries b).
        bp_marker b  snd q"
      using lower Cons by simp
    have boundaries_tail: "bp_bucket_boundaries_ok (c # cs)"
      using boundaries Cons by simp
    have b_le_c: "bp_marker b  bp_marker c"
      using sorted Cons by simp
    have b_le_all_tail:
      "dset (b # c # cs). bp_marker b  bp_marker d"
      using sorted Cons by auto
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have left_sorted:
        "sorted_wrt (λb c. bp_marker b  bp_marker c)
          (bp_bucketize_entries M [p])"
        by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
      have right_sorted:
        "sorted_wrt (λb c. bp_marker b  bp_marker c) (b # c # cs)"
        using sorted Cons by simp
      have left_le_b:
        "xset (bp_bucketize_entries M [p]).
          bp_marker x  bp_marker b"
      proof (rule bp_bucketize_entries_markers_le)
        show "qset [p]. snd q  bp_marker b"
          using True by simp
      qed
      have cross:
        "xset (bp_bucketize_entries M [p]).
          yset (b # c # cs). bp_marker x  bp_marker y"
        using left_le_b b_le_all_tail by force
      show ?thesis
        using Cons True left_sorted right_sorted cross
        by (simp add: sorted_wrt_append)
    next
      case False
      note not_before_b = False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have left_sorted:
          "sorted_wrt (λb c. bp_marker b  bp_marker c)
            (bp_bucketize_entries M (p # bp_bucket_entries b))"
          by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
        have left_le_c:
          "xset (bp_bucketize_entries M (p # bp_bucket_entries b)).
            bp_marker x  bp_marker c"
        proof (rule bp_bucketize_entries_markers_le)
          show "qset (p # bp_bucket_entries b). snd q  bp_marker c"
            using boundaries Cons True by auto
        qed
        have c_le_all:
          "dset (c # cs). bp_marker c  bp_marker d"
          using sorted_tail by auto
        have cross:
          "xset (bp_bucketize_entries M (p # bp_bucket_entries b)).
            yset (c # cs). bp_marker x  bp_marker y"
          using left_le_c c_le_all by force
        show ?thesis
          using Cons False True left_sorted sorted_tail cross
          by (simp add: sorted_wrt_append)
      next
        case False
        have p_ge_c: "bp_marker c  snd p"
          using False by simp
        have p_ge_hd: "bp_marker (hd (c # cs))  snd p"
          using p_ge_c by simp
        have tail_nonempty: "c # cs  []"
          by simp
        have tail_sorted_result:
          "sorted_wrt (λb c. bp_marker b  bp_marker c)
            (bp_local_insert_bucket M p (c # cs))"
          using IH[of p] sorted_tail lower_tail boundaries_tail Cons by auto
        have tail_ge_hd:
          "dset (bp_local_insert_bucket M p (c # cs)).
            bp_marker (hd (c # cs))  bp_marker d"
          by (rule bp_local_insert_bucket_markers_ge_hd
              [where bs = "c # cs" and p = p and M = M,
                OF M_pos sorted_tail lower_tail tail_nonempty p_ge_hd])
        have tail_ge_c:
          "dset (bp_local_insert_bucket M p (c # cs)).
            bp_marker c  bp_marker d"
          using tail_ge_hd by simp
        have tail_ge_b:
          "dset (bp_local_insert_bucket M p (c # cs)).
            bp_marker b  bp_marker d"
          using b_le_c tail_ge_c by force
        show ?thesis
          using Cons not_before_b False tail_sorted_result tail_ge_b by simp
      qed
    qed
  qed
qed

lemma bp_local_insert_bucket_boundaries_ok:
  assumes M_pos: "0 < M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and boundaries: "bp_bucket_boundaries_ok bs"
  shows "bp_bucket_boundaries_ok (bp_local_insert_bucket M p bs)"
  using sorted lower boundaries
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    by (simp add: bp_bucketize_entries_boundaries_ok[OF M_pos])
next
  case (Cons b bs)
  note IH = Cons.IH
  note sorted = Cons.prems(1)
  note lower = Cons.prems(2)
  note boundaries = Cons.prems(3)
  show ?case
  proof (cases bs)
    case Nil
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have tail: "bp_bucket_boundaries_ok [b]"
        by simp
      have upper: "qset [p]. snd q  bp_marker b"
        using True by simp
      show ?thesis
        using Nil True
        by (simp add: bp_bucket_boundaries_ok_bucketize_append_Cons
            [OF M_pos tail upper])
    next
      case False
      show ?thesis
        using Nil False by (simp add: bp_bucketize_entries_boundaries_ok[OF M_pos])
    qed
  next
    case (Cons c cs)
    have sorted_tail:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
      using sorted Cons by simp
    have lower_tail:
      "bset (c # cs). qset (bp_bucket_entries b).
        bp_marker b  snd q"
      using lower Cons by simp
    have boundaries_tail: "bp_bucket_boundaries_ok (c # cs)"
      using boundaries Cons by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have tail_all: "bp_bucket_boundaries_ok (b # c # cs)"
        using boundaries Cons by simp
      have upper: "qset [p]. snd q  bp_marker b"
        using True by simp
      show ?thesis
        using Cons True
        by (simp add: bp_bucket_boundaries_ok_bucketize_append_Cons
            [where c = b and bs = "c # cs" and xs = "[p]",
              OF M_pos tail_all upper])
    next
      case False
      note not_before_b = False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have upper:
          "qset (p # bp_bucket_entries b). snd q  bp_marker c"
          using boundaries Cons True by auto
        show ?thesis
          using Cons not_before_b True
          by (simp add: bp_bucket_boundaries_ok_bucketize_append_Cons
              [OF M_pos boundaries_tail upper])
      next
        case False
        have p_ge_c: "bp_marker c  snd p"
          using False by simp
        have p_ge_hd: "bp_marker (hd (c # cs))  snd p"
          using p_ge_c by simp
        have tail_nonempty: "c # cs  []"
          by simp
        have tail_boundaries:
          "bp_bucket_boundaries_ok (bp_local_insert_bucket M p (c # cs))"
          using IH[of p] sorted_tail lower_tail boundaries_tail Cons by auto
        have tail_ge_hd:
          "dset (bp_local_insert_bucket M p (c # cs)).
            bp_marker (hd (c # cs))  bp_marker d"
          by (rule bp_local_insert_bucket_markers_ge_hd
              [where bs = "c # cs" and p = p and M = M,
                OF M_pos sorted_tail lower_tail tail_nonempty p_ge_hd])
        have tail_nonempty_result:
          "bp_local_insert_bucket M p (c # cs)  []"
          by (rule bp_local_insert_bucket_nonempty[OF M_pos])
        obtain d ds where tail_eq:
          "bp_local_insert_bucket M p (c # cs) = d # ds"
          using tail_nonempty_result by (cases "bp_local_insert_bucket M p (c # cs)") auto
        have c_le_d: "bp_marker c  bp_marker d"
          using tail_ge_hd tail_eq by simp
        have head_boundary:
          "qset (bp_bucket_entries b). snd q  bp_marker d"
        proof
          fix q
          assume q: "q  set (bp_bucket_entries b)"
          have "snd q  bp_marker c"
            using boundaries Cons q by auto
          then show "snd q  bp_marker d"
            using c_le_d by linarith
        qed
        show ?thesis
          using Cons not_before_b False tail_eq tail_boundaries head_boundary by simp
      qed
    qed
  qed
qed

lemma bp_local_insert_bucket_preserves_bucket_shape:
  assumes M_pos: "0 < M"
    and sizes: "bset bs. length (bp_bucket_entries b)  M"
    and sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and lower: "bset bs. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    and boundaries: "bp_bucket_boundaries_ok bs"
  shows "(bset (bp_local_insert_bucket M p bs).
      length (bp_bucket_entries b)  M) 
    sorted_wrt (λb c. bp_marker b  bp_marker c)
      (bp_local_insert_bucket M p bs) 
    (bset (bp_local_insert_bucket M p bs).
      qset (bp_bucket_entries b). bp_marker b  snd q) 
    bp_bucket_boundaries_ok (bp_local_insert_bucket M p bs)"
  using bp_local_insert_bucket_sizes_ok[OF M_pos sizes, of p]
    bp_local_insert_bucket_markers_sorted[OF M_pos sorted lower boundaries, of p]
    bp_local_insert_bucket_markers_lower_bound[OF M_pos lower, of p]
    bp_local_insert_bucket_boundaries_ok[OF M_pos sorted lower boundaries, of p]
  by blast

text ‹
  The local-insert proof is deliberately split into many list-level lemmas
  because each invariant component has a different reason for being preserved.
  Size preservation depends on re-chunking only the affected bucket.  Marker
  ordering depends on inserting into the unique marker interval selected by the
  value of the new entry.  Boundary preservation depends on the fact that every
  entry of the previous bucket remains below the next bucket marker.  The
  bundled lemma @{thm bp_local_insert_bucket_preserves_bucket_shape} is the
  high-level summary used by the state-level Insert proof.
›

lemma length_bp_bucket_entries_flat_bucketize_entries [simp]:
  assumes "0 < M"
  shows "length (bp_bucket_entries_flat (bp_bucketize_entries M xs)) =
    length xs"
  using bp_bucket_entries_flat_bucketize_entries[OF assms, of xs] by simp

lemma length_bp_bucketize_sorted_entries_aux_le_ratio:
  assumes M_pos: "0 < M"
    and fuel: "length xs  fuel"
  shows "length (bp_bucketize_sorted_entries_aux fuel M xs) 
    Suc (length xs div M)"
  using M_pos fuel
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by simp
next
  case (Suc fuel)
  show ?case
  proof (cases "xs = []")
    case True
    then show ?thesis
      by simp
  next
    case False
    show ?thesis
    proof (cases "length xs < M")
      case True
      then have "drop M xs = []"
        by simp
      then show ?thesis
        using Suc.prems False True by simp
    next
      case False
      have M_le: "M  length xs"
        using False by simp
      have len_drop: "length (drop M xs)  fuel"
        using Suc.prems False by simp
      have tail:
        "length (bp_bucketize_sorted_entries_aux fuel M (drop M xs)) 
          Suc (length (drop M xs) div M)"
        by (rule Suc.IH[OF Suc.prems(1) len_drop])
      have len_xs:
        "length xs = M + length (drop M xs)"
        using M_le by simp
      have div_eq:
        "length xs div M = Suc (length (drop M xs) div M)"
      proof -
        have "length xs div M = (M + length (drop M xs)) div M"
          using len_xs by simp
        also have " = length (drop M xs) div M + 1"
          using Suc.prems(1) by (simp add: div_add_self1)
        finally show ?thesis
          by simp
      qed
      show ?thesis
        using Suc.prems False tail div_eq by simp
    qed
  qed
qed

lemma length_bp_bucketize_sorted_entries_le_ratio:
  assumes "0 < M"
  shows "length (bp_bucketize_sorted_entries M xs) 
    Suc (length xs div M)"
  unfolding bp_bucketize_sorted_entries_def
  by (rule length_bp_bucketize_sorted_entries_aux_le_ratio[OF assms]) simp

lemma length_bp_bucketize_entries_le_ratio:
  assumes "0 < M"
  shows "length (bp_bucketize_entries M xs) 
    Suc (length xs div M)"
  unfolding bp_bucketize_entries_def
  using length_bp_bucketize_sorted_entries_le_ratio[OF assms, of "sort_key snd xs"]
  by simp

lemma length_bp_bucketize_entries_singleton [simp]:
  assumes "0 < M"
  shows "length (bp_bucketize_entries M [p]) = 1"
  using assms
  unfolding bp_bucketize_entries_def bp_bucketize_sorted_entries_def
  by (cases M) simp_all

lemma length_bp_bucketize_sorted_entries_aux_le_length:
  assumes M_pos: "0 < M"
    and fuel: "length xs  fuel"
  shows "length (bp_bucketize_sorted_entries_aux fuel M xs) 
    length xs"
  using M_pos fuel
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by simp
next
  case (Suc fuel)
  show ?case
  proof (cases "xs = []")
    case True
    then show ?thesis by simp
  next
    case False
    have len_drop: "length (drop M xs)  fuel"
      using Suc.prems False by (cases M) auto
    have tail:
      "length (bp_bucketize_sorted_entries_aux fuel M (drop M xs)) 
        length (drop M xs)"
      by (rule Suc.IH[OF Suc.prems(1) len_drop])
    have drop_less: "length (drop M xs) < length xs"
      using Suc.prems False by simp
    have drop_le: "Suc (length (drop M xs))  length xs"
      using drop_less by simp
    have unfold:
      "length (bp_bucketize_sorted_entries_aux (Suc fuel) M xs) =
        Suc (length (bp_bucketize_sorted_entries_aux fuel M (drop M xs)))"
      using Suc.prems False by simp
    show ?thesis
      using tail drop_le unfolding unfold by simp
  qed
qed

lemma length_bp_bucketize_entries_le_length:
  assumes "0 < M"
  shows "length (bp_bucketize_entries M xs)  length xs"
  unfolding bp_bucketize_entries_def bp_bucketize_sorted_entries_def
  using length_bp_bucketize_sorted_entries_aux_le_length
    [OF assms, of "sort_key snd xs" "length xs"]
  by simp

lemma length_bp_bucketize_entries_le_three:
  assumes M_pos: "0 < M"
    and len: "length xs  Suc (2 * M)"
  shows "length (bp_bucketize_entries M xs)  3"
proof (cases "M = 1")
  case True
  have "length (bp_bucketize_entries M xs)  length xs"
    by (rule length_bp_bucketize_entries_le_length[OF M_pos])
  also have "  3"
    using len True by simp
  finally show ?thesis .
next
  case False
  have M_ge2: "2  M"
    using M_pos False by simp
  have div_bound: "length xs div M  2"
  proof -
    have "length xs div M  Suc (2 * M) div M"
      by (rule div_le_mono[OF len])
    moreover have "Suc (2 * M) div M < 3"
    proof -
      have "Suc (2 * M) < 3 * M"
        using M_ge2 by simp
      then show ?thesis
        using M_pos by (simp add: div_less_iff_less_mult)
    qed
    ultimately show ?thesis
      by simp
  qed
  have "length (bp_bucketize_entries M xs)  Suc (length xs div M)"
    by (rule length_bp_bucketize_entries_le_ratio[OF M_pos])
  also have "  3"
    using div_bound by simp
  finally show ?thesis .
qed

lemma length_bp_lazy_bucket_insert_entries_le_three:
  assumes M_pos: "0 < M"
    and size: "length (bp_bucket_entries b)  2 * M"
  shows "length (bp_lazy_bucket_insert_entries M p b)  3"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  then show ?thesis
    unfolding bp_lazy_bucket_insert_entries_def by simp
next
  case False
  have len: "length (p # bp_bucket_entries b)  Suc (2 * M)"
    using size by simp
  show ?thesis
    using False length_bp_bucketize_entries_le_three[OF M_pos len]
    unfolding bp_lazy_bucket_insert_entries_def by simp
qed

lemma length_bp_lazy_insert_bucket_le:
  assumes M_pos: "0 < M"
    and sizes: "bset bs. length (bp_bucket_entries b)  2 * M"
  shows "length (bp_lazy_insert_bucket M p bs)  length bs + 2"
  using sizes
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    using length_bp_bucketize_entries_singleton[OF M_pos, of p] by simp
next
  case (Cons b bs)
  note IH = Cons.IH
  note sizes = Cons.prems
  have b_size: "length (bp_bucket_entries b)  2 * M"
    using sizes by simp
  show ?case
  proof (cases bs)
    case Nil
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using Nil length_bp_bucketize_entries_singleton[OF M_pos, of p]
        by simp
    next
      case False
      have "length (bp_lazy_bucket_insert_entries M p b)  3"
        by (rule length_bp_lazy_bucket_insert_entries_le_three
            [OF M_pos b_size])
      then show ?thesis
        using Nil False by simp
    qed
  next
    case (Cons c cs)
    have tail_sizes:
      "bset bs. length (bp_bucket_entries b)  2 * M"
      using sizes by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using Cons length_bp_bucketize_entries_singleton[OF M_pos, of p]
        by simp
    next
      case False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have "length (bp_lazy_bucket_insert_entries M p b)  3"
          by (rule length_bp_lazy_bucket_insert_entries_le_three
              [OF M_pos b_size])
        then show ?thesis
          using Cons False True by simp
      next
        case False
        have tail:
          "length (bp_lazy_insert_bucket M p bs)  length bs + 2"
          by (rule IH[OF tail_sizes])
        show ?thesis
          using Cons ¬ snd p < bp_marker b False tail by simp
      qed
    qed
  qed
qed

lemma length_bp_bucket_entries_flat_local_insert_bucket [simp]:
  assumes "0 < M"
  shows "length (bp_bucket_entries_flat (bp_local_insert_bucket M p bs)) =
    Suc (length (bp_bucket_entries_flat bs))"
  using assms
proof (induction bs arbitrary: p)
  case Nil
  have len:
    "length (bp_bucket_entries_flat (bp_bucketize_entries M [p])) =
      length [p]"
    by (rule length_bp_bucket_entries_flat_bucketize_entries[OF Nil.prems])
  show ?case
    using len by (simp add: bp_bucket_entries_flat_def)
next
  case (Cons b bs)
  then show ?case
  proof (cases bs)
    case Nil
    have len_single:
      "length (bp_bucket_entries_flat (bp_bucketize_entries M [p])) =
        length [p]"
      by (rule length_bp_bucket_entries_flat_bucketize_entries[OF Cons.prems])
    have len_inserted:
      "length
        (bp_bucket_entries_flat
          (bp_bucketize_entries M (p # bp_bucket_entries b))) =
       length (p # bp_bucket_entries b)"
      by (rule length_bp_bucket_entries_flat_bucketize_entries[OF Cons.prems])
    then show ?thesis
      using Nil len_single len_inserted
      by (auto simp: bp_bucket_entries_flat_def)
  next
    case (Cons c cs)
    have len_single:
      "length (bp_bucket_entries_flat (bp_bucketize_entries M [p])) =
        length [p]"
      by (rule length_bp_bucket_entries_flat_bucketize_entries[OF Cons.prems])
    have len_inserted:
      "length
        (bp_bucket_entries_flat
          (bp_bucketize_entries M (p # bp_bucket_entries b))) =
       length (p # bp_bucket_entries b)"
      by (rule length_bp_bucket_entries_flat_bucketize_entries[OF Cons.prems])
    have tail_len:
      "length (bp_bucket_entries_flat
          (bp_local_insert_bucket M p (c # cs))) =
       Suc (length (bp_bucket_entries_flat (c # cs)))"
      using Cons.IH[OF Cons.prems, of p] Cons by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      then show ?thesis
        using Cons len_single by (simp add: bp_bucket_entries_flat_def)
    next
      case False
      note not_before_b = False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        then show ?thesis
          using Cons not_before_b len_inserted
          by (simp add: bp_bucket_entries_flat_def)
      next
        case False
        then show ?thesis
          using Cons not_before_b tail_len
          by (simp add: bp_bucket_entries_flat_def)
      qed
    qed
  qed
qed

lemma bp_local_insert_bucket_distinct_keys:
  assumes M_pos: "0 < M"
    and distinct: "distinct (map fst (bp_bucket_entries_flat bs))"
    and fresh: "fst p  bp_entry_keys (bp_bucket_entries_flat bs)"
  shows "distinct
    (map fst (bp_bucket_entries_flat (bp_local_insert_bucket M p bs)))"
proof (rule card_distinct)
  let ?old = "map fst (bp_bucket_entries_flat bs)"
  let ?new =
    "map fst (bp_bucket_entries_flat (bp_local_insert_bucket M p bs))"
  have set_new: "set ?new = insert (fst p) (set ?old)"
    using set_bp_bucket_entries_flat_local_insert_bucket[OF M_pos, of p bs]
    by auto
  have fresh_set: "fst p  set ?old"
    using fresh unfolding bp_entry_keys_def by simp
  have "card (set ?new) = Suc (card (set ?old))"
    unfolding set_new using fresh_set by simp
  also have " = Suc (length ?old)"
    using distinct_card[OF distinct] by simp
  also have " = length ?new"
    using length_bp_bucket_entries_flat_local_insert_bucket[OF M_pos, of p bs]
    by simp
  finally show "card (set ?new) = length ?new" .
qed

lemma bp_local_insert_bucket_values_consistent:
  assumes M_pos: "0 < M"
    and vals: "qset (bp_bucket_entries_flat bs). f (fst q) = snd q"
    and fresh: "fst p  bp_entry_keys (bp_bucket_entries_flat bs)"
  shows "qset (bp_bucket_entries_flat (bp_local_insert_bucket M p bs)).
    (f(fst p := snd p)) (fst q) = snd q"
proof
  fix q
  assume q: "q 
    set (bp_bucket_entries_flat (bp_local_insert_bucket M p bs))"
  then have q_cases: "q = p  q  set (bp_bucket_entries_flat bs)"
    using set_bp_bucket_entries_flat_local_insert_bucket[OF M_pos, of p bs]
    by auto
  from q_cases show "(f(fst p := snd p)) (fst q) = snd q"
  proof
    assume "q = p"
    then show ?thesis by simp
  next
    assume q_old: "q  set (bp_bucket_entries_flat bs)"
    have "fst q  bp_entry_keys (bp_bucket_entries_flat bs)"
      using q_old unfolding bp_entry_keys_def by auto
    then have "fst q  fst p"
      using fresh by auto
    moreover have "f (fst q) = snd q"
      using vals q_old by blast
    ultimately show ?thesis
      by simp
  qed
qed

lemma bp_empty_invariant:
  assumes "0 < M"
  shows "bp_invariant (bp_empty M B)"
  using assms
  unfolding bp_invariant_def bp_empty_def bp_entries_def
    bp_bucket_entries_flat_def bp_bucket_sizes_ok_def
    bp_bucket_markers_sorted_def bp_bucket_markers_lower_bound_def
    bp_values_consistent_def bp_distinct_keys_def
  by simp

lemma bp_empty_boundaries_state_ok [simp]:
  "bp_bucket_boundaries_state_ok (bp_empty M B)"
  unfolding bp_bucket_boundaries_state_ok_def bp_empty_def by simp

lemma bp_empty_ordered_invariant:
  assumes "0 < M"
  shows "bp_ordered_invariant (bp_empty M B)"
  unfolding bp_ordered_invariant_def
  using bp_empty_invariant[OF assms] by simp

lemma bp_empty_view [simp]:
  "bp_view (bp_empty M B) = keys_of = {}, value_of = (λ_. B)"
  unfolding bp_view_def bp_empty_def bp_entries_def
    bp_bucket_entries_flat_def bp_entry_keys_def
  by simp

lemma bp_empty_partition_upper_bound [simp]:
  "partition_upper_bound (bp_view (bp_empty M B0)) B"
  unfolding partition_upper_bound_def by simp

lemma set_bp_insert_bucket:
  "set (bp_insert_bucket p bs) = insert (bp_singleton_bucket p) (set bs)"
  by (induction bs) auto

lemma set_bp_bucket_entries_flat_insert_bucket:
  "set (bp_bucket_entries_flat (bp_insert_bucket p bs)) =
     insert p (set (bp_bucket_entries_flat bs))"
  unfolding bp_bucket_entries_flat_def
  by (induction bs) auto

lemma length_bp_bucket_entries_flat_insert_bucket [simp]:
  "length (bp_bucket_entries_flat (bp_insert_bucket p bs)) =
     Suc (length (bp_bucket_entries_flat bs))"
  unfolding bp_bucket_entries_flat_def
  by (induction bs) auto

lemma bp_entry_keys_insert_bucket [simp]:
  "bp_entry_keys (bp_bucket_entries_flat (bp_insert_bucket p bs)) =
     insert (fst p) (bp_entry_keys (bp_bucket_entries_flat bs))"
  unfolding bp_entry_keys_def
  using set_bp_bucket_entries_flat_insert_bucket[of p bs] by auto

lemma bp_insert_bucket_sizes_ok:
  assumes "bset bs. length (bp_bucket_entries b)  M"
    and "0 < M"
  shows "bset (bp_insert_bucket p bs).
    length (bp_bucket_entries b)  M"
  using assms unfolding bp_singleton_bucket_def
  by (induction bs) auto

lemma bp_insert_bucket_markers_sorted:
  assumes "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_insert_bucket p bs)"
  using assms
proof (induction bs)
  case Nil
  then show ?case
    unfolding bp_singleton_bucket_def by simp
next
  case (Cons b bs)
  show ?case
  proof (cases "snd p  bp_marker b")
    case True
    then show ?thesis
      using Cons.prems by auto
  next
    case False
    have tail_sorted:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
      using Cons.prems by simp
    have inserted_sorted:
      "sorted_wrt (λb c. bp_marker b  bp_marker c)
        (bp_insert_bucket p bs)"
      by (rule Cons.IH[OF tail_sorted])
    have lower:
      "c. c  set (bp_insert_bucket p bs) 
        bp_marker b  bp_marker c"
      using Cons.prems False
      by (auto simp: set_bp_insert_bucket bp_singleton_bucket_def)
    show ?thesis
      using False inserted_sorted lower by simp
  qed
qed

lemma bp_insert_bucket_markers_lower_bound:
  assumes "bset bs. pset (bp_bucket_entries b).
      bp_marker b  snd p"
  shows "bset (bp_insert_bucket p bs). pset (bp_bucket_entries b).
      bp_marker b  snd p"
  using assms
  by (induction bs) auto

lemma bp_insert_bucket_values_consistent:
  assumes "qset (bp_bucket_entries_flat bs). f (fst q) = snd q"
    and "fst p  bp_entry_keys (bp_bucket_entries_flat bs)"
  shows "qset (bp_bucket_entries_flat (bp_insert_bucket p bs)).
    (f(fst p := snd p)) (fst q) = snd q"
proof
  fix q
  assume q: "q  set (bp_bucket_entries_flat (bp_insert_bucket p bs))"
  then have q_cases: "q = p  q  set (bp_bucket_entries_flat bs)"
    using set_bp_bucket_entries_flat_insert_bucket[of p bs] by auto
  from q_cases show "(f(fst p := snd p)) (fst q) = snd q"
  proof
    assume "q = p"
    then show ?thesis by simp
  next
    assume q_old: "q  set (bp_bucket_entries_flat bs)"
    have "fst q  bp_entry_keys (bp_bucket_entries_flat bs)"
      using q_old unfolding bp_entry_keys_def by auto
    then have "fst q  fst p"
      using assms(2) by auto
    moreover have "f (fst q) = snd q"
      using assms(1) q_old by blast
    ultimately show ?thesis
      by simp
  qed
qed

lemma bp_insert_bucket_distinct_keys:
  assumes distinct: "distinct (map fst (bp_bucket_entries_flat bs))"
    and fresh: "fst p  bp_entry_keys (bp_bucket_entries_flat bs)"
  shows "distinct (map fst (bp_bucket_entries_flat (bp_insert_bucket p bs)))"
proof (rule card_distinct)
  let ?old = "map fst (bp_bucket_entries_flat bs)"
  let ?new = "map fst (bp_bucket_entries_flat (bp_insert_bucket p bs))"
  have set_new: "set ?new = insert (fst p) (set ?old)"
    using set_bp_bucket_entries_flat_insert_bucket[of p bs] by auto
  have fresh_set: "fst p  set ?old"
    using fresh unfolding bp_entry_keys_def by simp
  have "card (set ?new) = Suc (card (set ?old))"
    unfolding set_new using fresh_set by simp
  also have " = Suc (length ?old)"
    using distinct_card[OF distinct] by simp
  also have " = length ?new"
    by simp
  finally show "card (set ?new) = length ?new" .
qed

lemma distinct_map_fst_filter_neq:
  assumes "distinct (map fst xs)"
  shows "distinct (map fst (filter (λp. fst p  x) xs))"
  using assms by (induction xs) auto

lemma distinct_map_fst_filter_notin:
  assumes "distinct (map fst xs)"
  shows "distinct (map fst (filter (λp. fst p  S) xs))"
  using assms by (induction xs) auto

lemma bp_bucket_entries_flat_delete_key:
  "bp_bucket_entries_flat (map (bp_delete_key_from_bucket x) bs) =
     filter (λp. fst p  x) (bp_bucket_entries_flat bs)"
  unfolding bp_bucket_entries_flat_def bp_delete_key_from_bucket_def
  by (induction bs) simp_all

lemma bp_bucket_entries_flat_delete_keys:
  "bp_bucket_entries_flat (map (bp_delete_keys_from_bucket S) bs) =
     filter (λp. fst p  S) (bp_bucket_entries_flat bs)"
  unfolding bp_bucket_entries_flat_def bp_delete_keys_from_bucket_def
  by (induction bs) simp_all

lemma bp_entries_delete_key:
  "bp_entries (bp_delete_key x P) =
     filter (λp. fst p  x) (bp_entries P)"
  unfolding bp_entries_def bp_delete_key_def
  by (simp add: bp_bucket_entries_flat_delete_key)

lemma bp_entries_delete_keys:
  "bp_entries (bp_delete_keys S P) =
     filter (λp. fst p  S) (bp_entries P)"
  unfolding bp_entries_def bp_delete_keys_def
  by (simp add: bp_bucket_entries_flat_delete_keys)

lemma length_filter_fst_neq_ge_pred:
  assumes distinct: "distinct (map fst xs)"
  shows "length xs  Suc (length (filter (λp. fst p  x) xs))"
  using distinct
proof (induction xs)
  case Nil
  then show ?case by simp
next
  case (Cons p xs)
  show ?case
  proof (cases "fst p = x")
    case True
    have "fst p  fst ` set xs"
      using Cons.prems by simp
    have "qset xs. fst q  x"
    proof
      fix q
      assume "q  set xs"
      then have "fst q  fst ` set xs"
        by blast
      have "fst q  fst p"
      proof
        assume "fst q = fst p"
        then have "fst p  fst ` set xs"
          using fst q  fst ` set xs by simp
        then show False
          using fst p  fst ` set xs by simp
      qed
      then show "fst q  x"
        using True by simp
    qed
    then have "filter (λp. fst p  x) xs = xs"
      by (simp add: filter_id_conv)
    then show ?thesis
      using True by simp
  next
    case False
    have tail: "length xs  Suc (length (filter (λp. fst p  x) xs))"
      by (rule Cons.IH) (use Cons.prems in simp)
    show ?thesis
      using False tail by simp
  qed
qed

lemma length_bp_entries_delete_key_ge_pred:
  assumes "bp_distinct_keys P"
  shows "length (bp_entries P) 
    Suc (length (bp_entries (bp_delete_key x P)))"
  using length_filter_fst_neq_ge_pred
    [of "bp_entries P" x] assms
  unfolding bp_entries_delete_key bp_distinct_keys_def by simp

lemma bp_entry_keys_delete_key [simp]:
  "bp_entry_keys (bp_entries (bp_delete_key x P)) =
     bp_entry_keys (bp_entries P) - {x}"
  by (simp add: bp_entries_delete_key)

lemma bp_entry_keys_delete_keys [simp]:
  "bp_entry_keys (bp_entries (bp_delete_keys S P)) =
     bp_entry_keys (bp_entries P) - S"
  by (simp add: bp_entries_delete_keys)

lemma bp_values_delete_key [simp]:
  "bp_values (bp_delete_key x P) = bp_values P"
  unfolding bp_delete_key_def by simp

lemma bp_values_delete_keys [simp]:
  "bp_values (bp_delete_keys S P) = bp_values P"
  unfolding bp_delete_keys_def by simp

lemma bp_delete_key_markers_sorted_list:
  assumes "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (map (bp_delete_key_from_bucket x) bs)"
  using assms unfolding bp_delete_key_from_bucket_def
  by (induction bs) auto

lemma bp_delete_keys_markers_sorted_list:
  assumes "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (map (bp_delete_keys_from_bucket S) bs)"
  using assms unfolding bp_delete_keys_from_bucket_def
  by (induction bs) auto

lemma bp_delete_key_markers_sorted:
  assumes "bp_bucket_markers_sorted P"
  shows "bp_bucket_markers_sorted (bp_delete_key x P)"
  using assms
  unfolding bp_bucket_markers_sorted_def bp_delete_key_def
    bp_delete_key_from_bucket_def
  by (simp add: bp_delete_key_markers_sorted_list
      [unfolded bp_delete_key_from_bucket_def])

lemma bp_delete_keys_markers_sorted:
  assumes "bp_bucket_markers_sorted P"
  shows "bp_bucket_markers_sorted (bp_delete_keys S P)"
  using assms
  unfolding bp_bucket_markers_sorted_def bp_delete_keys_def
    bp_delete_keys_from_bucket_def
  by (simp add: bp_delete_keys_markers_sorted_list
      [unfolded bp_delete_keys_from_bucket_def])

lemma bp_delete_key_bucket_sizes_ok:
  assumes "bp_bucket_sizes_ok P"
  shows "bp_bucket_sizes_ok (bp_delete_key x P)"
  unfolding bp_bucket_sizes_ok_def
proof
  fix b
  assume b: "b  set (bp_buckets (bp_delete_key x P))"
  then obtain b0 where b0: "b0  set (bp_buckets P)"
    and b_def: "b = bp_delete_key_from_bucket x b0"
    unfolding bp_delete_key_def by auto
  have "length (bp_bucket_entries b)  length (bp_bucket_entries b0)"
    unfolding b_def bp_delete_key_from_bucket_def by simp
  also have "  bp_block_size P"
    using assms b0 unfolding bp_bucket_sizes_ok_def by blast
  finally show "length (bp_bucket_entries b) 
    bp_block_size (bp_delete_key x P)"
    unfolding bp_delete_key_def by simp
qed

lemma bp_delete_keys_bucket_sizes_ok:
  assumes "bp_bucket_sizes_ok P"
  shows "bp_bucket_sizes_ok (bp_delete_keys S P)"
  unfolding bp_bucket_sizes_ok_def
proof
  fix b
  assume b: "b  set (bp_buckets (bp_delete_keys S P))"
  then obtain b0 where b0: "b0  set (bp_buckets P)"
    and b_def: "b = bp_delete_keys_from_bucket S b0"
    unfolding bp_delete_keys_def by auto
  have "length (bp_bucket_entries b)  length (bp_bucket_entries b0)"
    unfolding b_def bp_delete_keys_from_bucket_def by simp
  also have "  bp_block_size P"
    using assms b0 unfolding bp_bucket_sizes_ok_def by blast
  finally show "length (bp_bucket_entries b) 
    bp_block_size (bp_delete_keys S P)"
    unfolding bp_delete_keys_def by simp
qed

lemma bp_delete_key_lazy_bucket_sizes_ok:
  assumes "bp_lazy_bucket_sizes_ok P"
  shows "bp_lazy_bucket_sizes_ok (bp_delete_key x P)"
  unfolding bp_lazy_bucket_sizes_ok_def
proof
  fix b
  assume b: "b  set (bp_buckets (bp_delete_key x P))"
  then obtain b0 where b0: "b0  set (bp_buckets P)"
    and b_def: "b = bp_delete_key_from_bucket x b0"
    unfolding bp_delete_key_def by auto
  have "length (bp_bucket_entries b)  length (bp_bucket_entries b0)"
    unfolding b_def bp_delete_key_from_bucket_def by simp
  also have "  2 * bp_block_size P"
    using assms b0 unfolding bp_lazy_bucket_sizes_ok_def by blast
  finally show "length (bp_bucket_entries b) 
    2 * bp_block_size (bp_delete_key x P)"
    unfolding bp_delete_key_def by simp
qed

lemma bp_delete_keys_lazy_bucket_sizes_ok:
  assumes "bp_lazy_bucket_sizes_ok P"
  shows "bp_lazy_bucket_sizes_ok (bp_delete_keys S P)"
  unfolding bp_lazy_bucket_sizes_ok_def
proof
  fix b
  assume b: "b  set (bp_buckets (bp_delete_keys S P))"
  then obtain b0 where b0: "b0  set (bp_buckets P)"
    and b_def: "b = bp_delete_keys_from_bucket S b0"
    unfolding bp_delete_keys_def by auto
  have "length (bp_bucket_entries b)  length (bp_bucket_entries b0)"
    unfolding b_def bp_delete_keys_from_bucket_def by simp
  also have "  2 * bp_block_size P"
    using assms b0 unfolding bp_lazy_bucket_sizes_ok_def by blast
  finally show "length (bp_bucket_entries b) 
    2 * bp_block_size (bp_delete_keys S P)"
    unfolding bp_delete_keys_def by simp
qed

lemma bp_delete_key_markers_lower_bound:
  assumes "bp_bucket_markers_lower_bound P"
  shows "bp_bucket_markers_lower_bound (bp_delete_key x P)"
  using assms
  unfolding bp_bucket_markers_lower_bound_def bp_delete_key_def
    bp_delete_key_from_bucket_def
  by auto

lemma bp_delete_keys_markers_lower_bound:
  assumes "bp_bucket_markers_lower_bound P"
  shows "bp_bucket_markers_lower_bound (bp_delete_keys S P)"
  using assms
  unfolding bp_bucket_markers_lower_bound_def bp_delete_keys_def
    bp_delete_keys_from_bucket_def
  by auto

lemma bp_delete_key_values_consistent:
  assumes "bp_values_consistent P"
  shows "bp_values_consistent (bp_delete_key x P)"
  using assms
  unfolding bp_values_consistent_def
  by (auto simp: bp_entries_delete_key)

lemma bp_delete_keys_values_consistent:
  assumes "bp_values_consistent P"
  shows "bp_values_consistent (bp_delete_keys S P)"
  using assms
  unfolding bp_values_consistent_def
  by (auto simp: bp_entries_delete_keys)

lemma bp_delete_key_distinct_keys:
  assumes "bp_distinct_keys P"
  shows "bp_distinct_keys (bp_delete_key x P)"
  using assms
  unfolding bp_distinct_keys_def
  by (simp add: bp_entries_delete_key distinct_map_fst_filter_neq)

lemma bp_delete_keys_distinct_keys:
  assumes "bp_distinct_keys P"
  shows "bp_distinct_keys (bp_delete_keys S P)"
  using assms
  unfolding bp_distinct_keys_def
  by (simp add: bp_entries_delete_keys distinct_map_fst_filter_notin)

lemma bp_bucket_boundaries_ok_delete_key_from_bucket:
  assumes "bp_bucket_boundaries_ok bs"
  shows "bp_bucket_boundaries_ok (map (bp_delete_key_from_bucket x) bs)"
  using assms
proof (induction bs)
  case Nil
  then show ?case
    by simp
next
  case (Cons b bs)
  then show ?case
  proof (cases bs)
    case Nil
    then show ?thesis
      by simp
  next
    case (Cons c cs)
    have head:
      "pset (bp_bucket_entries b). snd p  bp_marker c"
      using Cons.prems Cons by simp
    have tail: "bp_bucket_boundaries_ok
      (map (bp_delete_key_from_bucket x) (c # cs))"
      using Cons.IH Cons.prems Cons by simp
    show ?thesis
      using Cons head tail
      unfolding bp_delete_key_from_bucket_def by auto
  qed
qed

lemma bp_bucket_boundaries_ok_delete_keys_from_bucket:
  assumes "bp_bucket_boundaries_ok bs"
  shows "bp_bucket_boundaries_ok (map (bp_delete_keys_from_bucket S) bs)"
  using assms
proof (induction bs)
  case Nil
  then show ?case
    by simp
next
  case (Cons b bs)
  then show ?case
  proof (cases bs)
    case Nil
    then show ?thesis
      by simp
  next
    case (Cons c cs)
    have head:
      "pset (bp_bucket_entries b). snd p  bp_marker c"
      using Cons.prems Cons by simp
    have tail: "bp_bucket_boundaries_ok
      (map (bp_delete_keys_from_bucket S) (c # cs))"
      using Cons.IH Cons.prems Cons by simp
    show ?thesis
      using Cons head tail
      unfolding bp_delete_keys_from_bucket_def by auto
  qed
qed

lemma bp_delete_key_boundaries_state_ok:
  assumes "bp_bucket_boundaries_state_ok P"
  shows "bp_bucket_boundaries_state_ok (bp_delete_key x P)"
  using assms
  unfolding bp_bucket_boundaries_state_ok_def bp_delete_key_def
  by (simp add: bp_bucket_boundaries_ok_delete_key_from_bucket)

lemma bp_delete_keys_boundaries_state_ok:
  assumes "bp_bucket_boundaries_state_ok P"
  shows "bp_bucket_boundaries_state_ok (bp_delete_keys S P)"
  using assms
  unfolding bp_bucket_boundaries_state_ok_def bp_delete_keys_def
  by (simp add: bp_bucket_boundaries_ok_delete_keys_from_bucket)

lemma bp_delete_key_invariant:
  assumes "bp_invariant P"
  shows "bp_invariant (bp_delete_key x P)"
proof -
  have block: "0 < bp_block_size (bp_delete_key x P)"
    using assms unfolding bp_invariant_def bp_delete_key_def by simp
  have distinct: "bp_distinct_keys (bp_delete_key x P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_key_distinct_keys)
  have sizes: "bp_bucket_sizes_ok (bp_delete_key x P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_key_bucket_sizes_ok)
  have sorted: "bp_bucket_markers_sorted (bp_delete_key x P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_key_markers_sorted)
  have markers: "bp_bucket_markers_lower_bound (bp_delete_key x P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_key_markers_lower_bound)
  have vals: "bp_values_consistent (bp_delete_key x P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_key_values_consistent)
  show ?thesis
    unfolding bp_invariant_def using block distinct sizes sorted markers vals by blast
qed

lemma bp_delete_key_ordered_invariant:
  assumes "bp_ordered_invariant P"
  shows "bp_ordered_invariant (bp_delete_key x P)"
  unfolding bp_ordered_invariant_def
  using bp_delete_key_invariant[OF bp_ordered_invariant_invariant[OF assms]]
    bp_delete_key_boundaries_state_ok
      [OF bp_ordered_invariant_boundaries_state_ok[OF assms]]
  by blast

lemma bp_delete_key_lazy_invariant:
  assumes "bp_lazy_invariant P"
  shows "bp_lazy_invariant (bp_delete_key x P)"
proof -
  have block: "0 < bp_block_size (bp_delete_key x P)"
    using assms unfolding bp_lazy_invariant_def bp_delete_key_def by simp
  have distinct: "bp_distinct_keys (bp_delete_key x P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_key_distinct_keys)
  have sizes: "bp_lazy_bucket_sizes_ok (bp_delete_key x P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_key_lazy_bucket_sizes_ok)
  have sorted: "bp_bucket_markers_sorted (bp_delete_key x P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_key_markers_sorted)
  have markers: "bp_bucket_markers_lower_bound (bp_delete_key x P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_key_markers_lower_bound)
  have vals: "bp_values_consistent (bp_delete_key x P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_key_values_consistent)
  show ?thesis
    unfolding bp_lazy_invariant_def
    using block distinct sizes sorted markers vals by blast
qed

lemma bp_delete_key_lazy_ordered_invariant:
  assumes "bp_lazy_ordered_invariant P"
  shows "bp_lazy_ordered_invariant (bp_delete_key x P)"
  unfolding bp_lazy_ordered_invariant_def
  using bp_delete_key_lazy_invariant
      [OF bp_lazy_ordered_invariant_lazy_invariant[OF assms]]
    bp_delete_key_boundaries_state_ok
      [OF bp_lazy_ordered_invariant_boundaries_state_ok[OF assms]]
  by blast

lemma bp_delete_keys_invariant:
  assumes "bp_invariant P"
  shows "bp_invariant (bp_delete_keys S P)"
proof -
  have block: "0 < bp_block_size (bp_delete_keys S P)"
    using assms unfolding bp_invariant_def bp_delete_keys_def by simp
  have distinct: "bp_distinct_keys (bp_delete_keys S P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_keys_distinct_keys)
  have sizes: "bp_bucket_sizes_ok (bp_delete_keys S P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_keys_bucket_sizes_ok)
  have sorted: "bp_bucket_markers_sorted (bp_delete_keys S P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_keys_markers_sorted)
  have markers: "bp_bucket_markers_lower_bound (bp_delete_keys S P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_keys_markers_lower_bound)
  have vals: "bp_values_consistent (bp_delete_keys S P)"
    using assms unfolding bp_invariant_def
    by (auto intro: bp_delete_keys_values_consistent)
  show ?thesis
    unfolding bp_invariant_def using block distinct sizes sorted markers vals by blast
qed

lemma bp_delete_keys_ordered_invariant:
  assumes "bp_ordered_invariant P"
  shows "bp_ordered_invariant (bp_delete_keys S P)"
  unfolding bp_ordered_invariant_def
  using bp_delete_keys_invariant[OF bp_ordered_invariant_invariant[OF assms]]
    bp_delete_keys_boundaries_state_ok
      [OF bp_ordered_invariant_boundaries_state_ok[OF assms]]
  by blast

lemma bp_delete_keys_lazy_invariant:
  assumes "bp_lazy_invariant P"
  shows "bp_lazy_invariant (bp_delete_keys S P)"
proof -
  have block: "0 < bp_block_size (bp_delete_keys S P)"
    using assms unfolding bp_lazy_invariant_def bp_delete_keys_def by simp
  have distinct: "bp_distinct_keys (bp_delete_keys S P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_keys_distinct_keys)
  have sizes: "bp_lazy_bucket_sizes_ok (bp_delete_keys S P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_keys_lazy_bucket_sizes_ok)
  have sorted: "bp_bucket_markers_sorted (bp_delete_keys S P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_keys_markers_sorted)
  have markers: "bp_bucket_markers_lower_bound (bp_delete_keys S P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_keys_markers_lower_bound)
  have vals: "bp_values_consistent (bp_delete_keys S P)"
    using assms unfolding bp_lazy_invariant_def
    by (auto intro: bp_delete_keys_values_consistent)
  show ?thesis
    unfolding bp_lazy_invariant_def
    using block distinct sizes sorted markers vals by blast
qed

lemma bp_delete_keys_view:
  "bp_view (bp_delete_keys S P) =
      keys_of = keys_of (bp_view P) - S,
       value_of = value_of (bp_view P) "
  unfolding bp_view_def by (simp add: bp_entries_delete_keys)

lemma bp_entry_keys_insert_bucket_state [simp]:
  "bp_entry_keys (bp_entries
      (Pbp_buckets := bp_insert_bucket p (bp_buckets P))) =
     insert (fst p) (bp_entry_keys (bp_entries P))"
  unfolding bp_entries_def by simp

lemma bp_entry_keys_insert_bucket_state_values [simp]:
  "bp_entry_keys (bp_entries
      (Pbp_buckets := bp_insert_bucket p (bp_buckets P),
        bp_values := f)) =
     insert (fst p) (bp_entry_keys (bp_entries P))"
  unfolding bp_entries_def by simp

lemma bp_insert_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_invariant (bp_insert x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  have inv0: "bp_invariant ?P0"
    by (rule bp_delete_key_invariant[OF inv])
  have block_pos: "0 < bp_block_size ?P0"
    using inv0 unfolding bp_invariant_def by blast
  have distinct0:
    "distinct (map fst (bp_entries ?P0))"
    using inv0 unfolding bp_invariant_def bp_distinct_keys_def by blast
  have sizes0:
    "cset (bp_buckets ?P0).
      length (bp_bucket_entries c)  bp_block_size ?P0"
    using inv0 unfolding bp_invariant_def bp_bucket_sizes_ok_def by blast
  have sorted0:
    "sorted_wrt (λc d. bp_marker c  bp_marker d) (bp_buckets ?P0)"
    using inv0 unfolding bp_invariant_def bp_bucket_markers_sorted_def by blast
  have markers0:
    "cset (bp_buckets ?P0). pset (bp_bucket_entries c).
      bp_marker c  snd p"
    using inv0 unfolding bp_invariant_def bp_bucket_markers_lower_bound_def by blast
  have values0:
    "pset (bp_entries ?P0). bp_values ?P0 (fst p) = snd p"
    using inv0 by (auto simp: bp_invariant_def bp_values_consistent_def)
  have fresh: "x  bp_entry_keys (bp_entries ?P0)"
    unfolding bp_entries_delete_key by simp
  have distinct_insert:
    "distinct (map fst
      (bp_bucket_entries_flat (bp_insert_bucket (x, ?b) (bp_buckets ?P0))))"
    by (rule bp_insert_bucket_distinct_keys)
      (use distinct0 fresh in simp_all add: bp_entries_def)
  have values0_P:
    "pset (bp_entries ?P0). bp_values P (fst p) = snd p"
    using values0 unfolding bp_delete_key_def by simp
  have values_insert:
    "pset
        (bp_bucket_entries_flat (bp_insert_bucket (x, ?b) (bp_buckets ?P0))).
      ((bp_values P)(x := ?b)) (fst p) = snd p"
  proof
    fix p
    assume p:
      "p  set (bp_bucket_entries_flat
        (bp_insert_bucket (x, ?b) (bp_buckets ?P0)))"
    then have p_cases: "p = (x, ?b) 
        p  set (bp_bucket_entries_flat (bp_buckets ?P0))"
      using set_bp_bucket_entries_flat_insert_bucket[of "(x, ?b)" "bp_buckets ?P0"]
      by auto
    from p_cases show "((bp_values P)(x := ?b)) (fst p) = snd p"
    proof
      assume "p = (x, ?b)"
      then show ?thesis by simp
    next
      assume p_flat: "p  set (bp_bucket_entries_flat (bp_buckets ?P0))"
      then have p_old: "p  set (bp_entries ?P0)"
        unfolding bp_entries_def .
      have "fst p  x"
      proof
        assume "fst p = x"
        then have "x  bp_entry_keys (bp_entries ?P0)"
          using p_old unfolding bp_entry_keys_def by auto
        then show False
          using fresh by simp
      qed
      moreover have "bp_values P (fst p) = snd p"
        using values0_P p_old by blast
      ultimately show ?thesis
        by simp
    qed
  qed
  show ?thesis
    unfolding bp_insert_def Let_def bp_invariant_def
  proof (intro conjI)
    show "0 < bp_block_size
      (?P0bp_buckets := bp_insert_bucket (x, ?b) (bp_buckets ?P0),
        bp_values := (bp_values P)(x := ?b))"
      using block_pos by simp
    show "bp_distinct_keys
      (?P0bp_buckets := bp_insert_bucket (x, ?b) (bp_buckets ?P0),
        bp_values := (bp_values P)(x := ?b))"
      using distinct_insert
      unfolding bp_distinct_keys_def bp_entries_def by simp
    show "bp_bucket_sizes_ok
      (?P0bp_buckets := bp_insert_bucket (x, ?b) (bp_buckets ?P0),
        bp_values := (bp_values P)(x := ?b))"
      using bp_insert_bucket_sizes_ok[OF sizes0 block_pos]
      unfolding bp_bucket_sizes_ok_def by simp
    show "bp_bucket_markers_sorted
      (?P0bp_buckets := bp_insert_bucket (x, ?b) (bp_buckets ?P0),
        bp_values := (bp_values P)(x := ?b))"
      using bp_insert_bucket_markers_sorted[OF sorted0]
      unfolding bp_bucket_markers_sorted_def by simp
    show "bp_bucket_markers_lower_bound
      (?P0bp_buckets := bp_insert_bucket (x, ?b) (bp_buckets ?P0),
        bp_values := (bp_values P)(x := ?b))"
      using bp_insert_bucket_markers_lower_bound[OF markers0]
      unfolding bp_bucket_markers_lower_bound_def by simp
    show "bp_values_consistent
      (?P0bp_buckets := bp_insert_bucket (x, ?b) (bp_buckets ?P0),
        bp_values := (bp_values P)(x := ?b))"
      using values_insert
      unfolding bp_values_consistent_def bp_entries_def by simp
  qed
qed

lemma bp_insert_keys [simp]:
  "bp_entry_keys (bp_entries (bp_insert x b P)) =
     insert x (bp_entry_keys (bp_entries P))"
proof -
  let ?b = "if x  bp_entry_keys (bp_entries P)
    then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  have "bp_entry_keys
      (bp_entries
        (?P0bp_buckets := bp_insert_bucket (x, ?b) (bp_buckets ?P0),
          bp_values := (bp_values P)(x := ?b))) =
    insert x (bp_entry_keys (bp_entries ?P0))"
    by simp
  also have " = insert x (bp_entry_keys (bp_entries P))"
    by simp
  finally show ?thesis
    unfolding bp_insert_def Let_def .
qed

lemma bp_insert_values [simp]:
  "bp_values (bp_insert x b P) =
     (bp_values P)
       (x := if x  bp_entry_keys (bp_entries P)
             then min (bp_values P x) b else b)"
  unfolding bp_insert_def Let_def by simp

theorem bp_insert_refines_min_update:
  "bp_view (bp_insert x b P) = min_update (bp_view P) x b"
  unfolding bp_view_def min_update_def by simp

theorem bp_insert_refines_insert_spec:
  "insert_spec (bp_view P) x b (bp_view (bp_insert x b P))"
  unfolding bp_insert_refines_min_update
  by (rule min_update_insert_spec)

theorem bp_insert_preserves_upper_bound:
  assumes upper: "partition_upper_bound (bp_view P) B"
    and b_lt: "b < B"
  shows "partition_upper_bound (bp_view (bp_insert x b P)) B"
  unfolding bp_insert_refines_min_update
  by (rule min_update_preserves_upper_bound[OF upper b_lt])

lemma bp_local_insert_state_keys:
  assumes M_pos: "0 < bp_block_size P"
  shows "bp_entry_keys (bp_entries (bp_local_insert_state x b P)) =
    insert x (bp_entry_keys (bp_entries P))"
proof -
  let ?b = "if x  bp_entry_keys (bp_entries P)
    then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  have M0: "0 < bp_block_size ?P0"
    using M_pos unfolding bp_delete_key_def by simp
  have keys_step:
    "bp_entry_keys
      (bp_entries
        (?P0bp_buckets :=
             bp_local_insert_bucket (bp_block_size ?P0) (x, ?b)
               (bp_buckets ?P0),
           bp_values := (bp_values P)(x := ?b))) =
     insert x (bp_entry_keys (bp_entries ?P0))"
    using set_bp_bucket_entries_flat_local_insert_bucket
      [OF M0, of "(x, ?b)" "bp_buckets ?P0"]
    unfolding bp_entries_def bp_entry_keys_def by auto
  show ?thesis
    unfolding bp_local_insert_state_def Let_def
    using keys_step by simp
qed

lemma bp_local_insert_state_values [simp]:
  "bp_values (bp_local_insert_state x b P) =
     (bp_values P)
       (x := if x  bp_entry_keys (bp_entries P)
             then min (bp_values P x) b else b)"
  unfolding bp_local_insert_state_def Let_def by simp

theorem bp_local_insert_state_refines_min_update:
  assumes "0 < bp_block_size P"
  shows "bp_view (bp_local_insert_state x b P) = min_update (bp_view P) x b"
  using bp_local_insert_state_keys[OF assms, of x b]
  unfolding bp_view_def min_update_def by simp

theorem bp_local_insert_state_refines_insert_spec:
  assumes "0 < bp_block_size P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_local_insert_state x b P))"
  unfolding bp_local_insert_state_refines_min_update[OF assms]
  by (rule min_update_insert_spec)

theorem bp_local_insert_state_preserves_upper_bound:
  assumes M_pos: "0 < bp_block_size P"
    and upper: "partition_upper_bound (bp_view P) B"
    and b_lt: "b < B"
  shows "partition_upper_bound (bp_view (bp_local_insert_state x b P)) B"
  unfolding bp_local_insert_state_refines_min_update[OF M_pos]
  by (rule min_update_preserves_upper_bound[OF upper b_lt])

lemma bp_lazy_insert_state_keys:
  assumes M_pos: "0 < bp_block_size P"
  shows "bp_entry_keys (bp_entries (bp_lazy_insert_state x b P)) =
    insert x (bp_entry_keys (bp_entries P))"
proof -
  let ?b = "if x  bp_entry_keys (bp_entries P)
    then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  have M0: "0 < bp_block_size ?P0"
    using M_pos unfolding bp_delete_key_def by simp
  have keys_step:
    "bp_entry_keys
      (bp_entries
        (?P0bp_buckets :=
             bp_lazy_insert_bucket (bp_block_size ?P0) (x, ?b)
               (bp_buckets ?P0),
           bp_values := (bp_values P)(x := ?b))) =
     insert x (bp_entry_keys (bp_entries ?P0))"
    using set_bp_bucket_entries_flat_lazy_insert_bucket
      [OF M0, of "(x, ?b)" "bp_buckets ?P0"]
    unfolding bp_entries_def bp_entry_keys_def by auto
  show ?thesis
    unfolding bp_lazy_insert_state_def Let_def
    using keys_step by simp
qed

lemma bp_lazy_insert_state_values [simp]:
  "bp_values (bp_lazy_insert_state x b P) =
     (bp_values P)
       (x := if x  bp_entry_keys (bp_entries P)
             then min (bp_values P x) b else b)"
  unfolding bp_lazy_insert_state_def Let_def by simp

theorem bp_lazy_insert_state_refines_min_update:
  assumes "0 < bp_block_size P"
  shows "bp_view (bp_lazy_insert_state x b P) =
    min_update (bp_view P) x b"
  using bp_lazy_insert_state_keys[OF assms, of x b]
  unfolding bp_view_def min_update_def by simp

theorem bp_lazy_insert_state_refines_insert_spec:
  assumes "0 < bp_block_size P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_lazy_insert_state x b P))"
  unfolding bp_lazy_insert_state_refines_min_update[OF assms]
  by (rule min_update_insert_spec)

theorem bp_lazy_insert_state_preserves_upper_bound:
  assumes M_pos: "0 < bp_block_size P"
    and upper: "partition_upper_bound (bp_view P) B"
    and b_lt: "b < B"
  shows "partition_upper_bound (bp_view (bp_lazy_insert_state x b P)) B"
  unfolding bp_lazy_insert_state_refines_min_update[OF M_pos]
  by (rule min_update_preserves_upper_bound[OF upper b_lt])

lemma bp_lazy_insert_state_lazy_bucket_sizes_ok:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_bucket_sizes_ok (bp_lazy_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have M_pos: "0 < bp_block_size ?P0"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have sizes0:
    "cset (bp_buckets ?P0).
      length (bp_bucket_entries c)  2 * bp_block_size ?P0"
    using inv0 unfolding bp_lazy_invariant_def
      bp_lazy_bucket_sizes_ok_def by blast
  have sizes:
    "cset
        (bp_lazy_insert_bucket (bp_block_size ?P0) (x, ?b)
          (bp_buckets ?P0)).
      length (bp_bucket_entries c)  2 * bp_block_size ?P0"
    by (rule bp_lazy_insert_bucket_sizes_ok[OF M_pos sizes0])
  show ?thesis
    unfolding bp_lazy_insert_state_def Let_def bp_lazy_bucket_sizes_ok_def
    using sizes by simp
qed

lemma bp_lazy_insert_state_markers_lower_bound:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_bucket_markers_lower_bound (bp_lazy_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have M_pos: "0 < bp_block_size ?P0"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have lower0:
    "cset (bp_buckets ?P0). pset (bp_bucket_entries c).
      bp_marker c  snd p"
    using inv0 unfolding bp_lazy_invariant_def
      bp_bucket_markers_lower_bound_def by blast
  have lower:
    "cset
        (bp_lazy_insert_bucket (bp_block_size ?P0) (x, ?b)
          (bp_buckets ?P0)).
      qset (bp_bucket_entries c). bp_marker c  snd q"
    by (rule bp_lazy_insert_bucket_markers_lower_bound[OF M_pos lower0])
  show ?thesis
    unfolding bp_lazy_insert_state_def Let_def
      bp_bucket_markers_lower_bound_def
    using lower by simp
qed

lemma bp_lazy_insert_state_values_consistent:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_values_consistent (bp_lazy_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_lazy_insert_bucket ?M (x, ?b) ?bs"
  let ?P' = "?P0bp_buckets := ?new_bs,
      bp_values := (bp_values P)(x := ?b)"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have values0:
    "pset (bp_entries ?P0). bp_values ?P0 (fst p) = snd p"
    using inv0 unfolding bp_lazy_invariant_def bp_values_consistent_def
    by blast
  have values0_P:
    "pset (bp_entries ?P0). bp_values P (fst p) = snd p"
    using values0 unfolding bp_delete_key_def by simp
  have fresh: "x  bp_entry_keys (bp_entries ?P0)"
    by simp
  have values_insert:
    "pset (bp_bucket_entries_flat ?new_bs).
      ((bp_values P)(x := ?b)) (fst p) = snd p"
  proof
    fix p
    assume p: "p  set (bp_bucket_entries_flat ?new_bs)"
    then have p_cases:
      "p = (x, ?b)  p  set (bp_bucket_entries_flat ?bs)"
      using set_bp_bucket_entries_flat_lazy_insert_bucket
        [OF M_pos, of "(x, ?b)" ?bs]
      by auto
    from p_cases show "((bp_values P)(x := ?b)) (fst p) = snd p"
    proof
      assume "p = (x, ?b)"
      then show ?thesis by simp
    next
      assume p_flat: "p  set (bp_bucket_entries_flat ?bs)"
      then have p_old: "p  set (bp_entries ?P0)"
        unfolding bp_entries_def .
      have "fst p  x"
      proof
        assume "fst p = x"
        then have "x  bp_entry_keys (bp_entries ?P0)"
          using p_old unfolding bp_entry_keys_def by auto
        then show False
          using fresh by simp
      qed
      moreover have "bp_values P (fst p) = snd p"
        using values0_P p_old by blast
      ultimately show ?thesis
        by simp
    qed
  qed
  have state: "bp_lazy_insert_state x b P = ?P'"
    unfolding bp_lazy_insert_state_def Let_def by simp
  have "bp_values_consistent ?P'"
    using values_insert
    unfolding bp_values_consistent_def bp_entries_def by simp
  show ?thesis
    unfolding state by (rule bp_values_consistent ?P')
qed

lemma bp_lazy_insert_state_distinct_keys:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_distinct_keys (bp_lazy_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_lazy_insert_bucket ?M (x, ?b) ?bs"
  let ?P' = "?P0bp_buckets := ?new_bs,
      bp_values := (bp_values P)(x := ?b)"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have distinct0:
    "distinct (map fst (bp_entries ?P0))"
    using inv0 unfolding bp_lazy_invariant_def bp_distinct_keys_def
    by blast
  have fresh: "x  bp_entry_keys (bp_entries ?P0)"
    by simp
  have distinct_lazy:
    "distinct (map fst (bp_bucket_entries_flat ?new_bs))"
    by (rule bp_lazy_insert_bucket_distinct_keys[OF M_pos])
      (use distinct0 fresh in simp_all add: bp_entries_def)
  have state: "bp_lazy_insert_state x b P = ?P'"
    unfolding bp_lazy_insert_state_def Let_def by simp
  have "bp_distinct_keys ?P'"
    using distinct_lazy unfolding bp_distinct_keys_def bp_entries_def
    by simp
  show ?thesis
    unfolding state by (rule bp_distinct_keys ?P')
qed

lemma bp_lazy_insert_state_markers_sorted:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_bucket_markers_sorted (bp_lazy_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_lazy_insert_bucket ?M (x, ?b) ?bs"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have boundaries0_state: "bp_bucket_boundaries_state_ok ?P0"
    by (rule bp_delete_key_boundaries_state_ok
        [OF bp_lazy_ordered_invariant_boundaries_state_ok[OF lazy]])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have sorted0:
    "sorted_wrt (λc d. bp_marker c  bp_marker d) ?bs"
    using inv0 unfolding bp_lazy_invariant_def
      bp_bucket_markers_sorted_def by blast
  have lower0:
    "cset ?bs. pset (bp_bucket_entries c).
      bp_marker c  snd p"
    using inv0 unfolding bp_lazy_invariant_def
      bp_bucket_markers_lower_bound_def by blast
  have boundaries0: "bp_bucket_boundaries_ok ?bs"
    using boundaries0_state unfolding bp_bucket_boundaries_state_ok_def .
  have sorted_new:
    "sorted_wrt (λc d. bp_marker c  bp_marker d) ?new_bs"
    by (rule bp_lazy_insert_bucket_markers_sorted
        [OF M_pos sorted0 lower0 boundaries0])
  show ?thesis
    unfolding bp_lazy_insert_state_def Let_def
      bp_bucket_markers_sorted_def
    using sorted_new by simp
qed

lemma bp_lazy_insert_state_boundaries_state_ok:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_bucket_boundaries_state_ok (bp_lazy_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_lazy_insert_bucket ?M (x, ?b) ?bs"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have boundaries0_state: "bp_bucket_boundaries_state_ok ?P0"
    by (rule bp_delete_key_boundaries_state_ok
        [OF bp_lazy_ordered_invariant_boundaries_state_ok[OF lazy]])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have sorted0:
    "sorted_wrt (λc d. bp_marker c  bp_marker d) ?bs"
    using inv0 unfolding bp_lazy_invariant_def
      bp_bucket_markers_sorted_def by blast
  have lower0:
    "cset ?bs. pset (bp_bucket_entries c).
      bp_marker c  snd p"
    using inv0 unfolding bp_lazy_invariant_def
      bp_bucket_markers_lower_bound_def by blast
  have boundaries0: "bp_bucket_boundaries_ok ?bs"
    using boundaries0_state unfolding bp_bucket_boundaries_state_ok_def .
  have boundaries_new: "bp_bucket_boundaries_ok ?new_bs"
    by (rule bp_lazy_insert_bucket_boundaries_ok
        [OF M_pos sorted0 lower0 boundaries0])
  show ?thesis
    unfolding bp_lazy_insert_state_def Let_def
      bp_bucket_boundaries_state_ok_def
    using boundaries_new by simp
qed

lemma bp_lazy_insert_state_lazy_invariant:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_invariant (bp_lazy_insert_state x b P)"
proof -
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have M_pos: "0 < bp_block_size P"
    using inv unfolding bp_lazy_invariant_def by blast
  have block:
    "bp_block_size (bp_lazy_insert_state x b P) = bp_block_size P"
    unfolding bp_lazy_insert_state_def bp_delete_key_def
    by (simp add: Let_def split: if_splits)
  show ?thesis
    unfolding bp_lazy_invariant_def
  proof (intro conjI)
    show "0 < bp_block_size (bp_lazy_insert_state x b P)"
      using M_pos block by simp
    show "bp_distinct_keys (bp_lazy_insert_state x b P)"
      by (rule bp_lazy_insert_state_distinct_keys[OF lazy])
    show "bp_lazy_bucket_sizes_ok (bp_lazy_insert_state x b P)"
      by (rule bp_lazy_insert_state_lazy_bucket_sizes_ok[OF lazy])
    show "bp_bucket_markers_sorted (bp_lazy_insert_state x b P)"
      by (rule bp_lazy_insert_state_markers_sorted[OF lazy])
    show "bp_bucket_markers_lower_bound (bp_lazy_insert_state x b P)"
      by (rule bp_lazy_insert_state_markers_lower_bound[OF lazy])
    show "bp_values_consistent (bp_lazy_insert_state x b P)"
      by (rule bp_lazy_insert_state_values_consistent[OF lazy])
  qed
qed

lemma bp_lazy_insert_state_lazy_ordered_invariant:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_ordered_invariant (bp_lazy_insert_state x b P)"
  unfolding bp_lazy_ordered_invariant_def
  using bp_lazy_insert_state_lazy_invariant[OF lazy]
    bp_lazy_insert_state_boundaries_state_ok[OF lazy]
  by blast

lemma length_bp_lazy_insert_state_entries:
  assumes M_pos: "0 < bp_block_size P"
  shows "length (bp_entries (bp_lazy_insert_state x b P)) =
    Suc (length (bp_entries (bp_delete_key x P)))"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?new_bs = "bp_lazy_insert_bucket ?M (x, ?b) (bp_buckets ?P0)"
  let ?P' = "?P0bp_buckets := ?new_bs,
      bp_values := (bp_values P)(x := ?b)"
  have M0: "0 < ?M"
    using M_pos unfolding bp_delete_key_def by simp
  have len:
    "length (bp_bucket_entries_flat ?new_bs) =
      Suc (length (bp_bucket_entries_flat (bp_buckets ?P0)))"
    by (rule length_bp_bucket_entries_flat_lazy_insert_bucket[OF M0])
  have state: "bp_lazy_insert_state x b P = ?P'"
    unfolding bp_lazy_insert_state_def Let_def by simp
  have "length (bp_entries ?P') =
    Suc (length (bp_entries ?P0))"
    using len unfolding bp_entries_def by simp
  show ?thesis
    unfolding state by (rule length (bp_entries ?P') =
      Suc (length (bp_entries ?P0)))
qed

lemma length_bp_lazy_insert_state_entries_ge:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "length (bp_entries P) 
    length (bp_entries (bp_lazy_insert_state x b P))"
proof -
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have M_pos: "0 < bp_block_size P"
    using inv unfolding bp_lazy_invariant_def by blast
  have distinct: "bp_distinct_keys P"
    using inv unfolding bp_lazy_invariant_def by blast
  have delete_ge:
    "length (bp_entries P) 
      Suc (length (bp_entries (bp_delete_key x P)))"
    by (rule length_bp_entries_delete_key_ge_pred[OF distinct])
  have insert_len:
    "length (bp_entries (bp_lazy_insert_state x b P)) =
      Suc (length (bp_entries (bp_delete_key x P)))"
    by (rule length_bp_lazy_insert_state_entries[OF M_pos])
  show ?thesis
    using delete_ge unfolding insert_len .
qed

lemma length_bp_lazy_insert_state_buckets_le:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "length (bp_buckets (bp_lazy_insert_state x b P)) 
    length (bp_buckets P) + 2"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_lazy_insert_bucket ?M (x, ?b) ?bs"
  let ?P' = "?P0bp_buckets := ?new_bs,
      bp_values := (bp_values P)(x := ?b)"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have sizes0:
    "bset ?bs. length (bp_bucket_entries b)  2 * ?M"
    using inv0 unfolding bp_lazy_invariant_def
      bp_lazy_bucket_sizes_ok_def by blast
  have len_new:
    "length ?new_bs  length ?bs + 2"
    by (rule length_bp_lazy_insert_bucket_le[OF M_pos sizes0])
  have state: "bp_lazy_insert_state x b P = ?P'"
    unfolding bp_lazy_insert_state_def Let_def by simp
  have "length (bp_buckets ?P')  length (bp_buckets P) + 2"
    using len_new unfolding bp_delete_key_def by simp
  show ?thesis
    unfolding state by (rule length (bp_buckets ?P') 
      length (bp_buckets P) + 2)
qed

lemma bp_local_insert_state_invariant:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_invariant (bp_local_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_local_insert_bucket ?M (x, ?b) ?bs"
  let ?P' = "?P0bp_buckets := ?new_bs,
      bp_values := (bp_values P)(x := ?b)"
  have inv: "bp_invariant P"
    by (rule bp_ordered_invariant_invariant[OF ord])
  have inv0: "bp_invariant ?P0"
    by (rule bp_delete_key_invariant[OF inv])
  have boundaries0_state: "bp_bucket_boundaries_state_ok ?P0"
    by (rule bp_delete_key_boundaries_state_ok
        [OF bp_ordered_invariant_boundaries_state_ok[OF ord]])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_invariant_def by blast
  have distinct0: "distinct (map fst (bp_entries ?P0))"
    using inv0 unfolding bp_invariant_def bp_distinct_keys_def by blast
  have sizes0:
    "cset ?bs. length (bp_bucket_entries c)  ?M"
    using inv0 unfolding bp_invariant_def bp_bucket_sizes_ok_def by blast
  have sorted0:
    "sorted_wrt (λc d. bp_marker c  bp_marker d) ?bs"
    using inv0 unfolding bp_invariant_def bp_bucket_markers_sorted_def by blast
  have markers0:
    "cset ?bs. pset (bp_bucket_entries c).
      bp_marker c  snd p"
    using inv0 unfolding bp_invariant_def bp_bucket_markers_lower_bound_def
    by blast
  have boundaries0: "bp_bucket_boundaries_ok ?bs"
    using boundaries0_state unfolding bp_bucket_boundaries_state_ok_def .
  have shape:
    "(cset ?new_bs. length (bp_bucket_entries c)  ?M) 
     sorted_wrt (λc d. bp_marker c  bp_marker d) ?new_bs 
     (cset ?new_bs. qset (bp_bucket_entries c).
        bp_marker c  snd q) 
     bp_bucket_boundaries_ok ?new_bs"
    by (rule bp_local_insert_bucket_preserves_bucket_shape
        [OF M_pos sizes0 sorted0 markers0 boundaries0])
  have fresh: "x  bp_entry_keys (bp_entries ?P0)"
    by simp
  have distinct_local:
    "distinct (map fst (bp_bucket_entries_flat ?new_bs))"
    by (rule bp_local_insert_bucket_distinct_keys[OF M_pos])
      (use distinct0 fresh in simp_all add: bp_entries_def)
  have values0:
    "pset (bp_entries ?P0). bp_values ?P0 (fst p) = snd p"
    using inv0 unfolding bp_invariant_def bp_values_consistent_def by blast
  have values0_P:
    "pset (bp_entries ?P0). bp_values P (fst p) = snd p"
    using values0 unfolding bp_delete_key_def by simp
  have values_insert:
    "pset (bp_bucket_entries_flat ?new_bs).
      ((bp_values P)(x := ?b)) (fst p) = snd p"
  proof
    fix p
    assume p: "p  set (bp_bucket_entries_flat ?new_bs)"
    then have p_cases:
      "p = (x, ?b)  p  set (bp_bucket_entries_flat ?bs)"
      using set_bp_bucket_entries_flat_local_insert_bucket
        [OF M_pos, of "(x, ?b)" ?bs]
      by auto
    from p_cases show "((bp_values P)(x := ?b)) (fst p) = snd p"
    proof
      assume "p = (x, ?b)"
      then show ?thesis by simp
    next
      assume p_old: "p  set (bp_bucket_entries_flat ?bs)"
      then have p_old_entry: "p  set (bp_entries ?P0)"
        unfolding bp_entries_def .
      have "fst p  x"
      proof
        assume "fst p = x"
        then have "x  bp_entry_keys (bp_entries ?P0)"
          using p_old_entry unfolding bp_entry_keys_def by auto
        then show False
          using fresh by simp
      qed
      moreover have "bp_values P (fst p) = snd p"
        using values0_P p_old_entry by blast
      ultimately show ?thesis
        by simp
    qed
  qed
  show ?thesis
    unfolding bp_local_insert_state_def Let_def bp_invariant_def
  proof (intro conjI)
    show "0 < bp_block_size ?P'"
      using M_pos by simp
    show "bp_distinct_keys ?P'"
      using distinct_local unfolding bp_distinct_keys_def bp_entries_def
      by simp
    show "bp_bucket_sizes_ok ?P'"
      using shape unfolding bp_bucket_sizes_ok_def by simp
    show "bp_bucket_markers_sorted ?P'"
      using shape unfolding bp_bucket_markers_sorted_def by simp
    show "bp_bucket_markers_lower_bound ?P'"
      using shape unfolding bp_bucket_markers_lower_bound_def by simp
    show "bp_values_consistent ?P'"
      using values_insert unfolding bp_values_consistent_def bp_entries_def
      by simp
  qed
qed

lemma bp_local_insert_state_boundaries_state_ok:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_bucket_boundaries_state_ok (bp_local_insert_state x b P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_local_insert_bucket ?M (x, ?b) ?bs"
  have inv: "bp_invariant P"
    by (rule bp_ordered_invariant_invariant[OF ord])
  have inv0: "bp_invariant ?P0"
    by (rule bp_delete_key_invariant[OF inv])
  have boundaries0_state: "bp_bucket_boundaries_state_ok ?P0"
    by (rule bp_delete_key_boundaries_state_ok
        [OF bp_ordered_invariant_boundaries_state_ok[OF ord]])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_invariant_def by blast
  have sizes0:
    "cset ?bs. length (bp_bucket_entries c)  ?M"
    using inv0 unfolding bp_invariant_def bp_bucket_sizes_ok_def by blast
  have sorted0:
    "sorted_wrt (λc d. bp_marker c  bp_marker d) ?bs"
    using inv0 unfolding bp_invariant_def bp_bucket_markers_sorted_def by blast
  have markers0:
    "cset ?bs. pset (bp_bucket_entries c).
      bp_marker c  snd p"
    using inv0 unfolding bp_invariant_def bp_bucket_markers_lower_bound_def
    by blast
  have boundaries0: "bp_bucket_boundaries_ok ?bs"
    using boundaries0_state unfolding bp_bucket_boundaries_state_ok_def .
  have shape:
    "(cset ?new_bs. length (bp_bucket_entries c)  ?M) 
     sorted_wrt (λc d. bp_marker c  bp_marker d) ?new_bs 
     (cset ?new_bs. qset (bp_bucket_entries c).
        bp_marker c  snd q) 
     bp_bucket_boundaries_ok ?new_bs"
    by (rule bp_local_insert_bucket_preserves_bucket_shape
        [OF M_pos sizes0 sorted0 markers0 boundaries0])
  show ?thesis
    unfolding bp_local_insert_state_def Let_def
      bp_bucket_boundaries_state_ok_def
    using shape by simp
qed

lemma bp_local_insert_state_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_ordered_invariant (bp_local_insert_state x b P)"
  unfolding bp_ordered_invariant_def
  using bp_local_insert_state_invariant[OF ord]
    bp_local_insert_state_boundaries_state_ok[OF ord]
  by blast

lemma bp_batch_prepend_invariant:
  assumes "bp_invariant P"
  shows "bp_invariant (bp_batch_prepend xs P)"
  using assms
proof (induction xs arbitrary: P)
  case Nil
  then show ?case
    unfolding bp_batch_prepend_def by simp
next
  case (Cons xb xs)
  obtain x b where xb: "xb = (x, b)"
    by force
  have step: "bp_invariant (bp_insert x b P)"
    by (rule bp_insert_invariant[OF Cons.prems])
  have unfold_step:
    "bp_batch_prepend (xb # xs) P =
      bp_batch_prepend xs (bp_insert x b P)"
    unfolding bp_batch_prepend_def xb by simp
  show ?case
    unfolding unfold_step by (rule Cons.IH[OF step])
qed

theorem bp_batch_prepend_refines_batch_min_update:
  assumes "bp_invariant P"
  shows "bp_view (bp_batch_prepend xs P) =
    batch_min_update (bp_view P) xs"
  using assms
proof (induction xs arbitrary: P)
  case Nil
  then show ?case
    unfolding bp_batch_prepend_def batch_min_update_def by simp
next
  case (Cons xb xs)
  obtain x b where xb: "xb = (x, b)"
    by force
  have step_inv: "bp_invariant (bp_insert x b P)"
    by (rule bp_insert_invariant[OF Cons.prems])
  have step_view: "bp_view (bp_insert x b P) = min_update (bp_view P) x b"
    by (rule bp_insert_refines_min_update)
  have unfold_state:
    "bp_batch_prepend (xb # xs) P =
      bp_batch_prepend xs (bp_insert x b P)"
    unfolding bp_batch_prepend_def xb by simp
  have unfold_view:
    "batch_min_update (bp_view P) (xb # xs) =
      batch_min_update (min_update (bp_view P) x b) xs"
    unfolding batch_min_update_def xb by simp
  show ?case
    unfolding unfold_state unfold_view
    using Cons.IH[OF step_inv] step_view by simp
qed

theorem bp_batch_prepend_preserves_upper_bound:
  assumes inv: "bp_invariant P"
    and upper: "partition_upper_bound (bp_view P) B"
    and values_lt: "x b. (x, b)  set xs  b < B"
  shows "partition_upper_bound (bp_view (bp_batch_prepend xs P)) B"
  unfolding bp_batch_prepend_refines_batch_min_update[OF inv]
  by (rule batch_min_update_preserves_upper_bound[OF upper values_lt])

definition bp_rebucketed_insert ::
  "'k  real  'k bucketed_partition  'k bucketed_partition" where
  "bp_rebucketed_insert x b P = bp_rebucket (bp_insert x b P)"

definition bp_rebucketed_batch_prepend ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition" where
  "bp_rebucketed_batch_prepend xs P = bp_rebucket (bp_batch_prepend xs P)"

lemma bp_rebucketed_insert_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_invariant (bp_rebucketed_insert x b P)"
  unfolding bp_rebucketed_insert_def
  by (rule bp_rebucket_invariant[OF bp_insert_invariant[OF inv]])

lemma bp_rebucketed_insert_ordered_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_ordered_invariant (bp_rebucketed_insert x b P)"
  unfolding bp_rebucketed_insert_def
  by (rule bp_rebucket_ordered_invariant[OF bp_insert_invariant[OF inv]])

theorem bp_rebucketed_insert_refines_min_update:
  assumes inv: "bp_invariant P"
  shows "bp_view (bp_rebucketed_insert x b P) = min_update (bp_view P) x b"
proof -
  have step_inv: "bp_invariant (bp_insert x b P)"
    by (rule bp_insert_invariant[OF inv])
  then have block: "0 < bp_block_size (bp_insert x b P)"
    unfolding bp_invariant_def by blast
  have rebucket_view:
    "bp_view (bp_rebucket (bp_insert x b P)) = bp_view (bp_insert x b P)"
    by (rule bp_rebucket_view[OF block])
  show ?thesis
    unfolding bp_rebucketed_insert_def
    using rebucket_view bp_insert_refines_min_update by simp
qed

theorem bp_rebucketed_insert_refines_insert_spec:
  assumes inv: "bp_invariant P"
  shows "insert_spec (bp_view P) x b (bp_view (bp_rebucketed_insert x b P))"
  unfolding bp_rebucketed_insert_refines_min_update[OF inv]
  by (rule min_update_insert_spec)

theorem bp_rebucketed_insert_preserves_upper_bound:
  assumes inv: "bp_invariant P"
    and upper: "partition_upper_bound (bp_view P) B"
    and b_lt: "b < B"
  shows "partition_upper_bound (bp_view (bp_rebucketed_insert x b P)) B"
  unfolding bp_rebucketed_insert_refines_min_update[OF inv]
  by (rule min_update_preserves_upper_bound[OF upper b_lt])

lemma bp_rebucketed_batch_prepend_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_invariant (bp_rebucketed_batch_prepend xs P)"
  unfolding bp_rebucketed_batch_prepend_def
  by (rule bp_rebucket_invariant[OF bp_batch_prepend_invariant[OF inv]])

lemma bp_rebucketed_batch_prepend_ordered_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_ordered_invariant (bp_rebucketed_batch_prepend xs P)"
  unfolding bp_rebucketed_batch_prepend_def
  by (rule bp_rebucket_ordered_invariant[OF bp_batch_prepend_invariant[OF inv]])

theorem bp_rebucketed_batch_prepend_refines_batch_min_update:
  assumes inv: "bp_invariant P"
  shows "bp_view (bp_rebucketed_batch_prepend xs P) =
    batch_min_update (bp_view P) xs"
proof -
  have step_inv: "bp_invariant (bp_batch_prepend xs P)"
    by (rule bp_batch_prepend_invariant[OF inv])
  then have block: "0 < bp_block_size (bp_batch_prepend xs P)"
    unfolding bp_invariant_def by blast
  have rebucket_view:
    "bp_view (bp_rebucket (bp_batch_prepend xs P)) =
      bp_view (bp_batch_prepend xs P)"
    by (rule bp_rebucket_view[OF block])
  show ?thesis
    unfolding bp_rebucketed_batch_prepend_def
    using rebucket_view bp_batch_prepend_refines_batch_min_update[OF inv]
    by simp
qed

theorem bp_rebucketed_batch_prepend_preserves_upper_bound:
  assumes inv: "bp_invariant P"
    and upper: "partition_upper_bound (bp_view P) B"
    and values_lt: "x b. (x, b)  set xs  b < B"
  shows "partition_upper_bound
    (bp_view (bp_rebucketed_batch_prepend xs P)) B"
  unfolding bp_rebucketed_batch_prepend_refines_batch_min_update[OF inv]
  by (rule batch_min_update_preserves_upper_bound[OF upper values_lt])

lemma bp_min_value_le_entry:
  assumes "(x, b)  set xs"
  shows "bp_min_value B xs  b"
  using assms by (induction xs) auto

lemma bp_entries_Cons:
  assumes "bp_buckets P = b # bs"
  shows "bp_entries P = bp_bucket_entries b @ bp_bucket_entries_flat bs"
  using assms unfolding bp_entries_def bp_bucket_entries_flat_def by simp

lemma bp_tail_entry_ge_head_marker:
  assumes sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # bs)"
    and lower: "d p. d  set (c # bs); p  set (bp_bucket_entries d)
       bp_marker d  snd p"
    and p: "p  set (bp_bucket_entries_flat (c # bs))"
  shows "bp_marker c  snd p"
proof -
  obtain d where d: "d  set (c # bs)"
    and p_d: "p  set (bp_bucket_entries d)"
    using p unfolding bp_bucket_entries_flat_def by auto
  have c_le_d: "bp_marker c  bp_marker d"
    using sorted d by (cases "d = c") auto
  have d_le_p: "bp_marker d  snd p"
    by (rule lower[OF d p_d])
  show ?thesis
    using c_le_d d_le_p by linarith
qed

lemma bp_first_bucket_pull_invariant:
  assumes inv: "bp_invariant P"
    and pull: "bp_first_bucket_pull M B P = (S, beta, P')"
  shows "bp_invariant P'"
proof (cases "bp_buckets P")
  case Nil
  then have "P' = P"
    using pull unfolding bp_first_bucket_pull_def by simp
  then show ?thesis
    using inv by simp
next
  case (Cons b rest)
  then have buckets_outer: "bp_buckets P = b # rest" .
  then show ?thesis
  proof (cases rest)
    case Nil
    then have "P' = P"
      using buckets_outer pull unfolding bp_first_bucket_pull_def by simp
    then show ?thesis
      using inv by simp
  next
    case (Cons c bs)
    let ?S = "bp_bucket_keys b"
    have pull_eval:
      "bp_first_bucket_pull M B P = (?S, bp_marker c, bp_delete_keys ?S P)"
      using buckets_outer Cons
      unfolding bp_first_bucket_pull_def by (simp add: Let_def)
    have tuple_eq: "(?S, bp_marker c, bp_delete_keys ?S P) = (S, beta, P')"
      using pull_eval pull by simp
    have S_eq: "S = ?S"
      using tuple_eq by simp
    have P'_eq_raw: "bp_delete_keys ?S P = P'"
      using tuple_eq by (metis prod.inject)
    then have "P' = bp_delete_keys ?S P"
      by simp
    then have "P' = bp_delete_keys S P"
      using S_eq by simp
    then show ?thesis
      by (simp add: bp_delete_keys_invariant[OF inv])
  qed
qed

theorem bp_first_bucket_pull_refines_pull_separates:
  assumes inv: "bp_invariant P"
    and buckets: "bp_buckets P = b # c # bs"
    and len_b: "length (bp_bucket_entries b)  M"
    and below: "bp_bucket_below_bound b (bp_marker c)"
    and tail_nonempty: "bp_bucket_entries_flat (c # bs)  []"
    and pull: "bp_first_bucket_pull M B P = (S, beta, P')"
  shows "pull_separates (bp_view P) M B S beta (bp_view P')"
proof -
  let ?tail = "bp_bucket_entries_flat (c # bs)"
  have S_def: "S = bp_bucket_keys b"
    and beta_def: "beta = bp_marker c"
    and P'_def: "P' = bp_delete_keys S P"
    using pull buckets unfolding bp_first_bucket_pull_def by (auto simp: Let_def)
  have entries_P: "bp_entries P = bp_bucket_entries b @ ?tail"
    using buckets by (simp add: bp_entries_Cons)
  have distinct_P: "distinct (map fst (bp_entries P))"
    using inv unfolding bp_invariant_def bp_distinct_keys_def by blast
  have values_P:
    "p. p  set (bp_entries P)  bp_values P (fst p) = snd p"
    using inv unfolding bp_invariant_def bp_values_consistent_def by blast
  have sorted_tail:
    "sorted_wrt (λx y. bp_marker x  bp_marker y) (c # bs)"
    using inv buckets unfolding bp_invariant_def bp_bucket_markers_sorted_def by simp
  have lower_tail:
    "d p. d  set (c # bs); p  set (bp_bucket_entries d)
       bp_marker d  snd p"
    using inv buckets unfolding bp_invariant_def
      bp_bucket_markers_lower_bound_def by auto
  have S_subset: "S  keys_of (bp_view P)"
    unfolding S_def bp_view_def bp_bucket_keys_def bp_entry_keys_def entries_P
    by auto
  have card_S: "card S  M"
  proof -
    have "card S  length (bp_bucket_entries b)"
    proof -
      have "card S = card (fst ` set (bp_bucket_entries b))"
        unfolding S_def bp_bucket_keys_def bp_entry_keys_def by simp
      also have "  card (set (bp_bucket_entries b))"
        by (rule card_image_le) simp
      also have "  length (bp_bucket_entries b)"
        by (rule card_length)
      finally show ?thesis .
    qed
    then show ?thesis
      using len_b by linarith
  qed
  have P'_keys: "keys_of (bp_view P') = keys_of (bp_view P) - S"
    unfolding P'_def bp_delete_keys_view by simp
  have P'_values: "value_of (bp_view P') = value_of (bp_view P)"
    unfolding P'_def bp_delete_keys_view by simp
  have pulled_lt_beta:
    "u. u  S  value_of (bp_view P) u < beta"
  proof -
    fix u
    assume u: "u  S"
    then obtain p where p_b: "p  set (bp_bucket_entries b)"
      and fst_p: "fst p = u"
      unfolding S_def bp_bucket_keys_def bp_entry_keys_def by auto
    have "snd p < beta"
      using below p_b unfolding bp_bucket_below_bound_def beta_def by blast
    moreover have "bp_values P u = snd p"
      using values_P[of p] p_b fst_p entries_P by simp
    ultimately show "value_of (bp_view P) u < beta"
      unfolding bp_view_def by simp
  qed
  have tail_key_notin_S:
    "p. p  set ?tail  fst p  S"
  proof -
    fix p
    assume p_tail: "p  set ?tail"
    show "fst p  S"
    proof
      assume "fst p  S"
      then obtain q where q_b: "q  set (bp_bucket_entries b)"
        and fst_q: "fst q = fst p"
        unfolding S_def bp_bucket_keys_def bp_entry_keys_def by auto
      have distinct_append: "distinct (map fst (bp_bucket_entries b @ ?tail))"
        using distinct_P unfolding entries_P .
      have disjoint:
        "set (map fst (bp_bucket_entries b))  set (map fst ?tail) = {}"
        using distinct_append by simp
      have "fst p  set (map fst ?tail)"
        using p_tail by force
      then have "fst p  set (map fst (bp_bucket_entries b))"
        using disjoint by blast
      moreover have "fst p  set (map fst (bp_bucket_entries b))"
      proof -
        have "fst q  set (map fst (bp_bucket_entries b))"
          using q_b by force
        then show ?thesis
          using fst_q by simp
      qed
      ultimately show False
        by blast
    qed
  qed
  have tail_key_remaining:
    "p. p  set ?tail  fst p  keys_of (bp_view P')"
  proof -
    fix p
    assume p_tail: "p  set ?tail"
    have old: "fst p  keys_of (bp_view P)"
      unfolding bp_view_def bp_entry_keys_def entries_P using p_tail by auto
    have not_S: "fst p  S"
      by (rule tail_key_notin_S[OF p_tail])
    show "fst p  keys_of (bp_view P')"
      using old not_S unfolding P'_keys by blast
  qed
  have remaining_nonempty: "keys_of (bp_view P')  {}"
  proof -
    obtain p where p_tail: "p  set ?tail"
      using tail_nonempty by (cases ?tail) auto
    then have "fst p  keys_of (bp_view P')"
      by (rule tail_key_remaining)
    then show ?thesis by blast
  qed
  have lower_remaining:
    "v. v  keys_of (bp_view P')  beta  value_of (bp_view P') v"
  proof -
    fix v
    assume v: "v  keys_of (bp_view P')"
    then have v_old: "v  keys_of (bp_view P)"
      using P'_keys by blast
    then obtain p where p_entries: "p  set (bp_entries P)"
      and fst_p: "fst p = v"
      unfolding bp_view_def bp_entry_keys_def by auto
    have v_not_S: "v  S"
      using v P'_keys by blast
    have p_tail: "p  set ?tail"
    proof -
      have "p  set (bp_bucket_entries b)"
        using v_not_S fst_p unfolding S_def bp_bucket_keys_def bp_entry_keys_def
        by auto
      then show ?thesis
        using p_entries unfolding entries_P by auto
    qed
    have "beta  snd p"
      unfolding beta_def
      by (rule bp_tail_entry_ge_head_marker[OF sorted_tail lower_tail p_tail])
    moreover have "value_of (bp_view P') v = snd p"
    proof -
      have "value_of (bp_view P) v = snd p"
        using values_P[OF p_entries] fst_p unfolding bp_view_def by simp
      moreover have "value_of (bp_view P') v = value_of (bp_view P) v"
        using P'_values by simp
      ultimately show ?thesis by simp
    qed
    ultimately show "beta  value_of (bp_view P') v"
      by simp
  qed
  have pulled_before_remaining:
    "u v. u  S; v  keys_of (bp_view P')
       value_of (bp_view P) u  value_of (bp_view P') v"
  proof -
    fix u v
    assume u: "u  S" and v: "v  keys_of (bp_view P')"
    have "value_of (bp_view P) u < beta"
      by (rule pulled_lt_beta[OF u])
    moreover have "beta  value_of (bp_view P') v"
      by (rule lower_remaining[OF v])
    ultimately show "value_of (bp_view P) u  value_of (bp_view P') v"
      by simp
  qed
  show ?thesis
    unfolding pull_separates_def
    using S_subset card_S P'_keys P'_values remaining_nonempty
      pulled_before_remaining pulled_lt_beta lower_remaining
    by auto
qed

lemma bp_conservative_pull_invariant:
  assumes inv: "bp_invariant P"
    and pull: "bp_conservative_pull M B P = (S, beta, P')"
  shows "bp_invariant P'"
proof -
  have "P' = bp_delete_keys S P"
    using pull unfolding bp_conservative_pull_def by (auto simp: Let_def)
  then show ?thesis
    by (simp add: bp_delete_keys_invariant[OF inv])
qed

theorem bp_conservative_pull_refines_pull_separates:
  assumes inv: "bp_invariant P"
    and upper: "u. u  keys_of (bp_view P) 
      value_of (bp_view P) u < B"
    and pull: "bp_conservative_pull M B P = (S, beta, P')"
  shows "pull_separates (bp_view P) M B S beta (bp_view P')"
proof -
  have S_def: "S = bp_pull_set M P"
    and beta_def: "beta = bp_pull_bound M B P"
    and P'_def: "P' = bp_delete_keys S P"
    using pull unfolding bp_conservative_pull_def by (auto simp: Let_def)
  show ?thesis
  proof (cases "length (bp_entries P)  M")
    case True
    have S_keys: "S = keys_of (bp_view P)"
      using True unfolding S_def bp_pull_set_def bp_view_def by simp
    have beta_B: "beta = B"
      using True unfolding beta_def bp_pull_bound_def by simp
    have keys_empty: "keys_of (bp_view P') = {}"
      unfolding P'_def bp_delete_keys_view S_keys by simp
    have card_S: "card S  M"
    proof -
      have "card S = card (fst ` set (bp_entries P))"
        unfolding S_keys bp_view_def bp_entry_keys_def by simp
      also have "  card (set (bp_entries P))"
        by (rule card_image_le) simp
      also have "  length (bp_entries P)"
        by (rule card_length)
      also have "  M"
        by (rule True)
      finally show ?thesis .
    qed
    show ?thesis
      unfolding pull_separates_def P'_def bp_delete_keys_view
      using S_keys beta_B keys_empty card_S by auto
  next
    case False
    have S_empty: "S = {}"
      using False unfolding S_def bp_pull_set_def by simp
    have beta_min: "beta = bp_min_value B (bp_entries P)"
      using False unfolding beta_def bp_pull_bound_def by simp
    have P'_same: "P' = P"
      unfolding P'_def S_empty bp_delete_keys_def bp_delete_keys_from_bucket_def
      by simp
    have keys_nonempty: "keys_of (bp_view P')  {}"
    proof
      assume empty: "keys_of (bp_view P') = {}"
      then have "set (bp_entries P) = {}"
        unfolding P'_same bp_view_def bp_entry_keys_def by auto
      then have "length (bp_entries P) = 0"
        by simp
      then show False
        using False by simp
    qed
    have lower:
      "v. v  keys_of (bp_view P')  beta  value_of (bp_view P') v"
    proof -
      fix v
      assume v: "v  keys_of (bp_view P')"
      then obtain b where vb: "(v, b)  set (bp_entries P)"
        unfolding P'_same bp_view_def bp_entry_keys_def by auto
      have "bp_min_value B (bp_entries P)  b"
        by (rule bp_min_value_le_entry[OF vb])
      moreover have "bp_values P v = b"
        using inv vb by (auto simp: bp_invariant_def bp_values_consistent_def)
      ultimately show "beta  value_of (bp_view P') v"
        unfolding beta_min P'_same bp_view_def by simp
    qed
    have keys_nonempty_P: "keys_of (bp_view P)  {}"
      using keys_nonempty unfolding P'_same .
    have lower_P:
      "v. v  keys_of (bp_view P)  beta  value_of (bp_view P) v"
      using lower unfolding P'_same .
    show ?thesis
      unfolding pull_separates_def P'_same S_empty
      using lower_P keys_nonempty_P by auto
  qed
qed

lemma bp_pull_invariant:
  assumes inv: "bp_invariant P"
    and pull: "bp_pull M B P = (S, beta, P')"
  shows "bp_invariant P'"
proof (cases "bp_can_first_bucket_pull M P")
  case True
  have first_pull: "bp_first_bucket_pull M B P = (S, beta, P')"
    using pull True unfolding bp_pull_def by simp
  show ?thesis
    by (rule bp_first_bucket_pull_invariant[OF inv first_pull])
next
  case False
  have conservative_pull: "bp_conservative_pull M B P = (S, beta, P')"
    using pull False unfolding bp_pull_def by simp
  show ?thesis
    by (rule bp_conservative_pull_invariant[OF inv conservative_pull])
qed

lemma bp_first_bucket_pull_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
    and pull: "bp_first_bucket_pull M B P = (S, beta, P')"
  shows "bp_ordered_invariant P'"
proof -
  have cases: "P' = P  (T. P' = bp_delete_keys T P)"
    using pull unfolding bp_first_bucket_pull_def
    by (cases "bp_buckets P"; auto split: list.splits)
  then show ?thesis
  proof
    assume "P' = P"
    then show ?thesis
      using ord by simp
  next
    assume "T. P' = bp_delete_keys T P"
    then obtain T where "P' = bp_delete_keys T P"
      by blast
    then show ?thesis
      using bp_delete_keys_ordered_invariant[OF ord] by simp
  qed
qed

lemma bp_conservative_pull_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
    and pull: "bp_conservative_pull M B P = (S, beta, P')"
  shows "bp_ordered_invariant P'"
proof -
  have "P' = bp_delete_keys S P"
    using pull unfolding bp_conservative_pull_def by (auto simp: Let_def)
  then show ?thesis
    using bp_delete_keys_ordered_invariant[OF ord] by simp
qed

lemma bp_pull_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
    and pull: "bp_pull M B P = (S, beta, P')"
  shows "bp_ordered_invariant P'"
proof (cases "bp_can_first_bucket_pull M P")
  case True
  have first_pull: "bp_first_bucket_pull M B P = (S, beta, P')"
    using pull True unfolding bp_pull_def by simp
  show ?thesis
    by (rule bp_first_bucket_pull_ordered_invariant[OF ord first_pull])
next
  case False
  have conservative_pull: "bp_conservative_pull M B P = (S, beta, P')"
    using pull False unfolding bp_pull_def by simp
  show ?thesis
    by (rule bp_conservative_pull_ordered_invariant
        [OF ord conservative_pull])
qed

theorem bp_pull_refines_pull_separates:
  assumes inv: "bp_invariant P"
    and upper: "u. u  keys_of (bp_view P) 
      value_of (bp_view P) u < B"
    and pull: "bp_pull M B P = (S, beta, P')"
  shows "pull_separates (bp_view P) M B S beta (bp_view P')"
proof (cases "bp_can_first_bucket_pull M P")
  case True
  obtain b c bs where buckets: "bp_buckets P = b # c # bs"
    and len_b: "length (bp_bucket_entries b)  M"
    and below: "bp_bucket_below_bound b (bp_marker c)"
    and tail_nonempty: "bp_bucket_entries_flat (c # bs)  []"
    by (rule bp_can_first_bucket_pullE[OF True])
  have first_pull: "bp_first_bucket_pull M B P = (S, beta, P')"
    using pull True unfolding bp_pull_def by simp
  show ?thesis
    by (rule bp_first_bucket_pull_refines_pull_separates
        [OF inv buckets len_b below tail_nonempty first_pull])
next
  case False
  have conservative_pull: "bp_conservative_pull M B P = (S, beta, P')"
    using pull False unfolding bp_pull_def by simp
  show ?thesis
    by (rule bp_conservative_pull_refines_pull_separates
        [OF inv upper conservative_pull])
qed

theorem bp_pull_preserves_upper_bound:
  assumes inv: "bp_invariant P"
    and pull_upper: "partition_upper_bound (bp_view P) Bpull"
    and upper: "partition_upper_bound (bp_view P) B"
    and pull: "bp_pull M Bpull P = (S, beta, P')"
  shows "partition_upper_bound (bp_view P') B"
proof -
  have sep: "pull_separates (bp_view P) M Bpull S beta (bp_view P')"
  proof (rule bp_pull_refines_pull_separates[OF inv _ pull])
    fix u
    assume "u  keys_of (bp_view P)"
    then show "value_of (bp_view P) u < Bpull"
      using pull_upper unfolding partition_upper_bound_def by blast
  qed
  show ?thesis
    by (rule pull_separates_preserves_upper_bound[OF sep upper])
qed

text ‹
  The preceding block completes the functional refinement layer.  Insert and
  BatchPrepend update the view by minimum-value update, while Pull satisfies
  @{const pull_separates}: it returns at most the requested block, removes those
  keys, and establishes the returned boundary between pulled and remaining
  entries.  The implementation attempts a cheap first-bucket pull when the
  ordered boundary proves it is safe; otherwise it uses the
  conservative pull specification.  Both branches preserve @{const bp_invariant}
  and the abstract upper-bound condition.
›


section ‹Cost Budgets for the Bucketed Structure›

text ‹
  The cost layer counts primitive functional steps by pairing each operation
  result with a natural number.  The budget definitions isolate the
  paper-critical logarithmic search term as a function of N / M›, where
  N› is represented by an entry-list length and M› by the block size.
  The potential terms record the credits that pay for lazy bucket splitting and
  for restoring the bucket-count ratio after a rebuild.
›

definition bp_steps_of :: "'a × nat  nat" where
  "bp_steps_of r = snd r"

definition bp_result_of :: "'a × nat  'a" where
  "bp_result_of r = fst r"

lemma bp_steps_of_pair [simp]:
  "bp_steps_of (x, c) = c"
  unfolding bp_steps_of_def by simp

lemma bp_result_of_pair [simp]:
  "bp_result_of (x, c) = x"
  unfolding bp_result_of_def by simp

lemma bp_result_of_add_cost_case [simp]:
  "bp_result_of (case r of (x, c')  (x, c + c')) = bp_result_of r"
  by (cases r) simp

lemma bp_steps_of_add_cost_case [simp]:
  "bp_steps_of (case r of (x, c')  (x, c + c')) =
    c + bp_steps_of r"
  by (cases r) simp

definition bp_ratio_log_budget :: "nat  nat  nat" where
  "bp_ratio_log_budget N M = Suc (floor_log (Suc (N div M)))"

definition bp_insert_search_budget :: "nat  nat  nat" where
  "bp_insert_search_budget N M = Suc (bp_ratio_log_budget N M)"

definition bp_lazy_insert_amortized_budget ::
  "'k bucketed_partition  nat" where
  "bp_lazy_insert_amortized_budget P =
     bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) + 7"

definition bp_batch_prepend_log_budget :: "('k × real) list  nat  nat" where
  "bp_batch_prepend_log_budget xs M =
     length xs * bp_ratio_log_budget (length xs) M"

definition bp_batch_prepend_per_item_budget ::
  "('k × real) list  nat  nat" where
  "bp_batch_prepend_per_item_budget xs M =
     Suc (bp_ratio_log_budget (length xs) M)"

definition bp_batch_prepend_amortized_budget ::
  "('k × real) list  nat  nat" where
  "bp_batch_prepend_amortized_budget xs M =
     length xs + bp_batch_prepend_log_budget xs M"

definition bp_pull_amortized_budget :: "nat  nat" where
  "bp_pull_amortized_budget M = 2 * M"

definition bp_local_split_budget :: "nat  nat" where
  "bp_local_split_budget M = Suc (2 * Suc M)"

definition bp_lazy_split_budget :: "nat  nat" where
  "bp_lazy_split_budget M = 5 + 4 * M"

definition bp_bucket_overflow :: "nat  'k bp_bucket  nat" where
  "bp_bucket_overflow M b = length (bp_bucket_entries b) - M"

definition bp_bucket_overflow_sum ::
  "nat  'k bp_bucket list  nat" where
  "bp_bucket_overflow_sum M bs =
     sum_list (map (bp_bucket_overflow M) bs)"

definition bp_overflow_potential :: "'k bucketed_partition  nat" where
  "bp_overflow_potential P =
     sum_list (map (bp_bucket_overflow (bp_block_size P)) (bp_buckets P))"

definition bp_bucket_count_slack :: "'k bucketed_partition  nat" where
  "bp_bucket_count_slack P =
     length (bp_buckets P) -
       Suc (length (bp_entries P) div bp_block_size P)"

definition bp_split_potential :: "'k bucketed_partition  nat" where
  "bp_split_potential P =
     4 * bp_overflow_potential P + bp_bucket_count_slack P"

definition bp_amortized_step_bound ::
  "nat  'k bucketed_partition  'k bucketed_partition  nat  bool" where
  "bp_amortized_step_bound c P P' t 
     c + bp_split_potential P'  t + bp_split_potential P"

definition bp_pull_state_of ::
  "'k set × real × 'k bucketed_partition  'k bucketed_partition" where
  "bp_pull_state_of R = (case R of (_, _, P')  P')"

definition bp_pull_amortized_step_bound ::
  "nat  'k bucketed_partition 
    ('k set × real × 'k bucketed_partition)  nat  bool" where
  "bp_pull_amortized_step_bound c P R t 
     c + bp_split_potential (bp_pull_state_of R) 
       t + bp_split_potential P"

definition bp_bucket_count_ratio_ok :: "'k bucketed_partition  bool" where
  "bp_bucket_count_ratio_ok P 
     0 < bp_block_size P 
     length (bp_buckets P) 
       Suc (length (bp_entries P) div bp_block_size P)"

definition bp_regular_invariant :: "'k bucketed_partition  bool" where
  "bp_regular_invariant P 
     bp_ordered_invariant P  bp_bucket_count_ratio_ok P"

definition bp_bucket_count_loaded :: "'k bucketed_partition  bool" where
  "bp_bucket_count_loaded P 
     bp_block_size P * (length (bp_buckets P) - 1) 
       length (bp_entries P)"

definition bp_bucket_search_steps :: "'k bucketed_partition  nat" where
  "bp_bucket_search_steps P = Suc (floor_log (length (bp_buckets P)))"

fun bp_halving_search_steps :: "nat  nat" where
  [simp del]: "bp_halving_search_steps n =
    (if n < 2 then 1 else Suc (bp_halving_search_steps (n div 2)))"

definition bp_local_insert_search_charge :: "'k bucketed_partition  nat" where
  "bp_local_insert_search_charge P = Suc (bp_bucket_search_steps P)"

definition c_bp_bucket_directory_search ::
  "'k bp_bucket list  real  unit × nat" where
  "c_bp_bucket_directory_search bs b =
     ((), bp_halving_search_steps (length bs))"

fun c_bp_bucketize_sorted_entries_aux ::
  "nat  nat  ('k × real) list  'k bp_bucket list × nat" where
  "c_bp_bucketize_sorted_entries_aux 0 M xs = ([], 0)"
| "c_bp_bucketize_sorted_entries_aux (Suc fuel) M xs =
     (if M = 0  xs = []
      then ([], 0)
      else (let (bs, c) =
              c_bp_bucketize_sorted_entries_aux fuel M (drop M xs)
            in (bp_make_bucket (take M xs) # bs,
                Suc (length (take M xs) + c))))"

definition c_bp_bucketize_sorted_entries ::
  "nat  ('k × real) list  'k bp_bucket list × nat" where
  "c_bp_bucketize_sorted_entries M xs =
     c_bp_bucketize_sorted_entries_aux (length xs) M xs"

definition c_bp_bucketize_entries ::
  "nat  ('k × real) list  'k bp_bucket list × nat" where
  "c_bp_bucketize_entries M xs =
     c_bp_bucketize_sorted_entries M (sort_key snd xs)"

definition c_bp_rebucket_build ::
  "'k bucketed_partition  'k bucketed_partition × nat" where
  "c_bp_rebucket_build P =
     (case c_bp_bucketize_entries (bp_block_size P) (bp_entries P) of
        (bs, c)  (Pbp_buckets := bs, c))"

text ‹
  The definitions above introduce the amortized accounting used throughout the
  cost proof.  @{const bp_ratio_log_budget} is the formal ratio-log term:
  it applies @{const floor_log} to Suc (N div M)›, avoiding division by zero
  corner cases at the statement level.  The actual bucket-directory search is
  modeled by @{const bp_halving_search_steps}, and
  @{const bp_bucket_search_steps} records the resulting cost for a state.

  The potential @{const bp_split_potential} has two components.  The weighted
  overflow component @{const bp_overflow_potential} counts entries above the
  strict block size, multiplied by four in the combined potential.  The
  @{const bp_bucket_count_slack} component measures how far the bucket count is
  above the target ratio.  A regular state, captured by
  @{const bp_regular_invariant}, has no such debt: it is ordered and satisfies
  @{const bp_bucket_count_ratio_ok}.  The amortized predicates
  @{const bp_amortized_step_bound} and @{const bp_pull_amortized_step_bound}
  express the usual inequality actual + Phi(after) <= budget + Phi(before)›.
›

definition c_bp_local_insert_search ::
  "'k  real  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_local_insert_search x b P =
     (bp_local_insert_state x b P, bp_local_insert_search_charge P)"

definition c_bp_local_insert_split ::
  "'k  real  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_local_insert_split x b P =
     (bp_local_insert_state x b P,
      bp_local_insert_search_charge P +
        bp_local_split_budget (bp_block_size P))"

definition c_bp_lazy_insert ::
  "'k  real  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_lazy_insert x b P =
     (bp_lazy_insert_state x b P,
      bp_local_insert_search_charge P +
        bp_lazy_split_budget (bp_block_size P))"

definition bp_lazy_bucket_insert_charge ::
  "nat  'k bp_bucket  nat" where
  "bp_lazy_bucket_insert_charge M b =
     (if length (bp_bucket_entries b) < 2 * M
      then 1 else bp_lazy_split_budget M)"

fun bp_lazy_insert_bucket_charge ::
  "nat  'k × real  'k bp_bucket list  nat" where
  "bp_lazy_insert_bucket_charge M p [] = 1"
| "bp_lazy_insert_bucket_charge M p [b] =
     (if snd p < bp_marker b then 1
      else bp_lazy_bucket_insert_charge M b)"
| "bp_lazy_insert_bucket_charge M p (b # c # bs) =
     (if snd p < bp_marker b then 1
      else if snd p < bp_marker c
        then bp_lazy_bucket_insert_charge M b
        else bp_lazy_insert_bucket_charge M p (c # bs))"

definition bp_lazy_insert_charge ::
  "'k  real  'k bucketed_partition  nat" where
  "bp_lazy_insert_charge x b P =
     (let b' = (if x  bp_entry_keys (bp_entries P)
          then min (bp_values P x) b else b);
        P0 = bp_delete_key x P
      in bp_lazy_insert_bucket_charge (bp_block_size P0) (x, b')
           (bp_buckets P0))"

definition c_bp_lazy_insert_precise ::
  "'k  real  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_lazy_insert_precise x b P =
     (bp_lazy_insert_state x b P,
      bp_local_insert_search_charge P + bp_lazy_insert_charge x b P)"

fun bp_lazy_batch_prepend_state ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition" where
  "bp_lazy_batch_prepend_state [] P = P"
| "bp_lazy_batch_prepend_state ((x, b) # xs) P =
     bp_lazy_batch_prepend_state xs (bp_lazy_insert_state x b P)"

fun c_bp_lazy_batch_prepend_precise ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_lazy_batch_prepend_precise [] P = (P, 0)"
| "c_bp_lazy_batch_prepend_precise ((x, b) # xs) P =
     (case c_bp_lazy_insert_precise x b P of
        (P1, c1) 
          (case c_bp_lazy_batch_prepend_precise xs P1 of
             (P2, c2)  (P2, c1 + c2)))"

fun bp_lazy_batch_ratio_ok ::
  "('k × real) list  'k bucketed_partition  bool" where
  "bp_lazy_batch_ratio_ok [] P  True"
| "bp_lazy_batch_ratio_ok ((x, b) # xs) P 
     bp_bucket_count_ratio_ok P 
     bp_lazy_batch_ratio_ok xs
       (bp_result_of (c_bp_lazy_insert_precise x b P))"

fun bp_lazy_batch_insert_budget_sum ::
  "('k × real) list  'k bucketed_partition  nat" where
  "bp_lazy_batch_insert_budget_sum [] P = 0"
| "bp_lazy_batch_insert_budget_sum ((x, b) # xs) P =
     bp_lazy_insert_amortized_budget P +
     bp_lazy_batch_insert_budget_sum xs
       (bp_result_of (c_bp_lazy_insert_precise x b P))"

lemma c_bp_lazy_insert_precise_eq [simp]:
  "c_bp_lazy_insert_precise x b P =
    (bp_lazy_insert_state x b P,
     bp_local_insert_search_charge P + bp_lazy_insert_charge x b P)"
  unfolding c_bp_lazy_insert_precise_def by simp

definition bp_regularized_local_insert ::
  "'k  real  'k bucketed_partition  'k bucketed_partition" where
  "bp_regularized_local_insert x b P =
     bp_rebucket (bp_local_insert_state x b P)"

definition c_bp_regularized_local_insert ::
  "'k  real  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_regularized_local_insert x b P =
     (bp_regularized_local_insert x b P, bp_local_insert_search_charge P)"

text ‹
  This wrapper counts the concrete rebuilding pass explicitly.  It is an
  accounting bridge for the later lazy-split analysis, not the final insert
  operation bound: rebuilding every bucket has a linear term.
›

definition c_bp_regularized_local_insert_build ::
  "'k  real  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_regularized_local_insert_build x b P =
     (case c_bp_rebucket_build (bp_local_insert_state x b P) of
        (P', c)  (P', bp_local_insert_search_charge P + c))"

definition c_bp_rebucketed_batch_prepend_bulk ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_rebucketed_batch_prepend_bulk xs P =
     (bp_rebucketed_batch_prepend xs P,
      bp_batch_prepend_log_budget xs (bp_block_size P))"

definition c_bp_bucketed_batch_prepend_direct ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_bucketed_batch_prepend_direct xs P =
     (bp_bucketed_batch_prepend_state xs P,
      bp_batch_prepend_amortized_budget xs (bp_block_size P))"

definition c_bp_bucketed_batch_prepend_direct_actual ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_bucketed_batch_prepend_direct_actual xs P =
     (bp_bucketed_batch_prepend_state xs P,
      bp_batch_prepend_log_budget xs (bp_block_size P))"

definition c_bp_first_bucket_pull ::
  "nat  real  'k bucketed_partition 
    ('k set × real × 'k bucketed_partition) × nat" where
  "c_bp_first_bucket_pull M B P = (bp_first_bucket_pull M B P, M)"

definition c_bp_first_bucket_pull_scan ::
  "nat  real  'k bucketed_partition 
    ('k set × real × 'k bucketed_partition) × nat" where
  "c_bp_first_bucket_pull_scan M B P =
     (case bp_first_bucket_pull M B P of
        (S, beta, P')  ((S, beta, P'), card S))"

lemma bp_ratio_log_budget_pos [simp]:
  "0 < bp_ratio_log_budget N M"
  unfolding bp_ratio_log_budget_def by simp

lemma bp_insert_search_budget_pos [simp]:
  "0 < bp_insert_search_budget N M"
  unfolding bp_insert_search_budget_def by simp

lemma bp_lazy_insert_amortized_budget_ratio:
  "bp_lazy_insert_amortized_budget P =
     bp_ratio_log_budget (length (bp_entries P)) (bp_block_size P) + 8"
  unfolding bp_lazy_insert_amortized_budget_def bp_insert_search_budget_def
  by simp

lemma bp_batch_prepend_amortized_budget_alt:
  "bp_batch_prepend_amortized_budget xs M =
     bp_batch_prepend_per_item_budget xs M * length xs"
  unfolding bp_batch_prepend_amortized_budget_def
    bp_batch_prepend_log_budget_def
    bp_batch_prepend_per_item_budget_def
  by (simp add: algebra_simps)

lemma bp_batch_prepend_log_budget_le_amortized_budget:
  "bp_batch_prepend_log_budget xs M 
    bp_batch_prepend_amortized_budget xs M"
  unfolding bp_batch_prepend_amortized_budget_def by simp

lemma bp_halving_search_steps_eq_floor_log:
  "bp_halving_search_steps n = Suc (floor_log n)"
  by (induction n rule: bp_halving_search_steps.induct)
    (simp add: bp_halving_search_steps.simps floor_log.simps)

lemma c_bp_bucket_directory_search_result [simp]:
  "bp_result_of (c_bp_bucket_directory_search bs b) = ()"
  unfolding bp_result_of_def c_bp_bucket_directory_search_def by simp

lemma c_bp_bucket_directory_search_steps [simp]:
  "bp_steps_of (c_bp_bucket_directory_search bs b) =
    bp_halving_search_steps (length bs)"
  unfolding bp_steps_of_def c_bp_bucket_directory_search_def by simp

lemma c_bp_bucket_directory_search_steps_floor_log:
  "bp_steps_of (c_bp_bucket_directory_search bs b) =
    Suc (floor_log (length bs))"
  by (simp add: bp_halving_search_steps_eq_floor_log)

lemma c_bp_bucket_directory_search_state_steps:
  "bp_steps_of (c_bp_bucket_directory_search (bp_buckets P) b) =
    bp_bucket_search_steps P"
proof -
  have "bp_steps_of (c_bp_bucket_directory_search (bp_buckets P) b) =
      Suc (floor_log (length (bp_buckets P)))"
    by (simp add: bp_halving_search_steps_eq_floor_log)
  also have " = bp_bucket_search_steps P"
    unfolding bp_bucket_search_steps_def by simp
  finally show ?thesis .
qed

lemma c_bp_bucket_directory_search_ratio_bound:
  assumes count_le: "length bs  Suc (N div M)"
  shows "bp_steps_of (c_bp_bucket_directory_search bs b) 
    bp_ratio_log_budget N M"
proof -
  have "floor_log (length bs)  floor_log (Suc (N div M))"
    by (rule floor_log_le_iff[OF count_le])
  then show ?thesis
    unfolding bp_ratio_log_budget_def
    by (simp add: bp_halving_search_steps_eq_floor_log)
qed

lemma bp_local_insert_search_charge_search_steps:
  "bp_local_insert_search_charge P =
    Suc (bp_steps_of
      (c_bp_bucket_directory_search (bp_buckets P) b))"
proof -
  have search:
    "bp_steps_of (c_bp_bucket_directory_search (bp_buckets P) b) =
      bp_bucket_search_steps P"
    by (rule c_bp_bucket_directory_search_state_steps)
  show ?thesis
    unfolding bp_local_insert_search_charge_def using search by simp
qed

lemma c_bp_bucketize_sorted_entries_aux_empty [simp]:
  "c_bp_bucketize_sorted_entries_aux fuel M [] = ([], 0)"
  by (cases fuel) simp_all

lemma c_bp_bucketize_sorted_entries_aux_result [simp]:
  "bp_result_of (c_bp_bucketize_sorted_entries_aux fuel M xs) =
    bp_bucketize_sorted_entries_aux fuel M xs"
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by (simp add: bp_result_of_def)
next
  case (Suc fuel)
  show ?case
  proof (cases "M = 0  xs = []")
    case True
    then show ?thesis
      by (simp add: bp_result_of_def)
  next
    case False
    obtain bs c where rec:
      "c_bp_bucketize_sorted_entries_aux fuel M (drop M xs) = (bs, c)"
      by (cases "c_bp_bucketize_sorted_entries_aux fuel M (drop M xs)")
        simp
    have bs:
      "bs = bp_bucketize_sorted_entries_aux fuel M (drop M xs)"
      using Suc.IH[of "drop M xs"] rec
      by (simp add: bp_result_of_def)
    show ?thesis
      using False rec bs by (simp add: bp_result_of_def Let_def)
  qed
qed

lemma c_bp_bucketize_sorted_entries_result [simp]:
  "bp_result_of (c_bp_bucketize_sorted_entries M xs) =
    bp_bucketize_sorted_entries M xs"
  unfolding c_bp_bucketize_sorted_entries_def
    bp_bucketize_sorted_entries_def by simp

lemma c_bp_bucketize_entries_result [simp]:
  "bp_result_of (c_bp_bucketize_entries M xs) = bp_bucketize_entries M xs"
  unfolding c_bp_bucketize_entries_def bp_bucketize_entries_def by simp

lemma c_bp_bucketize_sorted_entries_aux_steps_le:
  assumes M_pos: "0 < M"
    and fuel: "length xs  fuel"
  shows "bp_steps_of (c_bp_bucketize_sorted_entries_aux fuel M xs) 
    length xs + Suc (length xs div M)"
  using M_pos fuel
proof (induction fuel arbitrary: xs)
  case 0
  then show ?case
    by (simp add: bp_steps_of_def)
next
  case (Suc fuel)
  show ?case
  proof (cases "xs = []")
    case True
    then show ?thesis
      by (simp add: bp_steps_of_def)
  next
    case False
    note xs_nonempty = False
    show ?thesis
    proof (cases "length xs < M")
      case True
      then have "drop M xs = []"
        by simp
      then show ?thesis
        using Suc.prems xs_nonempty True by (simp add: bp_steps_of_def)
    next
      case False
      have M_le: "M  length xs"
        using False by simp
      have drop_fuel: "length (drop M xs)  fuel"
        using Suc.prems False by simp
      have tail:
        "bp_steps_of
          (c_bp_bucketize_sorted_entries_aux fuel M (drop M xs)) 
          length (drop M xs) + Suc (length (drop M xs) div M)"
        by (rule Suc.IH[OF Suc.prems(1) drop_fuel])
      have len_xs: "length xs = M + length (drop M xs)"
        using M_le by simp
      have take_len: "length (take M xs) = M"
        using M_le by simp
      have div_eq:
        "length xs div M = Suc (length (drop M xs) div M)"
      proof -
        have "length xs div M = (M + length (drop M xs)) div M"
          using len_xs by simp
        also have " = length (drop M xs) div M + 1"
          using Suc.prems(1) by (simp add: div_add_self1)
        finally show ?thesis by simp
      qed
      obtain bs c where rec:
        "c_bp_bucketize_sorted_entries_aux fuel M (drop M xs) = (bs, c)"
        by (cases "c_bp_bucketize_sorted_entries_aux fuel M (drop M xs)")
          simp
      have c_le:
        "c  length (drop M xs) + Suc (length (drop M xs) div M)"
        using tail rec unfolding bp_steps_of_def by simp
      have step_eq:
        "bp_steps_of
          (c_bp_bucketize_sorted_entries_aux (Suc fuel) M xs) =
          Suc (M + c)"
        using Suc.prems xs_nonempty False rec take_len
        by (simp add: bp_steps_of_def Let_def)
      have "Suc (M + c) 
          M + length (drop M xs) +
            Suc (Suc (length (drop M xs) div M))"
        using c_le by linarith
      show ?thesis
        using step_eq len_xs div_eq
          Suc (M + c) 
            M + length (drop M xs) +
              Suc (Suc (length (drop M xs) div M))
        by simp
    qed
  qed
qed

lemma c_bp_bucketize_sorted_entries_steps_le:
  assumes "0 < M"
  shows "bp_steps_of (c_bp_bucketize_sorted_entries M xs) 
    length xs + Suc (length xs div M)"
  unfolding c_bp_bucketize_sorted_entries_def
  by (rule c_bp_bucketize_sorted_entries_aux_steps_le[OF assms]) simp

lemma c_bp_bucketize_entries_steps_le:
  assumes "0 < M"
  shows "bp_steps_of (c_bp_bucketize_entries M xs) 
    length xs + Suc (length xs div M)"
  unfolding c_bp_bucketize_entries_def
  using c_bp_bucketize_sorted_entries_steps_le[OF assms,
      of "sort_key snd xs"]
  by simp

lemma c_bp_bucketize_entries_steps_le_linear_length:
  assumes "0 < M"
  shows "bp_steps_of (c_bp_bucketize_entries M xs) 
    Suc (2 * length xs)"
proof -
  have "length xs div M  length xs"
    by simp
  then have "length xs + Suc (length xs div M) 
      Suc (2 * length xs)"
    by linarith
  moreover have "bp_steps_of (c_bp_bucketize_entries M xs) 
      length xs + Suc (length xs div M)"
    by (rule c_bp_bucketize_entries_steps_le[OF assms])
  ultimately show ?thesis
    by linarith
qed

lemma c_bp_bucketize_entries_steps_le_local_split_budget:
  assumes M_pos: "0 < M"
    and len: "length xs  Suc M"
  shows "bp_steps_of (c_bp_bucketize_entries M xs) 
    bp_local_split_budget M"
proof -
  have steps:
    "bp_steps_of (c_bp_bucketize_entries M xs) 
      Suc (2 * length xs)"
    by (rule c_bp_bucketize_entries_steps_le_linear_length[OF M_pos])
  have "Suc (2 * length xs)  bp_local_split_budget M"
    using len unfolding bp_local_split_budget_def by simp
  then show ?thesis
    using steps by linarith
qed

lemma bp_local_split_budget_le_lazy_split_budget:
  "bp_local_split_budget M  bp_lazy_split_budget M"
  unfolding bp_local_split_budget_def bp_lazy_split_budget_def by simp

lemma c_bp_bucketize_entries_steps_le_lazy_split_budget:
  assumes M_pos: "0 < M"
    and len: "length xs  Suc (2 * M)"
  shows "bp_steps_of (c_bp_bucketize_entries M xs) 
    bp_lazy_split_budget M"
proof -
  have steps:
    "bp_steps_of (c_bp_bucketize_entries M xs) 
      Suc (2 * length xs)"
    by (rule c_bp_bucketize_entries_steps_le_linear_length[OF M_pos])
  have "Suc (2 * length xs)  bp_lazy_split_budget M"
    using len unfolding bp_lazy_split_budget_def by simp
  then show ?thesis
    using steps by linarith
qed

lemma bp_lazy_split_budget_paid_by_bucket_overflow:
  assumes large: "2 * M  length (bp_bucket_entries b)"
  shows "bp_lazy_split_budget M 
    5 + 4 * bp_bucket_overflow M b"
proof -
  have "M  bp_bucket_overflow M b"
    using large unfolding bp_bucket_overflow_def by linarith
  then show ?thesis
    unfolding bp_lazy_split_budget_def by simp
qed

lemma bp_bucket_overflow_sum_simps [simp]:
  "bp_bucket_overflow_sum M [] = 0"
  "bp_bucket_overflow_sum M (b # bs) =
    bp_bucket_overflow M b + bp_bucket_overflow_sum M bs"
  "bp_bucket_overflow_sum M (bs @ cs) =
    bp_bucket_overflow_sum M bs + bp_bucket_overflow_sum M cs"
  unfolding bp_bucket_overflow_sum_def by simp_all

lemma bp_overflow_potential_alt:
  "bp_overflow_potential P =
    bp_bucket_overflow_sum (bp_block_size P) (bp_buckets P)"
  unfolding bp_overflow_potential_def bp_bucket_overflow_sum_def by simp

lemma bp_bucket_overflow_sum_zero_if_sizes_ok:
  assumes sizes: "bset bs. length (bp_bucket_entries b)  M"
  shows "bp_bucket_overflow_sum M bs = 0"
  using sizes unfolding bp_bucket_overflow_sum_def bp_bucket_overflow_def
  by (induction bs) auto

lemma bp_bucket_overflow_cons_credit:
  fixes b :: "'k bp_bucket"
  shows "1 + 4 * bp_bucket_overflow M
      (bbp_bucket_entries := p # bp_bucket_entries b) 
    5 + 4 * bp_bucket_overflow M b"
proof -
  let ?l = "length (bp_bucket_entries b)"
  show ?thesis
  proof (cases "?l < M")
    case True
    then have "Suc ?l  M"
      by simp
    then have after: "bp_bucket_overflow M
        (bbp_bucket_entries := p # bp_bucket_entries b) = 0"
      unfolding bp_bucket_overflow_def by simp
    have before: "bp_bucket_overflow M b = 0"
      using True unfolding bp_bucket_overflow_def by simp
    show ?thesis
      unfolding after before by simp
  next
    case False
    then have M_le: "M  ?l"
      by simp
    have after: "bp_bucket_overflow M
        (bbp_bucket_entries := p # bp_bucket_entries b) =
      Suc (bp_bucket_overflow M b)"
      using M_le unfolding bp_bucket_overflow_def by simp
    show ?thesis
      unfolding after by simp
  qed
qed

lemma bp_lazy_bucket_insert_entries_weighted_overflow_credit:
  assumes M_pos: "0 < M"
    and size: "length (bp_bucket_entries b)  2 * M"
  shows "bp_lazy_bucket_insert_charge M b +
      4 * bp_bucket_overflow_sum M
        (bp_lazy_bucket_insert_entries M p b) 
    5 + 4 * bp_bucket_overflow M b"
proof (cases "length (bp_bucket_entries b) < 2 * M")
  case True
  have charge: "bp_lazy_bucket_insert_charge M b = 1"
    using True unfolding bp_lazy_bucket_insert_charge_def by simp
  have result:
    "bp_lazy_bucket_insert_entries M p b =
      [bbp_bucket_entries := p # bp_bucket_entries b]"
    using True unfolding bp_lazy_bucket_insert_entries_def by simp
  have credit:
    "1 + 4 * bp_bucket_overflow M
        (bbp_bucket_entries := p # bp_bucket_entries b) 
      5 + 4 * bp_bucket_overflow M b"
    by (rule bp_bucket_overflow_cons_credit)
  show ?thesis
    using credit unfolding charge result by simp
next
  case False
  have len_eq: "length (bp_bucket_entries b) = 2 * M"
    using False size by simp
  have charge: "bp_lazy_bucket_insert_charge M b = bp_lazy_split_budget M"
    using False unfolding bp_lazy_bucket_insert_charge_def by simp
  have result:
    "bp_lazy_bucket_insert_entries M p b =
      bp_bucketize_entries M (p # bp_bucket_entries b)"
    using False unfolding bp_lazy_bucket_insert_entries_def by simp
  have sizes:
    "cset (bp_bucketize_entries M (p # bp_bucket_entries b)).
      length (bp_bucket_entries c)  M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  have overflow_zero:
    "bp_bucket_overflow_sum M
      (bp_bucketize_entries M (p # bp_bucket_entries b)) = 0"
    by (rule bp_bucket_overflow_sum_zero_if_sizes_ok[OF sizes])
  have before: "bp_bucket_overflow M b = M"
    using len_eq unfolding bp_bucket_overflow_def by simp
  show ?thesis
    unfolding charge result overflow_zero before bp_lazy_split_budget_def
    by simp
qed

lemma bp_lazy_insert_bucket_weighted_overflow_credit:
  assumes M_pos: "0 < M"
    and sizes: "bset bs. length (bp_bucket_entries b)  2 * M"
  shows "bp_lazy_insert_bucket_charge M p bs +
      4 * bp_bucket_overflow_sum M (bp_lazy_insert_bucket M p bs) 
    5 + 4 * bp_bucket_overflow_sum M bs"
  using sizes
proof (induction bs arbitrary: p)
  case Nil
  have result: "bp_lazy_insert_bucket M p [] = bp_bucketize_entries M [p]"
    by simp
  have sizes_result:
    "cset (bp_bucketize_entries M [p]).
      length (bp_bucket_entries c)  M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  have overflow_zero:
    "bp_bucket_overflow_sum M (bp_bucketize_entries M [p]) = 0"
    by (rule bp_bucket_overflow_sum_zero_if_sizes_ok[OF sizes_result])
  show ?case
    unfolding result overflow_zero by simp
next
  case (Cons b bs)
  note IH = Cons.IH
  note sizes = Cons.prems
  have b_size: "length (bp_bucket_entries b)  2 * M"
    using sizes by simp
  show ?case
  proof (cases bs)
    case Nil
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have result:
        "bp_lazy_insert_bucket M p (b # bs) =
          bp_bucketize_entries M [p] @ [b]"
        using Nil True by simp
      have charge: "bp_lazy_insert_bucket_charge M p (b # bs) = 1"
        using Nil True by simp
      have sizes_single:
        "cset (bp_bucketize_entries M [p]).
          length (bp_bucket_entries c)  M"
        by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
      have overflow_single:
        "bp_bucket_overflow_sum M (bp_bucketize_entries M [p]) = 0"
        by (rule bp_bucket_overflow_sum_zero_if_sizes_ok[OF sizes_single])
      show ?thesis
        using Nil True overflow_single unfolding result charge by simp
    next
      case False
      have result:
        "bp_lazy_insert_bucket M p (b # bs) =
          bp_lazy_bucket_insert_entries M p b"
        using Nil False by simp
      have charge:
        "bp_lazy_insert_bucket_charge M p (b # bs) =
          bp_lazy_bucket_insert_charge M b"
        using Nil False by simp
      show ?thesis
        unfolding result charge using Nil
        by (simp add: bp_lazy_bucket_insert_entries_weighted_overflow_credit
            [OF M_pos b_size, of p])
    qed
  next
    case (Cons c cs)
    have tail_sizes:
      "bset bs. length (bp_bucket_entries b)  2 * M"
      using sizes by simp
    show ?thesis
    proof (cases "snd p < bp_marker b")
      case True
      have result:
        "bp_lazy_insert_bucket M p (b # bs) =
          bp_bucketize_entries M [p] @ b # bs"
        using Cons True by simp
      have charge: "bp_lazy_insert_bucket_charge M p (b # bs) = 1"
        using Cons True by simp
      have sizes_single:
        "cset (bp_bucketize_entries M [p]).
          length (bp_bucket_entries c)  M"
        by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
      have overflow_single:
        "bp_bucket_overflow_sum M (bp_bucketize_entries M [p]) = 0"
        by (rule bp_bucket_overflow_sum_zero_if_sizes_ok[OF sizes_single])
      show ?thesis
        using Cons True overflow_single unfolding result charge by simp
    next
      case False
      show ?thesis
      proof (cases "snd p < bp_marker c")
        case True
        have result:
          "bp_lazy_insert_bucket M p (b # bs) =
            bp_lazy_bucket_insert_entries M p b @ bs"
          using Cons False True by simp
        have charge:
          "bp_lazy_insert_bucket_charge M p (b # bs) =
            bp_lazy_bucket_insert_charge M b"
          using Cons False True by simp
        have bucket_credit:
          "bp_lazy_bucket_insert_charge M b +
              4 * bp_bucket_overflow_sum M
                (bp_lazy_bucket_insert_entries M p b) 
            5 + 4 * bp_bucket_overflow M b"
          by (rule bp_lazy_bucket_insert_entries_weighted_overflow_credit
              [OF M_pos b_size])
        show ?thesis
          using bucket_credit unfolding result charge
          by simp
      next
        case False
        have result:
          "bp_lazy_insert_bucket M p (b # bs) =
            b # bp_lazy_insert_bucket M p bs"
          using Cons ¬ snd p < bp_marker b False by simp
        have charge:
          "bp_lazy_insert_bucket_charge M p (b # bs) =
            bp_lazy_insert_bucket_charge M p bs"
          using Cons ¬ snd p < bp_marker b False by simp
        have tail_credit:
          "bp_lazy_insert_bucket_charge M p bs +
              4 * bp_bucket_overflow_sum M
                (bp_lazy_insert_bucket M p bs) 
            5 + 4 * bp_bucket_overflow_sum M bs"
          by (rule IH[OF tail_sizes])
        show ?thesis
          using tail_credit unfolding result charge by simp
      qed
    qed
  qed
qed

lemma bp_delete_key_from_bucket_overflow_le:
  "bp_bucket_overflow M (bp_delete_key_from_bucket x b) 
    bp_bucket_overflow M b"
proof -
  have len_le:
    "length (bp_bucket_entries (bp_delete_key_from_bucket x b)) 
      length (bp_bucket_entries b)"
    unfolding bp_delete_key_from_bucket_def by simp
  show ?thesis
    using len_le unfolding bp_bucket_overflow_def by simp
qed

lemma bp_bucket_overflow_sum_map_delete_key_le:
  "bp_bucket_overflow_sum M (map (bp_delete_key_from_bucket x) bs) 
    bp_bucket_overflow_sum M bs"
proof (induction bs)
  case Nil
  then show ?case by simp
next
  case (Cons b bs)
  have head:
    "bp_bucket_overflow M (bp_delete_key_from_bucket x b) 
      bp_bucket_overflow M b"
    by (rule bp_delete_key_from_bucket_overflow_le)
  show ?case
    using head Cons.IH by simp
qed

lemma bp_delete_key_overflow_potential_le:
  "bp_overflow_potential (bp_delete_key x P)  bp_overflow_potential P"
proof -
  have "bp_bucket_overflow_sum (bp_block_size P)
      (map (bp_delete_key_from_bucket x) (bp_buckets P)) 
    bp_bucket_overflow_sum (bp_block_size P) (bp_buckets P)"
    by (rule bp_bucket_overflow_sum_map_delete_key_le)
  then show ?thesis
    unfolding bp_delete_key_def bp_overflow_potential_alt by simp
qed

lemma bp_delete_keys_from_bucket_overflow_le:
  "bp_bucket_overflow M (bp_delete_keys_from_bucket S b) 
    bp_bucket_overflow M b"
proof -
  have len_le:
    "length (bp_bucket_entries (bp_delete_keys_from_bucket S b)) 
      length (bp_bucket_entries b)"
    unfolding bp_delete_keys_from_bucket_def by simp
  show ?thesis
    using len_le unfolding bp_bucket_overflow_def by simp
qed

lemma bp_bucket_overflow_sum_map_delete_keys_le:
  "bp_bucket_overflow_sum M (map (bp_delete_keys_from_bucket S) bs) 
    bp_bucket_overflow_sum M bs"
proof (induction bs)
  case Nil
  then show ?case by simp
next
  case (Cons b bs)
  have head:
    "bp_bucket_overflow M (bp_delete_keys_from_bucket S b) 
      bp_bucket_overflow M b"
    by (rule bp_delete_keys_from_bucket_overflow_le)
  show ?case
    using head Cons.IH by simp
qed

lemma bp_delete_keys_overflow_potential_le:
  "bp_overflow_potential (bp_delete_keys S P)  bp_overflow_potential P"
proof -
  have "bp_bucket_overflow_sum (bp_block_size P)
      (map (bp_delete_keys_from_bucket S) (bp_buckets P)) 
    bp_bucket_overflow_sum (bp_block_size P) (bp_buckets P)"
    by (rule bp_bucket_overflow_sum_map_delete_keys_le)
  then show ?thesis
    unfolding bp_delete_keys_def bp_overflow_potential_alt by simp
qed

lemma length_filter_fst_notin_le_card:
  assumes distinct: "distinct (map fst xs)"
    and finite: "finite S"
  shows "length xs  length (filter (λp. fst p  S) xs) + card S"
proof -
  let ?removed = "filter (λp. fst p  S) xs"
  have len_part:
    "length xs = length (filter (λp. fst p  S) xs) + length ?removed"
    by (induction xs) auto
  have distinct_removed: "distinct (map fst ?removed)"
    using distinct by (induction xs) auto
  have "length ?removed = card (set (map fst ?removed))"
    using distinct_card[OF distinct_removed] by simp
  also have "  card S"
    using finite by (intro card_mono) auto
  finally have "length ?removed  card S" .
  then show ?thesis
    using len_part by linarith
qed

lemma div_add_right_le_div_plus:
  fixes n k M :: nat
  assumes M_pos: "0 < M"
  shows "(n + k) div M  n div M + k"
proof -
  have n_less: "n < Suc (n div M) * M"
  proof -
    have "n div M < Suc (n div M)"
      by simp
    moreover have
      "n div M < Suc (n div M)  n < Suc (n div M) * M"
      by (rule div_less_iff_less_mult[OF M_pos])
    then show ?thesis
      using calculation by simp
  qed
  have k_le: "k  k * M"
    using M_pos by (cases M) auto
  have "n + k < Suc (n div M) * M + k * M"
    using n_less k_le by linarith
  also have " = (Suc (n div M) + k) * M"
    by (simp add: algebra_simps)
  finally have "(n + k) div M < Suc (n div M) + k"
    using M_pos by (simp add: div_less_iff_less_mult)
  then show ?thesis by simp
qed

lemma div_bound_after_delete:
  assumes M_pos: "0 < M"
    and len: "n  n' + k"
  shows "Suc (n div M)  Suc (n' div M) + k"
proof -
  have "n div M  (n' + k) div M"
    by (rule div_le_mono[OF len])
  also have "  n' div M + k"
    by (rule div_add_right_le_div_plus[OF M_pos])
  finally show ?thesis by simp
qed

lemma nat_diff_le_diff_add_right:
  fixes a c d k :: nat
  assumes "c  d + k"
  shows "a - d  (a - c) + k"
proof -
  have base: "a - d  (a - c) + (c - d)"
    by simp
  have "c - d  k"
    using assms by simp
  then show ?thesis
    using base by linarith
qed

lemma nat_diff_add_right_le:
  fixes a b c d k :: nat
  assumes a_le: "a  k + b"
    and d_le_c: "d  c"
  shows "a - c  k + (b - d)"
proof -
  have "a - c  (k + b) - c"
    using a_le by simp
  also have "  k + (b - c)"
    by arith
  also have "  k + (b - d)"
    using d_le_c by simp
  finally show ?thesis .
qed

lemma bp_delete_keys_entries_length_le:
  assumes distinct: "bp_distinct_keys P"
    and finite: "finite S"
  shows "length (bp_entries P) 
    length (bp_entries (bp_delete_keys S P)) + card S"
  using length_filter_fst_notin_le_card[OF _ finite, of "bp_entries P"]
    distinct
  unfolding bp_entries_delete_keys bp_distinct_keys_def by simp

lemma bp_delete_keys_bucket_count_slack_le:
  assumes M_pos: "0 < bp_block_size P"
    and distinct: "bp_distinct_keys P"
    and finite: "finite S"
  shows "bp_bucket_count_slack (bp_delete_keys S P) 
    bp_bucket_count_slack P + card S"
proof -
  let ?M = "bp_block_size P"
  let ?N = "length (bp_entries P)"
  let ?N' = "length (bp_entries (bp_delete_keys S P))"
  let ?K = "length (bp_buckets P)"
  have len: "?N  ?N' + card S"
    by (rule bp_delete_keys_entries_length_le[OF distinct finite])
  have divs: "Suc (?N div ?M)  Suc (?N' div ?M) + card S"
    by (rule div_bound_after_delete[OF M_pos len])
  have slack:
    "?K - Suc (?N' div ?M)  (?K - Suc (?N div ?M)) + card S"
    by (rule nat_diff_le_diff_add_right[OF divs])
  show ?thesis
    using slack unfolding bp_bucket_count_slack_def bp_delete_keys_def by simp
qed

lemma bp_delete_keys_split_potential_le:
  assumes M_pos: "0 < bp_block_size P"
    and distinct: "bp_distinct_keys P"
    and finite: "finite S"
  shows "bp_split_potential (bp_delete_keys S P) 
    bp_split_potential P + card S"
proof -
  have overflow:
    "bp_overflow_potential (bp_delete_keys S P)  bp_overflow_potential P"
    by (rule bp_delete_keys_overflow_potential_le)
  have slack:
    "bp_bucket_count_slack (bp_delete_keys S P) 
      bp_bucket_count_slack P + card S"
    by (rule bp_delete_keys_bucket_count_slack_le[OF M_pos distinct finite])
  show ?thesis
    using overflow slack unfolding bp_split_potential_def by linarith
qed

lemma bp_lazy_insert_state_weighted_overflow_credit_after_delete:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_insert_charge x b P +
      4 * bp_overflow_potential (bp_lazy_insert_state x b P) 
    5 + 4 * bp_overflow_potential (bp_delete_key x P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  let ?M = "bp_block_size ?P0"
  let ?bs = "bp_buckets ?P0"
  let ?new_bs = "bp_lazy_insert_bucket ?M (x, ?b) ?bs"
  let ?P' = "?P0bp_buckets := ?new_bs,
      bp_values := (bp_values P)(x := ?b)"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have inv0: "bp_lazy_invariant ?P0"
    by (rule bp_delete_key_lazy_invariant[OF inv])
  have M_pos: "0 < ?M"
    using inv0 unfolding bp_lazy_invariant_def by blast
  have sizes0:
    "cset ?bs. length (bp_bucket_entries c)  2 * ?M"
    using inv0 unfolding bp_lazy_invariant_def
      bp_lazy_bucket_sizes_ok_def by blast
  have list_credit:
    "bp_lazy_insert_bucket_charge ?M (x, ?b) ?bs +
        4 * bp_bucket_overflow_sum ?M ?new_bs 
      5 + 4 * bp_bucket_overflow_sum ?M ?bs"
    by (rule bp_lazy_insert_bucket_weighted_overflow_credit
        [OF M_pos sizes0])
  have state: "bp_lazy_insert_state x b P = ?P'"
    unfolding bp_lazy_insert_state_def Let_def by simp
  have charge:
    "bp_lazy_insert_charge x b P =
      bp_lazy_insert_bucket_charge ?M (x, ?b) ?bs"
    unfolding bp_lazy_insert_charge_def Let_def by simp
  show ?thesis
    using list_credit
    unfolding state charge bp_overflow_potential_alt by simp
qed

lemma bp_lazy_insert_state_weighted_overflow_credit:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_insert_charge x b P +
      4 * bp_overflow_potential (bp_lazy_insert_state x b P) 
    5 + 4 * bp_overflow_potential P"
proof -
  have after_delete:
    "bp_lazy_insert_charge x b P +
        4 * bp_overflow_potential (bp_lazy_insert_state x b P) 
      5 + 4 * bp_overflow_potential (bp_delete_key x P)"
    by (rule bp_lazy_insert_state_weighted_overflow_credit_after_delete
        [OF lazy])
  have delete_le:
    "bp_overflow_potential (bp_delete_key x P)  bp_overflow_potential P"
    by (rule bp_delete_key_overflow_potential_le)
  show ?thesis
    using after_delete delete_le by linarith
qed

lemma nat_diff_le_diff_add:
  fixes a b c d k :: nat
  assumes a_le: "a  b + k"
    and c_le: "c  d"
  shows "a - d  (b - c) + k"
proof -
  have "a - d  a - c"
    using c_le by simp
  also have "  (b + k) - c"
    using a_le by simp
  also have "  (b - c) + k"
    by simp
  finally show ?thesis .
qed

lemma bp_lazy_insert_state_bucket_count_slack_le:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_bucket_count_slack (bp_lazy_insert_state x b P) 
    bp_bucket_count_slack P + 2"
proof -
  let ?P' = "bp_lazy_insert_state x b P"
  let ?M = "bp_block_size P"
  have inv: "bp_lazy_invariant P"
    by (rule bp_lazy_ordered_invariant_lazy_invariant[OF lazy])
  have M_pos: "0 < ?M"
    using inv unfolding bp_lazy_invariant_def by blast
  have block: "bp_block_size ?P' = ?M"
    unfolding bp_lazy_insert_state_def bp_delete_key_def
    by (simp add: Let_def split: if_splits)
  have buckets:
    "length (bp_buckets ?P')  length (bp_buckets P) + 2"
    by (rule length_bp_lazy_insert_state_buckets_le[OF lazy])
  have entries:
    "length (bp_entries P)  length (bp_entries ?P')"
    by (rule length_bp_lazy_insert_state_entries_ge[OF lazy])
  have divs:
    "Suc (length (bp_entries P) div ?M) 
      Suc (length (bp_entries ?P') div ?M)"
    using entries by (simp add: div_le_mono)
  have slack:
    "length (bp_buckets ?P') -
        Suc (length (bp_entries ?P') div ?M) 
      (length (bp_buckets P) -
        Suc (length (bp_entries P) div ?M)) + 2"
    by (rule nat_diff_le_diff_add[OF buckets divs])
  show ?thesis
    using slack unfolding bp_bucket_count_slack_def block by simp
qed

lemma bp_lazy_insert_state_split_potential_credit:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_insert_charge x b P +
      bp_split_potential (bp_lazy_insert_state x b P) 
    7 + bp_split_potential P"
proof -
  have overflow:
    "bp_lazy_insert_charge x b P +
        4 * bp_overflow_potential (bp_lazy_insert_state x b P) 
      5 + 4 * bp_overflow_potential P"
    by (rule bp_lazy_insert_state_weighted_overflow_credit[OF lazy])
  have slack:
    "bp_bucket_count_slack (bp_lazy_insert_state x b P) 
      bp_bucket_count_slack P + 2"
    by (rule bp_lazy_insert_state_bucket_count_slack_le[OF lazy])
  show ?thesis
    using overflow slack unfolding bp_split_potential_def by linarith
qed

text ‹
  The lazy Insert credit proof is the core amortized argument.  A local insert
  either adds an entry to a bucket below the lazy threshold or splits the bucket
  into strict chunks.  The weighted overflow lemma pays for the expensive case:
  any actual lazy-insert charge plus four times the post-state overflow is at
  most a constant plus four times the pre-state overflow.  The bucket-count
  slack can increase by only a small constant.  Combining those facts yields
  @{thm bp_lazy_insert_state_split_potential_credit}, which is the precise
  credit inequality used by the costed Insert operation.
›

lemma c_bp_rebucket_build_result [simp]:
  "bp_result_of (c_bp_rebucket_build P) = bp_rebucket P"
proof -
  obtain bs c where build:
    "c_bp_bucketize_entries (bp_block_size P) (bp_entries P) = (bs, c)"
    by (cases "c_bp_bucketize_entries (bp_block_size P) (bp_entries P)")
      simp
  have bs:
    "bs = bp_bucketize_entries (bp_block_size P) (bp_entries P)"
    using c_bp_bucketize_entries_result[of "bp_block_size P" "bp_entries P"]
      build
    by (simp add: bp_result_of_def)
  show ?thesis
    using build bs unfolding bp_result_of_def c_bp_rebucket_build_def
      bp_rebucket_def
    by simp
qed

lemma c_bp_rebucket_build_steps_le:
  assumes inv: "bp_invariant P"
  shows "bp_steps_of (c_bp_rebucket_build P) 
    length (bp_entries P) +
      Suc (length (bp_entries P) div bp_block_size P)"
proof -
  have M_pos: "0 < bp_block_size P"
    using inv unfolding bp_invariant_def by blast
  have steps:
    "bp_steps_of
      (c_bp_bucketize_entries (bp_block_size P) (bp_entries P)) 
      length (bp_entries P) +
        Suc (length (bp_entries P) div bp_block_size P)"
    by (rule c_bp_bucketize_entries_steps_le[OF M_pos])
  show ?thesis
    using steps unfolding bp_steps_of_def c_bp_rebucket_build_def
    by (auto split: prod.splits)
qed

lemma bp_bucket_overflow_zero:
  assumes "length (bp_bucket_entries b)  M"
  shows "bp_bucket_overflow M b = 0"
  using assms unfolding bp_bucket_overflow_def by simp

lemma bp_overflow_potential_zero_if_sizes_ok:
  assumes "bp_bucket_sizes_ok P"
  shows "bp_overflow_potential P = 0"
proof -
  have "bset (bp_buckets P). bp_bucket_overflow (bp_block_size P) b = 0"
    using assms
    unfolding bp_bucket_sizes_ok_def
    by (simp add: bp_bucket_overflow_zero)
  then show ?thesis
    unfolding bp_overflow_potential_def by (induction "bp_buckets P") auto
qed

lemma bp_invariant_overflow_potential_zero:
  assumes "bp_invariant P"
  shows "bp_overflow_potential P = 0"
  by (rule bp_overflow_potential_zero_if_sizes_ok)
    (use assms in simp add: bp_invariant_def)

lemma bp_bucket_count_slack_zero_if_ratio_ok:
  assumes "bp_bucket_count_ratio_ok P"
  shows "bp_bucket_count_slack P = 0"
  using assms unfolding bp_bucket_count_ratio_ok_def
    bp_bucket_count_slack_def by simp

lemma bp_split_potential_zero_if_regular:
  assumes inv: "bp_invariant P"
    and ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_split_potential P = 0"
  using bp_invariant_overflow_potential_zero[OF inv]
    bp_bucket_count_slack_zero_if_ratio_ok[OF ratio]
  unfolding bp_split_potential_def by simp

lemma bp_bucket_search_steps_ratio_bound:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_bucket_search_steps P 
    bp_ratio_log_budget (length (bp_entries P)) (bp_block_size P)"
proof -
  have count_le:
    "length (bp_buckets P) 
      Suc (length (bp_entries P) div bp_block_size P)"
    using ratio unfolding bp_bucket_count_ratio_ok_def by blast
  have "floor_log (length (bp_buckets P)) 
      floor_log (Suc (length (bp_entries P) div bp_block_size P))"
    by (rule floor_log_le_iff[OF count_le])
  then show ?thesis
    unfolding bp_bucket_search_steps_def bp_ratio_log_budget_def by simp
qed

lemma bp_bucket_count_ratio_okI_loaded:
  assumes M_pos: "0 < bp_block_size P"
    and loaded: "bp_bucket_count_loaded P"
  shows "bp_bucket_count_ratio_ok P"
proof -
  let ?M = "bp_block_size P"
  let ?k = "length (bp_buckets P)"
  let ?N = "length (bp_entries P)"
  have count_le: "?k  Suc (?N div ?M)"
  proof (cases ?k)
    case 0
    then show ?thesis by simp
  next
    case (Suc j)
    have "?M * j  ?N"
      using loaded Suc unfolding bp_bucket_count_loaded_def by simp
    then have "j  ?N div ?M"
    proof -
      have "j = (?M * j) div ?M"
        using M_pos by simp
      also have "  ?N div ?M"
        by (rule div_le_mono) (rule ?M * j  ?N)
      finally show ?thesis .
    qed
    then show ?thesis
      using Suc by simp
  qed
  show ?thesis
    unfolding bp_bucket_count_ratio_ok_def using M_pos count_le by blast
qed

lemma bp_empty_bucket_count_ratio_ok:
  assumes "0 < M"
  shows "bp_bucket_count_ratio_ok (bp_empty M B)"
  using assms unfolding bp_bucket_count_ratio_ok_def bp_empty_def
    bp_entries_def bp_bucket_entries_flat_def by simp

lemma bp_regular_invariant_ordered_invariant:
  assumes "bp_regular_invariant P"
  shows "bp_ordered_invariant P"
  using assms unfolding bp_regular_invariant_def by blast

lemma bp_regular_invariant_ratio_ok:
  assumes "bp_regular_invariant P"
  shows "bp_bucket_count_ratio_ok P"
  using assms unfolding bp_regular_invariant_def by blast

lemma bp_empty_regular_invariant:
  assumes "0 < M"
  shows "bp_regular_invariant (bp_empty M B)"
  unfolding bp_regular_invariant_def
  using bp_empty_ordered_invariant[OF assms]
    bp_empty_bucket_count_ratio_ok[OF assms]
  by blast

lemma bp_rebucket_bucket_count_ratio_ok:
  assumes inv: "bp_invariant P"
  shows "bp_bucket_count_ratio_ok (bp_rebucket P)"
proof -
  let ?M = "bp_block_size P"
  let ?xs = "bp_entries P"
  have M_pos: "0 < ?M"
    using inv unfolding bp_invariant_def by blast
  have count:
    "length (bp_bucketize_entries ?M ?xs) 
      Suc (length ?xs div ?M)"
    by (rule length_bp_bucketize_entries_le_ratio[OF M_pos])
  have entries_len:
    "length (bp_entries (bp_rebucket P)) = length ?xs"
    using bp_bucket_entries_flat_bucketize_entries[OF M_pos, of ?xs]
    unfolding bp_rebucket_def bp_entries_def by simp
  have block_eq [simp]: "bp_block_size (bp_rebucket P) = ?M"
    unfolding bp_rebucket_def by simp
  have buckets_eq [simp]:
    "bp_buckets (bp_rebucket P) = bp_bucketize_entries ?M ?xs"
    unfolding bp_rebucket_def by simp
  show ?thesis
    unfolding bp_bucket_count_ratio_ok_def
    using M_pos count entries_len by simp
qed

lemma bp_rebucket_bucket_count_ratio_ok_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_bucket_count_ratio_ok (bp_rebucket P)"
proof -
  let ?M = "bp_block_size P"
  let ?xs = "bp_entries P"
  have M_pos: "0 < ?M"
    using inv unfolding bp_lazy_invariant_def by blast
  have count:
    "length (bp_bucketize_entries ?M ?xs) 
      Suc (length ?xs div ?M)"
    by (rule length_bp_bucketize_entries_le_ratio[OF M_pos])
  have entries_len:
    "length (bp_entries (bp_rebucket P)) = length ?xs"
    using bp_bucket_entries_flat_bucketize_entries[OF M_pos, of ?xs]
    unfolding bp_rebucket_def bp_entries_def by simp
  have block_eq [simp]: "bp_block_size (bp_rebucket P) = ?M"
    unfolding bp_rebucket_def by simp
  have buckets_eq [simp]:
    "bp_buckets (bp_rebucket P) = bp_bucketize_entries ?M ?xs"
    unfolding bp_rebucket_def by simp
  show ?thesis
    unfolding bp_bucket_count_ratio_ok_def
    using M_pos count entries_len by simp
qed

lemma bp_rebucket_regular_split_potential_zero:
  assumes inv: "bp_invariant P"
  shows "bp_split_potential (bp_rebucket P) = 0"
proof (rule bp_split_potential_zero_if_regular)
  show "bp_invariant (bp_rebucket P)"
    by (rule bp_rebucket_invariant[OF inv])
  show "bp_bucket_count_ratio_ok (bp_rebucket P)"
    by (rule bp_rebucket_bucket_count_ratio_ok[OF inv])
qed

lemma bp_rebucket_regular_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_regular_invariant (bp_rebucket P)"
  unfolding bp_regular_invariant_def
  using bp_rebucket_ordered_invariant[OF inv]
    bp_rebucket_bucket_count_ratio_ok[OF inv]
  by blast

lemma bp_rebucket_regular_split_potential_zero_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_split_potential (bp_rebucket P) = 0"
proof (rule bp_split_potential_zero_if_regular)
  show "bp_invariant (bp_rebucket P)"
    by (rule bp_rebucket_invariant_from_lazy[OF inv])
  show "bp_bucket_count_ratio_ok (bp_rebucket P)"
    by (rule bp_rebucket_bucket_count_ratio_ok_from_lazy[OF inv])
qed

lemma bp_rebucket_regular_invariant_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_regular_invariant (bp_rebucket P)"
  unfolding bp_regular_invariant_def
  using bp_rebucket_ordered_invariant_from_lazy[OF inv]
    bp_rebucket_bucket_count_ratio_ok_from_lazy[OF inv]
  by blast

lemma c_bp_rebucket_build_steps_le_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_steps_of (c_bp_rebucket_build P) 
    length (bp_entries P) +
      Suc (length (bp_entries P) div bp_block_size P)"
proof -
  have M_pos: "0 < bp_block_size P"
    using inv unfolding bp_lazy_invariant_def by blast
  have steps:
    "bp_steps_of
      (c_bp_bucketize_entries (bp_block_size P) (bp_entries P)) 
      length (bp_entries P) +
        Suc (length (bp_entries P) div bp_block_size P)"
    by (rule c_bp_bucketize_entries_steps_le[OF M_pos])
  show ?thesis
    using steps unfolding bp_steps_of_def c_bp_rebucket_build_def
    by (auto split: prod.splits)
qed

lemma c_bp_rebucket_build_regular_invariant_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_regular_invariant (bp_result_of (c_bp_rebucket_build P))"
  by (simp add: bp_rebucket_regular_invariant_from_lazy[OF inv])

lemma c_bp_rebucket_build_split_potential_zero_from_lazy:
  assumes inv: "bp_lazy_invariant P"
  shows "bp_split_potential (bp_result_of (c_bp_rebucket_build P)) = 0"
  by (simp add: bp_rebucket_regular_split_potential_zero_from_lazy[OF inv])

lemma c_bp_rebucket_build_regular_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_regular_invariant (bp_result_of (c_bp_rebucket_build P))"
  by (simp add: bp_rebucket_regular_invariant[OF inv])

lemma c_bp_rebucket_build_split_potential_zero:
  assumes inv: "bp_invariant P"
  shows "bp_split_potential (bp_result_of (c_bp_rebucket_build P)) = 0"
  by (simp add: bp_rebucket_regular_split_potential_zero[OF inv])

lemma bp_rebucketed_insert_regular_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_regular_invariant (bp_rebucketed_insert x b P)"
  unfolding bp_rebucketed_insert_def
  by (rule bp_rebucket_regular_invariant[OF bp_insert_invariant[OF inv]])

lemma bp_rebucketed_batch_prepend_regular_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_regular_invariant (bp_rebucketed_batch_prepend xs P)"
  unfolding bp_rebucketed_batch_prepend_def
  by (rule bp_rebucket_regular_invariant[OF bp_batch_prepend_invariant[OF inv]])

lemma bp_rebucketed_insert_split_potential_zero:
  assumes inv: "bp_invariant P"
  shows "bp_split_potential (bp_rebucketed_insert x b P) = 0"
  unfolding bp_rebucketed_insert_def
  by (rule bp_rebucket_regular_split_potential_zero
      [OF bp_insert_invariant[OF inv]])

lemma bp_rebucketed_batch_prepend_split_potential_zero:
  assumes inv: "bp_invariant P"
  shows "bp_split_potential (bp_rebucketed_batch_prepend xs P) = 0"
  unfolding bp_rebucketed_batch_prepend_def
  by (rule bp_rebucket_regular_split_potential_zero
      [OF bp_batch_prepend_invariant[OF inv]])

lemma bp_regularized_local_insert_invariant:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_invariant (bp_regularized_local_insert x b P)"
  unfolding bp_regularized_local_insert_def
  by (rule bp_rebucket_invariant[OF bp_local_insert_state_invariant[OF ord]])

lemma bp_regularized_local_insert_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_ordered_invariant (bp_regularized_local_insert x b P)"
  unfolding bp_regularized_local_insert_def
  by (rule bp_rebucket_ordered_invariant
      [OF bp_local_insert_state_invariant[OF ord]])

lemma bp_regularized_local_insert_regular_invariant:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_regular_invariant (bp_regularized_local_insert x b P)"
  unfolding bp_regularized_local_insert_def
  by (rule bp_rebucket_regular_invariant
      [OF bp_local_insert_state_invariant[OF ord]])

lemma bp_regularized_local_insert_refines_min_update:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_view (bp_regularized_local_insert x b P) =
    min_update (bp_view P) x b"
proof -
  have inv: "bp_invariant P"
    by (rule bp_ordered_invariant_invariant[OF ord])
  then have M_pos: "0 < bp_block_size P"
    unfolding bp_invariant_def by blast
  have step_inv: "bp_invariant (bp_local_insert_state x b P)"
    by (rule bp_local_insert_state_invariant[OF ord])
  then have step_M_pos:
    "0 < bp_block_size (bp_local_insert_state x b P)"
    unfolding bp_invariant_def by blast
  have view_rebucket:
    "bp_view (bp_rebucket (bp_local_insert_state x b P)) =
      bp_view (bp_local_insert_state x b P)"
    by (rule bp_rebucket_view[OF step_M_pos])
  show ?thesis
    unfolding bp_regularized_local_insert_def
    using view_rebucket bp_local_insert_state_refines_min_update[OF M_pos, of x b]
    by simp
qed

lemma bp_regularized_local_insert_refines_insert_spec:
  assumes ord: "bp_ordered_invariant P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_regularized_local_insert x b P))"
  unfolding bp_regularized_local_insert_refines_min_update[OF ord]
  by (rule min_update_insert_spec)

lemma bp_regularized_local_insert_split_potential_zero:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_split_potential (bp_regularized_local_insert x b P) = 0"
  unfolding bp_regularized_local_insert_def
  by (rule bp_rebucket_regular_split_potential_zero
      [OF bp_local_insert_state_invariant[OF ord]])

lemma bp_local_insert_search_charge_ratio_bound:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_local_insert_search_charge P 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
  using bp_bucket_search_steps_ratio_bound[OF ratio]
  unfolding bp_local_insert_search_charge_def bp_insert_search_budget_def
  by simp

lemma c_bp_local_insert_search_result [simp]:
  "bp_result_of (c_bp_local_insert_search x b P) =
    bp_local_insert_state x b P"
  unfolding bp_result_of_def c_bp_local_insert_search_def by simp

lemma c_bp_local_insert_search_steps [simp]:
  "bp_steps_of (c_bp_local_insert_search x b P) =
    bp_local_insert_search_charge P"
  unfolding bp_steps_of_def c_bp_local_insert_search_def by simp

lemma c_bp_local_insert_search_refines_min_update:
  assumes "0 < bp_block_size P"
  shows "bp_view (bp_result_of (c_bp_local_insert_search x b P)) =
    min_update (bp_view P) x b"
  unfolding c_bp_local_insert_search_result
  by (rule bp_local_insert_state_refines_min_update[OF assms])

lemma c_bp_local_insert_search_invariant:
  assumes "bp_ordered_invariant P"
  shows "bp_invariant (bp_result_of (c_bp_local_insert_search x b P))"
  unfolding c_bp_local_insert_search_result
  by (rule bp_local_insert_state_invariant[OF assms])

lemma c_bp_local_insert_search_ordered_invariant:
  assumes "bp_ordered_invariant P"
  shows "bp_ordered_invariant
    (bp_result_of (c_bp_local_insert_search x b P))"
  unfolding c_bp_local_insert_search_result
  by (rule bp_local_insert_state_ordered_invariant[OF assms])

lemma c_bp_local_insert_search_refines_insert_spec:
  assumes "0 < bp_block_size P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_result_of (c_bp_local_insert_search x b P)))"
  unfolding c_bp_local_insert_search_refines_min_update[OF assms]
  by (rule min_update_insert_spec)

lemma c_bp_local_insert_search_ratio_bound:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_steps_of (c_bp_local_insert_search x b P) 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
  by (simp add: bp_local_insert_search_charge_ratio_bound[OF ratio])

lemma c_bp_local_insert_search_partition_insert_cost_bound:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "partition_insert_cost_bound
    (bp_steps_of (c_bp_local_insert_search x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P))"
  using c_bp_local_insert_search_ratio_bound[OF ratio]
  unfolding partition_insert_cost_bound_def .

lemma c_bp_local_insert_split_result [simp]:
  "bp_result_of (c_bp_local_insert_split x b P) =
    bp_local_insert_state x b P"
  unfolding bp_result_of_def c_bp_local_insert_split_def by simp

lemma c_bp_local_insert_split_steps [simp]:
  "bp_steps_of (c_bp_local_insert_split x b P) =
    bp_local_insert_search_charge P +
      bp_local_split_budget (bp_block_size P)"
  unfolding bp_steps_of_def c_bp_local_insert_split_def by simp

lemma c_bp_local_insert_split_refines_min_update:
  assumes "0 < bp_block_size P"
  shows "bp_view (bp_result_of (c_bp_local_insert_split x b P)) =
    min_update (bp_view P) x b"
  unfolding c_bp_local_insert_split_result
  by (rule bp_local_insert_state_refines_min_update[OF assms])

lemma c_bp_local_insert_split_invariant:
  assumes "bp_ordered_invariant P"
  shows "bp_invariant (bp_result_of (c_bp_local_insert_split x b P))"
  unfolding c_bp_local_insert_split_result
  by (rule bp_local_insert_state_invariant[OF assms])

lemma c_bp_local_insert_split_ordered_invariant:
  assumes "bp_ordered_invariant P"
  shows "bp_ordered_invariant
    (bp_result_of (c_bp_local_insert_split x b P))"
  unfolding c_bp_local_insert_split_result
  by (rule bp_local_insert_state_ordered_invariant[OF assms])

lemma c_bp_local_insert_split_refines_insert_spec:
  assumes "0 < bp_block_size P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_result_of (c_bp_local_insert_split x b P)))"
  unfolding c_bp_local_insert_split_refines_min_update[OF assms]
  by (rule min_update_insert_spec)

lemma c_bp_local_insert_split_steps_le:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_steps_of (c_bp_local_insert_split x b P) 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
      bp_local_split_budget (bp_block_size P)"
  using bp_local_insert_search_charge_ratio_bound[OF ratio]
  by simp

lemma c_bp_local_insert_split_steps_le_lazy_budget:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_steps_of (c_bp_local_insert_split x b P) 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
      bp_lazy_split_budget (bp_block_size P)"
proof -
  have local:
    "bp_steps_of (c_bp_local_insert_split x b P) 
      bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
        bp_local_split_budget (bp_block_size P)"
    by (rule c_bp_local_insert_split_steps_le[OF ratio])
  have "bp_local_split_budget (bp_block_size P) 
      bp_lazy_split_budget (bp_block_size P)"
    by (rule bp_local_split_budget_le_lazy_split_budget)
  then show ?thesis
    using local by linarith
qed

lemma c_bp_local_insert_split_amortized_if_split_credit:
  assumes ratio: "bp_bucket_count_ratio_ok P"
    and paid:
      "bp_local_split_budget (bp_block_size P) +
        bp_split_potential
          (bp_result_of (c_bp_local_insert_split x b P)) 
        bp_split_potential P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_local_insert_split x b P)) P
    (bp_result_of (c_bp_local_insert_split x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P))"
proof -
  have search:
    "bp_local_insert_search_charge P 
      bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
    by (rule bp_local_insert_search_charge_ratio_bound[OF ratio])
  have steps:
    "bp_steps_of (c_bp_local_insert_split x b P) =
      bp_local_insert_search_charge P +
        bp_local_split_budget (bp_block_size P)"
    by simp
  show ?thesis
    using search paid steps
    unfolding bp_amortized_step_bound_def
    by linarith
qed

lemma c_bp_lazy_insert_result [simp]:
  "bp_result_of (c_bp_lazy_insert x b P) =
    bp_lazy_insert_state x b P"
  unfolding bp_result_of_def c_bp_lazy_insert_def by simp

lemma c_bp_lazy_insert_steps [simp]:
  "bp_steps_of (c_bp_lazy_insert x b P) =
    bp_local_insert_search_charge P +
      bp_lazy_split_budget (bp_block_size P)"
  unfolding bp_steps_of_def c_bp_lazy_insert_def by simp

lemma c_bp_lazy_insert_refines_min_update:
  assumes "0 < bp_block_size P"
  shows "bp_view (bp_result_of (c_bp_lazy_insert x b P)) =
    min_update (bp_view P) x b"
  unfolding c_bp_lazy_insert_result
  by (rule bp_lazy_insert_state_refines_min_update[OF assms])

lemma c_bp_lazy_insert_lazy_ordered_invariant:
  assumes "bp_lazy_ordered_invariant P"
  shows "bp_lazy_ordered_invariant
    (bp_result_of (c_bp_lazy_insert x b P))"
  unfolding c_bp_lazy_insert_result
  by (rule bp_lazy_insert_state_lazy_ordered_invariant[OF assms])

lemma c_bp_lazy_insert_refines_insert_spec:
  assumes "0 < bp_block_size P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_result_of (c_bp_lazy_insert x b P)))"
  unfolding c_bp_lazy_insert_refines_min_update[OF assms]
  by (rule min_update_insert_spec)

lemma c_bp_lazy_insert_steps_le_lazy_budget:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_steps_of (c_bp_lazy_insert x b P) 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
      bp_lazy_split_budget (bp_block_size P)"
  using bp_local_insert_search_charge_ratio_bound[OF ratio]
  by simp

lemma c_bp_lazy_insert_amortized_if_split_credit:
  assumes ratio: "bp_bucket_count_ratio_ok P"
    and paid:
      "bp_lazy_split_budget (bp_block_size P) +
        bp_split_potential (bp_result_of (c_bp_lazy_insert x b P)) 
        bp_split_potential P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_lazy_insert x b P)) P
    (bp_result_of (c_bp_lazy_insert x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P))"
proof -
  have search:
    "bp_local_insert_search_charge P 
      bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
    by (rule bp_local_insert_search_charge_ratio_bound[OF ratio])
  have steps:
    "bp_steps_of (c_bp_lazy_insert x b P) =
      bp_local_insert_search_charge P +
        bp_lazy_split_budget (bp_block_size P)"
    by simp
  show ?thesis
    using search paid steps
    unfolding bp_amortized_step_bound_def
    by linarith
qed

lemma bp_lazy_bucket_insert_charge_le:
  "bp_lazy_bucket_insert_charge M b  bp_lazy_split_budget M"
  unfolding bp_lazy_bucket_insert_charge_def bp_lazy_split_budget_def
  by simp

lemma bp_lazy_insert_bucket_charge_le:
  "bp_lazy_insert_bucket_charge M p bs  bp_lazy_split_budget M"
proof (induction bs arbitrary: p)
  case Nil
  then show ?case
    unfolding bp_lazy_split_budget_def by simp
next
  case (Cons b bs)
  note IH = Cons.IH
  show ?case
  proof (cases bs)
    case Nil
    then show ?thesis
      using bp_lazy_bucket_insert_charge_le[of M b]
      unfolding bp_lazy_split_budget_def by auto
  next
    case (Cons c cs)
    have one_le: "1  bp_lazy_split_budget M"
      unfolding bp_lazy_split_budget_def by simp
    then show ?thesis
      using Cons IH[of p] bp_lazy_bucket_insert_charge_le[of M b] one_le
      by auto
  qed
qed

lemma bp_lazy_insert_charge_le:
  "bp_lazy_insert_charge x b P  bp_lazy_split_budget (bp_block_size P)"
proof -
  let ?old_keys = "bp_entry_keys (bp_entries P)"
  let ?b = "if x  ?old_keys then min (bp_values P x) b else b"
  let ?P0 = "bp_delete_key x P"
  have charge:
    "bp_lazy_insert_bucket_charge (bp_block_size ?P0) (x, ?b)
      (bp_buckets ?P0)  bp_lazy_split_budget (bp_block_size ?P0)"
    by (rule bp_lazy_insert_bucket_charge_le)
  have block: "bp_block_size ?P0 = bp_block_size P"
    unfolding bp_delete_key_def by simp
  show ?thesis
    using charge unfolding bp_lazy_insert_charge_def Let_def block by simp
qed

lemma c_bp_lazy_insert_precise_result [simp]:
  "bp_result_of (c_bp_lazy_insert_precise x b P) =
    bp_lazy_insert_state x b P"
  unfolding bp_result_of_def c_bp_lazy_insert_precise_def by simp

lemma c_bp_lazy_insert_precise_steps [simp]:
  "bp_steps_of (c_bp_lazy_insert_precise x b P) =
    bp_local_insert_search_charge P + bp_lazy_insert_charge x b P"
  unfolding bp_steps_of_def c_bp_lazy_insert_precise_def by simp

lemma c_bp_lazy_insert_precise_refines_min_update:
  assumes "0 < bp_block_size P"
  shows "bp_view (bp_result_of (c_bp_lazy_insert_precise x b P)) =
    min_update (bp_view P) x b"
  unfolding c_bp_lazy_insert_precise_result
  by (rule bp_lazy_insert_state_refines_min_update[OF assms])

lemma c_bp_lazy_insert_precise_lazy_ordered_invariant:
  assumes "bp_lazy_ordered_invariant P"
  shows "bp_lazy_ordered_invariant
    (bp_result_of (c_bp_lazy_insert_precise x b P))"
  unfolding c_bp_lazy_insert_precise_result
  by (rule bp_lazy_insert_state_lazy_ordered_invariant[OF assms])

lemma c_bp_lazy_insert_precise_refines_insert_spec:
  assumes "0 < bp_block_size P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_result_of (c_bp_lazy_insert_precise x b P)))"
  unfolding c_bp_lazy_insert_precise_refines_min_update[OF assms]
  by (rule min_update_insert_spec)

lemma c_bp_lazy_insert_precise_steps_le_lazy_budget:
  assumes ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_steps_of (c_bp_lazy_insert_precise x b P) 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
      bp_lazy_split_budget (bp_block_size P)"
proof -
  have search:
    "bp_local_insert_search_charge P 
      bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
    by (rule bp_local_insert_search_charge_ratio_bound[OF ratio])
  have charge:
    "bp_lazy_insert_charge x b P 
      bp_lazy_split_budget (bp_block_size P)"
    by (rule bp_lazy_insert_charge_le)
  show ?thesis
    using search charge by simp
qed

lemma c_bp_lazy_insert_precise_steps_le_coarse:
  "bp_steps_of (c_bp_lazy_insert_precise x b P) 
    bp_steps_of (c_bp_lazy_insert x b P)"
  using bp_lazy_insert_charge_le[of x b P] by simp

lemma c_bp_lazy_insert_precise_amortized_if_credit:
  assumes ratio: "bp_bucket_count_ratio_ok P"
    and paid:
      "bp_lazy_insert_charge x b P +
        bp_split_potential
          (bp_result_of (c_bp_lazy_insert_precise x b P)) 
        extra + bp_split_potential P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_lazy_insert_precise x b P)) P
    (bp_result_of (c_bp_lazy_insert_precise x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
      extra)"
proof -
  have search:
    "bp_local_insert_search_charge P 
      bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
    by (rule bp_local_insert_search_charge_ratio_bound[OF ratio])
  show ?thesis
    using search paid
    unfolding bp_amortized_step_bound_def
    by simp
qed

lemma c_bp_lazy_insert_precise_amortized_bound:
  assumes lazy: "bp_lazy_ordered_invariant P"
    and ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_lazy_insert_precise x b P)) P
    (bp_result_of (c_bp_lazy_insert_precise x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) + 7)"
proof (rule c_bp_lazy_insert_precise_amortized_if_credit[OF ratio])
  show "bp_lazy_insert_charge x b P +
    bp_split_potential (bp_result_of (c_bp_lazy_insert_precise x b P)) 
    7 + bp_split_potential P"
    using bp_lazy_insert_state_split_potential_credit[OF lazy, of x b]
    by simp
qed

lemma c_bp_lazy_insert_precise_amortized_ratio_budget:
  assumes lazy: "bp_lazy_ordered_invariant P"
    and ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_lazy_insert_precise x b P)) P
    (bp_result_of (c_bp_lazy_insert_precise x b P))
    (bp_lazy_insert_amortized_budget P)"
  unfolding bp_lazy_insert_amortized_budget_def
  by (rule c_bp_lazy_insert_precise_amortized_bound[OF lazy ratio])

lemma c_bp_lazy_insert_precise_regular_ratio_bound:
  assumes reg: "bp_regular_invariant P"
  shows "bp_steps_of (c_bp_lazy_insert_precise x b P) 
    bp_lazy_insert_amortized_budget P"
proof -
  have ord: "bp_ordered_invariant P"
    by (rule bp_regular_invariant_ordered_invariant[OF reg])
  have lazy: "bp_lazy_ordered_invariant P"
    by (rule bp_ordered_invariant_lazy_ordered_invariant[OF ord])
  have ratio: "bp_bucket_count_ratio_ok P"
    by (rule bp_regular_invariant_ratio_ok[OF reg])
  have am: "bp_amortized_step_bound
      (bp_steps_of (c_bp_lazy_insert_precise x b P)) P
      (bp_result_of (c_bp_lazy_insert_precise x b P))
      (bp_lazy_insert_amortized_budget P)"
    by (rule c_bp_lazy_insert_precise_amortized_ratio_budget[OF lazy ratio])
  have pot: "bp_split_potential P = 0"
    by (rule bp_split_potential_zero_if_regular
        [OF bp_ordered_invariant_invariant[OF ord] ratio])
  show ?thesis
    using am pot unfolding bp_amortized_step_bound_def by linarith
qed

lemma c_bp_lazy_insert_precise_regular_partition_insert_cost_bound:
  assumes reg: "bp_regular_invariant P"
  shows "partition_insert_cost_bound
    (bp_steps_of (c_bp_lazy_insert_precise x b P))
    (bp_lazy_insert_amortized_budget P)"
  using c_bp_lazy_insert_precise_regular_ratio_bound[OF reg]
  unfolding partition_insert_cost_bound_def .

lemma c_bp_lazy_batch_prepend_precise_result [simp]:
  "bp_result_of (c_bp_lazy_batch_prepend_precise xs P) =
    bp_lazy_batch_prepend_state xs P"
proof (induction xs arbitrary: P)
  case Nil
  then show ?case by simp
next
  case (Cons xb xs)
  obtain x b where xb: "xb = (x, b)"
    by force
  show ?case
    unfolding xb by (simp add: Cons.IH)
qed

lemma c_bp_lazy_batch_prepend_precise_steps_Nil [simp]:
  "bp_steps_of (c_bp_lazy_batch_prepend_precise [] P) = 0"
  unfolding bp_steps_of_def by simp

lemma c_bp_lazy_batch_prepend_precise_steps_Cons [simp]:
  "bp_steps_of (c_bp_lazy_batch_prepend_precise ((x, b) # xs) P) =
    bp_steps_of (c_bp_lazy_insert_precise x b P) +
    bp_steps_of
      (c_bp_lazy_batch_prepend_precise xs
        (bp_result_of (c_bp_lazy_insert_precise x b P)))"
  unfolding bp_steps_of_def bp_result_of_def
  by (simp split: prod.splits)

lemma c_bp_lazy_batch_prepend_precise_lazy_ordered_invariant:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_ordered_invariant
    (bp_result_of (c_bp_lazy_batch_prepend_precise xs P))"
  using lazy
proof (induction xs arbitrary: P)
  case Nil
  then show ?case by simp
next
  case (Cons xb xs)
  obtain x b where xb: "xb = (x, b)"
    by force
  have step_lazy: "bp_lazy_ordered_invariant
      (bp_result_of (c_bp_lazy_insert_precise x b P))"
    by (rule c_bp_lazy_insert_precise_lazy_ordered_invariant[OF Cons.prems])
  show ?case
    unfolding xb using Cons.IH[OF step_lazy] by simp
qed

lemma c_bp_lazy_batch_prepend_precise_refines_batch_min_update:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_view (bp_result_of (c_bp_lazy_batch_prepend_precise xs P)) =
    batch_min_update (bp_view P) xs"
  using lazy
proof (induction xs arbitrary: P)
  case Nil
  then show ?case
    unfolding batch_min_update_def by simp
next
  case (Cons xb xs)
  obtain x b where xb: "xb = (x, b)"
    by force
  have M_pos: "0 < bp_block_size P"
    using Cons.prems unfolding bp_lazy_ordered_invariant_def
      bp_lazy_invariant_def by blast
  have step_view:
    "bp_view (bp_result_of (c_bp_lazy_insert_precise x b P)) =
      min_update (bp_view P) x b"
    by (rule c_bp_lazy_insert_precise_refines_min_update[OF M_pos])
  have step_lazy: "bp_lazy_ordered_invariant
      (bp_result_of (c_bp_lazy_insert_precise x b P))"
    by (rule c_bp_lazy_insert_precise_lazy_ordered_invariant[OF Cons.prems])
  show ?case
    unfolding xb
    using Cons.IH[OF step_lazy] step_view
    by (simp add: batch_min_update_def)
qed

lemma c_bp_lazy_batch_prepend_precise_amortized_bound:
  assumes lazy: "bp_lazy_ordered_invariant P"
    and ratios: "bp_lazy_batch_ratio_ok xs P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_lazy_batch_prepend_precise xs P)) P
    (bp_result_of (c_bp_lazy_batch_prepend_precise xs P))
    (bp_lazy_batch_insert_budget_sum xs P)"
  using lazy ratios
proof (induction xs arbitrary: P)
  case Nil
  then show ?case
    unfolding bp_amortized_step_bound_def by simp
next
  case (Cons xb xs)
  obtain x b where xb: "xb = (x, b)"
    by force
  let ?I = "c_bp_lazy_insert_precise x b P"
  let ?P1 = "bp_result_of ?I"
  have ratio: "bp_bucket_count_ratio_ok P"
    using Cons.prems(2) unfolding xb by simp
  have tail_ratios: "bp_lazy_batch_ratio_ok xs ?P1"
    using Cons.prems(2) unfolding xb by simp
  have step_lazy: "bp_lazy_ordered_invariant ?P1"
    by (rule c_bp_lazy_insert_precise_lazy_ordered_invariant[OF Cons.prems(1)])
  have insert_bound:
    "bp_steps_of ?I + bp_split_potential ?P1 
      bp_lazy_insert_amortized_budget P + bp_split_potential P"
    using c_bp_lazy_insert_precise_amortized_ratio_budget
      [OF Cons.prems(1) ratio, of x b]
    unfolding bp_amortized_step_bound_def .
  have tail_bound:
    "bp_steps_of (c_bp_lazy_batch_prepend_precise xs ?P1) +
        bp_split_potential
          (bp_result_of (c_bp_lazy_batch_prepend_precise xs ?P1)) 
      bp_lazy_batch_insert_budget_sum xs ?P1 + bp_split_potential ?P1"
    using Cons.IH[OF step_lazy tail_ratios]
    unfolding bp_amortized_step_bound_def .
  show ?case
    unfolding xb bp_amortized_step_bound_def
    using insert_bound tail_bound by simp
qed

lemma c_bp_lazy_batch_prepend_precise_regular_steps_le_budget_sum:
  assumes reg: "bp_regular_invariant P"
    and ratios: "bp_lazy_batch_ratio_ok xs P"
  shows "bp_steps_of (c_bp_lazy_batch_prepend_precise xs P) 
    bp_lazy_batch_insert_budget_sum xs P"
proof -
  have ord: "bp_ordered_invariant P"
    by (rule bp_regular_invariant_ordered_invariant[OF reg])
  have lazy: "bp_lazy_ordered_invariant P"
    by (rule bp_ordered_invariant_lazy_ordered_invariant[OF ord])
  have am: "bp_amortized_step_bound
      (bp_steps_of (c_bp_lazy_batch_prepend_precise xs P)) P
      (bp_result_of (c_bp_lazy_batch_prepend_precise xs P))
      (bp_lazy_batch_insert_budget_sum xs P)"
    by (rule c_bp_lazy_batch_prepend_precise_amortized_bound[OF lazy ratios])
  have pot: "bp_split_potential P = 0"
    by (rule bp_split_potential_zero_if_regular
        [OF bp_ordered_invariant_invariant[OF ord]
          bp_regular_invariant_ratio_ok[OF reg]])
  show ?thesis
    using am pot unfolding bp_amortized_step_bound_def by linarith
qed

lemma c_bp_regularized_local_insert_result [simp]:
  "bp_result_of (c_bp_regularized_local_insert x b P) =
    bp_regularized_local_insert x b P"
  unfolding bp_result_of_def c_bp_regularized_local_insert_def by simp

lemma c_bp_regularized_local_insert_steps [simp]:
  "bp_steps_of (c_bp_regularized_local_insert x b P) =
    bp_local_insert_search_charge P"
  unfolding bp_steps_of_def c_bp_regularized_local_insert_def by simp

lemma c_bp_regularized_local_insert_regular_invariant:
  assumes reg: "bp_regular_invariant P"
  shows "bp_regular_invariant
    (bp_result_of (c_bp_regularized_local_insert x b P))"
  unfolding c_bp_regularized_local_insert_result
  by (rule bp_regularized_local_insert_regular_invariant
      [OF bp_regular_invariant_ordered_invariant[OF reg]])

lemma c_bp_regularized_local_insert_refines_min_update:
  assumes reg: "bp_regular_invariant P"
  shows "bp_view (bp_result_of (c_bp_regularized_local_insert x b P)) =
    min_update (bp_view P) x b"
  unfolding c_bp_regularized_local_insert_result
  by (rule bp_regularized_local_insert_refines_min_update
      [OF bp_regular_invariant_ordered_invariant[OF reg]])

lemma c_bp_regularized_local_insert_refines_insert_spec:
  assumes reg: "bp_regular_invariant P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_result_of (c_bp_regularized_local_insert x b P)))"
  unfolding c_bp_regularized_local_insert_refines_min_update[OF reg]
  by (rule min_update_insert_spec)

lemma c_bp_regularized_local_insert_ratio_bound:
  assumes reg: "bp_regular_invariant P"
  shows "bp_steps_of (c_bp_regularized_local_insert x b P) 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
  by (simp add: bp_local_insert_search_charge_ratio_bound
      [OF bp_regular_invariant_ratio_ok[OF reg]])

lemma c_bp_regularized_local_insert_split_potential_zero:
  assumes reg: "bp_regular_invariant P"
  shows "bp_split_potential
    (bp_result_of (c_bp_regularized_local_insert x b P)) = 0"
  unfolding c_bp_regularized_local_insert_result
  by (rule bp_regularized_local_insert_split_potential_zero
      [OF bp_regular_invariant_ordered_invariant[OF reg]])

lemma bp_regular_invariant_split_potential_zero:
  assumes reg: "bp_regular_invariant P"
  shows "bp_split_potential P = 0"
proof (rule bp_split_potential_zero_if_regular)
  show "bp_invariant P"
    by (rule bp_ordered_invariant_invariant
        [OF bp_regular_invariant_ordered_invariant[OF reg]])
  show "bp_bucket_count_ratio_ok P"
    by (rule bp_regular_invariant_ratio_ok[OF reg])
qed

lemma c_bp_regularized_local_insert_amortized_ratio_bound:
  assumes reg: "bp_regular_invariant P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_regularized_local_insert x b P)) P
    (bp_result_of (c_bp_regularized_local_insert x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P))"
  using c_bp_regularized_local_insert_ratio_bound[OF reg]
    c_bp_regularized_local_insert_split_potential_zero[OF reg, of x b]
    bp_regular_invariant_split_potential_zero[OF reg]
  unfolding bp_amortized_step_bound_def by simp

lemma c_bp_regularized_local_insert_partition_insert_cost_bound:
  assumes reg: "bp_regular_invariant P"
  shows "partition_insert_cost_bound
    (bp_steps_of (c_bp_regularized_local_insert x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P))"
  using c_bp_regularized_local_insert_ratio_bound[OF reg]
  unfolding partition_insert_cost_bound_def .

lemma c_bp_regularized_local_insert_build_result [simp]:
  "bp_result_of (c_bp_regularized_local_insert_build x b P) =
    bp_regularized_local_insert x b P"
proof -
  let ?Q = "bp_local_insert_state x b P"
  obtain P' c where build: "c_bp_rebucket_build ?Q = (P', c)"
    by (cases "c_bp_rebucket_build ?Q")
  have P': "P' = bp_rebucket ?Q"
    using c_bp_rebucket_build_result[of ?Q] build
    unfolding bp_result_of_def by simp
  show ?thesis
    using build P'
    unfolding c_bp_regularized_local_insert_build_def
      bp_regularized_local_insert_def bp_result_of_def
    by simp
qed

lemma c_bp_regularized_local_insert_build_steps:
  "bp_steps_of (c_bp_regularized_local_insert_build x b P) =
    bp_local_insert_search_charge P +
      bp_steps_of (c_bp_rebucket_build (bp_local_insert_state x b P))"
  unfolding c_bp_regularized_local_insert_build_def
  by (auto simp: bp_steps_of_def split: prod.splits)

lemma c_bp_regularized_local_insert_build_regular_invariant:
  assumes reg: "bp_regular_invariant P"
  shows "bp_regular_invariant
    (bp_result_of (c_bp_regularized_local_insert_build x b P))"
  unfolding c_bp_regularized_local_insert_build_result
  by (rule bp_regularized_local_insert_regular_invariant
      [OF bp_regular_invariant_ordered_invariant[OF reg]])

lemma c_bp_regularized_local_insert_build_refines_min_update:
  assumes reg: "bp_regular_invariant P"
  shows "bp_view (bp_result_of
      (c_bp_regularized_local_insert_build x b P)) =
    min_update (bp_view P) x b"
  unfolding c_bp_regularized_local_insert_build_result
  by (rule bp_regularized_local_insert_refines_min_update
      [OF bp_regular_invariant_ordered_invariant[OF reg]])

lemma c_bp_regularized_local_insert_build_refines_insert_spec:
  assumes reg: "bp_regular_invariant P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_result_of
      (c_bp_regularized_local_insert_build x b P)))"
  unfolding c_bp_regularized_local_insert_build_refines_min_update[OF reg]
  by (rule min_update_insert_spec)

lemma c_bp_regularized_local_insert_build_split_potential_zero:
  assumes reg: "bp_regular_invariant P"
  shows "bp_split_potential
    (bp_result_of (c_bp_regularized_local_insert_build x b P)) = 0"
  unfolding c_bp_regularized_local_insert_build_result
  by (rule bp_regularized_local_insert_split_potential_zero
      [OF bp_regular_invariant_ordered_invariant[OF reg]])

lemma c_bp_regularized_local_insert_build_rebuild_steps_le:
  assumes ord: "bp_ordered_invariant P"
  shows "bp_steps_of (c_bp_regularized_local_insert_build x b P) 
    bp_local_insert_search_charge P +
      length (bp_entries (bp_local_insert_state x b P)) +
      Suc (length (bp_entries (bp_local_insert_state x b P)) div
        bp_block_size P)"
proof -
  have step_inv: "bp_invariant (bp_local_insert_state x b P)"
    by (rule bp_local_insert_state_invariant[OF ord])
  have build:
    "bp_steps_of (c_bp_rebucket_build (bp_local_insert_state x b P)) 
      length (bp_entries (bp_local_insert_state x b P)) +
      Suc (length (bp_entries (bp_local_insert_state x b P)) div
        bp_block_size (bp_local_insert_state x b P))"
    by (rule c_bp_rebucket_build_steps_le[OF step_inv])
  have block:
    "bp_block_size (bp_local_insert_state x b P) = bp_block_size P"
    unfolding bp_local_insert_state_def bp_delete_key_def
    by (simp add: Let_def split: if_splits)
  show ?thesis
    using build
    unfolding c_bp_regularized_local_insert_build_steps block
    by simp
qed

lemma c_bp_regularized_local_insert_build_steps_le:
  assumes reg: "bp_regular_invariant P"
  shows "bp_steps_of (c_bp_regularized_local_insert_build x b P) 
    bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
      length (bp_entries (bp_local_insert_state x b P)) +
      Suc (length (bp_entries (bp_local_insert_state x b P)) div
        bp_block_size P)"
proof -
  have ord: "bp_ordered_invariant P"
    by (rule bp_regular_invariant_ordered_invariant[OF reg])
  have search:
    "bp_local_insert_search_charge P 
      bp_insert_search_budget (length (bp_entries P)) (bp_block_size P)"
    by (rule bp_local_insert_search_charge_ratio_bound
        [OF bp_regular_invariant_ratio_ok[OF reg]])
  have build:
    "bp_steps_of (c_bp_regularized_local_insert_build x b P) 
      bp_local_insert_search_charge P +
        length (bp_entries (bp_local_insert_state x b P)) +
        Suc (length (bp_entries (bp_local_insert_state x b P)) div
          bp_block_size P)"
    by (rule c_bp_regularized_local_insert_build_rebuild_steps_le[OF ord])
  show ?thesis
    using search build by linarith
qed

lemma c_bp_regularized_local_insert_build_amortized_rebuild_bound:
  assumes reg: "bp_regular_invariant P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_regularized_local_insert_build x b P)) P
    (bp_result_of (c_bp_regularized_local_insert_build x b P))
    (bp_insert_search_budget (length (bp_entries P)) (bp_block_size P) +
      length (bp_entries (bp_local_insert_state x b P)) +
      Suc (length (bp_entries (bp_local_insert_state x b P)) div
        bp_block_size P))"
  using c_bp_regularized_local_insert_build_steps_le[OF reg, of x b]
    c_bp_regularized_local_insert_build_split_potential_zero[OF reg, of x b]
    bp_regular_invariant_split_potential_zero[OF reg]
  unfolding bp_amortized_step_bound_def by simp

lemma c_bp_rebucketed_batch_prepend_bulk_result [simp]:
  "bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P) =
    bp_rebucketed_batch_prepend xs P"
  unfolding bp_result_of_def c_bp_rebucketed_batch_prepend_bulk_def by simp

lemma c_bp_rebucketed_batch_prepend_bulk_steps [simp]:
  "bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P) =
    bp_batch_prepend_log_budget xs (bp_block_size P)"
  unfolding bp_steps_of_def c_bp_rebucketed_batch_prepend_bulk_def by simp

lemma c_bp_bucketed_batch_prepend_direct_result [simp]:
  "bp_result_of (c_bp_bucketed_batch_prepend_direct xs P) =
    bp_bucketed_batch_prepend_state xs P"
  unfolding c_bp_bucketed_batch_prepend_direct_def by simp

lemma c_bp_bucketed_batch_prepend_direct_steps [simp]:
  "bp_steps_of (c_bp_bucketed_batch_prepend_direct xs P) =
    bp_batch_prepend_amortized_budget xs (bp_block_size P)"
  unfolding c_bp_bucketed_batch_prepend_direct_def by simp

lemma c_bp_bucketed_batch_prepend_direct_actual_result [simp]:
  "bp_result_of (c_bp_bucketed_batch_prepend_direct_actual xs P) =
    bp_bucketed_batch_prepend_state xs P"
  unfolding c_bp_bucketed_batch_prepend_direct_actual_def by simp

lemma c_bp_bucketed_batch_prepend_direct_actual_steps [simp]:
  "bp_steps_of (c_bp_bucketed_batch_prepend_direct_actual xs P) =
    bp_batch_prepend_log_budget xs (bp_block_size P)"
  unfolding c_bp_bucketed_batch_prepend_direct_actual_def by simp

lemma c_bp_bucketed_batch_prepend_direct_paper_batch_cost_bound:
  "partition_batch_cost_bound
    (bp_steps_of (c_bp_bucketed_batch_prepend_direct xs P))
    (bp_batch_prepend_per_item_budget xs (bp_block_size P)) xs"
  unfolding partition_batch_cost_bound_def
  by (simp add: bp_batch_prepend_amortized_budget_alt)

lemma bp_bucketed_batch_prepend_state_empty [simp]:
  "bp_bucketed_batch_prepend_state [] P = P"
  unfolding bp_bucketed_batch_prepend_state_def by simp

lemma bp_bucketed_batch_prepend_state_entries_nonempty:
  assumes M_pos: "0 < bp_block_size P"
    and xs: "xs  []"
  shows "bp_entries (bp_bucketed_batch_prepend_state xs P) =
    sort_key snd xs @ bp_entries P"
proof -
  obtain p ps where xs_def: "xs = p # ps"
    using xs by (cases xs) auto
  have flat:
    "bp_bucket_entries_flat
      (bp_bucketize_entries (bp_block_size P) xs) = sort_key snd xs"
    by (rule bp_bucket_entries_flat_bucketize_entries[OF M_pos])
  have flat':
    "bp_bucket_entries_flat
      (bp_bucketize_entries (bp_block_size P) (p # ps)) =
      sort_key snd (p # ps)"
    using flat unfolding xs_def .
  show ?thesis
    unfolding bp_bucketed_batch_prepend_state_def xs_def bp_entries_def
    using flat' by simp
qed

lemma bp_bucketed_batch_prepend_state_keys_nonempty:
  assumes M_pos: "0 < bp_block_size P"
    and xs: "xs  []"
  shows "keys_of (bp_view (bp_bucketed_batch_prepend_state xs P)) =
    bp_entry_keys xs  keys_of (bp_view P)"
  unfolding bp_view_def
    bp_bucketed_batch_prepend_state_entries_nonempty[OF M_pos xs]
    bp_entry_keys_def
  by auto

lemma bp_bucketed_batch_prepend_state_values:
  assumes distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
  shows "value_of (bp_view (bp_bucketed_batch_prepend_state xs P)) =
    value_of (batch_min_update (bp_view P) xs)"
proof -
  have disjoint': "fst ` set xs  keys_of (bp_view P) = {}"
    using disjoint unfolding bp_entry_keys_def by simp
  have vals_abs: "value_of (batch_min_update (bp_view P) xs) =
      bp_batch_value_update xs (value_of (bp_view P))"
    by (rule batch_min_update_value_distinct_disjoint
        [OF distinct disjoint'])
  show ?thesis
    using vals_abs
    unfolding bp_view_def bp_bucketed_batch_prepend_state_def
    by (cases xs) simp_all
qed

theorem bp_bucketed_batch_prepend_state_refines_batch_min_update:
  assumes inv: "bp_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
  shows "bp_view (bp_bucketed_batch_prepend_state xs P) =
    batch_min_update (bp_view P) xs"
proof (cases "xs = []")
  case True
  then show ?thesis
    unfolding batch_min_update_def by simp
next
  case False
  have M_pos: "0 < bp_block_size P"
    using inv unfolding bp_invariant_def by blast
  have keys: "keys_of (bp_view (bp_bucketed_batch_prepend_state xs P)) =
      keys_of (batch_min_update (bp_view P) xs)"
  proof -
    have state: "keys_of (bp_view (bp_bucketed_batch_prepend_state xs P)) =
        bp_entry_keys xs  keys_of (bp_view P)"
      by (rule bp_bucketed_batch_prepend_state_keys_nonempty[OF M_pos False])
    have abstract: "keys_of (batch_min_update (bp_view P) xs) =
        keys_of (bp_view P)  bp_entry_keys xs"
      by (simp add: batch_min_update_keys bp_entry_keys_def)
    show ?thesis
      using state abstract by auto
  qed
  have vals_state: "value_of (bp_view (bp_bucketed_batch_prepend_state xs P)) =
      value_of (batch_min_update (bp_view P) xs)"
    by (rule bp_bucketed_batch_prepend_state_values
        [OF distinct disjoint])
  show ?thesis
    using keys vals_state
    by (cases "bp_view (bp_bucketed_batch_prepend_state xs P)";
        cases "batch_min_update (bp_view P) xs"; simp)
qed

lemma bp_rebase_first_bucket_marker_markers_lower_bound:
  assumes lower:
    "bset bs. pset (bp_bucket_entries b). bp_marker b  snd p"
    and beta_le: "pset (bp_bucket_entries_flat bs). beta  snd p"
  shows "bset (bp_rebase_first_bucket_marker beta bs).
    pset (bp_bucket_entries b). bp_marker b  snd p"
  using assms
  by (cases bs) (auto simp: bp_bucket_entries_flat_def)

lemma bp_rebase_first_bucket_marker_markers_sorted:
  assumes sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c) bs"
    and boundaries: "bp_bucket_boundaries_ok bs"
    and head_nonempty:
      "b bs'. bp_drop_empty_prefix bs = b # bs' 
        bp_bucket_entries b  []"
    and beta_le:
      "pset (bp_bucket_entries_flat (bp_drop_empty_prefix bs)).
        beta  snd p"
  shows "sorted_wrt (λb c. bp_marker b  bp_marker c)
    (bp_rebase_first_bucket_marker beta (bp_drop_empty_prefix bs))"
proof (cases "bp_drop_empty_prefix bs")
  case Nil
  then show ?thesis by simp
next
  case (Cons b rest)
  note old0 = Cons
  have old0_sorted: "sorted_wrt (λb c. bp_marker b  bp_marker c)
      (bp_drop_empty_prefix bs)"
    by (rule bp_bucket_markers_sorted_drop_empty_prefix[OF sorted])
  have old0_boundaries:
    "bp_bucket_boundaries_ok (bp_drop_empty_prefix bs)"
    by (rule bp_bucket_boundaries_ok_drop_empty_prefix[OF boundaries])
  have b_nonempty: "bp_bucket_entries b  []"
    using head_nonempty Cons by blast
  show ?thesis
  proof (cases rest)
    case Nil
    then show ?thesis
      using old0 by simp
  next
    case (Cons c cs)
    obtain q where q: "q  set (bp_bucket_entries b)"
      using b_nonempty by (cases "bp_bucket_entries b") auto
    have beta_le_q: "beta  snd q"
      using beta_le old0 q unfolding bp_bucket_entries_flat_def by auto
    have q_le_c: "snd q  bp_marker c"
      using old0_boundaries old0 Cons q by simp
    have beta_le_c: "beta  bp_marker c"
      using beta_le_q q_le_c by linarith
    have tail_sorted:
      "sorted_wrt (λb c. bp_marker b  bp_marker c) (c # cs)"
      using old0_sorted old0 Cons by simp
    have beta_le_tail:
      "dset (c # cs). beta  bp_marker d"
    proof
      fix d
      assume d: "d  set (c # cs)"
      have "bp_marker c  bp_marker d"
        using tail_sorted d by (cases "d = c") auto
      then show "beta  bp_marker d"
        using beta_le_c by linarith
    qed
    show ?thesis
      using old0 Cons tail_sorted beta_le_tail by simp
  qed
qed

lemma bp_batch_max_value_le_old_entry:
  assumes xs: "xs = p # ps"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
    and inv: "bp_invariant P"
    and r: "r  set (bp_entries P)"
  shows "bp_batch_max_value (snd p) ps  snd r"
proof -
  have r_key: "fst r  keys_of (bp_view P)"
    using r unfolding bp_view_def bp_entry_keys_def by auto
  have r_value: "value_of (bp_view P) (fst r) = snd r"
    using inv r unfolding bp_invariant_def bp_values_consistent_def
      bp_view_def by simp
  have all_le: "q. q  set xs  snd q  snd r"
  proof -
    fix q
    assume q: "q  set xs"
    then have "snd q  value_of (bp_view P) (fst r)"
      using admissible r_key
      unfolding batch_prepend_admissible_def by force
    then show "snd q  snd r"
      using r_value by simp
  qed
  have ps_le: "q. q  set ps  snd q  snd r"
    using all_le xs by auto
  have p_le: "snd p  snd r"
    using all_le xs by simp
  show ?thesis
    by (rule bp_batch_max_value_upper[OF ps_le p_le])
qed

lemma bp_bucketed_batch_prepend_state_invariant:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_invariant (bp_bucketed_batch_prepend_state xs P)"
proof (cases xs)
  case Nil
  then show ?thesis
    using bp_ordered_invariant_invariant[OF ord] by simp
next
  case (Cons p ps)
  let ?M = "bp_block_size P"
  let ?beta = "bp_batch_max_value (snd p) ps"
  let ?new = "bp_bucketize_entries ?M xs"
  let ?trimmed = "bp_drop_empty_prefix (bp_buckets P)"
  let ?old = "bp_rebase_first_bucket_marker ?beta ?trimmed"
  let ?P' = "bp_bucketed_batch_prepend_state xs P"
  have inv: "bp_invariant P"
    by (rule bp_ordered_invariant_invariant[OF ord])
  have boundaries: "bp_bucket_boundaries_ok (bp_buckets P)"
    using bp_ordered_invariant_boundaries_state_ok[OF ord]
    unfolding bp_bucket_boundaries_state_ok_def .
  have M_pos: "0 < ?M"
    using inv unfolding bp_invariant_def by blast
  have entries_state: "bp_entries ?P' = sort_key snd xs @ bp_entries P"
    by (rule bp_bucketed_batch_prepend_state_entries_nonempty[OF M_pos])
      (simp add: Cons)
  have old_distinct: "distinct (map fst (bp_entries P))"
    using inv unfolding bp_invariant_def bp_distinct_keys_def by blast
  have new_distinct: "distinct (map fst (sort_key snd xs))"
    by (rule distinct_map_fst_sort_key[OF distinct])
  have disj_keys:
    "set (map fst (sort_key snd xs))  set (map fst (bp_entries P)) = {}"
    using disjoint unfolding bp_entry_keys_def bp_view_def by auto
  have distinct_entries:
    "distinct (map fst (sort_key snd xs @ bp_entries P))"
    using new_distinct old_distinct disj_keys by simp
  have beta_le_old:
    "rset (bp_entries P). ?beta  snd r"
  proof
    fix r
    assume r: "r  set (bp_entries P)"
    show "?beta  snd r"
      by (rule bp_batch_max_value_le_old_entry
          [OF Cons admissible inv r])
  qed
  have beta_le_trimmed:
    "rset (bp_bucket_entries_flat ?trimmed). ?beta  snd r"
    using beta_le_old unfolding bp_entries_def by simp
  have new_sizes:
    "bset ?new. length (bp_bucket_entries b)  ?M"
    by (rule bp_bucketize_entries_sizes_ok[OF M_pos])
  have trimmed_subset: "set ?trimmed  set (bp_buckets P)"
    by (rule bp_drop_empty_prefix_set_subset)
  have trimmed_sizes:
    "bset ?trimmed. length (bp_bucket_entries b)  ?M"
    using inv trimmed_subset unfolding bp_invariant_def bp_bucket_sizes_ok_def
    by blast
  have old_sizes:
    "bset ?old. length (bp_bucket_entries b)  ?M"
  proof (cases ?trimmed)
    case Nil
    then show ?thesis by simp
  next
    case (Cons b bs)
    then show ?thesis
      using trimmed_sizes by simp
  qed
  have new_sorted:
    "sorted_wrt (λb c. bp_marker b  bp_marker c) ?new"
    by (rule bp_bucketize_entries_markers_sorted[OF M_pos])
  have old_sorted:
    "sorted_wrt (λb c. bp_marker b  bp_marker c) ?old"
  proof (rule bp_rebase_first_bucket_marker_markers_sorted)
    show "sorted_wrt (λb c. bp_marker b  bp_marker c) (bp_buckets P)"
      using inv unfolding bp_invariant_def bp_bucket_markers_sorted_def
      by blast
    show "bp_bucket_boundaries_ok (bp_buckets P)"
      by (rule boundaries)
    show "b bs'. bp_drop_empty_prefix (bp_buckets P) = b # bs' 
        bp_bucket_entries b  []"
      by (rule bp_drop_empty_prefix_head_nonempty)
    show "rset (bp_bucket_entries_flat
        (bp_drop_empty_prefix (bp_buckets P))). ?beta  snd r"
      by (rule beta_le_trimmed)
  qed
  have new_marker_le_beta:
    "bset ?new. bp_marker b  ?beta"
  proof (rule bp_bucketize_entries_markers_le)
    show "qset xs. snd q  ?beta"
      using Cons
      by (auto simp: bp_batch_max_value_ge_member_Cons)
  qed
  have beta_le_old_markers:
    "bset ?old. ?beta  bp_marker b"
  proof (cases ?old)
    case Nil
    then show ?thesis by simp
  next
    case (Cons b bs)
    have head: "bp_marker b = ?beta"
      using Cons by (cases ?trimmed) auto
    have tail_ge: "cset bs. bp_marker b  bp_marker c"
      using old_sorted Cons by simp
    show ?thesis
      using Cons head tail_ge by auto
  qed
  have sorted_all:
    "sorted_wrt (λb c. bp_marker b  bp_marker c) (?new @ ?old)"
    unfolding sorted_wrt_append
  proof (intro conjI ballI)
    show "sorted_wrt (λb c. bp_marker b  bp_marker c) ?new"
      by (rule new_sorted)
    show "sorted_wrt (λb c. bp_marker b  bp_marker c) ?old"
      by (rule old_sorted)
    fix b c
    assume b: "b  set ?new" and c: "c  set ?old"
    have "bp_marker b  ?beta"
      using new_marker_le_beta b by blast
    moreover have "?beta  bp_marker c"
      using beta_le_old_markers c by blast
    ultimately show "bp_marker b  bp_marker c"
      by linarith
  qed
  have new_lower:
    "bset ?new. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    by (rule bp_bucketize_entries_markers_lower_bound[OF M_pos])
  have trimmed_lower:
    "bset ?trimmed. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    using inv trimmed_subset
    unfolding bp_invariant_def bp_bucket_markers_lower_bound_def by blast
  have old_lower:
    "bset ?old. qset (bp_bucket_entries b).
      bp_marker b  snd q"
    by (rule bp_rebase_first_bucket_marker_markers_lower_bound
        [OF trimmed_lower beta_le_trimmed])
  have lower_all:
    "bset (?new @ ?old). qset (bp_bucket_entries b).
      bp_marker b  snd q"
    using new_lower old_lower by auto
  have values_entries:
    "rset (sort_key snd xs @ bp_entries P).
      bp_batch_value_update xs (bp_values P) (fst r) = snd r"
  proof
    fix r
    assume r: "r  set (sort_key snd xs @ bp_entries P)"
    show "bp_batch_value_update xs (bp_values P) (fst r) = snd r"
    proof (cases "r  set (sort_key snd xs)")
      case True
      then have "r  set xs"
        by simp
      obtain x b where r_def: "r = (x, b)"
        by force
      then have "(x, b)  set xs"
        using r  set xs by simp
      then have "bp_batch_value_update xs (bp_values P) x = b"
        by (rule bp_batch_value_update_in_set_distinct[OF distinct])
      then show ?thesis
        unfolding r_def by simp
    next
      case False
      then have r_old: "r  set (bp_entries P)"
        using r by simp
      have "fst r  fst ` set xs"
        using disjoint r_old unfolding bp_entry_keys_def bp_view_def
        by auto
      then have unchanged:
        "bp_batch_value_update xs (bp_values P) (fst r) =
          bp_values P (fst r)"
        by (rule bp_batch_value_update_notin)
      have "bp_values P (fst r) = snd r"
        using inv r_old unfolding bp_invariant_def bp_values_consistent_def
        by blast
      then show ?thesis
        using unchanged by simp
    qed
  qed
  have flat_new: "bp_bucket_entries_flat ?new = sort_key snd xs"
    by (rule bp_bucket_entries_flat_bucketize_entries[OF M_pos])
  have flat_old: "bp_bucket_entries_flat ?old = bp_entries P"
    unfolding bp_entries_def by simp
  show ?thesis
    using M_pos distinct_entries new_sizes old_sizes sorted_all lower_all
      values_entries flat_new flat_old
    unfolding bp_bucketed_batch_prepend_state_def Cons Let_def
      bp_invariant_def bp_distinct_keys_def bp_bucket_sizes_ok_def
      bp_bucket_markers_sorted_def bp_bucket_markers_lower_bound_def
      bp_values_consistent_def bp_entries_def
    by auto
qed

lemma bp_bucketed_batch_prepend_state_boundaries_state_ok:
  assumes ord: "bp_ordered_invariant P"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_bucket_boundaries_state_ok
    (bp_bucketed_batch_prepend_state xs P)"
proof (cases xs)
  case Nil
  then show ?thesis
    using bp_ordered_invariant_boundaries_state_ok[OF ord] by simp
next
  case (Cons p ps)
  let ?M = "bp_block_size P"
  let ?beta = "bp_batch_max_value (snd p) ps"
  let ?new = "bp_bucketize_entries ?M xs"
  let ?trimmed = "bp_drop_empty_prefix (bp_buckets P)"
  let ?old = "bp_rebase_first_bucket_marker ?beta ?trimmed"
  have inv: "bp_invariant P"
    by (rule bp_ordered_invariant_invariant[OF ord])
  have M_pos: "0 < ?M"
    using inv unfolding bp_invariant_def by blast
  have trimmed_boundaries:
    "bp_bucket_boundaries_ok ?trimmed"
    by (rule bp_bucket_boundaries_ok_drop_empty_prefix)
      (use bp_ordered_invariant_boundaries_state_ok[OF ord] in
        simp add: bp_bucket_boundaries_state_ok_def)
  have old_boundaries: "bp_bucket_boundaries_ok ?old"
  proof (cases ?trimmed)
    case Nil
    then show ?thesis by simp
  next
    case (Cons b bs)
    then show ?thesis
    proof (cases bs)
      case Nil
      then show ?thesis
        using Cons by simp
    next
      case (Cons c cs)
      then show ?thesis
        using Cons trimmed_boundaries by simp
    qed
  qed
  have new_boundaries: "bp_bucket_boundaries_ok ?new"
    by (rule bp_bucketize_entries_boundaries_ok[OF M_pos])
  have new_entries_le_beta:
    "bset ?new. qset (bp_bucket_entries b).
      snd q  ?beta"
  proof (intro ballI)
    fix b q
    assume b: "b  set ?new"
      and q: "q  set (bp_bucket_entries b)"
    have "q  set xs"
      by (rule bp_bucketize_entries_entry_in_source[OF M_pos b q])
    then show "snd q  ?beta"
      using Cons by (auto simp: bp_batch_max_value_ge_member_Cons)
  qed
  have cross:
    "?old  [] 
      bset ?new. qset (bp_bucket_entries b).
        snd q  bp_marker (hd ?old)"
  proof -
    assume old_nonempty: "?old  []"
    have "bp_marker (hd ?old) = ?beta"
      using old_nonempty by (cases ?trimmed) auto
    then show "bset ?new. qset (bp_bucket_entries b).
        snd q  bp_marker (hd ?old)"
      using new_entries_le_beta by simp
  qed
  have appended: "bp_bucket_boundaries_ok (?new @ ?old)"
    by (rule bp_bucket_boundaries_ok_append
        [OF new_boundaries old_boundaries cross])
  show ?thesis
    using appended Cons
    unfolding bp_bucketed_batch_prepend_state_def Let_def
      bp_bucket_boundaries_state_ok_def
    by simp
qed

lemma bp_bucketed_batch_prepend_state_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_ordered_invariant (bp_bucketed_batch_prepend_state xs P)"
  unfolding bp_ordered_invariant_def
  using bp_bucketed_batch_prepend_state_invariant
      [OF ord distinct disjoint admissible]
    bp_bucketed_batch_prepend_state_boundaries_state_ok
      [OF ord admissible]
  by blast

text ‹
  Bucketed BatchPrepend is not implemented as repeated Insert.  The incoming
  batch is first bucketized on its own, then placed before the existing
  buckets.  To preserve the boundary condition, the old prefix of empty buckets
  is dropped and the first surviving old bucket is rebased to the maximum value
  of the batch.  The admissibility assumption is the abstract promise that
  every old entry is above the batch range.  Together with distinctness and
  disjointness of keys, this yields both the view refinement
  @{thm bp_bucketed_batch_prepend_state_refines_batch_min_update} and the
  ordered invariant theorem above.
›

lemma c_bp_bucketed_batch_prepend_direct_invariant:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_invariant
    (bp_result_of (c_bp_bucketed_batch_prepend_direct xs P))"
  unfolding c_bp_bucketed_batch_prepend_direct_result
  by (rule bp_bucketed_batch_prepend_state_invariant
      [OF ord distinct disjoint admissible])

lemma c_bp_bucketed_batch_prepend_direct_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_ordered_invariant
    (bp_result_of (c_bp_bucketed_batch_prepend_direct xs P))"
  unfolding c_bp_bucketed_batch_prepend_direct_result
  by (rule bp_bucketed_batch_prepend_state_ordered_invariant
      [OF ord distinct disjoint admissible])

lemma c_bp_bucketed_batch_prepend_direct_refines_batch_min_update:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
  shows "bp_view (bp_result_of (c_bp_bucketed_batch_prepend_direct xs P)) =
    batch_min_update (bp_view P) xs"
  unfolding c_bp_bucketed_batch_prepend_direct_result
  by (rule bp_bucketed_batch_prepend_state_refines_batch_min_update
      [OF bp_ordered_invariant_invariant[OF ord] distinct disjoint])

lemma c_bp_bucketed_batch_prepend_direct_preserves_upper_bound:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and upper: "partition_upper_bound (bp_view P) B"
    and values_lt: "x b. (x, b)  set xs  b < B"
  shows "partition_upper_bound
    (bp_view (bp_result_of (c_bp_bucketed_batch_prepend_direct xs P))) B"
  unfolding c_bp_bucketed_batch_prepend_direct_refines_batch_min_update
    [OF ord distinct disjoint]
  by (rule batch_min_update_preserves_upper_bound[OF upper values_lt])

lemma c_bp_bucketed_batch_prepend_direct_batch_cost_bound:
  "partition_batch_cost_bound
    (bp_steps_of (c_bp_bucketed_batch_prepend_direct xs P))
    (bp_batch_prepend_per_item_budget xs (bp_block_size P)) xs"
  by (rule c_bp_bucketed_batch_prepend_direct_paper_batch_cost_bound)

lemma bp_bucketed_batch_prepend_state_buckets_length_nonempty:
  assumes M_pos: "0 < bp_block_size P"
    and xs: "xs  []"
  shows "length (bp_buckets (bp_bucketed_batch_prepend_state xs P)) 
    length xs + length (bp_buckets P)"
proof -
  obtain p ps where xs_def: "xs = p # ps"
    using xs by (cases xs) auto
  have new:
    "length (bp_bucketize_entries (bp_block_size P) xs)  length xs"
    by (rule length_bp_bucketize_entries_le_length[OF M_pos])
  have new':
    "length (bp_bucketize_entries (bp_block_size P) (p # ps)) 
      Suc (length ps)"
    using new unfolding xs_def by simp
  have old:
    "length (bp_rebase_first_bucket_marker
        (bp_batch_max_value (snd p) ps)
        (bp_drop_empty_prefix (bp_buckets P))) 
      length (bp_buckets P)"
    by simp
  have old':
    "length (bp_drop_empty_prefix (bp_buckets P)) 
      length (bp_buckets P)"
    by simp
  have total:
    "length (bp_bucketize_entries (bp_block_size P) (p # ps)) +
      length (bp_drop_empty_prefix (bp_buckets P)) 
      Suc (length ps) + length (bp_buckets P)"
    using new' old' by linarith
  show ?thesis
    unfolding bp_bucketed_batch_prepend_state_def xs_def Let_def
    using total by simp
qed

lemma bp_bucketed_batch_prepend_state_bucket_count_slack_le:
  assumes inv: "bp_invariant P"
  shows "bp_bucket_count_slack (bp_bucketed_batch_prepend_state xs P) 
    length xs + bp_bucket_count_slack P"
proof (cases "xs = []")
  case True
  then show ?thesis by simp
next
  case False
  let ?P' = "bp_bucketed_batch_prepend_state xs P"
  let ?M = "bp_block_size P"
  let ?N = "length (bp_entries P)"
  let ?N' = "length (bp_entries ?P')"
  let ?K = "length (bp_buckets P)"
  let ?K' = "length (bp_buckets ?P')"
  let ?L = "length xs"
  have M_pos: "0 < ?M"
    using inv unfolding bp_invariant_def by blast
  have entries_len: "?N' = ?L + ?N"
    using bp_bucketed_batch_prepend_state_entries_nonempty[OF M_pos False]
    by simp
  have buckets_len: "?K'  ?L + ?K"
    by (rule bp_bucketed_batch_prepend_state_buckets_length_nonempty
        [OF M_pos False])
  have div_le: "Suc (?N div ?M)  Suc (?N' div ?M)"
    unfolding entries_len by (simp add: div_le_mono)
  have block: "bp_block_size ?P' = ?M"
    unfolding bp_bucketed_batch_prepend_state_def
    by (cases xs) (simp_all add: Let_def)
  have diff:
    "?K' - Suc (?N' div ?M) 
      ?L + (?K - Suc (?N div ?M))"
    by (rule nat_diff_add_right_le[OF buckets_len div_le])
  show ?thesis
    using diff
    unfolding bp_bucket_count_slack_def entries_len block
    by simp
qed

lemma bp_bucketed_batch_prepend_state_split_potential_le:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_split_potential (bp_bucketed_batch_prepend_state xs P) 
    length xs + bp_split_potential P"
proof -
  have inv: "bp_invariant P"
    by (rule bp_ordered_invariant_invariant[OF ord])
  have inv':
    "bp_invariant (bp_bucketed_batch_prepend_state xs P)"
    by (rule bp_bucketed_batch_prepend_state_invariant
        [OF ord distinct disjoint admissible])
  have overflow':
    "bp_overflow_potential (bp_bucketed_batch_prepend_state xs P) = 0"
    by (rule bp_invariant_overflow_potential_zero[OF inv'])
  have slack:
    "bp_bucket_count_slack (bp_bucketed_batch_prepend_state xs P) 
      length xs + bp_bucket_count_slack P"
    by (rule bp_bucketed_batch_prepend_state_bucket_count_slack_le[OF inv])
  have "bp_split_potential (bp_bucketed_batch_prepend_state xs P) =
      bp_bucket_count_slack (bp_bucketed_batch_prepend_state xs P)"
    unfolding bp_split_potential_def using overflow' by simp
  also have "  length xs + bp_bucket_count_slack P"
    by (rule slack)
  also have "  length xs + bp_split_potential P"
    unfolding bp_split_potential_def by simp
  finally show ?thesis .
qed

lemma c_bp_bucketed_batch_prepend_direct_actual_refines_batch_min_update:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
  shows "bp_view
    (bp_result_of (c_bp_bucketed_batch_prepend_direct_actual xs P)) =
    batch_min_update (bp_view P) xs"
  unfolding c_bp_bucketed_batch_prepend_direct_actual_result
  by (rule bp_bucketed_batch_prepend_state_refines_batch_min_update
      [OF bp_ordered_invariant_invariant[OF ord] distinct disjoint])

lemma c_bp_bucketed_batch_prepend_direct_actual_invariant:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_invariant
    (bp_result_of (c_bp_bucketed_batch_prepend_direct_actual xs P))"
  unfolding c_bp_bucketed_batch_prepend_direct_actual_result
  by (rule bp_bucketed_batch_prepend_state_invariant
      [OF ord distinct disjoint admissible])

lemma c_bp_bucketed_batch_prepend_direct_actual_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_ordered_invariant
    (bp_result_of (c_bp_bucketed_batch_prepend_direct_actual xs P))"
  unfolding c_bp_bucketed_batch_prepend_direct_actual_result
  by (rule bp_bucketed_batch_prepend_state_ordered_invariant
      [OF ord distinct disjoint admissible])

lemma c_bp_bucketed_batch_prepend_direct_actual_preserves_upper_bound:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and upper: "partition_upper_bound (bp_view P) B"
    and values_lt: "x b. (x, b)  set xs  b < B"
  shows "partition_upper_bound
    (bp_view
      (bp_result_of (c_bp_bucketed_batch_prepend_direct_actual xs P))) B"
  unfolding c_bp_bucketed_batch_prepend_direct_actual_refines_batch_min_update
    [OF ord distinct disjoint]
  by (rule batch_min_update_preserves_upper_bound[OF upper values_lt])

lemma c_bp_bucketed_batch_prepend_direct_actual_amortized_paper_bound:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_bucketed_batch_prepend_direct_actual xs P)) P
    (bp_result_of (c_bp_bucketed_batch_prepend_direct_actual xs P))
    (bp_batch_prepend_amortized_budget xs (bp_block_size P))"
proof -
  have pot:
    "bp_split_potential
        (bp_bucketed_batch_prepend_state xs P) 
      length xs + bp_split_potential P"
    by (rule bp_bucketed_batch_prepend_state_split_potential_le
        [OF ord distinct disjoint admissible])
  show ?thesis
    using pot
    unfolding bp_amortized_step_bound_def
      bp_batch_prepend_amortized_budget_def
    by simp
qed

lemma c_bp_bucketed_batch_prepend_direct_actual_batch_cost_bound:
  "partition_batch_cost_bound
    (bp_steps_of (c_bp_bucketed_batch_prepend_direct_actual xs P))
    (bp_ratio_log_budget (length xs) (bp_block_size P)) xs"
  unfolding partition_batch_cost_bound_def
    c_bp_bucketed_batch_prepend_direct_actual_steps
    bp_batch_prepend_log_budget_def
  by (simp add: mult.commute)

lemma c_bp_rebucketed_batch_prepend_bulk_regular_invariant:
  assumes reg: "bp_regular_invariant P"
  shows "bp_regular_invariant
    (bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P))"
  unfolding c_bp_rebucketed_batch_prepend_bulk_result
  by (rule bp_rebucketed_batch_prepend_regular_invariant
      [OF bp_ordered_invariant_invariant
        [OF bp_regular_invariant_ordered_invariant[OF reg]]])

lemma c_bp_rebucketed_batch_prepend_bulk_refines_batch_min_update:
  assumes reg: "bp_regular_invariant P"
  shows "bp_view (bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P)) =
    batch_min_update (bp_view P) xs"
  unfolding c_bp_rebucketed_batch_prepend_bulk_result
  by (rule bp_rebucketed_batch_prepend_refines_batch_min_update
      [OF bp_ordered_invariant_invariant
        [OF bp_regular_invariant_ordered_invariant[OF reg]]])

lemma c_bp_rebucketed_batch_prepend_bulk_preserves_upper_bound:
  assumes reg: "bp_regular_invariant P"
    and upper: "partition_upper_bound (bp_view P) B"
    and values_lt: "x b. (x, b)  set xs  b < B"
  shows "partition_upper_bound
    (bp_view (bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P))) B"
  unfolding c_bp_rebucketed_batch_prepend_bulk_result
  by (rule bp_rebucketed_batch_prepend_preserves_upper_bound
      [OF bp_ordered_invariant_invariant
        [OF bp_regular_invariant_ordered_invariant[OF reg]]
        upper values_lt])

lemma c_bp_rebucketed_batch_prepend_bulk_split_potential_zero:
  assumes reg: "bp_regular_invariant P"
  shows "bp_split_potential
    (bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P)) = 0"
  unfolding c_bp_rebucketed_batch_prepend_bulk_result
  by (rule bp_rebucketed_batch_prepend_split_potential_zero
      [OF bp_ordered_invariant_invariant
        [OF bp_regular_invariant_ordered_invariant[OF reg]]])

lemma c_bp_rebucketed_batch_prepend_bulk_amortized_bound:
  assumes reg: "bp_regular_invariant P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P)) P
    (bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P))
    (bp_batch_prepend_log_budget xs (bp_block_size P))"
  using c_bp_rebucketed_batch_prepend_bulk_split_potential_zero[OF reg, of xs]
    bp_regular_invariant_split_potential_zero[OF reg]
  unfolding bp_amortized_step_bound_def by simp

lemma c_bp_rebucketed_batch_prepend_bulk_steps_le_amortized_budget:
  "bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P) 
    bp_batch_prepend_amortized_budget xs (bp_block_size P)"
  using bp_batch_prepend_log_budget_le_amortized_budget[of xs "bp_block_size P"]
  by simp

lemma c_bp_rebucketed_batch_prepend_bulk_amortized_paper_bound:
  assumes reg: "bp_regular_invariant P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P)) P
    (bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P))
    (bp_batch_prepend_amortized_budget xs (bp_block_size P))"
proof -
  have base: "bp_amortized_step_bound
      (bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P)) P
      (bp_result_of (c_bp_rebucketed_batch_prepend_bulk xs P))
      (bp_batch_prepend_log_budget xs (bp_block_size P))"
    by (rule c_bp_rebucketed_batch_prepend_bulk_amortized_bound[OF reg])
  have budget:
    "bp_batch_prepend_log_budget xs (bp_block_size P) 
      bp_batch_prepend_amortized_budget xs (bp_block_size P)"
    by (rule bp_batch_prepend_log_budget_le_amortized_budget)
  show ?thesis
    using base budget unfolding bp_amortized_step_bound_def by linarith
qed

lemma c_bp_rebucketed_batch_prepend_bulk_batch_cost_bound:
  "partition_batch_cost_bound
    (bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P))
    (bp_ratio_log_budget (length xs) (bp_block_size P)) xs"
  unfolding partition_batch_cost_bound_def
  by (simp add: c_bp_rebucketed_batch_prepend_bulk_steps
      bp_batch_prepend_log_budget_def mult.commute)

lemma c_bp_rebucketed_batch_prepend_bulk_paper_batch_cost_bound:
  "partition_batch_cost_bound
    (bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P))
    (bp_batch_prepend_per_item_budget xs (bp_block_size P)) xs"
proof -
  have steps:
    "bp_steps_of (c_bp_rebucketed_batch_prepend_bulk xs P) 
      bp_batch_prepend_amortized_budget xs (bp_block_size P)"
    by (rule c_bp_rebucketed_batch_prepend_bulk_steps_le_amortized_budget)
  show ?thesis
    using steps
    unfolding partition_batch_cost_bound_def
      bp_batch_prepend_amortized_budget_alt
    by simp
qed

lemma c_bp_first_bucket_pull_result [simp]:
  "bp_result_of (c_bp_first_bucket_pull M B P) =
    bp_first_bucket_pull M B P"
  unfolding bp_result_of_def c_bp_first_bucket_pull_def by simp

lemma c_bp_first_bucket_pull_steps [simp]:
  "bp_steps_of (c_bp_first_bucket_pull M B P) = M"
  unfolding bp_steps_of_def c_bp_first_bucket_pull_def by simp

lemma c_bp_first_bucket_pull_M_bound:
  "bp_steps_of (c_bp_first_bucket_pull M B P)  M"
  by simp

lemma c_bp_first_bucket_pull_scan_result [simp]:
  "bp_result_of (c_bp_first_bucket_pull_scan M B P) =
    bp_first_bucket_pull M B P"
  unfolding bp_result_of_def c_bp_first_bucket_pull_scan_def
  by (auto split: prod.splits)

lemma c_bp_first_bucket_pull_scan_steps:
  assumes "bp_first_bucket_pull M B P = (S, beta, P')"
  shows "bp_steps_of (c_bp_first_bucket_pull_scan M B P) = card S"
  using assms unfolding bp_steps_of_def c_bp_first_bucket_pull_scan_def
  by simp

lemma bp_bucket_keys_card_le_length:
  "card (bp_bucket_keys b)  length (bp_bucket_entries b)"
  unfolding bp_bucket_keys_def bp_entry_keys_def
  by (metis card_length length_map set_map)

lemma c_bp_first_bucket_pull_scan_M_bound:
  assumes can: "bp_can_first_bucket_pull M P"
  shows "bp_steps_of (c_bp_first_bucket_pull_scan M B P)  M"
proof -
  obtain b c bs where buckets: "bp_buckets P = b # c # bs"
    and len_b: "length (bp_bucket_entries b)  M"
    by (rule bp_can_first_bucket_pullE[OF can])
  have pull:
    "bp_first_bucket_pull M B P =
      (bp_bucket_keys b, bp_marker c, bp_delete_keys (bp_bucket_keys b) P)"
    unfolding bp_first_bucket_pull_def buckets by simp
  have "bp_steps_of (c_bp_first_bucket_pull_scan M B P) =
      card (bp_bucket_keys b)"
    by (rule c_bp_first_bucket_pull_scan_steps[OF pull])
  also have "  length (bp_bucket_entries b)"
    by (rule bp_bucket_keys_card_le_length)
  also have "  M"
    by (rule len_b)
  finally show ?thesis .
qed

lemma c_bp_first_bucket_pull_scan_partition_pull_cost_bound:
  assumes pull: "bp_first_bucket_pull M B P = (S, beta, P')"
  shows "partition_pull_cost_bound
    (bp_steps_of (c_bp_first_bucket_pull_scan M B P)) S"
  using c_bp_first_bucket_pull_scan_steps[OF pull]
  unfolding partition_pull_cost_bound_def by simp

lemma c_bp_first_bucket_pull_scan_partition_pull_cost_bound_from_result:
  assumes pull:
    "bp_result_of (c_bp_first_bucket_pull_scan M B P) = (S, beta, P')"
  shows "partition_pull_cost_bound
    (bp_steps_of (c_bp_first_bucket_pull_scan M B P)) S"
proof -
  have pull': "bp_first_bucket_pull M B P = (S, beta, P')"
    using pull by simp
  show ?thesis
    by (rule c_bp_first_bucket_pull_scan_partition_pull_cost_bound[OF pull'])
qed

lemma c_bp_first_bucket_pull_scan_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_invariant
    (bp_pull_state_of (bp_result_of (c_bp_first_bucket_pull_scan M B P)))"
proof -
  obtain S beta P' where pull: "bp_first_bucket_pull M B P = (S, beta, P')"
    by (cases "bp_first_bucket_pull M B P")
  have "bp_invariant P'"
    by (rule bp_first_bucket_pull_invariant[OF inv pull])
  then show ?thesis
    using pull unfolding bp_pull_state_of_def by simp
qed

lemma c_bp_first_bucket_pull_scan_amortized_M_bound:
  assumes inv: "bp_invariant P"
    and can: "bp_can_first_bucket_pull M P"
  shows "bp_pull_amortized_step_bound
    (bp_steps_of (c_bp_first_bucket_pull_scan M B P)) P
    (bp_result_of (c_bp_first_bucket_pull_scan M B P)) (2 * M)"
proof -
  obtain b c bs where buckets: "bp_buckets P = b # c # bs"
    and len_b: "length (bp_bucket_entries b)  M"
    by (rule bp_can_first_bucket_pullE[OF can])
  let ?S = "bp_bucket_keys b"
  have pull:
    "bp_first_bucket_pull M B P =
      (?S, bp_marker c, bp_delete_keys ?S P)"
    unfolding bp_first_bucket_pull_def buckets by simp
  have state:
    "bp_pull_state_of
      (bp_result_of (c_bp_first_bucket_pull_scan M B P)) =
      bp_delete_keys ?S P"
    unfolding bp_pull_state_of_def using pull by simp
  have steps: "bp_steps_of (c_bp_first_bucket_pull_scan M B P)  M"
    by (rule c_bp_first_bucket_pull_scan_M_bound[OF can])
  have card_S: "card ?S  M"
  proof -
    have "card ?S  length (bp_bucket_entries b)"
      by (rule bp_bucket_keys_card_le_length)
    also have "  M"
      by (rule len_b)
    finally show ?thesis .
  qed
  have finite_S: "finite ?S"
    unfolding bp_bucket_keys_def bp_entry_keys_def by simp
  have potential:
    "bp_split_potential (bp_delete_keys ?S P) 
      bp_split_potential P + card ?S"
  proof (rule bp_delete_keys_split_potential_le)
    show "0 < bp_block_size P"
      using inv unfolding bp_invariant_def by blast
    show "bp_distinct_keys P"
      using inv unfolding bp_invariant_def by blast
    show "finite ?S"
      by (rule finite_S)
  qed
  show ?thesis
    using steps card_S potential unfolding bp_pull_amortized_step_bound_def
      state
    by linarith
qed

lemma c_bp_first_bucket_pull_scan_amortized_paper_bound:
  assumes inv: "bp_invariant P"
    and can: "bp_can_first_bucket_pull M P"
  shows "bp_pull_amortized_step_bound
    (bp_steps_of (c_bp_first_bucket_pull_scan M B P)) P
    (bp_result_of (c_bp_first_bucket_pull_scan M B P))
    (bp_pull_amortized_budget M)"
  unfolding bp_pull_amortized_budget_def
  by (rule c_bp_first_bucket_pull_scan_amortized_M_bound[OF inv can])

lemma c_bp_first_bucket_pull_scan_refines_pull_separates:
  assumes inv: "bp_invariant P"
    and can: "bp_can_first_bucket_pull M P"
    and pull:
      "bp_result_of (c_bp_first_bucket_pull_scan M B P) = (S, beta, P')"
  shows "pull_separates (bp_view P) M B S beta (bp_view P')"
proof -
  obtain b c bs where buckets: "bp_buckets P = b # c # bs"
    and len_b: "length (bp_bucket_entries b)  M"
    and below: "bp_bucket_below_bound b (bp_marker c)"
    and tail_nonempty: "bp_bucket_entries_flat (c # bs)  []"
    by (rule bp_can_first_bucket_pullE[OF can])
  have pull': "bp_first_bucket_pull M B P = (S, beta, P')"
    using pull by simp
  show ?thesis
    by (rule bp_first_bucket_pull_refines_pull_separates
        [OF inv buckets len_b below tail_nonempty pull'])
qed

text ‹
  Pull is charged by the size of the set it returns.  The first-bucket policy is
  sound when @{const bp_can_first_bucket_pull} exposes two adjacent nonempty
  ranges and the first bucket lies entirely below the next marker.  In that
  case the returned boundary is the next marker, the deleted set is the key set
  of the first bucket, and @{const pull_separates} follows from the bucket
  boundary invariant.  The scan-cost lemmas count exactly the returned keys, so
  the primitive cost is at most M›; the amortized Pull bound additionally
  allows potential to change after deleting those keys.
›


subsection ‹Paper-Facing Costed Operations›

text ‹
  The following aliases are the operations exported to the rest of the BMSSP
  development.  They choose the lazy precise Insert, the direct bucketed
  BatchPrepend, and the first-bucket Pull scan.  The aliases keep the public
  layer small: clients do not need to know which internal costed variant proved
  the bound, only that the selected operation refines the abstract interface
  and has the paper budget.
›

definition c_bp_paper_insert ::
  "'k  real  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_paper_insert x b P = c_bp_lazy_insert_precise x b P"

definition c_bp_paper_batch_prepend ::
  "('k × real) list  'k bucketed_partition 
    'k bucketed_partition × nat" where
  "c_bp_paper_batch_prepend xs P =
     c_bp_bucketed_batch_prepend_direct_actual xs P"

definition c_bp_paper_pull ::
  "nat  real  'k bucketed_partition 
    ('k set × real × 'k bucketed_partition) × nat" where
  "c_bp_paper_pull M B P = c_bp_first_bucket_pull_scan M B P"

definition bp_insert_paper_budget :: "nat  nat  nat" where
  "bp_insert_paper_budget N M =
     9 + floor_log (Suc (N div M))"

definition bp_batch_prepend_paper_budget :: "nat  nat  nat" where
  "bp_batch_prepend_paper_budget N M =
     2 + floor_log (Suc (N div M))"

definition bp_pull_paper_budget :: "nat  nat" where
  "bp_pull_paper_budget M = 2 * M"

lemma bp_lazy_insert_amortized_budget_paper_form:
  "bp_lazy_insert_amortized_budget P =
    bp_insert_paper_budget (length (bp_entries P)) (bp_block_size P)"
  unfolding bp_lazy_insert_amortized_budget_def
    bp_insert_search_budget_def bp_ratio_log_budget_def
    bp_insert_paper_budget_def
  by simp

lemma bp_batch_prepend_amortized_budget_paper_form:
  "bp_batch_prepend_amortized_budget xs M =
    length xs * bp_batch_prepend_paper_budget (length xs) M"
  unfolding bp_batch_prepend_amortized_budget_def
    bp_batch_prepend_log_budget_def bp_ratio_log_budget_def
    bp_batch_prepend_paper_budget_def
  by (simp add: algebra_simps)

lemma bp_ratio_log_budget_le_insert_paper_budget:
  "bp_ratio_log_budget N M  bp_insert_paper_budget N M"
  unfolding bp_ratio_log_budget_def bp_insert_paper_budget_def by simp

lemma bp_ratio_log_budget_le_batch_prepend_paper_budget:
  "bp_ratio_log_budget N M  bp_batch_prepend_paper_budget N M"
  unfolding bp_ratio_log_budget_def bp_batch_prepend_paper_budget_def by simp

lemma bp_insert_paper_budget_bigo_ratio_log:
  "(λN. real (bp_insert_paper_budget N M)) 
    O(λN. real (bp_ratio_log_budget N M))"
proof -
  have bound:
    "N. norm (real (bp_insert_paper_budget N M)) 
      9 * norm (real (bp_ratio_log_budget N M))"
  proof -
    fix N
    have "bp_insert_paper_budget N M 
        9 * bp_ratio_log_budget N M"
      unfolding bp_insert_paper_budget_def bp_ratio_log_budget_def by simp
    then show "norm (real (bp_insert_paper_budget N M)) 
      9 * norm (real (bp_ratio_log_budget N M))"
      by simp
  qed
  show ?thesis
    unfolding bigo_def
    by (intro CollectI exI[of _ 9] eventuallyI)
      (simp add: bp_insert_paper_budget_def bp_ratio_log_budget_def)
qed

lemma bp_batch_prepend_paper_budget_bigo_ratio_log:
  "(λN. real (bp_batch_prepend_paper_budget N M)) 
    O(λN. real (bp_ratio_log_budget N M))"
proof -
  have bound:
    "N. norm (real (bp_batch_prepend_paper_budget N M)) 
      2 * norm (real (bp_ratio_log_budget N M))"
  proof -
    fix N
    have "bp_batch_prepend_paper_budget N M 
        2 * bp_ratio_log_budget N M"
      unfolding bp_batch_prepend_paper_budget_def bp_ratio_log_budget_def
      by simp
    then show "norm (real (bp_batch_prepend_paper_budget N M)) 
      2 * norm (real (bp_ratio_log_budget N M))"
      by simp
  qed
  show ?thesis
    unfolding bigo_def
    by (intro CollectI exI[of _ 2] eventuallyI)
      (simp add: bp_batch_prepend_paper_budget_def bp_ratio_log_budget_def)
qed

lemma bp_pull_paper_budget_bigo_linear:
  "(λM. real (bp_pull_paper_budget M))  O(λM. real M)"
  unfolding bp_pull_paper_budget_def bigo_def
  by (intro CollectI exI[of _ 2] eventuallyI) simp

text ‹
  The named paper budgets are intentionally simple.  The Insert budget
  @{const bp_insert_paper_budget} is a constant plus the ratio-log term over
  stored entries and block size.  The BatchPrepend budget
  @{const bp_batch_prepend_paper_budget} is the corresponding per-item budget;
  the abstract batch predicate then multiplies it by the batch length.  Pull
  uses @{const bp_pull_paper_budget}, linear in the requested block size.  The
  Big-O lemmas above record exactly the envelopes consumed by the headline
  bridge.
›

lemma c_bp_paper_insert_result [simp]:
  "bp_result_of (c_bp_paper_insert x b P) =
    bp_lazy_insert_state x b P"
  unfolding c_bp_paper_insert_def by simp

lemma c_bp_paper_insert_steps [simp]:
  "bp_steps_of (c_bp_paper_insert x b P) =
    bp_local_insert_search_charge P + bp_lazy_insert_charge x b P"
  unfolding c_bp_paper_insert_def by simp

lemma c_bp_paper_insert_refines_min_update:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_view (bp_result_of (c_bp_paper_insert x b P)) =
    min_update (bp_view P) x b"
proof -
  have M_pos: "0 < bp_block_size P"
    using lazy unfolding bp_lazy_ordered_invariant_def
      bp_lazy_invariant_def by blast
  show ?thesis
    unfolding c_bp_paper_insert_def
    by (rule c_bp_lazy_insert_precise_refines_min_update[OF M_pos])
qed

lemma c_bp_paper_insert_refines_insert_spec:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "insert_spec (bp_view P) x b
    (bp_view (bp_result_of (c_bp_paper_insert x b P)))"
  unfolding c_bp_paper_insert_refines_min_update[OF lazy]
  by (rule min_update_insert_spec)

lemma c_bp_paper_insert_lazy_ordered_invariant:
  assumes lazy: "bp_lazy_ordered_invariant P"
  shows "bp_lazy_ordered_invariant
    (bp_result_of (c_bp_paper_insert x b P))"
  unfolding c_bp_paper_insert_def
  by (rule c_bp_lazy_insert_precise_lazy_ordered_invariant[OF lazy])

lemma c_bp_paper_insert_amortized_paper_bound:
  assumes lazy: "bp_lazy_ordered_invariant P"
    and ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_paper_insert x b P)) P
    (bp_result_of (c_bp_paper_insert x b P))
    (bp_lazy_insert_amortized_budget P)"
  unfolding c_bp_paper_insert_def
  by (rule c_bp_lazy_insert_precise_amortized_ratio_budget
      [OF lazy ratio])

lemma c_bp_paper_insert_regular_partition_insert_cost_bound:
  assumes reg: "bp_regular_invariant P"
  shows "partition_insert_cost_bound
    (bp_steps_of (c_bp_paper_insert x b P))
    (bp_lazy_insert_amortized_budget P)"
  unfolding c_bp_paper_insert_def
  by (rule c_bp_lazy_insert_precise_regular_partition_insert_cost_bound
      [OF reg])

lemma c_bp_paper_batch_prepend_result [simp]:
  "bp_result_of (c_bp_paper_batch_prepend xs P) =
    bp_bucketed_batch_prepend_state xs P"
  unfolding c_bp_paper_batch_prepend_def by simp

lemma c_bp_paper_batch_prepend_steps [simp]:
  "bp_steps_of (c_bp_paper_batch_prepend xs P) =
    bp_batch_prepend_log_budget xs (bp_block_size P)"
  unfolding c_bp_paper_batch_prepend_def by simp

lemma c_bp_paper_batch_prepend_refines_batch_min_update:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
  shows "bp_view (bp_result_of (c_bp_paper_batch_prepend xs P)) =
    batch_min_update (bp_view P) xs"
  unfolding c_bp_paper_batch_prepend_def
  by (rule c_bp_bucketed_batch_prepend_direct_actual_refines_batch_min_update
      [OF ord distinct disjoint])

lemma c_bp_paper_batch_prepend_ordered_invariant:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_ordered_invariant
    (bp_result_of (c_bp_paper_batch_prepend xs P))"
  unfolding c_bp_paper_batch_prepend_def
  by (rule c_bp_bucketed_batch_prepend_direct_actual_ordered_invariant
      [OF ord distinct disjoint admissible])

lemma c_bp_paper_batch_prepend_preserves_upper_bound:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and upper: "partition_upper_bound (bp_view P) B"
    and values_lt: "x b. (x, b)  set xs  b < B"
  shows "partition_upper_bound
    (bp_view (bp_result_of (c_bp_paper_batch_prepend xs P))) B"
  unfolding c_bp_paper_batch_prepend_def
  by (rule c_bp_bucketed_batch_prepend_direct_actual_preserves_upper_bound
      [OF ord distinct disjoint upper values_lt])

lemma c_bp_paper_batch_prepend_amortized_paper_bound:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_paper_batch_prepend xs P)) P
    (bp_result_of (c_bp_paper_batch_prepend xs P))
    (bp_batch_prepend_amortized_budget xs (bp_block_size P))"
  unfolding c_bp_paper_batch_prepend_def
  by (rule c_bp_bucketed_batch_prepend_direct_actual_amortized_paper_bound
      [OF ord distinct disjoint admissible])

lemma c_bp_paper_batch_prepend_batch_cost_bound:
  "partition_batch_cost_bound
    (bp_steps_of (c_bp_paper_batch_prepend xs P))
    (bp_ratio_log_budget (length xs) (bp_block_size P)) xs"
  unfolding c_bp_paper_batch_prepend_def
  by (rule c_bp_bucketed_batch_prepend_direct_actual_batch_cost_bound)

lemma c_bp_paper_pull_result [simp]:
  "bp_result_of (c_bp_paper_pull M B P) =
    bp_first_bucket_pull M B P"
  unfolding c_bp_paper_pull_def by simp

lemma c_bp_paper_pull_M_bound:
  assumes can: "bp_can_first_bucket_pull M P"
  shows "bp_steps_of (c_bp_paper_pull M B P)  M"
  unfolding c_bp_paper_pull_def
  by (rule c_bp_first_bucket_pull_scan_M_bound[OF can])

lemma c_bp_paper_pull_partition_pull_cost_bound:
  assumes pull:
    "bp_result_of (c_bp_paper_pull M B P) = (S, beta, P')"
  shows "partition_pull_cost_bound
    (bp_steps_of (c_bp_paper_pull M B P)) S"
  unfolding c_bp_paper_pull_def
  by (rule c_bp_first_bucket_pull_scan_partition_pull_cost_bound_from_result
      [OF pull[unfolded c_bp_paper_pull_def]])

lemma c_bp_paper_pull_invariant:
  assumes inv: "bp_invariant P"
  shows "bp_invariant
    (bp_pull_state_of (bp_result_of (c_bp_paper_pull M B P)))"
  unfolding c_bp_paper_pull_def
  by (rule c_bp_first_bucket_pull_scan_invariant[OF inv])

lemma c_bp_paper_pull_amortized_paper_bound:
  assumes inv: "bp_invariant P"
    and can: "bp_can_first_bucket_pull M P"
  shows "bp_pull_amortized_step_bound
    (bp_steps_of (c_bp_paper_pull M B P)) P
    (bp_result_of (c_bp_paper_pull M B P))
    (bp_pull_amortized_budget M)"
  unfolding c_bp_paper_pull_def
  by (rule c_bp_first_bucket_pull_scan_amortized_paper_bound[OF inv can])

lemma c_bp_paper_pull_refines_pull_separates:
  assumes inv: "bp_invariant P"
    and can: "bp_can_first_bucket_pull M P"
    and pull:
      "bp_result_of (c_bp_paper_pull M B P) = (S, beta, P')"
  shows "pull_separates (bp_view P) M B S beta (bp_view P')"
  unfolding c_bp_paper_pull_def
  by (rule c_bp_first_bucket_pull_scan_refines_pull_separates
      [OF inv can pull[unfolded c_bp_paper_pull_def]])

corollary bp_realises_partition_insert_cost_bound:
  assumes reg: "bp_regular_invariant P"
  shows "t. partition_insert_cost_bound
      (bp_steps_of (c_bp_paper_insert x b P)) t 
    t = bp_insert_paper_budget (length (bp_entries P)) (bp_block_size P)"
proof (intro exI conjI)
  show "partition_insert_cost_bound
      (bp_steps_of (c_bp_paper_insert x b P))
      (bp_insert_paper_budget (length (bp_entries P)) (bp_block_size P))"
    using c_bp_paper_insert_regular_partition_insert_cost_bound[OF reg, of x b]
    by (simp add: bp_lazy_insert_amortized_budget_paper_form)
qed simp

corollary bp_realises_partition_batch_cost_bound:
  shows "t. partition_batch_cost_bound
      (bp_steps_of (c_bp_paper_batch_prepend xs P)) t xs 
    t = bp_batch_prepend_paper_budget (length xs) (bp_block_size P)"
proof (intro exI conjI)
  have cost:
    "partition_batch_cost_bound
      (bp_steps_of (c_bp_paper_batch_prepend xs P))
      (bp_ratio_log_budget (length xs) (bp_block_size P)) xs"
    by (rule c_bp_paper_batch_prepend_batch_cost_bound)
  have le:
    "bp_ratio_log_budget (length xs) (bp_block_size P) 
      bp_batch_prepend_paper_budget (length xs) (bp_block_size P)"
    by (rule bp_ratio_log_budget_le_batch_prepend_paper_budget)
  show "partition_batch_cost_bound
      (bp_steps_of (c_bp_paper_batch_prepend xs P))
      (bp_batch_prepend_paper_budget (length xs) (bp_block_size P)) xs"
  proof -
    have steps_le:
      "bp_steps_of (c_bp_paper_batch_prepend xs P) 
        bp_ratio_log_budget (length xs) (bp_block_size P) * length xs"
      using cost unfolding partition_batch_cost_bound_def .
    have budget_le:
      "bp_ratio_log_budget (length xs) (bp_block_size P) * length xs 
        bp_batch_prepend_paper_budget (length xs) (bp_block_size P) *
          length xs"
      using le by simp
    show ?thesis
      using steps_le budget_le unfolding partition_batch_cost_bound_def
      by linarith
  qed
qed simp

corollary bp_realises_partition_pull_cost_bound:
  assumes pull:
    "bp_result_of (c_bp_paper_pull M B P) = (S, beta, P')"
  shows "partition_pull_cost_bound
    (bp_steps_of (c_bp_paper_pull M B P)) S"
  by (rule c_bp_paper_pull_partition_pull_cost_bound[OF pull])

text ‹
  The realization corollaries are the interface-facing summary.  They convert
  the concrete step counters of @{const c_bp_paper_insert},
  @{const c_bp_paper_batch_prepend}, and @{const c_bp_paper_pull} into the
  abstract predicates @{const partition_insert_cost_bound},
  @{const partition_batch_cost_bound}, and @{const partition_pull_cost_bound}.
  These are the facts imported by the headline bridge; the operation-specific
  theorems below keep the sharper amortized statements visible for readers who
  want to inspect the data-structure proof itself.
›

theorem bp_insert_cost_bound:
  assumes lazy: "bp_lazy_ordered_invariant P"
    and ratio: "bp_bucket_count_ratio_ok P"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_paper_insert x b P)) P
    (bp_result_of (c_bp_paper_insert x b P))
    (9 + floor_log
      (Suc (length (bp_entries P) div bp_block_size P)))"
  using c_bp_paper_insert_amortized_paper_bound[OF lazy ratio, of x b]
  by (simp add: bp_lazy_insert_amortized_budget_paper_form
      bp_insert_paper_budget_def)

theorem bp_batch_prepend_cost_bound:
  assumes ord: "bp_ordered_invariant P"
    and distinct: "distinct (map fst xs)"
    and disjoint: "bp_entry_keys xs  keys_of (bp_view P) = {}"
    and admissible: "batch_prepend_admissible (bp_view P) xs"
  shows "bp_amortized_step_bound
    (bp_steps_of (c_bp_paper_batch_prepend xs P)) P
    (bp_result_of (c_bp_paper_batch_prepend xs P))
    (length xs *
      (2 + floor_log (Suc (length xs div bp_block_size P))))"
  using c_bp_paper_batch_prepend_amortized_paper_bound
      [OF ord distinct disjoint admissible]
  by (simp add: bp_batch_prepend_amortized_budget_paper_form
      bp_batch_prepend_paper_budget_def)

theorem bp_pull_cost_bound:
  assumes inv: "bp_invariant P"
    and can: "bp_can_first_bucket_pull M P"
  shows "bp_pull_amortized_step_bound
    (bp_steps_of (c_bp_paper_pull M B P)) P
    (bp_result_of (c_bp_paper_pull M B P))
    (2 * M)"
  using c_bp_paper_pull_amortized_paper_bound[OF inv can, of B]
  unfolding bp_pull_amortized_budget_def .

text ‹
  The three theorems above are the exported paper-tight cost bounds for the
  bucketed structure.  @{thm bp_insert_cost_bound} combines a ratio-log bucket
  search with the lazy split potential, giving an amortized Insert budget of a
  constant plus @{const floor_log} of Suc (N div M)›.  This is the formal
  log(N/M)› term required by the BMSSP parameter schedule.  The batch theorem
  @{thm bp_batch_prepend_cost_bound} charges the same ratio-log scale per
  incoming item, matching the paper's batched prepend cost.  Finally,
  @{thm bp_pull_cost_bound} gives the amortized linear Pull budget 2 * M›.
  These statements are intentionally stronger and more concrete than the
  abstract cost-interface corollaries: they expose the primitive-step and
  potential accounting that justifies plugging the structure into the
  top-level runtime proof.
›

end