Theory AlphabetRoundtrip

theory AlphabetRoundtrip
  imports
    "Multitape_Alphabet_Enlargement.AlphabetEnlargement_Reverse"
    "Multitape_Alphabet_Reduction.AlphabetReduction_Reverse"
begin

section ‹Round-trip composition of the alphabet transformations›

text ‹The two alphabet transformations compose ‹as machines› in both
  orders on the shared substrate.  This theory states, for each order,
  language preservation and a composed linear-time slowdown bound.  Nothing
  is re-proved: each headline chains the language / time theorems of
  constalphabet_enlarge and constalphabet_reduce already established
  in the two sibling sessions.

  Two directions:
   ‹reduce after enlarge›: termalphabet_reduce (alphabet_enlarge M).
    The enlarged machine feeds constalphabet_reduce; the four-symbol lower
    bound its hypotheses require follows from the constant-cell embedding of
    the source alphabet into the block alphabet (card_gamma_block_ge_card›).
   ‹enlarge after reduce›: termalphabet_enlarge (alphabet_reduce M).
    The reduced machine is well-formed for ‹any› valid source with a
    four-symbol alphabet (alphabet_reduce_well_formed›), which discharges the
    constwell_formed_mttm hypothesis constalphabet_enlarge requires of its
    input -- the cut-tolerance payoff.›

subsection ‹The enlarged alphabet has at least as many symbols as the source›

text ‹The block alphabet termgamma_block Γ contains the constant
  blocks termλ_. a for every terma  Γ, and the embedding sending
  a› to that constant cell is injective (the index type is inhabited).  Hence
  the enlarged alphabet is at least as large as the source, so a source with
  term4  card Γ enlarges to a machine whose alphabet still meets the
  reduction combinator's minimal-alphabet bound.›

lemma card_gamma_block_ge_card:
  fixes Γ :: "'a set"
  assumes finG: "finite Γ"
  shows "card Γ  card (gamma_block Γ :: (('c :: enum)  'a) set)"
proof -
  have inj: "inj_on (λa. (λ_::'c. a)) Γ"
    by (rule inj_onI) (metis fun_cong)
  have img: "(λa. (λ_::'c. a)) ` Γ  gamma_block Γ"
    by (auto simp: gamma_block_def)
  have "card Γ = card ((λa. (λ_::'c. a)) ` Γ)"
    by (simp add: card_image[OF inj])
  also have "  card (gamma_block Γ :: ('c  'a) set)"
    by (rule card_mono[OF finite_gamma_block[OF finG] img])
  finally show ?thesis .
qed

subsection ‹Time-composition preliminaries›

text ‹A small fact used when composing the running-time bounds: the block
  count (n + c - 1) div c› (rounding n / c› up) that the enlargement
  bound divides by never exceeds n› for a nonempty index (0 < c›).  (Weak
  acceptance monotonicity, formerly local here, is now the substrate's
  accepts_in_time_mttm_mono›.)›

lemma ceil_div_le:
  fixes n c :: nat
  assumes cpos: "0 < c"
  shows "(n + c - 1) div c  n"
proof (cases "n = 0")
  case True
  from cpos obtain m where cm: "c = Suc m" using gr0_implies_Suc by blast
  have "c - 1 < c" using cm by simp
  hence "(c - 1) div c = 0" by (rule div_less)
  thus ?thesis using True by simp
next
  case False
  then have n1: "1  n" by simp
  have cnz: "c  0" using cpos by simp
  have eq: "n + c - 1 = (n - 1) + c" using n1 by simp
  have "(n + c - 1) div c = (n - 1) div c + 1"
    unfolding eq by (rule div_add_self2[OF cnz])
  also have "  (n - 1) + 1"
    using div_le_dividend[of "n - 1" c] by simp
  also have " = n" using n1 by simp
  finally show ?thesis .
qed

subsection ‹Enlarge after reduce›

text ‹Reduce M› to the four-symbol machine termalphabet_reduce M, then
  enlarge that.  Language preservation chains the two headline biconditionals:
  alphabet_reduce_language› (from M› to the reduced machine, under the
  per-symbol encoding constencode_input_ar) and alphabet_enlarge_language›
  (from the reduced machine to its enlargement, under the block encoding
  constencode_input).  Two seams are discharged locally: the reduced machine
  is well-formed for any valid four-symbol source
  (alphabet_reduce_well_formed›, the input hypothesis
  constalphabet_enlarge requires), and the encoded intermediate word lies in
  the reduced machine's input alphabet term{BIT0, BIT1}
  (set_encode_input_ar›).›

