# Theory HOL-Combinatorics.Cycles

```(*  Author:     Paulo Emílio de Vilhena
*)

theory Cycles
imports
"HOL-Library.FuncSet"
Permutations
begin

section ‹Cycles›

subsection ‹Definitions›

abbreviation cycle :: "'a list ⇒ bool"
where "cycle cs ≡ distinct cs"

fun cycle_of_list :: "'a list ⇒ 'a ⇒ 'a"
where
"cycle_of_list (i # j # cs) = transpose i j ∘ cycle_of_list (j # cs)"
| "cycle_of_list cs = id"

subsection ‹Basic Properties›

text ‹We start proving that the function derived from a cycle rotates its support list.›

lemma id_outside_supp:
assumes "x ∉ set cs" shows "(cycle_of_list cs) x = x"
using assms by (induct cs rule: cycle_of_list.induct) (simp_all)

lemma permutation_of_cycle: "permutation (cycle_of_list cs)"
proof (induct cs rule: cycle_of_list.induct)
case 1 thus ?case
using permutation_compose[OF permutation_swap_id] unfolding comp_apply by simp
qed simp_all

lemma cycle_permutes: "(cycle_of_list cs) permutes (set cs)"
using permutation_bijective[OF permutation_of_cycle] id_outside_supp[of _ cs]

theorem cyclic_rotation:
assumes "cycle cs" shows "map ((cycle_of_list cs) ^^ n) cs = rotate n cs"
proof -
{ have "map (cycle_of_list cs) cs = rotate1 cs" using assms(1)
proof (induction cs rule: cycle_of_list.induct)
case (1 i j cs)
then have ‹i ∉ set cs› ‹j ∉ set cs›
by auto
then have ‹map (Transposition.transpose i j) cs = cs›
by (auto intro: map_idI simp add: transpose_eq_iff)
show ?case
proof (cases)
assume "cs = Nil" thus ?thesis by simp
next
assume "cs ≠ Nil" hence ge_two: "length (j # cs) ≥ 2"
using not_less by auto
have "map (cycle_of_list (i # j # cs)) (i # j # cs) =
map (transpose i j) (map (cycle_of_list (j # cs)) (i # j # cs))" by simp
also have " ... = map (transpose i j) (i # (rotate1 (j # cs)))"
by (metis "1.IH" "1.prems" distinct.simps(2) id_outside_supp list.simps(9))
also have " ... = map (transpose i j) (i # (cs @ [j]))" by simp
also have " ... = j # (map (transpose i j) cs) @ [i]" by simp
also have " ... = j # cs @ [i]"
using ‹map (Transposition.transpose i j) cs = cs› by simp
also have " ... = rotate1 (i # j # cs)" by simp
finally show ?thesis .
qed
qed simp_all }
note cyclic_rotation' = this

show ?thesis
using cyclic_rotation' by (induct n) (auto, metis map_map rotate1_rotate_swap rotate_map)
qed

corollary cycle_is_surj:
assumes "cycle cs" shows "(cycle_of_list cs) ` (set cs) = (set cs)"
using cyclic_rotation[OF assms, of "Suc 0"] by (simp add: image_set)

corollary cycle_is_id_root:
assumes "cycle cs" shows "(cycle_of_list cs) ^^ (length cs) = id"
proof -
have "map ((cycle_of_list cs) ^^ (length cs)) cs = cs"
unfolding cyclic_rotation[OF assms] by simp
hence "((cycle_of_list cs) ^^ (length cs)) i = i" if "i ∈ set cs" for i
using that map_eq_conv by fastforce
moreover have "((cycle_of_list cs) ^^ n) i = i" if "i ∉ set cs" for i n
using id_outside_supp[OF that] by (induct n) (simp_all)
ultimately show ?thesis
by fastforce
qed

