src/HOL/Library/Rounded_Division.thy
author wenzelm
Fri, 24 Feb 2023 20:23:48 +0100
changeset 77367 d27d1224c67f
parent 76251 fbde7d1211fc
child 77811 ae9e6218443d
permissions -rw-r--r--
more operations;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     1
(*  Author:  Florian Haftmann, TU Muenchen
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     2
*)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     3
76247
e19d4c1c48ce spelling
haftmann
parents: 76143
diff changeset
     4
subsection \<open>Rounded division: modulus centered towards zero.\<close>
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     5
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     6
theory Rounded_Division
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     7
  imports Main
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     8
begin
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
     9
76251
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
    10
lemma off_iff_abs_mod_2_eq_one:
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
    11
  \<open>odd l \<longleftrightarrow> \<bar>l\<bar> mod 2 = 1\<close> for l :: int
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
    12
  by (simp flip: odd_iff_mod_2_eq_one)
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
    13
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    14
definition rounded_divide :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>  (infixl \<open>rdiv\<close> 70)
76248
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    15
  where \<open>k rdiv l = sgn l * ((k + \<bar>l\<bar> div 2) div \<bar>l\<bar>)\<close>
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    16
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    17
definition rounded_modulo :: \<open>int \<Rightarrow> int \<Rightarrow> int\<close>  (infixl \<open>rmod\<close> 70)
76248
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    18
  where \<open>k rmod l = (k + \<bar>l\<bar> div 2) mod \<bar>l\<bar> - \<bar>l\<bar> div 2\<close>
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    19
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    20
lemma rdiv_mult_rmod_eq:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    21
  \<open>k rdiv l * l + k rmod l = k\<close>
76248
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    22
proof -
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    23
  have *: \<open>l * (sgn l * j) = \<bar>l\<bar> * j\<close> for j
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    24
    by (simp add: ac_simps abs_sgn)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    25
  show ?thesis
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    26
    by (simp add: rounded_divide_def rounded_modulo_def algebra_simps *)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    27
qed
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    28
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    29
lemma mult_rdiv_rmod_eq:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    30
  \<open>l * (k rdiv l) + k rmod l = k\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    31
  using rdiv_mult_rmod_eq [of k l] by (simp add: ac_simps)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    32
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    33
lemma rmod_rdiv_mult_eq:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    34
  \<open>k rmod l + k rdiv l * l = k\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    35
  using rdiv_mult_rmod_eq [of k l] by (simp add: ac_simps)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    36
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    37
lemma rmod_mult_rdiv_eq:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    38
  \<open>k rmod l + l * (k rdiv l) = k\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    39
  using rdiv_mult_rmod_eq [of k l] by (simp add: ac_simps)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    40
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    41
lemma minus_rdiv_mult_eq_rmod:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    42
  \<open>k - k rdiv l * l = k rmod l\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    43
  by (rule add_implies_diff [symmetric]) (fact rmod_rdiv_mult_eq)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    44
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    45
lemma minus_mult_rdiv_eq_rmod:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    46
  \<open>k - l * (k rdiv l) = k rmod l\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    47
  by (rule add_implies_diff [symmetric]) (fact rmod_mult_rdiv_eq)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    48
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    49
lemma minus_rmod_eq_rdiv_mult:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    50
  \<open>k - k rmod l = k rdiv l * l\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    51
  by (rule add_implies_diff [symmetric]) (fact rdiv_mult_rmod_eq)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    52
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    53
lemma minus_rmod_eq_mult_rdiv:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    54
  \<open>k - k rmod l = l * (k rdiv l)\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    55
  by (rule add_implies_diff [symmetric]) (fact mult_rdiv_rmod_eq)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    56
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    57
lemma rdiv_0_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    58
  \<open>k rdiv 0 = 0\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    59
  by (simp add: rounded_divide_def)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    60
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    61
lemma rmod_0_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    62
  \<open>k rmod 0 = k\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    63
  by (simp add: rounded_modulo_def)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    64
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    65
lemma rdiv_1_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    66
  \<open>k rdiv 1 = k\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    67
  by (simp add: rounded_divide_def)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    68
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    69
lemma rmod_1_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    70
  \<open>k rmod 1 = 0\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    71
  by (simp add: rounded_modulo_def)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    72
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    73
lemma zero_rdiv_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    74
  \<open>0 rdiv k = 0\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    75
  by (auto simp add: rounded_divide_def not_less zdiv_eq_0_iff)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    76
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    77
lemma zero_rmod_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    78
  \<open>0 rmod k = 0\<close>