theorem alphabet_reduce_enlarge_language:
  fixes M :: "('q, 'a) mttm"
  assumes vM: "valid_mttm M"
      and s_neq_t: "s_tm M  t_tm M"
      and s_neq_r: "s_tm M  r_tm M"
      and le_neq_bl: "le_tm M  bl_tm M"
      and card_ge: "card (Γ_tm M)  4"
  shows "w. set w  Sigma_tm M 
           (encode_input (bl_tm (alphabet_reduce M))
                (encode_input_ar (Γ_tm M) (bl_tm M) w)
               Lang_mttm (alphabet_enlarge (alphabet_reduce M)
                   :: ((('q × 'a ar_stage) × (sym4, 'c :: enum) ae_stage),
                       'c  sym4) mttm))
           = (w  Lang_mttm M)"
proof (intro allI impI)
  fix w assume w: "set w  Sigma_tm M"
  let ?Mr = "alphabet_reduce M :: ('q × 'a ar_stage, sym4) mttm"
  let ?enc = "encode_input_ar (Γ_tm M) (bl_tm M) w"
  have wfr: "well_formed_mttm ?Mr"
    by (rule alphabet_reduce_well_formed[OF vM card_ge])
  have red: "(?enc  Lang_mttm ?Mr) = (w  Lang_mttm M)"
    using alphabet_reduce_language[OF vM s_neq_t s_neq_r le_neq_bl card_ge] w
    by blast
  have guard: "set ?enc  Sigma_tm ?Mr"
    using set_encode_input_ar[of "Γ_tm M" "bl_tm M" w]
    by (simp add: alphabet_reduce_Sigma)
  have enl: "(encode_input (bl_tm ?Mr) ?enc
                 Lang_mttm (alphabet_enlarge ?Mr
                     :: ((('q × 'a ar_stage) × (sym4, 'c) ae_stage),
                         'c  sym4) mttm))
             = (?enc  Lang_mttm ?Mr)"
    using alphabet_enlarge_language[OF wfr] guard by blast
  show "(encode_input (bl_tm ?Mr) ?enc
             Lang_mttm (alphabet_enlarge ?Mr
                 :: ((('q × 'a ar_stage) × (sym4, 'c) ae_stage),
                     'c  sym4) mttm))
        = (w  Lang_mttm M)"
    using enl red by simp
qed

text ‹The composed slowdown, with explicit constants.  Reducing then
  enlarging is linear-time, with the affine bound
  8 ⋅ (6 ⋅ k_tm M + 1) ⋅ b ⋅ T(|w|) + 2 ⋅ b ⋅ |w| + 4›, where
  b = block_width (Γ_tm M)› is the per-symbol binary width and k_tm M› the tape
  count.  It routes the explicit reduction bound
  ((6 ⋅ k_tm M + 1) ⋅ b ⋅ T›, alphabet_reduce_time_explicit›) in as the
  enlargement's per-input running-time function Tr›; on the encoded
  intermediate word (length b ⋅ |w|›) the enlargement hypothesis holds
  ‹exactly› (Tr (b ⋅ |w|) = (6 ⋅ k_tm M + 1) ⋅ b ⋅ T(|w|)›), and the
  enlargement's ceiling divisions are relaxed by ceil_div_le› and
  accepts_in_time_mttm_mono›.  The enlargement's block-speedup divisor
  c = card (UNIV :: 'c set)› ‹cancels›: it divides the intermediate length
  and running time, but ceil_div_le› discards it in the relaxation, so it
  does not appear in the bound --- the block speedup buys nothing once the
  reduction has fixed the alphabet.  The classical existential form is
  alphabet_reduce_enlarge_time› below.›

theorem alphabet_reduce_enlarge_time_explicit:
  fixes M :: "('q, 'a) mttm" and T :: "nat  nat"
  assumes vM: "valid_mttm M"
      and s_neq_t: "s_tm M  t_tm M"
      and s_neq_r: "s_tm M  r_tm M"
      and le_neq_bl: "le_tm M  bl_tm M"
      and card_ge: "card (Γ_tm M)  4"
  shows "w. set w  Sigma_tm M 
           accepts_in_time_mttm M w (T (length w)) 
           accepts_in_time_mttm
             (alphabet_enlarge (alphabet_reduce M)
                :: ((('q × 'a ar_stage) × (sym4, 'c :: enum) ae_stage),
                    'c  sym4) mttm)
             (encode_input (bl_tm (alphabet_reduce M))
                (encode_input_ar (Γ_tm M) (bl_tm M) w))
             (8 * (6 * k_tm M + 1) * block_width (Γ_tm M) * T (length w)
               + 2 * block_width (Γ_tm M) * length w + 4)"
proof -
  let ?Mr = "alphabet_reduce M :: ('q × 'a ar_stage, sym4) mttm"
  let ?Me = "alphabet_enlarge ?Mr
               :: ((('q × 'a ar_stage) × (sym4, 'c :: enum) ae_stage),
                   'c  sym4) mttm"
  let ?kf = "block_width (Γ_tm M)"
  let ?c = "card (UNIV :: 'c set)"
  let ?d = "6 * k_tm M + 1"
  have wfr: "well_formed_mttm ?Mr" by (rule alphabet_reduce_well_formed[OF vM card_ge])
  have kfpos: "0 < ?kf" using block_width_pos[of "Γ_tm M"] by simp
  have cpos: "0 < ?c" by (simp add: card_gt_0_iff)
  have ar: "w. set w  Sigma_tm M 
               accepts_in_time_mttm M w (T (length w)) 
               accepts_in_time_mttm ?Mr (encode_input_ar (Γ_tm M) (bl_tm M) w)
                 (?d * ?kf * T (length w))"
    by (rule alphabet_reduce_time_explicit[OF vM s_neq_t s_neq_r le_neq_bl card_ge])
  ― ‹route the reduction bound in as the enlargement's per-input time function›
  define Tr :: "nat  nat" where "Tr = (λn. ?d * ?kf * T (n div ?kf))"
  have ae: "v. set v  Sigma_tm ?Mr 
        accepts_in_time_mttm ?Mr v (Tr (length v)) 
        accepts_in_time_mttm ?Me (encode_input (bl_tm ?Mr) v)
          (2 * ((length v + ?c - 1) div ?c)
            + 8 * ((Tr (length v) + ?c - 1) div ?c) + 4)"
    by (rule alphabet_enlarge_time_explicit[OF wfr, where T = Tr])
  show "w. set w  Sigma_tm M 
        accepts_in_time_mttm M w (T (length w)) 
        accepts_in_time_mttm ?Me
          (encode_input (bl_tm ?Mr) (encode_input_ar (Γ_tm M) (bl_tm M) w))
          (8 * (6 * k_tm M + 1) * block_width (Γ_tm M) * T (length w)
            + 2 * block_width (Γ_tm M) * length w + 4)"
  proof (intro allI impI)
    fix w assume w: "set w  Sigma_tm M"
      and accM: "accepts_in_time_mttm M w (T (length w))"
    let ?v = "encode_input_ar (Γ_tm M) (bl_tm M) w"
    have lenv: "length ?v = ?kf * length w"
      by (simp add: length_encode_input_ar)
    have div_w: "length ?v div ?kf = length w"
      using lenv kfpos by simp
    have Tr_v: "Tr (length ?v) = ?d * ?kf * T (length w)"
      using div_w by (simp add: Tr_def)
    have accr: "accepts_in_time_mttm ?Mr ?v (Tr (length ?v))"
      using ar w accM Tr_v by simp
    have guard: "set ?v  Sigma_tm ?Mr"
      using set_encode_input_ar[of "Γ_tm M" "bl_tm M" w]
      by (simp add: alphabet_reduce_Sigma)
    have ae_acc: "accepts_in_time_mttm ?Me (encode_input (bl_tm ?Mr) ?v)
                    (2 * ((length ?v + ?c - 1) div ?c)
                      + 8 * ((Tr (length ?v) + ?c - 1) div ?c) + 4)"
      using ae guard accr by blast
    have bound_le:
      "2 * ((length ?v + ?c - 1) div ?c)
         + 8 * ((Tr (length ?v) + ?c - 1) div ?c) + 4
        8 * ?d * ?kf * T (length w) + 2 * ?kf * length w + 4"
    proof -
      have h1: "(length ?v + ?c - 1) div ?c  length ?v" by (rule ceil_div_le[OF cpos])
      have h2: "(Tr (length ?v) + ?c - 1) div ?c  Tr (length ?v)" by (rule ceil_div_le[OF cpos])
      have "2 * ((length ?v + ?c - 1) div ?c)
              + 8 * ((Tr (length ?v) + ?c - 1) div ?c) + 4
             2 * length ?v + 8 * Tr (length ?v) + 4"
        using h1 h2 by (simp add: add_mono mult_le_mono2)
      also have " = 2 * (?kf * length w) + 8 * (?d * ?kf * T (length w)) + 4"
        using lenv Tr_v by simp
      also have " = 8 * ?d * ?kf * T (length w) + 2 * ?kf * length w + 4"
        by (simp add: algebra_simps)
      finally show ?thesis .
    qed
    show "accepts_in_time_mttm ?Me
            (encode_input (bl_tm ?Mr) ?v)
            (8 * (6 * k_tm M + 1) * block_width (Γ_tm M) * T (length w)
              + 2 * block_width (Γ_tm M) * length w + 4)"
      by (rule accepts_in_time_mttm_mono[OF ae_acc bound_le])
  qed
qed

text ‹The classical existential form A ⋅ T(|w|) + B ⋅ |w| + C›, with
  A = 8 ⋅ (6 ⋅ k_tm M + 1) ⋅ b›,
  B = 2 ⋅ b›, and C = 4› from
  alphabet_reduce_enlarge_time_explicit›.›

theorem alphabet_reduce_enlarge_time:
  fixes M :: "('q, 'a) mttm" and T :: "nat  nat"
  assumes vM: "valid_mttm M"
      and s_neq_t: "s_tm M  t_tm M"
      and s_neq_r: "s_tm M  r_tm M"
      and le_neq_bl: "le_tm M  bl_tm M"
      and card_ge: "card (Γ_tm M)  4"
  obtains A B C :: nat
  where "w. set w  Sigma_tm M 
           accepts_in_time_mttm M w (T (length w)) 
           accepts_in_time_mttm
             (alphabet_enlarge (alphabet_reduce M)
                :: ((('q × 'a ar_stage) × (sym4, 'c :: enum) ae_stage),
                    'c  sym4) mttm)
             (encode_input (bl_tm (alphabet_reduce M))
                (encode_input_ar (Γ_tm M) (bl_tm M) w))
             (A * T (length w) + B * length w + C)"
proof (rule that[of "8 * (6 * k_tm M + 1) * block_width (Γ_tm M)"
                    "2 * block_width (Γ_tm M)" 4])
  show "w. set w  Sigma_tm M 
           accepts_in_time_mttm M w (T (length w)) 
           accepts_in_time_mttm
             (alphabet_enlarge (alphabet_reduce M)
                :: ((('q × 'a ar_stage) × (sym4, 'c :: enum) ae_stage),
                    'c  sym4) mttm)
             (encode_input (bl_tm (alphabet_reduce M))
                (encode_input_ar (Γ_tm M) (bl_tm M) w))
             (8 * (6 * k_tm M + 1) * block_width (Γ_tm M) * T (length w)
               + 2 * block_width (Γ_tm M) * length w + 4)"
    by (rule alphabet_reduce_enlarge_time_explicit[OF vM s_neq_t s_neq_r le_neq_bl card_ge])
qed

subsection ‹Reduce after enlarge›

text ‹Enlarge M› to the block machine termalphabet_enlarge M, then reduce
  that back to four symbols.  This is the direction whose seams need the
  enlarged machine's own well-formedness data: its start / accept / reject
  states, blank and endmarker are the source ones tagged / block-encoded (the
  field accessors s_tm_alphabet_enlarge› etc.), and its tape alphabet is the
  block alphabet termgamma_block (Γ_tm M), whose cardinality is at least
  the source's (card_gamma_block_ge_card›) --- so a four-symbol source stays
  above the reduction's minimal-alphabet bound.›

lemma Gamma_tm_alphabet_enlarge:
  fixes M :: "('q, 'a) mttm"
  shows "Γ_tm (alphabet_enlarge M
                  :: ('q × ('a, ('c :: enum)) ae_stage, 'c  'a) mttm)
          = gamma_block (Γ_tm M)"
  by (cases M) (simp add: alphabet_enlarge_def)

text ‹Enlargement preserves the tape count (the last mttm› field is
  copied unchanged): the block transformation is purely alphabet-level, so the
  reduction's tape-count factor 6 ⋅ k_tm M + 1› is the ‹source› tape count
  even when the reduction is applied to the enlarged machine.  Mirrors
  alphabet_reduce_preserves_tape_count›.›

lemma k_tm_alphabet_enlarge:
  fixes M :: "('q, 'a) mttm"
  shows "k_tm (alphabet_enlarge M
                  :: ('q × ('a, ('c :: enum)) ae_stage, 'c  'a) mttm)
          = k_tm M"
  by (cases M) (simp add: alphabet_enlarge_def)

text ‹Discharge of the reduction's input hypotheses on the enlarged machine
  (validity, the three non-degeneracy conditions, and the four-symbol lower
  bound), packaged for reuse by both the language and the time theorem.›

lemma alphabet_enlarge_reduce_hyps:
  fixes M :: "('q, 'a) mttm"
  assumes vM: "valid_mttm M"
      and s_neq_t: "s_tm M  t_tm M"
      and s_neq_r: "s_tm M  r_tm M"
      and le_neq_bl: "le_tm M  bl_tm M"
      and card_ge: "card (Γ_tm M)  4"
  shows "valid_mttm (alphabet_enlarge M
            :: ('q × ('a, 'c :: enum) ae_stage, 'c  'a) mttm)"
    and "s_tm (alphabet_enlarge M
            :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm)
           t_tm (alphabet_enlarge M)"
    and "s_tm (alphabet_enlarge M
            :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm)
           r_tm (alphabet_enlarge M)"
    and "le_tm (alphabet_enlarge M
            :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm)
           bl_tm (alphabet_enlarge M)"
    and "card (Γ_tm (alphabet_enlarge M
            :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))  4"
proof -
  let ?M' = "alphabet_enlarge M :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm"
  have finG: "finite (Γ_tm M)" by (rule valid_mttm_finite_Gamma[OF vM])
  show "valid_mttm ?M'" by (rule alphabet_enlarge_wf[OF vM])
  show "s_tm ?M'  t_tm ?M'"
    using s_neq_t by (simp add: s_tm_alphabet_enlarge t_tm_alphabet_enlarge)
  show "s_tm ?M'  r_tm ?M'"
    using s_neq_r by (simp add: s_tm_alphabet_enlarge r_tm_alphabet_enlarge)
  show "le_tm ?M'  bl_tm ?M'"
  proof
    assume "le_tm ?M' = bl_tm ?M'"
    hence "(LE_block (le_tm M) :: 'c  'a) = bl_block (bl_tm M)"
      by (simp add: le_tm_alphabet_enlarge bl_tm_alphabet_enlarge)
    hence "le_tm M = bl_tm M" by (rule LE_block_eq_bl_block_imp_eq)
    with le_neq_bl show False by simp
  qed
  have "card (Γ_tm M)  card (gamma_block (Γ_tm M) :: ('c  'a) set)"
    by (rule card_gamma_block_ge_card[OF finG])
  hence "4  card (gamma_block (Γ_tm M) :: ('c  'a) set)"
    using card_ge by linarith
  thus "card (Γ_tm ?M')  4" by (simp add: Gamma_tm_alphabet_enlarge)
qed

text ‹The intermediate-word guard: the block encoding of a genuine input
  word lands in the enlarged machine's input alphabet (it is a block
  over the source, and avoids the two reserved blocks).  Shared by the
  language and time theorems of this direction.›

lemma encode_input_in_Sigma_alphabet_enlarge:
  fixes M :: "('q, 'a) mttm"
  assumes vM: "valid_mttm M" and w: "set w  Sigma_tm M"
  shows "set (encode_input (bl_tm M) w :: ('c :: enum  'a) list)
            Sigma_tm (alphabet_enlarge M
                :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm)"
proof -
  have "set (encode_input (bl_tm M) w :: ('c  'a) list)
           gamma_block (Sigma_tm M  {bl_tm M})"
    by (rule encode_input_in_gamma_block[OF w])
  moreover have "bl_block (bl_tm M)
           set (encode_input (bl_tm M) w :: ('c  'a) list)"
    by (rule encode_input_no_bl_block[OF vM w])
  moreover have "LE_block (le_tm M)
           set (encode_input (bl_tm M) w :: ('c  'a) list)"
    by (rule encode_input_no_LE_block[OF vM w])
  ultimately show ?thesis by (auto simp: Sigma_tm_alphabet_enlarge)
qed

theorem alphabet_enlarge_reduce_language:
  fixes M :: "('q, 'a) mttm"
  assumes wfM: "well_formed_mttm M"
      and card_ge: "card (Γ_tm M)  4"
  shows "w. set w  Sigma_tm M 
           (encode_input_ar
               (Γ_tm (alphabet_enlarge M
                        :: ('q × ('a, 'c :: enum) ae_stage, 'c  'a) mttm))
               (bl_tm (alphabet_enlarge M))
               (encode_input (bl_tm M) w)
              Lang_mttm (alphabet_reduce (alphabet_enlarge M)
                  :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm))
           = (w  Lang_mttm M)"
proof (intro allI impI)
  fix w assume w: "set w  Sigma_tm M"
  let ?M' = "alphabet_enlarge M :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm"
  have vM: "valid_mttm M"
    and s_neq_t: "s_tm M  t_tm M"
    and s_neq_r: "s_tm M  r_tm M"
    and le_neq_bl: "le_tm M  bl_tm M"
    using wfM by auto
  note hyps = alphabet_enlarge_reduce_hyps[OF vM s_neq_t s_neq_r le_neq_bl card_ge]
  have enl: "(encode_input (bl_tm M) w  Lang_mttm ?M') = (w  Lang_mttm M)"
    using alphabet_enlarge_language[OF wfM] w by blast
  have guard: "set (encode_input (bl_tm M) w :: ('c  'a) list)  Sigma_tm ?M'"
    by (rule encode_input_in_Sigma_alphabet_enlarge[OF vM w])
  have red: "(encode_input_ar (Γ_tm ?M') (bl_tm ?M') (encode_input (bl_tm M) w)
                 Lang_mttm (alphabet_reduce ?M'
                     :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm))
             = (encode_input (bl_tm M) w  Lang_mttm ?M')"
    using alphabet_reduce_language[OF hyps(1) hyps(2) hyps(3) hyps(4) hyps(5)] guard
    by blast
  show "(encode_input_ar (Γ_tm ?M') (bl_tm ?M') (encode_input (bl_tm M) w)
             Lang_mttm (alphabet_reduce ?M'
                 :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm))
        = (w  Lang_mttm M)"
    using red enl by simp
qed

text ‹The composed slowdown for reduce-after-enlarge, with explicit
  constants.  Unlike the other order, the inner transformation (enlargement)
  ‹speeds up› by the block factor c = card (UNIV :: 'c set)›, so the
  intermediate word has length ⌈|w| / c⌉› --- a lossy function of |w|›,
  not an exact multiple --- and the enlarged machine's running time cannot be
  routed into the reduction's time function exactly.  Two mild ingredients
  close the gap: T› is assumed non-decreasing (mono T›), and the outer
  bound is stated at T(|w| + c - 1)› --- T› at the input length rounded up
  to the next block boundary.  The bound is
  8 ⋅ D ⋅ b' ⋅ T(|w| + c - 1) + 2 ⋅ D ⋅ b' ⋅ |w| + 4 ⋅ D ⋅ b'›, where
  D = 6 ⋅ k_tm M + 1› (the tape count is preserved by enlargement,
  k_tm_alphabet_enlarge›) and
  b' = block_width (Γ_tm (alphabet_enlarge M)) = block_width (gamma_block (Γ_tm M))› is
  the per-symbol width of the ‹block› alphabet, i.e.
  ⌈c ⋅ log2 (card ΓM)⌉›.  Because b'› grows with c›, the block-speedup
  factor ‹does not› cancel here: c› survives both in the time argument
  T(|w| + c - 1)› and, through b'›, in every coefficient.  The classical
  existential form is alphabet_enlarge_reduce_time› below.›

theorem alphabet_enlarge_reduce_time_explicit:
  fixes M :: "('q, 'a) mttm" and T :: "nat  nat"
  assumes wfM: "well_formed_mttm M"
      and card_ge: "card (Γ_tm M)  4"
      and Tmono: "mono T"
  shows "w. set w  Sigma_tm M 
           accepts_in_time_mttm M w (T (length w)) 
           accepts_in_time_mttm
             (alphabet_reduce (alphabet_enlarge M)
                :: ((('q × ('a, 'c :: enum) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
             (encode_input_ar
                 (Γ_tm (alphabet_enlarge M :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))
                 (bl_tm (alphabet_enlarge M))
                 (encode_input (bl_tm M) w))
             (8 * (6 * k_tm M + 1)
                   * block_width (Γ_tm (alphabet_enlarge M
                        :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))
                   * T (length w + card (UNIV :: 'c set) - 1)
               + 2 * (6 * k_tm M + 1)
                   * block_width (Γ_tm (alphabet_enlarge M
                        :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))
                   * length w
               + 4 * (6 * k_tm M + 1)
                   * block_width (Γ_tm (alphabet_enlarge M
                        :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm)))"
proof -
  let ?M' = "alphabet_enlarge M :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm"
  let ?c = "card (UNIV :: 'c set)"
  let ?ke = "block_width (Γ_tm ?M')"
  let ?d = "6 * k_tm M + 1"
  have vM: "valid_mttm M"
    and s_neq_t: "s_tm M  t_tm M"
    and s_neq_r: "s_tm M  r_tm M"
    and le_neq_bl: "le_tm M  bl_tm M"
    using wfM by auto
  have cpos: "0 < ?c" by (simp add: card_gt_0_iff)
  have ktm: "k_tm ?M' = k_tm M" by (rule k_tm_alphabet_enlarge)
  note hyps = alphabet_enlarge_reduce_hyps[OF vM s_neq_t s_neq_r le_neq_bl card_ge]
  ― ‹enlargement time constants (explicit: al = 2›, fe = 4›)›
  have ae: "w. set w  Sigma_tm M 
        accepts_in_time_mttm M w (T (length w)) 
        accepts_in_time_mttm ?M' (encode_input (bl_tm M) w)
          (2 * ((length w + ?c - 1) div ?c)
            + 8 * ((T (length w) + ?c - 1) div ?c) + 4)"
    by (rule alphabet_enlarge_time_explicit[OF wfM])
  ― ‹route the enlarged machine's running time in as the reduction's time function›
  define Te :: "nat  nat" where "Te = (λn. 8 * T (?c * n) + 2 * n + 4)"
  ― ‹reduction on the enlarged machine (explicit: e = fr = 0›,
      d = 6 ⋅ k_tm M + 1› by tape preservation, b› the block-alphabet width)›
  have ar0: "v. set v  Sigma_tm ?M' 
        accepts_in_time_mttm ?M' v (Te (length v)) 
        accepts_in_time_mttm (alphabet_reduce ?M'
            :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
          (encode_input_ar (Γ_tm ?M') (bl_tm ?M') v)
          ((6 * k_tm ?M' + 1) * ?ke * Te (length v))"
    by (rule alphabet_reduce_time_explicit[OF hyps(1) hyps(2) hyps(3) hyps(4) hyps(5)])
  have ar: "v. set v  Sigma_tm ?M' 
        accepts_in_time_mttm ?M' v (Te (length v)) 
        accepts_in_time_mttm (alphabet_reduce ?M'
            :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
          (encode_input_ar (Γ_tm ?M') (bl_tm ?M') v)
          (?d * ?ke * Te (length v))"
    using ar0 by (simp add: ktm)
  show "w. set w  Sigma_tm M 
        accepts_in_time_mttm M w (T (length w)) 
        accepts_in_time_mttm (alphabet_reduce ?M'
            :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
          (encode_input_ar (Γ_tm ?M') (bl_tm ?M') (encode_input (bl_tm M) w))
          (8 * ?d * ?ke * T (length w + ?c - 1)
            + 2 * ?d * ?ke * length w + 4 * ?d * ?ke)"
  proof (intro allI impI)
    fix w assume w: "set w  Sigma_tm M"
      and accM: "accepts_in_time_mttm M w (T (length w))"
    let ?v = "encode_input (bl_tm M) w :: ('c  'a) list"
    have lenv: "length ?v = (length w + ?c - 1) div ?c"
      by (rule length_encode_input)
    have lv_le: "length ?v  length w"
      using lenv ceil_div_le[OF cpos] by simp
    have cge: "length w  ?c * length ?v"
    proof -
      have eq: "?c * ((length w + ?c - 1) div ?c) + (length w + ?c - 1) mod ?c
              = length w + ?c - 1"
        by (rule mult_div_mod_eq)
      have ml: "(length w + ?c - 1) mod ?c < ?c"
        using cpos by (rule mod_less_divisor)
      have "length w  ?c * ((length w + ?c - 1) div ?c)"
        using eq ml cpos by linarith
      thus ?thesis by (simp add: lenv)
    qed
    have mcle: "?c * length ?v  length w + ?c - 1"
    proof -
      have "?c * ((length w + ?c - 1) div ?c)  length w + ?c - 1"
        by (metis mult_div_mod_eq le_add1)
      thus ?thesis using lenv by simp
    qed
    ― ‹enlargement: the enlarged machine accepts the block encoding›
    have accAE: "accepts_in_time_mttm ?M' ?v
                   (2 * ((length w + ?c - 1) div ?c)
                     + 8 * ((T (length w) + ?c - 1) div ?c) + 4)"
      using ae w accM by blast
    ― ‹its bound is dominated by Te› at the intermediate length›
    have le1: "2 * ((length w + ?c - 1) div ?c)
                 + 8 * ((T (length w) + ?c - 1) div ?c) + 4
                Te (length ?v)"
    proof -
      have alv: "2 * ((length w + ?c - 1) div ?c) = 2 * length ?v"
        by (simp add: lenv)
      have tb: "8 * ((T (length w) + ?c - 1) div ?c)  8 * T (?c * length ?v)"
      proof -
        have "(T (length w) + ?c - 1) div ?c  T (length w)"
          by (rule ceil_div_le[OF cpos])
        also have "  T (?c * length ?v)" using Tmono cge by (rule monoD)
        finally show ?thesis by (rule mult_le_mono2)
      qed
      have "2 * ((length w + ?c - 1) div ?c)
              + 8 * ((T (length w) + ?c - 1) div ?c) + 4
            = 2 * length ?v + 8 * ((T (length w) + ?c - 1) div ?c) + 4"
        by (simp only: alv)
      also have "  2 * length ?v + 8 * T (?c * length ?v) + 4"
        using tb by simp
      also have " = Te (length ?v)" by (simp add: Te_def)
      finally show ?thesis .
    qed
    have accr_hyp: "accepts_in_time_mttm ?M' ?v (Te (length ?v))"
      by (rule accepts_in_time_mttm_mono[OF accAE le1])
    have guard: "set ?v  Sigma_tm ?M'"
      by (rule encode_input_in_Sigma_alphabet_enlarge[OF vM w])
    have accAR: "accepts_in_time_mttm (alphabet_reduce ?M'
                    :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
                    (encode_input_ar (Γ_tm ?M') (bl_tm ?M') ?v)
                    (?d * ?ke * Te (length ?v))"
      using ar guard accr_hyp by blast
    have le2: "?d * ?ke * Te (length ?v)
                  8 * ?d * ?ke * T (length w + ?c - 1)
                     + 2 * ?d * ?ke * length w + 4 * ?d * ?ke"
    proof -
      have T_le: "T (?c * length ?v)  T (length w + ?c - 1)"
        using Tmono mcle by (simp add: monoD)
      have TeB: "Te (length ?v)  8 * T (length w + ?c - 1) + 2 * length w + 4"
        unfolding Te_def using T_le lv_le
        by (auto intro: add_mono mult_le_mono2)
      have "?d * ?ke * Te (length ?v)
               ?d * ?ke * (8 * T (length w + ?c - 1) + 2 * length w + 4)"
        using TeB by (rule mult_le_mono2)
      also have " = 8 * ?d * ?ke * T (length w + ?c - 1)
                        + 2 * ?d * ?ke * length w + 4 * ?d * ?ke"
        by (simp add: algebra_simps)
      finally show ?thesis .
    qed
    show "accepts_in_time_mttm (alphabet_reduce ?M'
              :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
            (encode_input_ar (Γ_tm ?M') (bl_tm ?M') ?v)
            (8 * ?d * ?ke * T (length w + ?c - 1)
              + 2 * ?d * ?ke * length w + 4 * ?d * ?ke)"
      by (rule accepts_in_time_mttm_mono[OF accAR le2])
  qed
qed

text ‹The classical existential form A ⋅ T(|w| + c - 1) + B ⋅ |w| + C›,
  with A = 8 ⋅ D ⋅ b'›, B = 2 ⋅ D ⋅ b'›, C = 4 ⋅ D ⋅ b'› for
  D = 6 ⋅ k_tm M + 1› and b' = block_width (Γ_tm (alphabet_enlarge M))›, from
  alphabet_enlarge_reduce_time_explicit›.›

theorem alphabet_enlarge_reduce_time:
  fixes M :: "('q, 'a) mttm" and T :: "nat  nat"
  assumes wfM: "well_formed_mttm M"
      and card_ge: "card (Γ_tm M)  4"
      and Tmono: "mono T"
  obtains A B C :: nat
  where "w. set w  Sigma_tm M 
           accepts_in_time_mttm M w (T (length w)) 
           accepts_in_time_mttm
             (alphabet_reduce (alphabet_enlarge M)
                :: ((('q × ('a, 'c :: enum) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
             (encode_input_ar
                 (Γ_tm (alphabet_enlarge M :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))
                 (bl_tm (alphabet_enlarge M))
                 (encode_input (bl_tm M) w))
             (A * T (length w + card (UNIV :: 'c set) - 1) + B * length w + C)"
proof (rule that[of "8 * (6 * k_tm M + 1)
                       * block_width (Γ_tm (alphabet_enlarge M
                            :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))"
                    "2 * (6 * k_tm M + 1)
                       * block_width (Γ_tm (alphabet_enlarge M
                            :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))"
                    "4 * (6 * k_tm M + 1)
                       * block_width (Γ_tm (alphabet_enlarge M
                            :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))"])
  show "w. set w  Sigma_tm M 
           accepts_in_time_mttm M w (T (length w)) 
           accepts_in_time_mttm
             (alphabet_reduce (alphabet_enlarge M)
                :: ((('q × ('a, 'c) ae_stage) × ('c  'a) ar_stage), sym4) mttm)
             (encode_input_ar
                 (Γ_tm (alphabet_enlarge M :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))
                 (bl_tm (alphabet_enlarge M))
                 (encode_input (bl_tm M) w))
             (8 * (6 * k_tm M + 1)
                   * block_width (Γ_tm (alphabet_enlarge M
                        :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))
                   * T (length w + card (UNIV :: 'c set) - 1)
               + 2 * (6 * k_tm M + 1)
                   * block_width (Γ_tm (alphabet_enlarge M
                        :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm))
                   * length w
               + 4 * (6 * k_tm M + 1)
                   * block_width (Γ_tm (alphabet_enlarge M
                        :: ('q × ('a, 'c) ae_stage, 'c  'a) mttm)))"
    by (rule alphabet_enlarge_reduce_time_explicit[OF wfM card_ge Tmono])
qed

end