corollary cycle_of_list_rotate_independent:
assumes "cycle cs" shows "(cycle_of_list cs) = (cycle_of_list (rotate n cs))"
proof -
{ fix cs :: "'a list" assume cs: "cycle cs"
have "(cycle_of_list cs) = (cycle_of_list (rotate1 cs))"
proof -
from cs have rotate1_cs: "cycle (rotate1 cs)" by simp
hence "map (cycle_of_list (rotate1 cs)) (rotate1 cs) = (rotate 2 cs)"
using cyclic_rotation[OF rotate1_cs, of 1] by (simp add: numeral_2_eq_2)
moreover have "map (cycle_of_list cs) (rotate1 cs) = (rotate 2 cs)"
using cyclic_rotation[OF cs]
by (metis One_nat_def Suc_1 funpow.simps(2) id_apply map_map rotate0 rotate_Suc)
ultimately have "(cycle_of_list cs) i = (cycle_of_list (rotate1 cs)) i" if "i ∈ set cs" for i
using that map_eq_conv unfolding sym[OF set_rotate1[of cs]] by fastforce
moreover have "(cycle_of_list cs) i = (cycle_of_list (rotate1 cs)) i" if "i ∉ set cs" for i
using that by (simp add: id_outside_supp)
ultimately show "(cycle_of_list cs) = (cycle_of_list (rotate1 cs))"
by blast
qed } note rotate1_lemma = this

show ?thesis
using rotate1_lemma[of "rotate n cs"] by (induct n) (auto, metis assms distinct_rotate rotate1_lemma)
qed

subsection‹Conjugation of cycles›