76248
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    79
  by (auto simp add: rounded_modulo_def not_less zmod_trivial_iff)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    80
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    81
lemma rdiv_minus_eq:
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    82
  \<open>k rdiv - l = - (k rdiv l)\<close>
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    83
  by (simp add: rounded_divide_def)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    84
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    85
lemma rmod_minus_eq [simp]:
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    86
  \<open>k rmod - l = k rmod l\<close>
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    87
  by (simp add: rounded_modulo_def)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    88
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    89
lemma rdiv_abs_eq:
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    90
  \<open>k rdiv \<bar>l\<bar> = sgn l * (k rdiv l)\<close>
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    91
  by (simp add: rounded_divide_def)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    92
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    93
lemma rmod_abs_eq [simp]:
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    94
  \<open>k rmod \<bar>l\<bar> = k rmod l\<close>
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    95
  by (simp add: rounded_modulo_def)
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    96
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    97
lemma nonzero_mult_rdiv_cancel_right:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
    98
  \<open>k * l rdiv l = k\<close> if \<open>l \<noteq> 0\<close>
76248
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
    99
proof -
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   100
  have \<open>sgn l * k * \<bar>l\<bar> rdiv l = k\<close>
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   101
    using that by (simp add: rounded_divide_def)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   102
  with that show ?thesis
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   103
    by (simp add: ac_simps abs_sgn)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   104
qed
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   105
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   106
lemma rdiv_self_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   107
  \<open>k rdiv k = 1\<close> if \<open>k \<noteq> 0\<close>
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   108
  using that nonzero_mult_rdiv_cancel_right [of k 1] by simp
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   109
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   110
lemma rmod_self_eq [simp]:
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   111
  \<open>k rmod k = 0\<close>
76248
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   112
proof -
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   113
  have \<open>(sgn k * \<bar>k\<bar> + \<bar>k\<bar> div 2) mod \<bar>k\<bar> = \<bar>k\<bar> div 2\<close>
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   114
    by (auto simp add: zmod_trivial_iff)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   115
  also have \<open>sgn k * \<bar>k\<bar> = k\<close>
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   116
    by (simp add: abs_sgn)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   117
  finally show ?thesis
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   118
    by (simp add: rounded_modulo_def algebra_simps)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   119
qed
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   120
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   121
lemma signed_take_bit_eq_rmod:
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   122
  \<open>signed_take_bit n k = k rmod (2 ^ Suc n)\<close>
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   123
  by (simp only: rounded_modulo_def power_abs abs_numeral flip: take_bit_eq_mod)
da4e57d30579 tuned definition
haftmann
parents: 76247
diff changeset
   124
    (simp add: signed_take_bit_eq_take_bit_shift)
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   125
76251
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   126
lemma rmod_less_divisor:
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   127
  \<open>k rmod l < \<bar>l\<bar> - \<bar>l\<bar> div 2\<close> if \<open>l \<noteq> 0\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   128
  using that pos_mod_bound [of \<open>\<bar>l\<bar>\<close>] by (simp add: rounded_modulo_def)
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   129
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   130
lemma rmod_less_equal_divisor:
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   131
  \<open>k rmod l \<le> \<bar>l\<bar> div 2\<close> if \<open>l \<noteq> 0\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   132
proof -
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   133
  from that rmod_less_divisor [of l k]
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   134
  have \<open>k rmod l < \<bar>l\<bar> - \<bar>l\<bar> div 2\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   135
    by simp
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   136
  also have \<open>\<bar>l\<bar> - \<bar>l\<bar> div 2 = \<bar>l\<bar> div 2 + of_bool (odd l)\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   137
    by auto
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   138
  finally show ?thesis
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   139
    by (cases \<open>even l\<close>) simp_all
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   140
qed
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   141
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   142
lemma divisor_less_equal_rmod':
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   143
  \<open>\<bar>l\<bar> div 2 - \<bar>l\<bar> \<le> k rmod l\<close> if \<open>l \<noteq> 0\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   144
proof -
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   145
  have \<open>0 \<le> (k + \<bar>l\<bar> div 2) mod \<bar>l\<bar>\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   146
    using that pos_mod_sign [of \<open>\<bar>l\<bar>\<close>] by simp
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   147
  then show ?thesis
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   148
    by (simp_all add: rounded_modulo_def)
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   149
qed
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   150
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   151
lemma divisor_less_equal_rmod:
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   152
  \<open>- (\<bar>l\<bar> div 2) \<le> k rmod l\<close> if \<open>l \<noteq> 0\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   153
  using that divisor_less_equal_rmod' [of l k]
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   154
  by (simp add: rounded_modulo_def)
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   155
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   156
lemma abs_rmod_less_equal:
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   157
  \<open>\<bar>k rmod l\<bar> \<le> \<bar>l\<bar> div 2\<close> if \<open>l \<noteq> 0\<close>
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   158
  using that divisor_less_equal_rmod [of l k]
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   159
  by (simp add: abs_le_iff rmod_less_equal_divisor)
fbde7d1211fc euclidean division on gaussian numbers
haftmann
parents: 76248
diff changeset
   160
76143
e278bf6430cf More on division concerning gauss numbers.
haftmann
parents:
diff changeset
   161
end