src/HOL/Nonstandard_Analysis/NatStar.thy
changeset 70219 b21efbf64292
parent 69597 ff784d5a5bfb
equal deleted inserted replaced
70218:e48c0b5897a6 70219:b21efbf64292
    13 
    13 
    14 lemma star_n_eq_starfun_whn: "star_n X = ( *f* X) whn"
    14 lemma star_n_eq_starfun_whn: "star_n X = ( *f* X) whn"
    15   by (simp add: hypnat_omega_def starfun_def star_of_def Ifun_star_n)
    15   by (simp add: hypnat_omega_def starfun_def star_of_def Ifun_star_n)
    16 
    16 
    17 lemma starset_n_Un: "*sn* (\<lambda>n. (A n) \<union> (B n)) = *sn* A \<union> *sn* B"
    17 lemma starset_n_Un: "*sn* (\<lambda>n. (A n) \<union> (B n)) = *sn* A \<union> *sn* B"
    18   apply (simp add: starset_n_def star_n_eq_starfun_whn Un_def)
    18 proof -
    19   apply (rule_tac x=whn in spec, transfer, simp)
    19   have "\<And>N. Iset ((*f* (\<lambda>n. {x. x \<in> A n \<or> x \<in> B n})) N) =
    20   done
    20     {x. x \<in> Iset ((*f* A) N) \<or> x \<in> Iset ((*f* B) N)}"
       
    21     by transfer simp
       
    22   then show ?thesis
       
    23     by (simp add: starset_n_def star_n_eq_starfun_whn Un_def)
       
    24 qed
    21 
    25 
    22 lemma InternalSets_Un: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X \<union> Y \<in> InternalSets"
    26 lemma InternalSets_Un: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X \<union> Y \<in> InternalSets"
    23   by (auto simp add: InternalSets_def starset_n_Un [symmetric])
    27   by (auto simp add: InternalSets_def starset_n_Un [symmetric])
    24 
    28 
    25 lemma starset_n_Int: "*sn* (\<lambda>n. A n \<inter> B n) = *sn* A \<inter> *sn* B"
    29 lemma starset_n_Int: "*sn* (\<lambda>n. A n \<inter> B n) = *sn* A \<inter> *sn* B"
    26   apply (simp add: starset_n_def star_n_eq_starfun_whn Int_def)
    30 proof -
    27   apply (rule_tac x=whn in spec, transfer, simp)
    31   have "\<And>N. Iset ((*f* (\<lambda>n. {x. x \<in> A n \<and> x \<in> B n})) N) =
    28   done
    32     {x. x \<in> Iset ((*f* A) N) \<and> x \<in> Iset ((*f* B) N)}"
       
    33     by transfer simp
       
    34   then show ?thesis
       
    35     by (simp add: starset_n_def star_n_eq_starfun_whn Int_def)
       
    36 qed
    29 
    37 
    30 lemma InternalSets_Int: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X \<inter> Y \<in> InternalSets"
    38 lemma InternalSets_Int: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X \<inter> Y \<in> InternalSets"
    31   by (auto simp add: InternalSets_def starset_n_Int [symmetric])
    39   by (auto simp add: InternalSets_def starset_n_Int [symmetric])
    32 
    40 
    33 lemma starset_n_Compl: "*sn* ((\<lambda>n. - A n)) = - ( *sn* A)"
    41 lemma starset_n_Compl: "*sn* ((\<lambda>n. - A n)) = - ( *sn* A)"
    34   apply (simp add: starset_n_def star_n_eq_starfun_whn Compl_eq)
    42 proof -
    35   apply (rule_tac x=whn in spec, transfer, simp)
    43   have "\<And>N. Iset ((*f* (\<lambda>n. {x. x \<notin> A n})) N) =
    36   done
    44     {x. x \<notin> Iset ((*f* A) N)}"
       
    45     by transfer simp
       
    46   then show ?thesis
       
    47     by (simp add: starset_n_def star_n_eq_starfun_whn Compl_eq)
       
    48 qed
    37 
    49 
    38 lemma InternalSets_Compl: "X \<in> InternalSets \<Longrightarrow> - X \<in> InternalSets"
    50 lemma InternalSets_Compl: "X \<in> InternalSets \<Longrightarrow> - X \<in> InternalSets"
    39   by (auto simp add: InternalSets_def starset_n_Compl [symmetric])
    51   by (auto simp add: InternalSets_def starset_n_Compl [symmetric])
    40 
    52 
    41 lemma starset_n_diff: "*sn* (\<lambda>n. (A n) - (B n)) = *sn* A - *sn* B"
    53 lemma starset_n_diff: "*sn* (\<lambda>n. (A n) - (B n)) = *sn* A - *sn* B"
    42   apply (simp add: starset_n_def star_n_eq_starfun_whn set_diff_eq)
    54 proof -
    43   apply (rule_tac x=whn in spec, transfer, simp)
    55   have "\<And>N. Iset ((*f* (\<lambda>n. {x. x \<in> A n \<and> x \<notin> B n})) N) =
    44   done
    56     {x. x \<in> Iset ((*f* A) N) \<and> x \<notin> Iset ((*f* B) N)}"
       
    57     by transfer simp
       
    58   then show ?thesis
       
    59     by (simp add: starset_n_def star_n_eq_starfun_whn set_diff_eq)
       
    60 qed
    45 
    61 
    46 lemma InternalSets_diff: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X - Y \<in> InternalSets"
    62 lemma InternalSets_diff: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X - Y \<in> InternalSets"
    47   by (auto simp add: InternalSets_def starset_n_diff [symmetric])
    63   by (auto simp add: InternalSets_def starset_n_diff [symmetric])
    48 
    64 
    49 lemma NatStar_SHNat_subset: "Nats \<le> *s* (UNIV:: nat set)"
    65 lemma NatStar_SHNat_subset: "Nats \<le> *s* (UNIV:: nat set)"
    57 
    73 
    58 lemma InternalSets_starset_n [simp]: "( *s* X) \<in> InternalSets"
    74 lemma InternalSets_starset_n [simp]: "( *s* X) \<in> InternalSets"
    59   by (auto simp add: InternalSets_def starset_starset_n_eq)
    75   by (auto simp add: InternalSets_def starset_starset_n_eq)
    60 
    76 
    61 lemma InternalSets_UNIV_diff: "X \<in> InternalSets \<Longrightarrow> UNIV - X \<in> InternalSets"
    77 lemma InternalSets_UNIV_diff: "X \<in> InternalSets \<Longrightarrow> UNIV - X \<in> InternalSets"
    62   apply (subgoal_tac "UNIV - X = - X")
    78   by (simp add: InternalSets_Compl diff_eq)
    63    apply (auto intro: InternalSets_Compl)
       
    64   done
       
    65 
    79 
    66 
    80 
    67 subsection \<open>Nonstandard Extensions of Functions\<close>
    81 subsection \<open>Nonstandard Extensions of Functions\<close>
    68 
    82 
    69 text \<open>Example of transfer of a property from reals to hyperreals
    83 text \<open>Example of transfer of a property from reals to hyperreals
   102 lemma starfunNat_real_of_nat: "( *f* real) = hypreal_of_hypnat"
   116 lemma starfunNat_real_of_nat: "( *f* real) = hypreal_of_hypnat"
   103   by transfer (simp add: fun_eq_iff)
   117   by transfer (simp add: fun_eq_iff)
   104 
   118 
   105 lemma starfun_inverse_real_of_nat_eq:
   119 lemma starfun_inverse_real_of_nat_eq:
   106   "N \<in> HNatInfinite \<Longrightarrow> ( *f* (\<lambda>x::nat. inverse (real x))) N = inverse (hypreal_of_hypnat N)"
   120   "N \<in> HNatInfinite \<Longrightarrow> ( *f* (\<lambda>x::nat. inverse (real x))) N = inverse (hypreal_of_hypnat N)"
   107   apply (rule_tac f1 = inverse in starfun_o2 [THEN subst])
   121   by (metis of_hypnat_def starfun_inverse2)
   108   apply (subgoal_tac "hypreal_of_hypnat N \<noteq> 0")
       
   109    apply (simp_all add: zero_less_HNatInfinite starfunNat_real_of_nat)
       
   110   done
       
   111 
   122 
   112 text \<open>Internal functions -- some redundancy with \<open>*f*\<close> now.\<close>
   123 text \<open>Internal functions -- some redundancy with \<open>*f*\<close> now.\<close>
   113 
   124 
   114 lemma starfun_n: "( *fn* f) (star_n X) = star_n (\<lambda>n. f n (X n))"
   125 lemma starfun_n: "( *fn* f) (star_n X) = star_n (\<lambda>n. f n (X n))"
   115   by (simp add: starfun_n_def Ifun_star_n)
   126   by (simp add: starfun_n_def Ifun_star_n)
   142 lemma starfun_eq_iff: "(( *f* f) = ( *f* g)) \<longleftrightarrow> f = g"
   153 lemma starfun_eq_iff: "(( *f* f) = ( *f* g)) \<longleftrightarrow> f = g"
   143   by transfer (rule refl)
   154   by transfer (rule refl)
   144 
   155 
   145 lemma starfunNat_inverse_real_of_nat_Infinitesimal [simp]:
   156 lemma starfunNat_inverse_real_of_nat_Infinitesimal [simp]:
   146   "N \<in> HNatInfinite \<Longrightarrow> ( *f* (\<lambda>x. inverse (real x))) N \<in> Infinitesimal"
   157   "N \<in> HNatInfinite \<Longrightarrow> ( *f* (\<lambda>x. inverse (real x))) N \<in> Infinitesimal"
   147   apply (rule_tac f1 = inverse in starfun_o2 [THEN subst])
   158   using starfun_inverse_real_of_nat_eq by auto
   148   apply (subgoal_tac "hypreal_of_hypnat N \<noteq> 0")
       
   149    apply (simp_all add: zero_less_HNatInfinite starfunNat_real_of_nat)
       
   150   done
       
   151 
   159 
   152 
   160 
   153 subsection \<open>Nonstandard Characterization of Induction\<close>
   161 subsection \<open>Nonstandard Characterization of Induction\<close>
   154 
   162 
   155 lemma hypnat_induct_obj:
   163 lemma hypnat_induct_obj:
   164   by transfer (rule refl)
   172   by transfer (rule refl)
   165 
   173 
   166 lemma starP2_eq_iff2: "( *p2* (\<lambda>x y. x = y)) X Y \<longleftrightarrow> X = Y"
   174 lemma starP2_eq_iff2: "( *p2* (\<lambda>x y. x = y)) X Y \<longleftrightarrow> X = Y"
   167   by (simp add: starP2_eq_iff)
   175   by (simp add: starP2_eq_iff)
   168 
   176 
   169 lemma nonempty_nat_set_Least_mem: "c \<in> S \<Longrightarrow> (LEAST n. n \<in> S) \<in> S"
   177 lemma nonempty_set_star_has_least_lemma:
   170   for S :: "nat set"
   178   "\<exists>n\<in>S. \<forall>m\<in>S. n \<le> m" if "S \<noteq> {}" for S :: "nat set"
   171   by (erule LeastI)
   179 proof
       
   180   show "\<forall>m\<in>S. (LEAST n. n \<in> S) \<le> m"
       
   181     by (simp add: Least_le)
       
   182   show "(LEAST n. n \<in> S) \<in> S"
       
   183     by (meson that LeastI_ex equals0I)
       
   184 qed
   172 
   185 
   173 lemma nonempty_set_star_has_least:
   186 lemma nonempty_set_star_has_least:
   174   "\<And>S::nat set star. Iset S \<noteq> {} \<Longrightarrow> \<exists>n \<in> Iset S. \<forall>m \<in> Iset S. n \<le> m"
   187   "\<And>S::nat set star. Iset S \<noteq> {} \<Longrightarrow> \<exists>n \<in> Iset S. \<forall>m \<in> Iset S. n \<le> m"
   175   apply (transfer empty_def)
   188   using nonempty_set_star_has_least_lemma by (transfer empty_def)
   176   apply (rule_tac x="LEAST n. n \<in> S" in bexI)
       
   177    apply (simp add: Least_le)
       
   178   apply (rule LeastI_ex, auto)
       
   179   done
       
   180 
   189 
   181 lemma nonempty_InternalNatSet_has_least: "S \<in> InternalSets \<Longrightarrow> S \<noteq> {} \<Longrightarrow> \<exists>n \<in> S. \<forall>m \<in> S. n \<le> m"
   190 lemma nonempty_InternalNatSet_has_least: "S \<in> InternalSets \<Longrightarrow> S \<noteq> {} \<Longrightarrow> \<exists>n \<in> S. \<forall>m \<in> S. n \<le> m"
   182   for S :: "hypnat set"
   191   for S :: "hypnat set"
   183   apply (clarsimp simp add: InternalSets_def starset_n_def)
   192   by (force simp add: InternalSets_def starset_n_def dest!: nonempty_set_star_has_least)
   184   apply (erule nonempty_set_star_has_least)
       
   185   done
       
   186 
   193 
   187 text \<open>Goldblatt, page 129 Thm 11.3.2.\<close>
   194 text \<open>Goldblatt, page 129 Thm 11.3.2.\<close>
   188 lemma internal_induct_lemma:
   195 lemma internal_induct_lemma:
   189   "\<And>X::nat set star.
   196   "\<And>X::nat set star.
   190     (0::hypnat) \<in> Iset X \<Longrightarrow> \<forall>n. n \<in> Iset X \<longrightarrow> n + 1 \<in> Iset X \<Longrightarrow> Iset X = (UNIV:: hypnat set)"
   197     (0::hypnat) \<in> Iset X \<Longrightarrow> \<forall>n. n \<in> Iset X \<longrightarrow> n + 1 \<in> Iset X \<Longrightarrow> Iset X = (UNIV:: hypnat set)"