src/HOL/List.thy
changeset 72735 bbe5d3ef2052
parent 72555 653ac845b466
child 72737 98fe7a10ace3
equal deleted inserted replaced
72687:8e5428ff35af 72735:bbe5d3ef2052
  4540 
  4540 
  4541 lemma replicate_length_filter:
  4541 lemma replicate_length_filter:
  4542   "replicate (length (filter (\<lambda>y. x = y) xs)) x = filter (\<lambda>y. x = y) xs"
  4542   "replicate (length (filter (\<lambda>y. x = y) xs)) x = filter (\<lambda>y. x = y) xs"
  4543   by (induct xs) auto
  4543   by (induct xs) auto
  4544 
  4544 
       
  4545 text \<open>This stronger version is thanks to Stepan Holub\<close>
  4545 lemma comm_append_are_replicate:
  4546 lemma comm_append_are_replicate:
  4546   "\<lbrakk> xs \<noteq> []; ys \<noteq> []; xs @ ys = ys @ xs \<rbrakk>
  4547   "xs @ ys = ys @ xs
  4547   \<Longrightarrow> \<exists>m n zs. concat (replicate m zs) = xs \<and> concat (replicate n zs) = ys"
  4548   \<Longrightarrow> \<exists>m n zs. concat (replicate m zs) = xs \<and> concat (replicate n zs) = ys"
  4548 proof (induction "length (xs @ ys)" arbitrary: xs ys rule: less_induct)
  4549 proof (induction "length (xs @ ys) + length xs" arbitrary: xs ys rule: less_induct)
  4549   case less
  4550   case less
  4550 
  4551   consider "length ys < length xs" | "xs = []" | "length xs \<le> length ys \<and> xs \<noteq> []"
  4551   define xs' ys' where "xs' = (if (length xs \<le> length ys) then xs else ys)"
  4552     by linarith
  4552     and "ys' = (if (length xs \<le> length ys) then ys else xs)"
  4553   then show ?case
  4553   then have
  4554   proof (cases)
  4554     prems': "length xs' \<le> length ys'"
  4555     assume "length ys < length xs"
  4555             "xs' @ ys' = ys' @ xs'"
  4556     then show ?thesis
  4556       and "xs' \<noteq> []"
  4557       using less.hyps[OF _ less.prems[symmetric]] nat_add_left_cancel_less by auto
  4557       and len: "length (xs @ ys) = length (xs' @ ys')"
       
  4558     using less by (auto intro: less.hyps)
       
  4559 
       
  4560   from prems'
       
  4561   obtain ws where "ys' = xs' @ ws"
       
  4562     by (auto simp: append_eq_append_conv2)
       
  4563 
       
  4564   have "\<exists>m n zs. concat (replicate m zs) = xs' \<and> concat (replicate n zs) = ys'"
       
  4565   proof (cases "ws = []")
       
  4566     case True
       
  4567     then have "concat (replicate 1 xs') = xs'"
       
  4568       and "concat (replicate 1 xs') = ys'"
       
  4569       using \<open>ys' = xs' @ ws\<close> by auto
       
  4570     then show ?thesis by blast
       
  4571   next
  4558   next
  4572     case False
  4559     assume "xs = []"
  4573     from \<open>ys' = xs' @ ws\<close> and \<open>xs' @ ys' = ys' @ xs'\<close>
  4560     then have "concat (replicate 0 ys) = xs \<and> concat (replicate 1 ys) = ys"
  4574     have "xs' @ ws = ws @ xs'" by simp
  4561       by simp
  4575     then have "\<exists>m n zs. concat (replicate m zs) = xs' \<and> concat (replicate n zs) = ws"
  4562     then show ?case
  4576       using False and \<open>xs' \<noteq> []\<close> and \<open>ys' = xs' @ ws\<close> and len
  4563       by blast
  4577       by (intro less.hyps) auto
  4564   next
  4578     then obtain m n zs where *: "concat (replicate m zs) = xs'"
  4565     assume "length xs \<le> length ys \<and> xs \<noteq> []"
  4579       and "concat (replicate n zs) = ws" by blast
  4566     then have "length xs \<le> length ys" and "xs \<noteq> []"
  4580     then have "concat (replicate (m + n) zs) = ys'"
  4567       by blast+
  4581       using \<open>ys' = xs' @ ws\<close>
  4568     from \<open>length xs \<le> length ys\<close> and  \<open>xs @ ys = ys @ xs\<close>
       
  4569     obtain ws where "ys = xs @ ws"
       
  4570       by (auto simp: append_eq_append_conv2)
       
  4571     from this and \<open>xs \<noteq> []\<close>
       
  4572     have "length ws < length ys"
       
  4573       by simp
       
  4574     from \<open>xs @ ys = ys @ xs\<close>[unfolded \<open>ys = xs @ ws\<close>]
       
  4575     have "xs @ ws = ws @ xs"
       
  4576       by simp
       
  4577     from less.hyps[OF _ this] \<open>length ws < length ys\<close>
       
  4578     obtain m n' zs where "concat (replicate m zs) = xs" and  "concat (replicate n' zs) = ws"
       
  4579       by auto
       
  4580     then have "concat (replicate (m+n') zs) = ys"
       
  4581       using \<open>ys = xs @ ws\<close>
  4582       by (simp add: replicate_add)
  4582       by (simp add: replicate_add)
  4583     with * show ?thesis by blast
  4583     then show ?case
       
  4584       using \<open>concat (replicate m zs) = xs\<close> by blast
  4584   qed
  4585   qed
  4585   then show ?case
       
  4586     using xs'_def ys'_def by meson
       
  4587 qed
  4586 qed
  4588 
  4587 
  4589 lemma comm_append_is_replicate:
  4588 lemma comm_append_is_replicate:
  4590   fixes xs ys :: "'a list"
  4589   fixes xs ys :: "'a list"
  4591   assumes "xs \<noteq> []" "ys \<noteq> []"
  4590   assumes "xs \<noteq> []" "ys \<noteq> []"
  4592   assumes "xs @ ys = ys @ xs"
  4591   assumes "xs @ ys = ys @ xs"
  4593   shows "\<exists>n zs. n > 1 \<and> concat (replicate n zs) = xs @ ys"
  4592   shows "\<exists>n zs. n > 1 \<and> concat (replicate n zs) = xs @ ys"
  4594 proof -
  4593 proof -
  4595   obtain m n zs where "concat (replicate m zs) = xs"
  4594   obtain m n zs where "concat (replicate m zs) = xs"
  4596     and "concat (replicate n zs) = ys"
  4595     and "concat (replicate n zs) = ys"
  4597     using comm_append_are_replicate[of xs ys, OF assms] by blast
  4596     using comm_append_are_replicate[of xs ys] assms by blast
  4598   then have "m + n > 1" and "concat (replicate (m+n) zs) = xs @ ys"
  4597   then have "m + n > 1" and "concat (replicate (m+n) zs) = xs @ ys"
  4599     using \<open>xs \<noteq> []\<close> and \<open>ys \<noteq> []\<close>
  4598     using \<open>xs \<noteq> []\<close> and \<open>ys \<noteq> []\<close>
  4600     by (auto simp: replicate_add)
  4599     by (auto simp: replicate_add)
  4601   then show ?thesis by blast
  4600   then show ?thesis by blast
  4602 qed
  4601 qed