src/HOL/Matrix_LP/LP.thy
changeset 61945 1135b8de26c3
parent 54230 b1d955791529
child 62390 842917225d56
equal deleted inserted replaced
61944:5d06ecfdb472 61945:1135b8de26c3
    17 
    17 
    18 lemma linprog_dual_estimate:
    18 lemma linprog_dual_estimate:
    19   assumes
    19   assumes
    20   "A * x \<le> (b::'a::lattice_ring)"
    20   "A * x \<le> (b::'a::lattice_ring)"
    21   "0 \<le> y"
    21   "0 \<le> y"
    22   "abs (A - A') \<le> \<delta>_A"
    22   "\<bar>A - A'\<bar> \<le> \<delta>_A"
    23   "b \<le> b'"
    23   "b \<le> b'"
    24   "abs (c - c') \<le> \<delta>_c"
    24   "\<bar>c - c'\<bar> \<le> \<delta>_c"
    25   "abs x \<le> r"
    25   "\<bar>x\<bar> \<le> r"
    26   shows
    26   shows
    27   "c * x \<le> y * b' + (y * \<delta>_A + abs (y * A' - c') + \<delta>_c) * r"
    27   "c * x \<le> y * b' + (y * \<delta>_A + \<bar>y * A' - c'\<bar> + \<delta>_c) * r"
    28 proof -
    28 proof -
    29   from assms have 1: "y * b <= y * b'" by (simp add: mult_left_mono)
    29   from assms have 1: "y * b <= y * b'" by (simp add: mult_left_mono)
    30   from assms have 2: "y * (A * x) <= y * b" by (simp add: mult_left_mono) 
    30   from assms have 2: "y * (A * x) <= y * b" by (simp add: mult_left_mono) 
    31   have 3: "y * (A * x) = c * x + (y * (A - A') + (y * A' - c') + (c'-c)) * x" by (simp add: algebra_simps)  
    31   have 3: "y * (A * x) = c * x + (y * (A - A') + (y * A' - c') + (c'-c)) * x" by (simp add: algebra_simps)  
    32   from 1 2 3 have 4: "c * x + (y * (A - A') + (y * A' - c') + (c'-c)) * x <= y * b'" by simp
    32   from 1 2 3 have 4: "c * x + (y * (A - A') + (y * A' - c') + (c'-c)) * x <= y * b'" by simp
    33   have 5: "c * x <= y * b' + abs((y * (A - A') + (y * A' - c') + (c'-c)) * x)"
    33   have 5: "c * x <= y * b' + \<bar>(y * (A - A') + (y * A' - c') + (c'-c)) * x\<bar>"
    34     by (simp only: 4 estimate_by_abs)  
    34     by (simp only: 4 estimate_by_abs)  
    35   have 6: "abs((y * (A - A') + (y * A' - c') + (c'-c)) * x) <= abs (y * (A - A') + (y * A' - c') + (c'-c)) * abs x"
    35   have 6: "\<bar>(y * (A - A') + (y * A' - c') + (c'-c)) * x\<bar> <= \<bar>y * (A - A') + (y * A' - c') + (c'-c)\<bar> * \<bar>x\<bar>"
    36     by (simp add: abs_le_mult)
    36     by (simp add: abs_le_mult)
    37   have 7: "(abs (y * (A - A') + (y * A' - c') + (c'-c))) * abs x <= (abs (y * (A-A') + (y*A'-c')) + abs(c'-c)) * abs x"
    37   have 7: "(\<bar>y * (A - A') + (y * A' - c') + (c'-c)\<bar>) * \<bar>x\<bar> <= (\<bar>y * (A-A') + (y*A'-c')\<bar> + \<bar>c' - c\<bar>) * \<bar>x\<bar>"
    38     by(rule abs_triangle_ineq [THEN mult_right_mono]) simp
    38     by(rule abs_triangle_ineq [THEN mult_right_mono]) simp
    39   have 8: " (abs (y * (A-A') + (y*A'-c')) + abs(c'-c)) * abs x <=  (abs (y * (A-A')) + abs (y*A'-c') + abs(c'-c)) * abs x"
    39   have 8: "(\<bar>y * (A-A') + (y*A'-c')\<bar> + \<bar>c' - c\<bar>) * \<bar>x\<bar> <= (\<bar>y * (A-A')\<bar> + \<bar>y*A'-c'\<bar> + \<bar>c' - c\<bar>) * \<bar>x\<bar>"
    40     by (simp add: abs_triangle_ineq mult_right_mono)    
    40     by (simp add: abs_triangle_ineq mult_right_mono)    
    41   have 9: "(abs (y * (A-A')) + abs (y*A'-c') + abs(c'-c)) * abs x <= (abs y * abs (A-A') + abs (y*A'-c') + abs (c'-c)) * abs x"
    41   have 9: "(\<bar>y * (A-A')\<bar> + \<bar>y*A'-c'\<bar> + \<bar>c'-c\<bar>) * \<bar>x\<bar> <= (\<bar>y\<bar> * \<bar>A-A'\<bar> + \<bar>y*A'-c'\<bar> + \<bar>c'-c\<bar>) * \<bar>x\<bar>"
    42     by (simp add: abs_le_mult mult_right_mono)  
    42     by (simp add: abs_le_mult mult_right_mono)  
    43   have 10: "c'-c = -(c-c')" by (simp add: algebra_simps)
    43   have 10: "c'-c = -(c-c')" by (simp add: algebra_simps)
    44   have 11: "abs (c'-c) = abs (c-c')" 
    44   have 11: "\<bar>c'-c\<bar> = \<bar>c-c'\<bar>"
    45     by (subst 10, subst abs_minus_cancel, simp)
    45     by (subst 10, subst abs_minus_cancel, simp)
    46   have 12: "(abs y * abs (A-A') + abs (y*A'-c') + abs (c'-c)) * abs x <= (abs y * abs (A-A') + abs (y*A'-c') + \<delta>_c) * abs x"
    46   have 12: "(\<bar>y\<bar> * \<bar>A-A'\<bar> + \<bar>y*A'-c'\<bar> + \<bar>c'-c\<bar>) * \<bar>x\<bar> <= (\<bar>y\<bar> * \<bar>A-A'\<bar> + \<bar>y*A'-c'\<bar> + \<delta>_c) * \<bar>x\<bar>"
    47     by (simp add: 11 assms mult_right_mono)
    47     by (simp add: 11 assms mult_right_mono)
    48   have 13: "(abs y * abs (A-A') + abs (y*A'-c') + \<delta>_c) * abs x <= (abs y * \<delta>_A + abs (y*A'-c') + \<delta>_c) * abs x"
    48   have 13: "(\<bar>y\<bar> * \<bar>A-A'\<bar> + \<bar>y*A'-c'\<bar> + \<delta>_c) * \<bar>x\<bar> <= (\<bar>y\<bar> * \<delta>_A + \<bar>y*A'-c'\<bar> + \<delta>_c) * \<bar>x\<bar>"
    49     by (simp add: assms mult_right_mono mult_left_mono)  
    49     by (simp add: assms mult_right_mono mult_left_mono)  
    50   have r: "(abs y * \<delta>_A + abs (y*A'-c') + \<delta>_c) * abs x <=  (abs y * \<delta>_A + abs (y*A'-c') + \<delta>_c) * r"
    50   have r: "(\<bar>y\<bar> * \<delta>_A + \<bar>y*A'-c'\<bar> + \<delta>_c) * \<bar>x\<bar> <= (\<bar>y\<bar> * \<delta>_A + \<bar>y*A'-c'\<bar> + \<delta>_c) * r"
    51     apply (rule mult_left_mono)
    51     apply (rule mult_left_mono)
    52     apply (simp add: assms)
    52     apply (simp add: assms)
    53     apply (rule_tac add_mono[of "0::'a" _ "0", simplified])+
    53     apply (rule_tac add_mono[of "0::'a" _ "0", simplified])+
    54     apply (rule mult_left_mono[of "0" "\<delta>_A", simplified])
    54     apply (rule mult_left_mono[of "0" "\<delta>_A", simplified])
    55     apply (simp_all)
    55     apply (simp_all)
    56     apply (rule order_trans[where y="abs (A-A')"], simp_all add: assms)
    56     apply (rule order_trans[where y="\<bar>A-A'\<bar>"], simp_all add: assms)
    57     apply (rule order_trans[where y="abs (c-c')"], simp_all add: assms)
    57     apply (rule order_trans[where y="\<bar>c-c'\<bar>"], simp_all add: assms)
    58     done    
    58     done    
    59   from 6 7 8 9 12 13 r have 14:" abs((y * (A - A') + (y * A' - c') + (c'-c)) * x) <=(abs y * \<delta>_A + abs (y*A'-c') + \<delta>_c) * r"     
    59   from 6 7 8 9 12 13 r have 14: "\<bar>(y * (A - A') + (y * A' - c') + (c'-c)) * x\<bar> <= (\<bar>y\<bar> * \<delta>_A + \<bar>y*A'-c'\<bar> + \<delta>_c) * r"
    60     by (simp)
    60     by (simp)
    61   show ?thesis
    61   show ?thesis
    62     apply (rule le_add_right_mono[of _ _ "abs((y * (A - A') + (y * A' - c') + (c'-c)) * x)"])
    62     apply (rule le_add_right_mono[of _ _ "\<bar>(y * (A - A') + (y * A' - c') + (c'-c)) * x\<bar>"])
    63     apply (simp_all only: 5 14[simplified abs_of_nonneg[of y, simplified assms]])
    63     apply (simp_all only: 5 14[simplified abs_of_nonneg[of y, simplified assms]])
    64     done
    64     done
    65 qed
    65 qed
    66 
    66 
    67 lemma le_ge_imp_abs_diff_1:
    67 lemma le_ge_imp_abs_diff_1:
    68   assumes
    68   assumes
    69   "A1 <= (A::'a::lattice_ring)"
    69   "A1 <= (A::'a::lattice_ring)"
    70   "A <= A2" 
    70   "A <= A2" 
    71   shows "abs (A-A1) <= A2-A1"
    71   shows "\<bar>A-A1\<bar> <= A2-A1"
    72 proof -
    72 proof -
    73   have "0 <= A - A1"    
    73   have "0 <= A - A1"    
    74   proof -
    74   proof -
    75     from assms add_right_mono [of A1 A "- A1"] show ?thesis by simp
    75     from assms add_right_mono [of A1 A "- A1"] show ?thesis by simp
    76   qed
    76   qed
    77   then have "abs (A-A1) = A-A1" by (rule abs_of_nonneg)
    77   then have "\<bar>A-A1\<bar> = A-A1" by (rule abs_of_nonneg)
    78   with assms show "abs (A-A1) <= (A2-A1)" by simp
    78   with assms show "\<bar>A-A1\<bar> <= (A2-A1)" by simp
    79 qed
    79 qed
    80 
    80 
    81 lemma mult_le_prts:
    81 lemma mult_le_prts:
    82   assumes
    82   assumes
    83   "a1 <= (a::'a::lattice_ring)"
    83   "a1 <= (a::'a::lattice_ring)"