lemma conjugation_of_cycle:
assumes "cycle cs" and "bij p"
shows "p ∘ (cycle_of_list cs) ∘ (inv p) = cycle_of_list (map p cs)"
using assms
proof (induction cs rule: cycle_of_list.induct)
case (1 i j cs)
have "p ∘ cycle_of_list (i # j # cs) ∘ inv p =
(p ∘ (transpose i j) ∘ inv p) ∘ (p ∘ cycle_of_list (j # cs) ∘ inv p)"
by (simp add: assms(2) bij_is_inj fun.map_comp)
also have " ... = (transpose (p i) (p j)) ∘ (p ∘ cycle_of_list (j # cs) ∘ inv p)"
using "1.prems"(2) by (simp add: bij_inv_eq_iff transpose_apply_commute fun_eq_iff bij_betw_inv_into_left)
finally have "p ∘ cycle_of_list (i # j # cs) ∘ inv p =
(transpose (p i) (p j)) ∘ (cycle_of_list (map p (j # cs)))"
using "1.IH" "1.prems"(1) assms(2) by fastforce
thus ?case by (simp add: fun_eq_iff)
next
case "2_1" thus ?case
by (metis bij_is_surj comp_id cycle_of_list.simps(2) list.simps(8) surj_iff)
next
case "2_2" thus ?case
by (metis bij_is_surj comp_id cycle_of_list.simps(3) list.simps(8) list.simps(9) surj_iff)
qed

subsection‹When Cycles Commute›

lemma cycles_commute:
assumes "cycle p" "cycle q" and "set p ∩ set q = {}"
shows "(cycle_of_list p) ∘ (cycle_of_list q) = (cycle_of_list q) ∘ (cycle_of_list p)"
proof
{ fix p :: "'a list" and q :: "'a list" and i :: "'a"
assume A: "cycle p" "cycle q" "set p ∩ set q = {}" "i ∈ set p" "i ∉ set q"
have "((cycle_of_list p) ∘ (cycle_of_list q)) i =
((cycle_of_list q) ∘ (cycle_of_list p)) i"
proof -
have "((cycle_of_list p) ∘ (cycle_of_list q)) i = (cycle_of_list p) i"
using id_outside_supp[OF A(5)] by simp
also have " ... = ((cycle_of_list q) ∘ (cycle_of_list p)) i"
using id_outside_supp[of "(cycle_of_list p) i"] cycle_is_surj[OF A(1)] A(3,4) by fastforce
finally show ?thesis .
qed } note aui_lemma = this

fix i consider "i ∈ set p" "i ∉ set q" | "i ∉ set p" "i ∈ set q" | "i ∉ set p" "i ∉ set q"
using ‹set p ∩ set q = {}› by blast
thus "((cycle_of_list p) ∘ (cycle_of_list q)) i = ((cycle_of_list q) ∘ (cycle_of_list p)) i"
proof cases
case 1 thus ?thesis
using aui_lemma[OF assms] by simp
next
case 2 thus ?thesis
using aui_lemma[OF assms(2,1)] assms(3) by (simp add: ac_simps)
next
case 3 thus ?thesis
qed
qed

subsection ‹Cycles from Permutations›

subsubsection ‹Exponentiation of permutations›

text ‹Some important properties of permutations before defining how to extract its cycles.›

lemma permutation_funpow:
assumes "permutation p" shows "permutation (p ^^ n)"
using assms by (induct n) (simp_all add: permutation_compose)

lemma permutes_funpow:
assumes "p permutes S" shows "(p ^^ n) permutes S"
using assms by (induct n) (simp add: permutes_def, metis funpow_Suc_right permutes_compose)

lemma funpow_diff:
assumes "inj p" and "i ≤ j" "(p ^^ i) a = (p ^^ j) a" shows "(p ^^ (j - i)) a = a"
proof -
have "(p ^^ i) ((p ^^ (j - i)) a) = (p ^^ i) a"
thus ?thesis
unfolding inj_eq[OF inj_fn[OF assms(1)], of i] .
qed

lemma permutation_is_nilpotent:
assumes "permutation p" obtains n where "(p ^^ n) = id" and "n > 0"
proof -
obtain S where "finite S" and "p permutes S"
using assms unfolding permutation_permutes by blast
hence "∃n. (p ^^ n) = id ∧ n > 0"
proof (induct S arbitrary: p)
case empty thus ?case
using id_funpow[of 1] unfolding permutes_empty by blast
next
case (insert s S)
have "(λn. (p ^^ n) s) ` UNIV ⊆ (insert s S)"
using permutes_in_image[OF permutes_funpow[OF insert(4)], of _ s] by auto
hence "¬ inj_on (λn. (p ^^ n) s)  UNIV"
using insert(1) infinite_iff_countable_subset unfolding sym[OF finite_insert, of S s] by metis
then obtain i j where ij: "i < j" "(p ^^ i) s = (p ^^ j) s"
unfolding inj_on_def by (metis nat_neq_iff)
hence "(p ^^ (j - i)) s = s"
using funpow_diff[OF permutes_inj[OF insert(4)]] le_eq_less_or_eq by blast
hence "p ^^ (j - i) permutes S"
using permutes_superset[OF permutes_funpow[OF insert(4), of "j - i"], of S] by auto
then obtain n where n: "((p ^^ (j - i)) ^^ n) = id" "n > 0"
using insert(3) by blast
thus ?case
using ij(1) nat_0_less_mult_iff zero_less_diff unfolding funpow_mult by metis
qed
thus thesis
using that by blast
qed

lemma permutation_is_nilpotent':
assumes "permutation p" obtains n where "(p ^^ n) = id" and "n > m"
proof -
obtain n where "(p ^^ n) = id" and "n > 0"
using permutation_is_nilpotent[OF assms] by blast
then obtain k where "n * k > m"
by (metis dividend_less_times_div mult_Suc_right)
from ‹(p ^^ n) = id› have "p ^^ (n * k) = id"
by (induct k) (simp, metis funpow_mult id_funpow)
with ‹n * k > m› show thesis
using that by blast
qed

subsubsection ‹Extraction of cycles from permutations›

definition least_power :: "('a ⇒ 'a) ⇒ 'a ⇒ nat"
where "least_power f x = (LEAST n. (f ^^ n) x = x ∧ n > 0)"

abbreviation support :: "('a ⇒ 'a) ⇒ 'a ⇒ 'a list"
where "support p x ≡ map (λi. (p ^^ i) x) [0..< (least_power p x)]"

lemma least_powerI:
assumes "(f ^^ n) x = x" and "n > 0"
shows "(f ^^ (least_power f x)) x = x" and "least_power f x > 0"
using assms unfolding least_power_def by (metis (mono_tags, lifting) LeastI)+

lemma least_power_le:
assumes "(f ^^ n) x = x" and "n > 0" shows "least_power f x ≤ n"
using assms unfolding least_power_def by (simp add: Least_le)

lemma least_power_of_permutation:
assumes "permutation p" shows "(p ^^ (least_power p a)) a = a" and "least_power p a > 0"
using permutation_is_nilpotent[OF assms] least_powerI by (metis id_apply)+

lemma least_power_gt_one:
assumes "permutation p" and "p a ≠ a" shows "least_power p a > Suc 0"
using least_power_of_permutation[OF assms(1)] assms(2)
by (metis Suc_lessI funpow.simps(2) funpow_simps_right(1) o_id)

lemma least_power_minimal:
assumes "(p ^^ n) a = a" shows "(least_power p a) dvd n"
proof (cases "n = 0", simp)
let ?lpow = "least_power p"

assume "n ≠ 0" then have "n > 0" by simp
hence "(p ^^ (?lpow a)) a = a" and "least_power p a > 0"
using assms unfolding least_power_def by (metis (mono_tags, lifting) LeastI)+
hence aux_lemma: "(p ^^ ((?lpow a) * k)) a = a" for k :: nat

have "(p ^^ (n mod ?lpow a)) ((p ^^ (n - (n mod ?lpow a))) a) = (p ^^ n) a"
with ‹(p ^^ n) a = a› have "(p ^^ (n mod ?lpow a)) a = a"
using aux_lemma by (simp add: minus_mod_eq_mult_div)
hence "?lpow a ≤ n mod ?lpow a" if "n mod ?lpow a > 0"
using least_power_le[OF _ that, of p a] by simp
with ‹least_power p a > 0› show "(least_power p a) dvd n"
using mod_less_divisor not_le by blast
qed

lemma least_power_dvd:
assumes "permutation p" shows "(least_power p a) dvd n ⟷ (p ^^ n) a = a"
proof
show "(p ^^ n) a = a ⟹ (least_power p a) dvd n"
using least_power_minimal[of _ p] by simp
next
have "(p ^^ ((least_power p a) * k)) a = a" for k :: nat
thus "(least_power p a) dvd n ⟹ (p ^^ n) a = a" by blast
qed

theorem cycle_of_permutation:
assumes "permutation p" shows "cycle (support p a)"
proof -
have "(least_power p a) dvd (j - i)" if "i ≤ j" "j < least_power p a" and "(p ^^ i) a = (p ^^ j) a" for i j
using funpow_diff[OF bij_is_inj that(1,3)] assms by (simp add: permutation least_power_dvd)
moreover have "i = j" if "i ≤ j" "j < least_power p a" and "(least_power p a) dvd (j - i)" for i j
using that le_eq_less_or_eq nat_dvd_not_less by auto
ultimately have "inj_on (λi. (p ^^ i) a) {..< (least_power p a)}"
unfolding inj_on_def by (metis le_cases lessThan_iff)
thus ?thesis
qed

subsection ‹Decomposition on Cycles›

text ‹We show that a permutation can be decomposed on cycles›

subsubsection ‹Preliminaries›

lemma support_set:
assumes "permutation p" shows "set (support p a) = range (λi. (p ^^ i) a)"
proof
show "set (support p a) ⊆ range (λi. (p ^^ i) a)"
by auto
next
show "range (λi. (p ^^ i) a) ⊆ set (support p a)"
proof (auto)
fix i
have "(p ^^ i) a = (p ^^ (i mod (least_power p a))) ((p ^^ (i - (i mod (least_power p a)))) a)"
also have " ... = (p ^^ (i mod (least_power p a))) a"
using least_power_dvd[OF assms] by (metis dvd_minus_mod)
also have " ... ∈ (λi. (p ^^ i) a) ` {0..< (least_power p a)}"
using least_power_of_permutation(2)[OF assms] by fastforce
finally show "(p ^^ i) a ∈ (λi. (p ^^ i) a) ` {0..< (least_power p a)}" .
qed
qed

lemma disjoint_support:
assumes "permutation p" shows "disjoint (range (λa. set (support p a)))" (is "disjoint ?A")
proof (rule disjointI)
{ fix i j a b
assume "set (support p a) ∩ set (support p b) ≠ {}" have "set (support p a) ⊆ set (support p b)"
unfolding support_set[OF assms]
proof (auto)
from ‹set (support p a) ∩ set (support p b) ≠ {}›
obtain i j where ij: "(p ^^ i) a = (p ^^ j) b"
by auto

fix k
have "(p ^^ k) a = (p ^^ (k + (least_power p a) * l)) a" for l
using least_power_dvd[OF assms] by (induct l) (simp, metis dvd_triv_left funpow_add o_def)
then obtain m where "m ≥ i" and "(p ^^ m) a = (p ^^ k) a"
using least_power_of_permutation(2)[OF assms]
by (metis dividend_less_times_div le_eq_less_or_eq mult_Suc_right trans_less_add2)
hence "(p ^^ m) a = (p ^^ (m - i)) ((p ^^ i) a)"
with ‹(p ^^ m) a = (p ^^ k) a› have "(p ^^ k) a = (p ^^ ((m - i) + j)) b"
thus "(p ^^ k) a ∈ range (λi. (p ^^ i) b)"
by blast
qed } note aux_lemma = this

fix supp_a supp_b
assume "supp_a ∈ ?A" and "supp_b ∈ ?A"
then obtain a b where a: "supp_a = set (support p a)" and b: "supp_b = set (support p b)"
by auto
assume "supp_a ≠ supp_b" thus "supp_a ∩ supp_b = {}"
using aux_lemma unfolding a b by blast
qed

lemma disjoint_support':
assumes "permutation p"
shows "set (support p a) ∩ set (support p b) = {} ⟷ a ∉ set (support p b)"
proof -
have "a ∈ set (support p a)"
using least_power_of_permutation(2)[OF assms] by force
show ?thesis
proof
assume "set (support p a) ∩ set (support p b) = {}"
with ‹a ∈ set (support p a)› show "a ∉ set (support p b)"
by blast
next
assume "a ∉ set (support p b)" show "set (support p a) ∩ set (support p b) = {}"
proof (rule ccontr)
assume "set (support p a) ∩ set (support p b) ≠ {}"
hence "set (support p a) = set (support p b)"
using disjoint_support[OF assms] by (meson UNIV_I disjoint_def image_iff)
with ‹a ∈ set (support p a)› and ‹a ∉ set (support p b)› show False
by simp
qed
qed
qed

lemma support_coverture:
assumes "permutation p" shows "⋃ { set (support p a) | a. p a ≠ a } = { a. p a ≠ a }"
proof
show "{ a. p a ≠ a } ⊆ ⋃ { set (support p a) | a. p a ≠ a }"
proof
fix a assume "a ∈ { a. p a ≠ a }"
have "a ∈ set (support p a)"
using least_power_of_permutation(2)[OF assms, of a] by force
with ‹a ∈ { a. p a ≠ a }› show "a ∈ ⋃ { set (support p a) | a. p a ≠ a }"
by blast
qed
next
show "⋃ { set (support p a) | a. p a ≠ a } ⊆ { a. p a ≠ a }"
proof
fix b assume "b ∈ ⋃ { set (support p a) | a. p a ≠ a }"
then obtain a i where "p a ≠ a" and "(p ^^ i) a = b"
by auto
have "p a = a" if "(p ^^ i) a = (p ^^ Suc i) a"
using funpow_diff[OF bij_is_inj _ that] assms unfolding permutation by simp
with ‹p a ≠ a› and ‹(p ^^ i) a = b› show "b ∈ { a. p a ≠ a }"
by auto
qed
qed

theorem cycle_restrict:
assumes "permutation p" and "b ∈ set (support p a)" shows "p b = (cycle_of_list (support p a)) b"
proof -
note least_power_props [simp] = least_power_of_permutation[OF assms(1)]

have "map (cycle_of_list (support p a)) (support p a) = rotate1 (support p a)"
using cyclic_rotation[OF cycle_of_permutation[OF assms(1)], of 1 a] by simp
hence "map (cycle_of_list (support p a)) (support p a) = tl (support p a) @ [ a ]"
also have " ... = map p (support p a)"
proof (rule nth_equalityI, auto)
fix i assume "i < least_power p a" show "(tl (support p a) @ [a]) ! i = p ((p ^^ i) a)"
proof (cases)
assume i: "i = least_power p a - 1"
hence "(tl (support p a) @ [ a ]) ! i = a"
by (metis (no_types, lifting) diff_zero length_map length_tl length_upt nth_append_length)
also have " ... = p ((p ^^ i) a)"
by (metis (mono_tags, opaque_lifting) least_power_props i Suc_diff_1 funpow_simps_right(2) funpow_swap1 o_apply)
finally show ?thesis .
next
assume "i ≠ least_power p a - 1"
with ‹i < least_power p a› have "i < least_power p a - 1"
by simp
hence "(tl (support p a) @ [ a ]) ! i = (p ^^ (Suc i)) a"
by (metis One_nat_def Suc_eq_plus1 add.commute length_map length_upt map_tl nth_append nth_map_upt tl_upt)
thus ?thesis
by simp
qed
qed
finally have "map (cycle_of_list (support p a)) (support p a) = map p (support p a)" .
thus ?thesis
using assms(2) by auto
qed

subsubsection‹Decomposition›

inductive cycle_decomp :: "'a set ⇒ ('a ⇒ 'a) ⇒ bool"
where
empty:  "cycle_decomp {} id"
| comp: "⟦ cycle_decomp I p; cycle cs; set cs ∩ I = {} ⟧ ⟹
cycle_decomp (set cs ∪ I) ((cycle_of_list cs) ∘ p)"

lemma semidecomposition:
assumes "p permutes S" and "finite S"
shows "(λy. if y ∈ (S - set (support p a)) then p y else y) permutes (S - set (support p a))"
proof (rule bij_imp_permutes)
show "(if b ∈ (S - set (support p a)) then p b else b) = b" if "b ∉ S - set (support p a)" for b
using that by auto
next
have is_permutation: "permutation p"
using assms unfolding permutation_permutes by blast

let ?q = "λy. if y ∈ (S - set (support p a)) then p y else y"
show "bij_betw ?q (S - set (support p a)) (S - set (support p a))"
proof (rule bij_betw_imageI)
show "inj_on ?q (S - set (support p a))"
using permutes_inj[OF assms(1)] unfolding inj_on_def by auto
next
have aux_lemma: "set (support p s) ⊆ (S - set (support p a))" if "s ∈ S - set (support p a)" for s
proof -
have "(p ^^ i) s ∈ S" for i
using that unfolding permutes_in_image[OF permutes_funpow[OF assms(1)]] by simp
thus ?thesis
using that disjoint_support'[OF is_permutation, of s a] by auto
qed
have "(p ^^ 1) s ∈ set (support p s)" for s
unfolding support_set[OF is_permutation] by blast
hence "p s ∈ set (support p s)" for s
by simp
hence "p ` (S - set (support p a)) ⊆ S - set (support p a)"
using aux_lemma by blast
moreover have "(p ^^ ((least_power p s) - 1)) s ∈ set (support p s)" for s
unfolding support_set[OF is_permutation] by blast
hence "∃s' ∈ set (support p s). p s' = s" for s
using least_power_of_permutation[OF is_permutation] by (metis Suc_diff_1 funpow.simps(2) o_apply)
hence "S - set (support p a) ⊆ p ` (S - set (support p a))"
using aux_lemma
by (clarsimp simp add: image_iff) (metis image_subset_iff)
ultimately show "?q ` (S - set (support p a)) = (S - set (support p a))"
by auto
qed
qed

theorem cycle_decomposition:
assumes "p permutes S" and "finite S" shows "cycle_decomp S p"
using assms
proof(induct "card S" arbitrary: S p rule: less_induct)
case less show ?case
proof (cases)
assume "S = {}" thus ?thesis
using empty less(2) by auto
next
have is_permutation: "permutation p"
using less(2-3) unfolding permutation_permutes by blast

assume "S ≠ {}" then obtain s where "s ∈ S"
by blast
define q where "q = (λy. if y ∈ (S - set (support p s)) then p y else y)"
have "(cycle_of_list (support p s) ∘ q) = p"
proof
fix a
consider "a ∈ S - set (support p s)" | "a ∈ set (support p s)" | "a ∉ S" "a ∉ set (support p s)"
by blast
thus "((cycle_of_list (support p s) ∘ q)) a = p a"
proof cases
case 1
have "(p ^^ 1) a ∈ set (support p a)"
unfolding support_set[OF is_permutation] by blast
with ‹a ∈ S - set (support p s)› have "p a ∉ set (support p s)"
using disjoint_support'[OF is_permutation, of a s] by auto
with ‹a ∈ S - set (support p s)› show ?thesis
using id_outside_supp[of _ "support p s"] unfolding q_def by simp
next
case 2 thus ?thesis
using cycle_restrict[OF is_permutation] unfolding q_def by simp
next
case 3 thus ?thesis
using id_outside_supp[OF 3(2)] less(2) permutes_not_in unfolding q_def by fastforce
qed
qed

moreover from ‹s ∈ S› have "(p ^^ i) s ∈ S" for i
unfolding permutes_in_image[OF permutes_funpow[OF less(2)]] .
hence "set (support p s) ∪ (S - set (support p s)) = S"
by auto

moreover have "s ∈ set (support p s)"
using least_power_of_permutation[OF is_permutation] by force
with ‹s ∈ S› have "card (S - set (support p s)) < card S"
using less(3) by (metis DiffE card_seteq linorder_not_le subsetI)
hence "cycle_decomp (S - set (support p s)) q"
using less(1)[OF _ semidecomposition[OF less(2-3)], of s] less(3) unfolding q_def by blast

moreover show ?thesis
using comp[OF calculation(3) cycle_of_permutation[OF is_permutation], of s]
unfolding calculation(1-2) by blast
qed
qed

end
```