Merged.
authorballarin
Tue Dec 30 11:10:01 2008 +0100 (2008-12-30)
changeset 29252ea97aa6aeba2
parent 29251 8f84a608883d
parent 29205 7dc7a75033ea
child 29253 3c6cd80a4854
child 29254 ef3e2c3399d7
child 29332 edc1e2a56398
Merged.
etc/isar-keywords-ZF.el
etc/isar-keywords.el
src/HOL/Complex/Fundamental_Theorem_Algebra.thy
src/HOL/Complex/README.html
src/HOL/Complex/document/root.tex
src/HOL/Dense_Linear_Order.thy
src/HOL/Divides.thy
src/HOL/HahnBanach/Bounds.thy
src/HOL/HahnBanach/FunctionNorm.thy
src/HOL/HahnBanach/HahnBanach.thy
src/HOL/HahnBanach/HahnBanachExtLemmas.thy
src/HOL/HahnBanach/HahnBanachSupLemmas.thy
src/HOL/HahnBanach/Linearform.thy
src/HOL/HahnBanach/NormedSpace.thy
src/HOL/HahnBanach/Subspace.thy
src/HOL/HahnBanach/VectorSpace.thy
src/HOL/HahnBanach/ZornLemma.thy
src/HOL/Hyperreal/SEQ.thy
src/HOL/Library/Dense_Linear_Order.thy
src/HOL/Library/Multiset.thy
src/HOL/Real/HahnBanach/Bounds.thy
src/HOL/Real/HahnBanach/FunctionNorm.thy
src/HOL/Real/HahnBanach/FunctionOrder.thy
src/HOL/Real/HahnBanach/HahnBanach.thy
src/HOL/Real/HahnBanach/HahnBanachExtLemmas.thy
src/HOL/Real/HahnBanach/HahnBanachLemmas.thy
src/HOL/Real/HahnBanach/HahnBanachSupLemmas.thy
src/HOL/Real/HahnBanach/Linearform.thy
src/HOL/Real/HahnBanach/NormedSpace.thy
src/HOL/Real/HahnBanach/README.html
src/HOL/Real/HahnBanach/ROOT.ML
src/HOL/Real/HahnBanach/Subspace.thy
src/HOL/Real/HahnBanach/VectorSpace.thy
src/HOL/Real/HahnBanach/ZornLemma.thy
src/HOL/Real/HahnBanach/document/root.bib
src/HOL/Real/HahnBanach/document/root.tex
src/HOL/Real/RealVector.thy
src/HOL/RealVector.thy
src/HOL/ex/LexOrds.thy
src/HOLCF/Algebraic.thy
src/HOLCF/Bifinite.thy
src/HOLCF/CompactBasis.thy
src/HOLCF/Completion.thy
src/HOLCF/ConvexPD.thy
src/HOLCF/Deflation.thy
src/HOLCF/LowerPD.thy
src/HOLCF/Universal.thy
src/HOLCF/UpperPD.thy
src/Pure/Concurrent/schedule.ML
src/Pure/IsaMakefile
src/Pure/Isar/theory_target.ML
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/Admin/MacOS/README	Tue Dec 30 11:10:01 2008 +0100
     1.3 @@ -0,0 +1,17 @@
     1.4 +Isabelle application bundle for MacOS
     1.5 +=====================================
     1.6 +
     1.7 +Requirements:
     1.8 +
     1.9 +* CocoaDialog http://cocoadialog.sourceforge.net/
    1.10 +
    1.11 +* Platypus http://www.sveinbjorn.org/platypus
    1.12 +
    1.13 +* AppHack 1.1 http://www.sveinbjorn.org/apphack
    1.14 +
    1.15 +  Manual setup:
    1.16 +    File type: "Isabelle theory"
    1.17 +    Icon: "theory.icns"
    1.18 +    "Editor"
    1.19 +    Suffixes: "thy"
    1.20 +
     2.1 Binary file Admin/MacOS/isabelle.icns has changed
     3.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.2 +++ b/Admin/MacOS/mk	Tue Dec 30 11:10:01 2008 +0100
     3.3 @@ -0,0 +1,19 @@
     3.4 +#!/bin/bash
     3.5 +#
     3.6 +# Make Isabelle application bundle
     3.7 +
     3.8 +THIS="$(cd "$(dirname "$0")"; pwd)"
     3.9 +
    3.10 +PLATYPUS_APP="/Applications/Platypus-4.0/Platypus.app"
    3.11 +COCOADIALOG_APP="/Applications/CocoaDialog.app"
    3.12 +
    3.13 +"$PLATYPUS_APP/Contents/Resources/platypus" \
    3.14 +  -a Isabelle -u Isabelle \
    3.15 +  -I "de.tum.in.isabelle" \
    3.16 +  -i "$THIS/isabelle.icns" \
    3.17 +  -D -X thy \
    3.18 +  -p /bin/bash \
    3.19 +  -c "$THIS/script" \
    3.20 +  -o None \
    3.21 +  -f "$COCOADIALOG_APP" \
    3.22 +  "$PWD/Isabelle.app"
     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/Admin/MacOS/script	Tue Dec 30 11:10:01 2008 +0100
     4.3 @@ -0,0 +1,78 @@
     4.4 +#!/bin/bash
     4.5 +#
     4.6 +# Author: Makarius
     4.7 +#
     4.8 +# Isabelle application wrapper
     4.9 +
    4.10 +THIS="$(cd "$(dirname "$0")"; pwd)"
    4.11 +THIS_APP="$(cd "$THIS/../.."; pwd)"
    4.12 +SUPER_APP="$(cd "$THIS/../../.."; pwd)"
    4.13 +
    4.14 +
    4.15 +# sane environment defaults
    4.16 +cd "$HOME"
    4.17 +PATH="$PATH:/opt/local/bin"
    4.18 +
    4.19 +
    4.20 +# settings support
    4.21 +
    4.22 +function choosefrom ()
    4.23 +{
    4.24 +  local RESULT=""
    4.25 +  local FILE=""
    4.26 +
    4.27 +  for FILE in "$@"
    4.28 +  do
    4.29 +    [ -z "$RESULT" -a -e "$FILE" ] && RESULT="$FILE"
    4.30 +  done
    4.31 +
    4.32 +  [ -z "$RESULT" ] && RESULT="$FILE"
    4.33 +  echo "$RESULT"
    4.34 +}
    4.35 +
    4.36 +
    4.37 +# Isabelle
    4.38 +
    4.39 +ISABELLE_TOOL="$(choosefrom \
    4.40 +  "$THIS/Isabelle/bin/isabelle" \
    4.41 +  "$SUPER_APP/Isabelle/bin/isabelle" \
    4.42 +  "$HOME/bin/isabelle" \
    4.43 +  isabelle)"
    4.44 +
    4.45 +
    4.46 +# Proof General / Emacs
    4.47 +
    4.48 +PROOFGENERAL_EMACS="$(choosefrom \
    4.49 +  "$THIS/Emacs.app/Contents/MacOS/Emacs" \
    4.50 +  "$SUPER_APP/Emacs.app/Contents/MacOS/Emacs" \
    4.51 +  /Applications/Emacs.app/Contents/MacOS/Emacs \
    4.52 +  "")"
    4.53 +
    4.54 +if [ -n "$PROOFGENERAL_EMACS" ]; then
    4.55 +  PROOFGENERAL_OPTIONS="-p $PROOFGENERAL_EMACS $PROOFGENERAL_OPTIONS"
    4.56 +fi
    4.57 +
    4.58 +
    4.59 +# run interface with error feedback
    4.60 +
    4.61 +OUTPUT="/tmp/isabelle$$.out"
    4.62 +
    4.63 +( "$HOME/bin/isabelle" emacs "$@" ) > "$OUTPUT" 2>&1
    4.64 +RC=$?
    4.65 +
    4.66 +if [ "$RC" != 0 ]; then
    4.67 +  echo >> "$OUTPUT"
    4.68 +  echo "Return code: $RC" >> "$OUTPUT"
    4.69 +fi
    4.70 +
    4.71 +if [ $(stat -f "%z" "$OUTPUT") != 0 ]; then
    4.72 +  "$THIS/CocoaDialog.app/Contents/MacOS/CocoaDialog" textbox \
    4.73 +    --title "Isabelle" \
    4.74 +    --informative-text "Isabelle output" \
    4.75 +    --text-from-file "$OUTPUT" \
    4.76 +    --button1 "OK"
    4.77 +fi
    4.78 +
    4.79 +rm -f "$OUTPUT"
    4.80 +
    4.81 +exit "$RC"
     5.1 Binary file Admin/MacOS/theory.icns has changed
     6.1 --- a/Admin/Mercurial/isabelle-style.diff	Tue Dec 30 08:18:54 2008 +0100
     6.2 +++ b/Admin/Mercurial/isabelle-style.diff	Tue Dec 30 11:10:01 2008 +0100
     6.3 @@ -13,23 +13,22 @@
     6.4  > <div class="files">
     6.5  > #files#
     6.6  > </div>
     6.7 -Only in isabelle: filelog.tmpl~
     6.8 +diff -r gitweb/changeset.tmpl isabelle/changeset.tmpl
     6.9 +19c19
    6.10 +< <a class="title" href="{url}raw-rev/#node|short#">#desc|strip|escape|firstline# <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a>
    6.11 +---
    6.12 +> <a class="title" href="{url}raw-rev/#node|short#">#desc|strip|escape# <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a>
    6.13  diff -r gitweb/map isabelle/map
    6.14 -56,57c56,57
    6.15 +29c29
    6.16 +< annotateline = '<tr style="font-family:monospace" class="parity#parity#"><td class="linenr" style="text-align: right;"><a href="#url#annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}#l{targetline}" title="{node|short}: {desc|escape|firstline}">#author|user#@#rev#</a></td><td><pre><a class="linenr" href="##lineid#" id="#lineid#">#linenumber#</a></pre></td><td><pre>#line|escape#</pre></td></tr>'
    6.17 +---
    6.18 +> annotateline = '<tr style="font-family:monospace" class="parity#parity#"><td class="linenr" style="text-align: right;"><a href="#url#annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}#l{targetline}" title="{node|short}: {desc|escape}">#author|user#@#rev#</a></td><td><pre><a class="linenr" href="##lineid#" id="#lineid#">#linenumber#</a></pre></td><td><pre>#line|escape#</pre></td></tr>'
    6.19 +59,60c59,60
    6.20  < shortlogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><i>#author|person#</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|firstline|escape#</b> <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a></td><td class="link" nowrap><a href="{url}rev/#node|short#{sessionvars%urlparameter}">changeset</a> | <a href="{url}file/#node|short#{sessionvars%urlparameter}">files</a></td></tr>'
    6.21  < filelogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|firstline|escape#</b></a></td><td class="link"><a href="{url}file/#node|short#/#file|urlescape#{sessionvars%urlparameter}">file</a>&nbsp;|&nbsp;<a href="{url}diff/#node|short#/#file|urlescape#{sessionvars%urlparameter}">diff</a>&nbsp;|&nbsp;<a href="{url}annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}">annotate</a> #rename%filelogrename#</td></tr>'
    6.22  ---
    6.23  > shortlogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><i>#date|shortdate#</i></td><td><i>#author|person#</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|escape#</b> <span class="logtags">{inbranch%inbranchtag}{branches%branchtag}{tags%tagtag}</span></a></td><td class="link" nowrap><a href="{url}rev/#node|short#{sessionvars%urlparameter}">changeset</a> | <a href="{url}file/#node|short#{sessionvars%urlparameter}">files</a></td></tr>'
    6.24  > filelogentry = '<tr class="parity#parity#"><td class="age"><i>#date|age# ago</i></td><td><i>#date|shortdate#</i></td><td><i>#author|person#</i></td><td><a class="list" href="{url}rev/#node|short#{sessionvars%urlparameter}"><b>#desc|strip|escape#</b></a></td><td class="link"><a href="{url}file/#node|short#/#file|urlescape#{sessionvars%urlparameter}">file</a>&nbsp;|&nbsp;<a href="{url}diff/#node|short#/#file|urlescape#{sessionvars%urlparameter}">diff</a>&nbsp;|&nbsp;<a href="{url}annotate/#node|short#/#file|urlescape#{sessionvars%urlparameter}">annotate</a> #rename%filelogrename#</td></tr>'
    6.25 -Only in isabelle: map~
    6.26  diff -r gitweb/summary.tmpl isabelle/summary.tmpl
    6.27 -33d32
    6.28 +34d33
    6.29  < <tr><td>owner</td><td>#owner|obfuscate#</td></tr>
    6.30 -49,55d47
    6.31 -< <div><a class="title" href="#">branches</a></div>
    6.32 -< <table cellspacing="0">
    6.33 -< {branches%branchentry}
    6.34 -< <tr class="light">
    6.35 -<   <td colspan="4"><a class="list"  href="#">...</a></td>
    6.36 -< </tr>
    6.37 -< </table>
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/Admin/Mercurial/misc.diff	Tue Dec 30 11:10:01 2008 +0100
     7.3 @@ -0,0 +1,20 @@
     7.4 +diff -r hgweb/webcommands.py hgweb/webcommands.py
     7.5 +653c653
     7.6 +<         desc = templatefilters.firstline(ctx.description())
     7.7 +---
     7.8 +>         desc = ctx.description()
     7.9 +diff -r templates/atom/changelogentry.tmpl templates/atom/changelogentry.tmpl
    7.10 +2c2
    7.11 +<   <title>#desc|strip|firstline|strip|escape#</title>
    7.12 +---
    7.13 +>   <title>#desc|strip|escape#</title>
    7.14 +diff -r templates/rss/changelogentry.tmpl templates/rss/changelogentry.tmpl
    7.15 +2c2
    7.16 +<     <title>#desc|strip|firstline|strip|escape#</title>
    7.17 +---
    7.18 +>     <title>#desc|strip|escape#</title>
    7.19 +diff -r templates/rss/filelogentry.tmpl templates/rss/filelogentry.tmpl
    7.20 +2c2
    7.21 +<     <title>#desc|strip|firstline|strip|escape#</title>
    7.22 +---
    7.23 +>     <title>#desc|strip|escape#</title>
     8.1 --- a/Admin/build	Tue Dec 30 08:18:54 2008 +0100
     8.2 +++ b/Admin/build	Tue Dec 30 11:10:01 2008 +0100
     8.3 @@ -7,7 +7,7 @@
     8.4  #paranoia setting for sunbroy
     8.5  PATH="/usr/local/dist/DIR/j2sdk1.5.0/bin:$PATH"
     8.6  
     8.7 -PATH="/home/scala/scala/bin:$PATH"
     8.8 +PATH="/home/scala/current/bin:$PATH"
     8.9  
    8.10  
    8.11  ## directory layout
    8.12 @@ -101,15 +101,6 @@
    8.13    pushd "$ISABELLE_HOME/src/Pure" >/dev/null
    8.14    "$ISABELLE_TOOL" make jar || fail "Failed to build Pure.jar!"
    8.15    popd >/dev/null
    8.16 -
    8.17 -  if [ -d "$HOME/lib/jedit/current" ]; then
    8.18 -    pushd "$ISABELLE_HOME/lib/jedit/plugin" >/dev/null
    8.19 -    ./mk
    8.20 -    [ -f ../isabelle.jar ] || fail "Failed to build jEdit plugin!"
    8.21 -    popd >/dev/null
    8.22 -  else
    8.23 -    echo "Warning: skipping jedit plugin"
    8.24 -  fi
    8.25  }
    8.26  
    8.27  
     9.1 --- a/Admin/isatest/settings/at-mac-poly-5.1-para	Tue Dec 30 08:18:54 2008 +0100
     9.2 +++ b/Admin/isatest/settings/at-mac-poly-5.1-para	Tue Dec 30 11:10:01 2008 +0100
     9.3 @@ -4,7 +4,7 @@
     9.4    ML_SYSTEM="polyml-5.2.1"
     9.5    ML_PLATFORM="x86-darwin"
     9.6    ML_HOME="$POLYML_HOME/$ML_PLATFORM"
     9.7 -  ML_OPTIONS="-H 2000"
     9.8 +  ML_OPTIONS="--immutable 800 --mutable 1200"
     9.9  
    9.10  
    9.11  ISABELLE_HOME_USER=~/isabelle-at-mac-poly-e
    10.1 --- a/CONTRIBUTORS	Tue Dec 30 08:18:54 2008 +0100
    10.2 +++ b/CONTRIBUTORS	Tue Dec 30 11:10:01 2008 +0100
    10.3 @@ -7,6 +7,9 @@
    10.4  Contributions to this Isabelle version
    10.5  --------------------------------------
    10.6  
    10.7 +* December 2008: Armin Heller, TUM and Alexander Krauss, TUM
    10.8 +  Method "sizechange" for advanced termination proofs.
    10.9 +
   10.10  * November 2008: Timothy Bourke, NICTA
   10.11    Performance improvement (factor 50) for find_theorems.
   10.12  
   10.13 @@ -204,5 +207,3 @@
   10.14  * 2004/2005: Tjark Weber, TUM
   10.15    SAT solver method using zChaff.
   10.16    Improved version of HOL/refute.
   10.17 -
   10.18 -$Id$
    11.1 --- a/INSTALL	Tue Dec 30 08:18:54 2008 +0100
    11.2 +++ b/INSTALL	Tue Dec 30 11:10:01 2008 +0100
    11.3 @@ -85,6 +85,3 @@
    11.4  Note that the site-wide Isabelle installation may already provide
    11.5  Isabelle executables in some global bin directory (such as
    11.6  /usr/local/bin).
    11.7 -
    11.8 -
    11.9 -$Id$
    12.1 --- a/NEWS	Tue Dec 30 08:18:54 2008 +0100
    12.2 +++ b/NEWS	Tue Dec 30 11:10:01 2008 +0100
    12.3 @@ -42,6 +42,11 @@
    12.4  ISABELLE_HOME_USER can be changed in Isabelle/etc/settings of any
    12.5  Isabelle distribution.
    12.6  
    12.7 +* Proofs of fully specified statements are run in parallel on
    12.8 +multi-core systems.  A speedup factor of 2-3 can be expected on a
    12.9 +regular 4-core machine, if the initial heap space is made reasonably
   12.10 +large (cf. Poly/ML option -H).  [Poly/ML 5.2.1 or later]
   12.11 +
   12.12  * The Isabelle System Manual (system) has been updated, with formally
   12.13  checked references as hyperlinks.
   12.14  
   12.15 @@ -55,8 +60,8 @@
   12.16  * Removed exotic 'token_translation' command.  INCOMPATIBILITY, use ML
   12.17  interface instead.
   12.18  
   12.19 -* There is a new lexical item "float" with syntax ["-"] digit+ "." digit+,
   12.20 -without spaces.
   12.21 +* There is a new syntactic category "float_const" for signed decimal
   12.22 +fractions (e.g. 123.45 or -123.45).
   12.23  
   12.24  
   12.25  *** Pure ***
   12.26 @@ -152,11 +157,12 @@
   12.27  
   12.28  *** HOL ***
   12.29  
   12.30 -* Made repository layout more coherent with logical
   12.31 -distribution structure:
   12.32 +* Made source layout more coherent with logical distribution
   12.33 +structure:
   12.34  
   12.35      src/HOL/Library/RType.thy ~> src/HOL/Typerep.thy
   12.36      src/HOL/Library/Code_Message.thy ~> src/HOL/
   12.37 +    src/HOL/Library/Dense_Linear_Order.thy ~> src/HOL/
   12.38      src/HOL/Library/GCD.thy ~> src/HOL/
   12.39      src/HOL/Library/Order_Relation.thy ~> src/HOL/
   12.40      src/HOL/Library/Parity.thy ~> src/HOL/
   12.41 @@ -172,6 +178,7 @@
   12.42      src/HOL/Complex/Complex_Main.thy ~> src/HOL/
   12.43      src/HOL/Complex/Complex.thy ~> src/HOL/
   12.44      src/HOL/Complex/FrechetDeriv.thy ~> src/HOL/
   12.45 +    src/HOL/Complex/Fundamental_Theorem_Algebra.thy ~> src/HOL/
   12.46      src/HOL/Hyperreal/Deriv.thy ~> src/HOL/
   12.47      src/HOL/Hyperreal/Fact.thy ~> src/HOL/
   12.48      src/HOL/Hyperreal/Integration.thy ~> src/HOL/
   12.49 @@ -181,9 +188,12 @@
   12.50      src/HOL/Hyperreal/MacLaurin.thy ~> src/HOL/
   12.51      src/HOL/Hyperreal/NthRoot.thy ~> src/HOL/
   12.52      src/HOL/Hyperreal/Series.thy ~> src/HOL/
   12.53 +    src/HOL/Hyperreal/SEQ.thy ~> src/HOL/
   12.54      src/HOL/Hyperreal/Taylor.thy ~> src/HOL/
   12.55      src/HOL/Hyperreal/Transcendental.thy ~> src/HOL/
   12.56      src/HOL/Real/Float ~> src/HOL/Library/
   12.57 +    src/HOL/Real/HahnBanach ~> src/HOL/HahnBanach
   12.58 +    src/HOL/Real/RealVector.thy ~> src/HOL/
   12.59  
   12.60      src/HOL/arith_data.ML ~> src/HOL/Tools
   12.61      src/HOL/hologic.ML ~> src/HOL/Tools
   12.62 @@ -239,6 +249,10 @@
   12.63  mechanisms may be specified (currently, [SML], [code] or [nbe]).  See
   12.64  further src/HOL/ex/Eval_Examples.thy.
   12.65  
   12.66 +* New method "sizechange" to automate termination proofs using (a
   12.67 +modification of) the size-change principle. Requires SAT solver. See
   12.68 +src/HOL/ex/Termination.thy for examples.
   12.69 +
   12.70  * HOL/Orderings: class "wellorder" moved here, with explicit induction
   12.71  rule "less_induct" as assumption.  For instantiation of "wellorder" by
   12.72  means of predicate "wf", use rule wf_wellorderI.  INCOMPATIBILITY.
   12.73 @@ -388,6 +402,14 @@
   12.74  
   12.75  *** ML ***
   12.76  
   12.77 +* High-level support for concurrent ML programming, see
   12.78 +src/Pure/Cuncurrent.  The data-oriented model of "future values" is
   12.79 +particularly convenient to organize independent functional
   12.80 +computations.  The concept of "synchronized variables" provides a
   12.81 +higher-order interface for components with shared state, avoiding the
   12.82 +delicate details of mutexes and condition variables.  [Poly/ML 5.2.1
   12.83 +or later]
   12.84 +
   12.85  * Simplified ML oracle interface Thm.add_oracle promotes 'a -> cterm
   12.86  to 'a -> thm, while results are always tagged with an authentic oracle
   12.87  name.  The Isar command 'oracle' is now polymorphic, no argument type
   12.88 @@ -857,8 +879,8 @@
   12.89  print_mode_active, PrintMode.setmp etc.  INCOMPATIBILITY.
   12.90  
   12.91  * Functions system/system_out provide a robust way to invoke external
   12.92 -shell commands, with propagation of interrupts (requires Poly/ML 5.2).
   12.93 -Do not use OS.Process.system etc. from the basis library!
   12.94 +shell commands, with propagation of interrupts (requires Poly/ML
   12.95 +5.2.1).  Do not use OS.Process.system etc. from the basis library!
   12.96  
   12.97  
   12.98  *** System ***
   12.99 @@ -5953,6 +5975,3 @@
  12.100  types;
  12.101  
  12.102  :mode=text:wrap=hard:maxLineLen=72:
  12.103 -
  12.104 -
  12.105 -$Id$
    13.1 --- a/build	Tue Dec 30 08:18:54 2008 +0100
    13.2 +++ b/build	Tue Dec 30 11:10:01 2008 +0100
    13.3 @@ -1,6 +1,5 @@
    13.4  #!/usr/bin/env bash
    13.5  #
    13.6 -# $Id$
    13.7  # Author: Markus Wenzel, TU Muenchen
    13.8  #
    13.9  # build - compile the Isabelle system and object-logics
    14.1 --- a/doc-src/IsarAdvanced/Classes/style.sty	Tue Dec 30 08:18:54 2008 +0100
    14.2 +++ b/doc-src/IsarAdvanced/Classes/style.sty	Tue Dec 30 11:10:01 2008 +0100
    14.3 @@ -30,7 +30,7 @@
    14.4  
    14.5  \pagestyle{headings}
    14.6  \binperiod
    14.7 -\underscoreon
    14.8 +\underscoreoff
    14.9  
   14.10  \renewcommand{\isadigit}[1]{\isamath{#1}}
   14.11  
    15.1 --- a/doc-src/IsarAdvanced/Codegen/style.sty	Tue Dec 30 08:18:54 2008 +0100
    15.2 +++ b/doc-src/IsarAdvanced/Codegen/style.sty	Tue Dec 30 11:10:01 2008 +0100
    15.3 @@ -42,7 +42,7 @@
    15.4  
    15.5  \pagestyle{headings}
    15.6  \binperiod
    15.7 -\underscoreon
    15.8 +\underscoreoff
    15.9  
   15.10  \renewcommand{\isadigit}[1]{\isamath{#1}}
   15.11  
    16.1 --- a/doc-src/IsarImplementation/Thy/ML.thy	Tue Dec 30 08:18:54 2008 +0100
    16.2 +++ b/doc-src/IsarImplementation/Thy/ML.thy	Tue Dec 30 11:10:01 2008 +0100
    16.3 @@ -107,18 +107,23 @@
    16.4  section {* Thread-safe programming *}
    16.5  
    16.6  text {*
    16.7 -  Recent versions of Poly/ML (5.2 or later) support multithreaded
    16.8 -  execution based on native operating system threads of the underlying
    16.9 -  platform.  Thus threads will actually be executed in parallel on
   16.10 -  multi-core systems.  A speedup-factor of approximately 2--4 can be
   16.11 -  expected for large well-structured Isabelle sessions, where theories
   16.12 -  are organized as a graph with sufficiently many independent nodes.
   16.13 +  Recent versions of Poly/ML (5.2.1 or later) support robust
   16.14 +  multithreaded execution, based on native operating system threads of
   16.15 +  the underlying platform.  Thus threads will actually be executed in
   16.16 +  parallel on multi-core systems.  A speedup-factor of approximately
   16.17 +  1.5--3 can be expected on a regular 4-core machine.\footnote{There
   16.18 +  is some inherent limitation of the speedup factor due to garbage
   16.19 +  collection, which is still sequential.  It helps to provide initial
   16.20 +  heap space generously, using the \texttt{-H} option of Poly/ML.}
   16.21 +  Threads also help to organize advanced operations of the system,
   16.22 +  with explicit communication between sub-components, real-time
   16.23 +  conditions, time-outs etc.
   16.24  
   16.25 -  Threads lack the memory protection of separate processes, but
   16.26 +  Threads lack the memory protection of separate processes, and
   16.27    operate concurrently on shared heap memory.  This has the advantage
   16.28    that results of independent computations are immediately available
   16.29 -  to other threads, without requiring explicit communication,
   16.30 -  reloading, or even recoding of data.
   16.31 +  to other threads, without requiring untyped character streams,
   16.32 +  awkward serialization etc.
   16.33  
   16.34    On the other hand, some programming guidelines need to be observed
   16.35    in order to make unprotected parallelism work out smoothly.  While
   16.36 @@ -143,27 +148,29 @@
   16.37  
   16.38    \end{itemize}
   16.39  
   16.40 -  Note that ML bindings within the toplevel environment (@{verbatim
   16.41 -  "type"}, @{verbatim val}, @{verbatim "structure"} etc.) due to
   16.42 -  run-time invocation of the compiler are non-critical, because
   16.43 -  Isabelle/Isar incorporates such bindings within the theory or proof
   16.44 -  context.
   16.45 -
   16.46    The majority of tools implemented within the Isabelle/Isar framework
   16.47    will not require any of these critical elements: nothing special
   16.48    needs to be observed when staying in the purely functional fragment
   16.49    of ML.  Note that output via the official Isabelle channels does not
   16.50 -  even count as direct I/O in the above sense, so the operations @{ML
   16.51 -  "writeln"}, @{ML "warning"}, @{ML "tracing"} etc.\ are safe.
   16.52 +  count as direct I/O, so the operations @{ML "writeln"}, @{ML
   16.53 +  "warning"}, @{ML "tracing"} etc.\ are safe.
   16.54 +
   16.55 +  Moreover, ML bindings within the toplevel environment (@{verbatim
   16.56 +  "type"}, @{verbatim val}, @{verbatim "structure"} etc.) due to
   16.57 +  run-time invocation of the compiler are also safe, because
   16.58 +  Isabelle/Isar manages this as part of the theory or proof context.
   16.59  
   16.60 -  \paragraph{Multithreading in Isabelle/Isar.}  Our parallel execution
   16.61 -  model is centered around the theory loader.  Whenever a given
   16.62 -  subgraph of theories needs to be updated, the system schedules a
   16.63 -  number of threads to process the sources as required, while
   16.64 -  observing their dependencies.  Thus concurrency is limited to
   16.65 -  independent nodes according to the theory import relation.
   16.66 +  \paragraph{Multithreading in Isabelle/Isar.}  The theory loader
   16.67 +  automatically exploits the overall parallelism of independent nodes
   16.68 +  in the development graph, as well as the inherent irrelevance of
   16.69 +  proofs for goals being fully specified in advance.  This means,
   16.70 +  checking of individual Isar proofs is parallelized by default.
   16.71 +  Beyond that, very sophisticated proof tools may use local
   16.72 +  parallelism internally, via the general programming model of
   16.73 +  ``future values'' (see also @{"file"
   16.74 +  "~~/src/Pure/Concurrent/future.ML"}).
   16.75  
   16.76 -  Any user-code that works relatively to the present background theory
   16.77 +  Any ML code that works relatively to the present background theory
   16.78    is already safe.  Contextual data may be easily stored within the
   16.79    theory or proof context, thanks to the generic data concept of
   16.80    Isabelle/Isar (see \secref{sec:context-data}).  This greatly
   16.81 @@ -179,9 +186,13 @@
   16.82    quickly, otherwise parallel execution performance may degrade
   16.83    significantly.
   16.84  
   16.85 -  Despite this potential bottle-neck, we refrain from fine-grained
   16.86 -  locking mechanism within user-code: the restriction to a single lock
   16.87 -  prevents deadlocks without demanding special precautions.
   16.88 +  Despite this potential bottle-neck, centralized locking is
   16.89 +  convenient, because it prevents deadlocks without demanding special
   16.90 +  precautions.  Explicit communication demands other means, though.
   16.91 +  The high-level abstraction of synchronized variables @{"file"
   16.92 +  "~~/src/Pure/Concurrent/synchronized.ML"} enables parallel
   16.93 +  components to communicate via shared state; see also @{"file"
   16.94 +  "~~/src/Pure/Concurrent/mailbox.ML"} as canonical example.
   16.95  
   16.96    \paragraph{Good conduct of impure programs.} The following
   16.97    guidelines enable non-functional programs to participate in
    17.1 --- a/doc-src/IsarImplementation/Thy/document/ML.tex	Tue Dec 30 08:18:54 2008 +0100
    17.2 +++ b/doc-src/IsarImplementation/Thy/document/ML.tex	Tue Dec 30 11:10:01 2008 +0100
    17.3 @@ -128,18 +128,23 @@
    17.4  \isamarkuptrue%
    17.5  %
    17.6  \begin{isamarkuptext}%
    17.7 -Recent versions of Poly/ML (5.2 or later) support multithreaded
    17.8 -  execution based on native operating system threads of the underlying
    17.9 -  platform.  Thus threads will actually be executed in parallel on
   17.10 -  multi-core systems.  A speedup-factor of approximately 2--4 can be
   17.11 -  expected for large well-structured Isabelle sessions, where theories
   17.12 -  are organized as a graph with sufficiently many independent nodes.
   17.13 +Recent versions of Poly/ML (5.2.1 or later) support robust
   17.14 +  multithreaded execution, based on native operating system threads of
   17.15 +  the underlying platform.  Thus threads will actually be executed in
   17.16 +  parallel on multi-core systems.  A speedup-factor of approximately
   17.17 +  1.5--3 can be expected on a regular 4-core machine.\footnote{There
   17.18 +  is some inherent limitation of the speedup factor due to garbage
   17.19 +  collection, which is still sequential.  It helps to provide initial
   17.20 +  heap space generously, using the \texttt{-H} option of Poly/ML.}
   17.21 +  Threads also help to organize advanced operations of the system,
   17.22 +  with explicit communication between sub-components, real-time
   17.23 +  conditions, time-outs etc.
   17.24  
   17.25 -  Threads lack the memory protection of separate processes, but
   17.26 +  Threads lack the memory protection of separate processes, and
   17.27    operate concurrently on shared heap memory.  This has the advantage
   17.28    that results of independent computations are immediately available
   17.29 -  to other threads, without requiring explicit communication,
   17.30 -  reloading, or even recoding of data.
   17.31 +  to other threads, without requiring untyped character streams,
   17.32 +  awkward serialization etc.
   17.33  
   17.34    On the other hand, some programming guidelines need to be observed
   17.35    in order to make unprotected parallelism work out smoothly.  While
   17.36 @@ -163,25 +168,26 @@
   17.37  
   17.38    \end{itemize}
   17.39  
   17.40 -  Note that ML bindings within the toplevel environment (\verb|type|, \verb|val|, \verb|structure| etc.) due to
   17.41 -  run-time invocation of the compiler are non-critical, because
   17.42 -  Isabelle/Isar incorporates such bindings within the theory or proof
   17.43 -  context.
   17.44 -
   17.45    The majority of tools implemented within the Isabelle/Isar framework
   17.46    will not require any of these critical elements: nothing special
   17.47    needs to be observed when staying in the purely functional fragment
   17.48    of ML.  Note that output via the official Isabelle channels does not
   17.49 -  even count as direct I/O in the above sense, so the operations \verb|writeln|, \verb|warning|, \verb|tracing| etc.\ are safe.
   17.50 +  count as direct I/O, so the operations \verb|writeln|, \verb|warning|, \verb|tracing| etc.\ are safe.
   17.51 +
   17.52 +  Moreover, ML bindings within the toplevel environment (\verb|type|, \verb|val|, \verb|structure| etc.) due to
   17.53 +  run-time invocation of the compiler are also safe, because
   17.54 +  Isabelle/Isar manages this as part of the theory or proof context.
   17.55  
   17.56 -  \paragraph{Multithreading in Isabelle/Isar.}  Our parallel execution
   17.57 -  model is centered around the theory loader.  Whenever a given
   17.58 -  subgraph of theories needs to be updated, the system schedules a
   17.59 -  number of threads to process the sources as required, while
   17.60 -  observing their dependencies.  Thus concurrency is limited to
   17.61 -  independent nodes according to the theory import relation.
   17.62 +  \paragraph{Multithreading in Isabelle/Isar.}  The theory loader
   17.63 +  automatically exploits the overall parallelism of independent nodes
   17.64 +  in the development graph, as well as the inherent irrelevance of
   17.65 +  proofs for goals being fully specified in advance.  This means,
   17.66 +  checking of individual Isar proofs is parallelized by default.
   17.67 +  Beyond that, very sophisticated proof tools may use local
   17.68 +  parallelism internally, via the general programming model of
   17.69 +  ``future values'' (see also \hyperlink{file.~~/src/Pure/Concurrent/future.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Concurrent{\isacharslash}future{\isachardot}ML}}}}).
   17.70  
   17.71 -  Any user-code that works relatively to the present background theory
   17.72 +  Any ML code that works relatively to the present background theory
   17.73    is already safe.  Contextual data may be easily stored within the
   17.74    theory or proof context, thanks to the generic data concept of
   17.75    Isabelle/Isar (see \secref{sec:context-data}).  This greatly
   17.76 @@ -197,9 +203,11 @@
   17.77    quickly, otherwise parallel execution performance may degrade
   17.78    significantly.
   17.79  
   17.80 -  Despite this potential bottle-neck, we refrain from fine-grained
   17.81 -  locking mechanism within user-code: the restriction to a single lock
   17.82 -  prevents deadlocks without demanding special precautions.
   17.83 +  Despite this potential bottle-neck, centralized locking is
   17.84 +  convenient, because it prevents deadlocks without demanding special
   17.85 +  precautions.  Explicit communication demands other means, though.
   17.86 +  The high-level abstraction of synchronized variables \hyperlink{file.~~/src/Pure/Concurrent/synchronized.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Concurrent{\isacharslash}synchronized{\isachardot}ML}}}} enables parallel
   17.87 +  components to communicate via shared state; see also \hyperlink{file.~~/src/Pure/Concurrent/mailbox.ML}{\mbox{\isa{\isatt{{\isachartilde}{\isachartilde}{\isacharslash}src{\isacharslash}Pure{\isacharslash}Concurrent{\isacharslash}mailbox{\isachardot}ML}}}} as canonical example.
   17.88  
   17.89    \paragraph{Good conduct of impure programs.} The following
   17.90    guidelines enable non-functional programs to participate in
    18.1 --- a/doc-src/IsarRef/Thy/HOL_Specific.thy	Tue Dec 30 08:18:54 2008 +0100
    18.2 +++ b/doc-src/IsarRef/Thy/HOL_Specific.thy	Tue Dec 30 11:10:01 2008 +0100
    18.3 @@ -804,12 +804,15 @@
    18.4      @{command_def (HOL) "print_atps"}@{text "\<^sup>*"} & : & @{text "context \<rightarrow>"} \\
    18.5      @{command_def (HOL) "atp_info"}@{text "\<^sup>*"} & : & @{text "any \<rightarrow>"} \\
    18.6      @{command_def (HOL) "atp_kill"}@{text "\<^sup>*"} & : & @{text "any \<rightarrow>"} \\
    18.7 +    @{command_def (HOL) "atp_messages"}@{text "\<^sup>*"} & : & @{text "any \<rightarrow>"} \\
    18.8      @{method_def (HOL) metis} & : & @{text method} \\
    18.9    \end{matharray}
   18.10  
   18.11    \begin{rail}
   18.12    'sledgehammer' (nameref *)
   18.13    ;
   18.14 +  'atp\_messages' ('(' nat ')')?
   18.15 +  ;
   18.16  
   18.17    'metis' thmrefs
   18.18    ;
   18.19 @@ -842,6 +845,12 @@
   18.20    \item @{command (HOL) atp_kill} terminates all presently running
   18.21    provers.
   18.22  
   18.23 +  \item @{command (HOL) atp_messages} displays recent messages issued
   18.24 +  by automated theorem provers.  This allows to examine results that
   18.25 +  might have got lost due to the asynchronous nature of default
   18.26 +  @{command (HOL) sledgehammer} output.  An optional message limit may
   18.27 +  be specified (default 5).
   18.28 +
   18.29    \item @{method (HOL) metis}~@{text "facts"} invokes the Metis prover
   18.30    with the given facts.  Metis is an automated proof tool of medium
   18.31    strength, but is fully integrated into Isabelle/HOL, with explicit
    19.1 --- a/doc-src/IsarRef/Thy/Inner_Syntax.thy	Tue Dec 30 08:18:54 2008 +0100
    19.2 +++ b/doc-src/IsarRef/Thy/Inner_Syntax.thy	Tue Dec 30 11:10:01 2008 +0100
    19.3 @@ -683,17 +683,23 @@
    19.4      @{syntax_def (inner) tid} & = & @{syntax_ref typefree} \\
    19.5      @{syntax_def (inner) tvar} & = & @{syntax_ref typevar} \\
    19.6      @{syntax_def (inner) num} & = & @{syntax_ref nat}@{text "  |  "}@{verbatim "-"}@{syntax_ref nat} \\
    19.7 +    @{syntax_def (inner) float_token} & = & @{syntax_ref nat}@{verbatim "."}@{syntax_ref nat}@{text "  |  "}@{verbatim "-"}@{syntax_ref nat}@{verbatim "."}@{syntax_ref nat} \\
    19.8      @{syntax_def (inner) xnum} & = & @{verbatim "#"}@{syntax_ref nat}@{text "  |  "}@{verbatim "#-"}@{syntax_ref nat} \\
    19.9  
   19.10      @{syntax_def (inner) xstr} & = & @{verbatim "''"} @{text "\<dots>"} @{verbatim "''"} \\
   19.11    \end{supertabular}
   19.12    \end{center}
   19.13  
   19.14 -  The token categories @{syntax_ref (inner) num}, @{syntax_ref (inner)
   19.15 -  xnum}, and @{syntax_ref (inner) xstr} are not used in Pure.
   19.16 -  Object-logics may implement numerals and string constants by adding
   19.17 -  appropriate syntax declarations, together with some translation
   19.18 -  functions (e.g.\ see Isabelle/HOL).
   19.19 +  The token categories @{syntax (inner) num}, @{syntax (inner)
   19.20 +  float_token}, @{syntax (inner) xnum}, and @{syntax (inner) xstr} are
   19.21 +  not used in Pure.  Object-logics may implement numerals and string
   19.22 +  constants by adding appropriate syntax declarations, together with
   19.23 +  some translation functions (e.g.\ see Isabelle/HOL).
   19.24 +
   19.25 +  The derived categories @{syntax_def (inner) num_const} and
   19.26 +  @{syntax_def (inner) float_const} provide robust access to @{syntax
   19.27 +  (inner) num}, and @{syntax (inner) float_token}, respectively: the
   19.28 +  syntax tree holds a syntactic constant instead of a free variable.
   19.29  *}
   19.30  
   19.31  
    20.1 --- a/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Tue Dec 30 08:18:54 2008 +0100
    20.2 +++ b/doc-src/IsarRef/Thy/document/HOL_Specific.tex	Tue Dec 30 11:10:01 2008 +0100
    20.3 @@ -814,12 +814,15 @@
    20.4      \indexdef{HOL}{command}{print\_atps}\hypertarget{command.HOL.print-atps}{\hyperlink{command.HOL.print-atps}{\mbox{\isa{\isacommand{print{\isacharunderscore}atps}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}context\ {\isasymrightarrow}{\isachardoublequote}} \\
    20.5      \indexdef{HOL}{command}{atp\_info}\hypertarget{command.HOL.atp-info}{\hyperlink{command.HOL.atp-info}{\mbox{\isa{\isacommand{atp{\isacharunderscore}info}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}any\ {\isasymrightarrow}{\isachardoublequote}} \\
    20.6      \indexdef{HOL}{command}{atp\_kill}\hypertarget{command.HOL.atp-kill}{\hyperlink{command.HOL.atp-kill}{\mbox{\isa{\isacommand{atp{\isacharunderscore}kill}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}any\ {\isasymrightarrow}{\isachardoublequote}} \\
    20.7 +    \indexdef{HOL}{command}{atp\_messages}\hypertarget{command.HOL.atp-messages}{\hyperlink{command.HOL.atp-messages}{\mbox{\isa{\isacommand{atp{\isacharunderscore}messages}}}}}\isa{{\isachardoublequote}\isactrlsup {\isacharasterisk}{\isachardoublequote}} & : & \isa{{\isachardoublequote}any\ {\isasymrightarrow}{\isachardoublequote}} \\
    20.8      \indexdef{HOL}{method}{metis}\hypertarget{method.HOL.metis}{\hyperlink{method.HOL.metis}{\mbox{\isa{metis}}}} & : & \isa{method} \\
    20.9    \end{matharray}
   20.10  
   20.11    \begin{rail}
   20.12    'sledgehammer' (nameref *)
   20.13    ;
   20.14 +  'atp\_messages' ('(' nat ')')?
   20.15 +  ;
   20.16  
   20.17    'metis' thmrefs
   20.18    ;
   20.19 @@ -850,6 +853,12 @@
   20.20    \item \hyperlink{command.HOL.atp-kill}{\mbox{\isa{\isacommand{atp{\isacharunderscore}kill}}}} terminates all presently running
   20.21    provers.
   20.22  
   20.23 +  \item \hyperlink{command.HOL.atp-messages}{\mbox{\isa{\isacommand{atp{\isacharunderscore}messages}}}} displays recent messages issued
   20.24 +  by automated theorem provers.  This allows to examine results that
   20.25 +  might have got lost due to the asynchronous nature of default
   20.26 +  \hyperlink{command.HOL.sledgehammer}{\mbox{\isa{\isacommand{sledgehammer}}}} output.  An optional message limit may
   20.27 +  be specified (default 5).
   20.28 +
   20.29    \item \hyperlink{method.HOL.metis}{\mbox{\isa{metis}}}~\isa{{\isachardoublequote}facts{\isachardoublequote}} invokes the Metis prover
   20.30    with the given facts.  Metis is an automated proof tool of medium
   20.31    strength, but is fully integrated into Isabelle/HOL, with explicit
    21.1 --- a/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Tue Dec 30 08:18:54 2008 +0100
    21.2 +++ b/doc-src/IsarRef/Thy/document/Inner_Syntax.tex	Tue Dec 30 11:10:01 2008 +0100
    21.3 @@ -702,16 +702,21 @@
    21.4      \indexdef{inner}{syntax}{tid}\hypertarget{syntax.inner.tid}{\hyperlink{syntax.inner.tid}{\mbox{\isa{tid}}}} & = & \indexref{}{syntax}{typefree}\hyperlink{syntax.typefree}{\mbox{\isa{typefree}}} \\
    21.5      \indexdef{inner}{syntax}{tvar}\hypertarget{syntax.inner.tvar}{\hyperlink{syntax.inner.tvar}{\mbox{\isa{tvar}}}} & = & \indexref{}{syntax}{typevar}\hyperlink{syntax.typevar}{\mbox{\isa{typevar}}} \\
    21.6      \indexdef{inner}{syntax}{num}\hypertarget{syntax.inner.num}{\hyperlink{syntax.inner.num}{\mbox{\isa{num}}}} & = & \indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|-|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}} \\
    21.7 +    \indexdef{inner}{syntax}{float\_token}\hypertarget{syntax.inner.float-token}{\hyperlink{syntax.inner.float-token}{\mbox{\isa{float{\isacharunderscore}token}}}} & = & \indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\verb|.|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|-|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\verb|.|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}} \\
    21.8      \indexdef{inner}{syntax}{xnum}\hypertarget{syntax.inner.xnum}{\hyperlink{syntax.inner.xnum}{\mbox{\isa{xnum}}}} & = & \verb|#|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}}\isa{{\isachardoublequote}\ \ {\isacharbar}\ \ {\isachardoublequote}}\verb|#-|\indexref{}{syntax}{nat}\hyperlink{syntax.nat}{\mbox{\isa{nat}}} \\
    21.9  
   21.10      \indexdef{inner}{syntax}{xstr}\hypertarget{syntax.inner.xstr}{\hyperlink{syntax.inner.xstr}{\mbox{\isa{xstr}}}} & = & \verb|''| \isa{{\isachardoublequote}{\isasymdots}{\isachardoublequote}} \verb|''| \\
   21.11    \end{supertabular}
   21.12    \end{center}
   21.13  
   21.14 -  The token categories \indexref{inner}{syntax}{num}\hyperlink{syntax.inner.num}{\mbox{\isa{num}}}, \indexref{inner}{syntax}{xnum}\hyperlink{syntax.inner.xnum}{\mbox{\isa{xnum}}}, and \indexref{inner}{syntax}{xstr}\hyperlink{syntax.inner.xstr}{\mbox{\isa{xstr}}} are not used in Pure.
   21.15 -  Object-logics may implement numerals and string constants by adding
   21.16 -  appropriate syntax declarations, together with some translation
   21.17 -  functions (e.g.\ see Isabelle/HOL).%
   21.18 +  The token categories \hyperlink{syntax.inner.num}{\mbox{\isa{num}}}, \hyperlink{syntax.inner.float-token}{\mbox{\isa{float{\isacharunderscore}token}}}, \hyperlink{syntax.inner.xnum}{\mbox{\isa{xnum}}}, and \hyperlink{syntax.inner.xstr}{\mbox{\isa{xstr}}} are
   21.19 +  not used in Pure.  Object-logics may implement numerals and string
   21.20 +  constants by adding appropriate syntax declarations, together with
   21.21 +  some translation functions (e.g.\ see Isabelle/HOL).
   21.22 +
   21.23 +  The derived categories \indexdef{inner}{syntax}{num\_const}\hypertarget{syntax.inner.num-const}{\hyperlink{syntax.inner.num-const}{\mbox{\isa{num{\isacharunderscore}const}}}} and
   21.24 +  \indexdef{inner}{syntax}{float\_const}\hypertarget{syntax.inner.float-const}{\hyperlink{syntax.inner.float-const}{\mbox{\isa{float{\isacharunderscore}const}}}} provide robust access to \hyperlink{syntax.inner.num}{\mbox{\isa{num}}}, and \hyperlink{syntax.inner.float-token}{\mbox{\isa{float{\isacharunderscore}token}}}, respectively: the
   21.25 +  syntax tree holds a syntactic constant instead of a free variable.%
   21.26  \end{isamarkuptext}%
   21.27  \isamarkuptrue%
   21.28  %
    22.1 --- a/etc/isar-keywords-ZF.el	Tue Dec 30 08:18:54 2008 +0100
    22.2 +++ b/etc/isar-keywords-ZF.el	Tue Dec 30 11:10:01 2008 +0100
    22.3 @@ -200,7 +200,6 @@
    22.4      "use"
    22.5      "use_thy"
    22.6      "using"
    22.7 -    "value"
    22.8      "welcome"
    22.9      "with"
   22.10      "{"
   22.11 @@ -323,7 +322,6 @@
   22.12      "typ"
   22.13      "unused_thms"
   22.14      "use_thy"
   22.15 -    "value"
   22.16      "welcome"))
   22.17  
   22.18  (defconst isar-keywords-theory-begin
    23.1 --- a/etc/isar-keywords.el	Tue Dec 30 08:18:54 2008 +0100
    23.2 +++ b/etc/isar-keywords.el	Tue Dec 30 11:10:01 2008 +0100
    23.3 @@ -32,6 +32,7 @@
    23.4      "atom_decl"
    23.5      "atp_info"
    23.6      "atp_kill"
    23.7 +    "atp_messages"
    23.8      "automaton"
    23.9      "ax_specification"
   23.10      "axclass"
   23.11 @@ -334,6 +335,7 @@
   23.12      "ML_val"
   23.13      "atp_info"
   23.14      "atp_kill"
   23.15 +    "atp_messages"
   23.16      "cd"
   23.17      "class_deps"
   23.18      "code_deps"
    24.1 --- a/etc/proofgeneral-settings.el	Tue Dec 30 08:18:54 2008 +0100
    24.2 +++ b/etc/proofgeneral-settings.el	Tue Dec 30 11:10:01 2008 +0100
    24.3 @@ -1,6 +1,3 @@
    24.4 -;;;
    24.5 -;;; $Id$
    24.6 -;;;
    24.7  ;;; Options for Proof General
    24.8  
    24.9  ;; Examples for sensible settings:
    25.1 --- a/etc/settings	Tue Dec 30 08:18:54 2008 +0100
    25.2 +++ b/etc/settings	Tue Dec 30 11:10:01 2008 +0100
    25.3 @@ -1,5 +1,4 @@
    25.4  # -*- shell-script -*- :mode=shellscript:
    25.5 -# $Id$
    25.6  #
    25.7  # Isabelle settings -- site defaults.
    25.8  #
    25.9 @@ -202,9 +201,8 @@
   25.10    "/opt/ProofGeneral" \
   25.11    "")
   25.12  
   25.13 -PROOFGENERAL_EMACS=$(choosefrom /Applications/Emacs.app/Contents/MacOS/Emacs emacs22)
   25.14 -PROOFGENERAL_OPTIONS="-p $PROOFGENERAL_EMACS"
   25.15 -#PROOFGENERAL_OPTIONS="-m no_brackets -m no_type_brackets -x true -p $PROOFGENERAL_EMACS"
   25.16 +PROOFGENERAL_OPTIONS=""
   25.17 +#PROOFGENERAL_OPTIONS="-m no_brackets -m no_type_brackets"
   25.18  
   25.19  # Automatic setup of remote fonts
   25.20  #XSYMBOL_INSTALLFONTS="xset fp+ tcp/isafonts.informatik.tu-muenchen.de:7200"
    26.1 --- a/etc/symbols	Tue Dec 30 08:18:54 2008 +0100
    26.2 +++ b/etc/symbols	Tue Dec 30 11:10:01 2008 +0100
    26.3 @@ -1,4 +1,3 @@
    26.4 -# $Id$
    26.5  # Default interpretation of some Isabelle symbols
    26.6  
    26.7  \<zero>                 code: 0x01d7ec  font: Isabelle
    27.1 --- a/etc/user-settings.sample	Tue Dec 30 08:18:54 2008 +0100
    27.2 +++ b/etc/user-settings.sample	Tue Dec 30 11:10:01 2008 +0100
    27.3 @@ -1,5 +1,4 @@
    27.4  # -*- shell-script -*-
    27.5 -# $Id$
    27.6  #
    27.7  # Isabelle user settings sample -- for use in ~/.isabelle/etc/settings
    27.8  
    28.1 --- a/lib/Tools/browser	Tue Dec 30 08:18:54 2008 +0100
    28.2 +++ b/lib/Tools/browser	Tue Dec 30 11:10:01 2008 +0100
    28.3 @@ -1,6 +1,5 @@
    28.4  #!/usr/bin/env bash
    28.5  #
    28.6 -# $Id$
    28.7  # Author: Markus Wenzel, TU Muenchen
    28.8  #
    28.9  # DESCRIPTION: Isabelle graph browser
    29.1 --- a/lib/Tools/codegen	Tue Dec 30 08:18:54 2008 +0100
    29.2 +++ b/lib/Tools/codegen	Tue Dec 30 11:10:01 2008 +0100
    29.3 @@ -1,6 +1,5 @@
    29.4  #!/usr/bin/env bash
    29.5  #
    29.6 -# $Id$
    29.7  # Author: Florian Haftmann, TUM
    29.8  #
    29.9  # DESCRIPTION: issue code generation from shell
    30.1 --- a/lib/Tools/dimacs2hol	Tue Dec 30 08:18:54 2008 +0100
    30.2 +++ b/lib/Tools/dimacs2hol	Tue Dec 30 11:10:01 2008 +0100
    30.3 @@ -1,8 +1,6 @@
    30.4  #!/usr/bin/env bash
    30.5  #
    30.6 -# $Id$
    30.7  # Author: Tjark Weber
    30.8 -# Copyright 2004
    30.9  #
   30.10  # DESCRIPTION: convert DIMACS CNF files into Isabelle/HOL theories
   30.11  
    31.1 --- a/lib/Tools/display	Tue Dec 30 08:18:54 2008 +0100
    31.2 +++ b/lib/Tools/display	Tue Dec 30 11:10:01 2008 +0100
    31.3 @@ -1,6 +1,5 @@
    31.4  #!/usr/bin/env bash
    31.5  #
    31.6 -# $Id$
    31.7  # Author: Markus Wenzel, TU Muenchen
    31.8  #
    31.9  # DESCRIPTION: display document (in DVI or PDF format)
    32.1 --- a/lib/Tools/doc	Tue Dec 30 08:18:54 2008 +0100
    32.2 +++ b/lib/Tools/doc	Tue Dec 30 11:10:01 2008 +0100
    32.3 @@ -1,6 +1,5 @@
    32.4  #!/usr/bin/env bash
    32.5  #
    32.6 -# $Id$
    32.7  # Author: Markus Wenzel, TU Muenchen
    32.8  #
    32.9  # DESCRIPTION: view Isabelle documentation
    33.1 --- a/lib/Tools/document	Tue Dec 30 08:18:54 2008 +0100
    33.2 +++ b/lib/Tools/document	Tue Dec 30 11:10:01 2008 +0100
    33.3 @@ -1,6 +1,5 @@
    33.4  #!/usr/bin/env bash
    33.5  #
    33.6 -# $Id$
    33.7  # Author: Markus Wenzel, TU Muenchen
    33.8  #
    33.9  # DESCRIPTION: prepare theory session document
    34.1 --- a/lib/Tools/emacs	Tue Dec 30 08:18:54 2008 +0100
    34.2 +++ b/lib/Tools/emacs	Tue Dec 30 11:10:01 2008 +0100
    34.3 @@ -1,6 +1,5 @@
    34.4  #!/usr/bin/env bash
    34.5  #
    34.6 -# $Id$
    34.7  # Author: Makarius
    34.8  #
    34.9  # DESCRIPTION: Proof General / Emacs interface wrapper
    35.1 --- a/lib/Tools/env	Tue Dec 30 08:18:54 2008 +0100
    35.2 +++ b/lib/Tools/env	Tue Dec 30 11:10:01 2008 +0100
    35.3 @@ -1,6 +1,5 @@
    35.4  #!/usr/bin/env bash
    35.5  #
    35.6 -# $Id$
    35.7  # Author: Markus Wenzel, TU Muenchen
    35.8  #
    35.9  # DESCRIPTION: run a program in a modified environment
    36.1 --- a/lib/Tools/findlogics	Tue Dec 30 08:18:54 2008 +0100
    36.2 +++ b/lib/Tools/findlogics	Tue Dec 30 11:10:01 2008 +0100
    36.3 @@ -1,6 +1,5 @@
    36.4  #!/usr/bin/env bash
    36.5  #
    36.6 -# $Id$
    36.7  # Author: Markus Wenzel, TU Muenchen
    36.8  #
    36.9  # DESCRIPTION: collect heap names from ISABELLE_PATH
    37.1 --- a/lib/Tools/getenv	Tue Dec 30 08:18:54 2008 +0100
    37.2 +++ b/lib/Tools/getenv	Tue Dec 30 11:10:01 2008 +0100
    37.3 @@ -1,6 +1,5 @@
    37.4  #!/usr/bin/env bash
    37.5  #
    37.6 -# $Id$
    37.7  # Author: Markus Wenzel, TU Muenchen
    37.8  #
    37.9  # DESCRIPTION: get values from Isabelle settings environment
    38.1 --- a/lib/Tools/install	Tue Dec 30 08:18:54 2008 +0100
    38.2 +++ b/lib/Tools/install	Tue Dec 30 11:10:01 2008 +0100
    38.3 @@ -1,6 +1,5 @@
    38.4  #!/usr/bin/env bash
    38.5  #
    38.6 -# $Id$
    38.7  # Author: Markus Wenzel, TU Muenchen
    38.8  #
    38.9  # DESCRIPTION: install standalone Isabelle executables
    39.1 --- a/lib/Tools/java	Tue Dec 30 08:18:54 2008 +0100
    39.2 +++ b/lib/Tools/java	Tue Dec 30 11:10:01 2008 +0100
    39.3 @@ -1,6 +1,5 @@
    39.4  #!/usr/bin/env bash
    39.5  #
    39.6 -# $Id$
    39.7  # Author: Makarius
    39.8  #
    39.9  # DESCRIPTION: invoke Java within the Isabelle environment
    40.1 --- a/lib/Tools/jedit	Tue Dec 30 08:18:54 2008 +0100
    40.2 +++ b/lib/Tools/jedit	Tue Dec 30 11:10:01 2008 +0100
    40.3 @@ -1,6 +1,5 @@
    40.4  #!/usr/bin/env bash
    40.5  #
    40.6 -# $Id$
    40.7  # Author: Makarius
    40.8  #
    40.9  # DESCRIPTION: Isabelle/jEdit interface wrapper
    41.1 --- a/lib/Tools/keywords	Tue Dec 30 08:18:54 2008 +0100
    41.2 +++ b/lib/Tools/keywords	Tue Dec 30 11:10:01 2008 +0100
    41.3 @@ -1,6 +1,5 @@
    41.4  #!/usr/bin/env bash
    41.5  #
    41.6 -# $Id$
    41.7  # Author: Makarius
    41.8  #
    41.9  # DESCRIPTION: generate outer syntax keyword files from session logs
    42.1 --- a/lib/Tools/latex	Tue Dec 30 08:18:54 2008 +0100
    42.2 +++ b/lib/Tools/latex	Tue Dec 30 11:10:01 2008 +0100
    42.3 @@ -1,6 +1,5 @@
    42.4  #!/usr/bin/env bash
    42.5  #
    42.6 -# $Id$
    42.7  # Author: Markus Wenzel, TU Muenchen
    42.8  #
    42.9  # DESCRIPTION: run LaTeX (and related tools)
    43.1 --- a/lib/Tools/logo	Tue Dec 30 08:18:54 2008 +0100
    43.2 +++ b/lib/Tools/logo	Tue Dec 30 11:10:01 2008 +0100
    43.3 @@ -1,6 +1,5 @@
    43.4  #!/usr/bin/env bash
    43.5  #
    43.6 -# $Id$
    43.7  # Author: Markus Wenzel, TU Muenchen
    43.8  #
    43.9  # DESCRIPTION: create an instance of the Isabelle logo
    44.1 --- a/lib/Tools/make	Tue Dec 30 08:18:54 2008 +0100
    44.2 +++ b/lib/Tools/make	Tue Dec 30 11:10:01 2008 +0100
    44.3 @@ -1,6 +1,5 @@
    44.4  #!/usr/bin/env bash
    44.5  #
    44.6 -# $Id$
    44.7  # Author: Markus Wenzel, TU Muenchen
    44.8  #
    44.9  # DESCRIPTION: Isabelle make utility
    45.1 --- a/lib/Tools/makeall	Tue Dec 30 08:18:54 2008 +0100
    45.2 +++ b/lib/Tools/makeall	Tue Dec 30 11:10:01 2008 +0100
    45.3 @@ -1,6 +1,5 @@
    45.4  #!/usr/bin/env bash
    45.5  #
    45.6 -# $Id$
    45.7  # Author: Markus Wenzel, TU Muenchen
    45.8  #
    45.9  # DESCRIPTION: apply make utility to all logics
    46.1 --- a/lib/Tools/mkdir	Tue Dec 30 08:18:54 2008 +0100
    46.2 +++ b/lib/Tools/mkdir	Tue Dec 30 11:10:01 2008 +0100
    46.3 @@ -1,6 +1,5 @@
    46.4  #!/usr/bin/env bash
    46.5  #
    46.6 -# $Id$
    46.7  # Author: Markus Wenzel, TU Muenchen
    46.8  #
    46.9  # DESCRIPTION: prepare logic session directory
    47.1 --- a/lib/Tools/mkfifo	Tue Dec 30 08:18:54 2008 +0100
    47.2 +++ b/lib/Tools/mkfifo	Tue Dec 30 11:10:01 2008 +0100
    47.3 @@ -1,6 +1,5 @@
    47.4  #!/usr/bin/env bash
    47.5  #
    47.6 -# $Id$
    47.7  # Author: Makarius
    47.8  #
    47.9  # DESCRIPTION: create named pipe
    48.1 --- a/lib/Tools/mkproject	Tue Dec 30 08:18:54 2008 +0100
    48.2 +++ b/lib/Tools/mkproject	Tue Dec 30 11:10:01 2008 +0100
    48.3 @@ -1,7 +1,6 @@
    48.4  #!/usr/bin/env bash
    48.5  #
    48.6 -# $Id$
    48.7 -# Author: David Aspinall and Makarius Wenzel
    48.8 +# Author: David Aspinall
    48.9  #
   48.10  # DESCRIPTION: prepare a session directory for PG-Eclipse
   48.11  
    49.1 --- a/lib/Tools/print	Tue Dec 30 08:18:54 2008 +0100
    49.2 +++ b/lib/Tools/print	Tue Dec 30 11:10:01 2008 +0100
    49.3 @@ -1,6 +1,5 @@
    49.4  #!/usr/bin/env bash
    49.5  #
    49.6 -# $Id$
    49.7  # Author: Markus Wenzel, TU Muenchen
    49.8  #
    49.9  # DESCRIPTION: print document
    50.1 --- a/lib/Tools/rmfifo	Tue Dec 30 08:18:54 2008 +0100
    50.2 +++ b/lib/Tools/rmfifo	Tue Dec 30 11:10:01 2008 +0100
    50.3 @@ -1,6 +1,5 @@
    50.4  #!/usr/bin/env bash
    50.5  #
    50.6 -# $Id$
    50.7  # Author: Makarius
    50.8  #
    50.9  # DESCRIPTION: remove named pipe
    51.1 --- a/lib/Tools/scala	Tue Dec 30 08:18:54 2008 +0100
    51.2 +++ b/lib/Tools/scala	Tue Dec 30 11:10:01 2008 +0100
    51.3 @@ -1,6 +1,5 @@
    51.4  #!/usr/bin/env bash
    51.5  #
    51.6 -# $Id$
    51.7  # Author: Makarius
    51.8  #
    51.9  # DESCRIPTION: invoke Scala within the Isabelle environment
    52.1 --- a/lib/Tools/tty	Tue Dec 30 08:18:54 2008 +0100
    52.2 +++ b/lib/Tools/tty	Tue Dec 30 11:10:01 2008 +0100
    52.3 @@ -1,6 +1,5 @@
    52.4  #!/usr/bin/env bash
    52.5  #
    52.6 -# $Id$
    52.7  # Author: Markus Wenzel, TU Muenchen
    52.8  #
    52.9  # DESCRIPTION: run Isabelle process with plain tty interaction
    53.1 --- a/lib/Tools/unsymbolize	Tue Dec 30 08:18:54 2008 +0100
    53.2 +++ b/lib/Tools/unsymbolize	Tue Dec 30 11:10:01 2008 +0100
    53.3 @@ -1,6 +1,5 @@
    53.4  #!/usr/bin/env bash
    53.5  #
    53.6 -# $Id$
    53.7  # Author: Markus Wenzel, TU Muenchen
    53.8  #
    53.9  # DESCRIPTION: remove unreadable symbol names from sources
    54.1 --- a/lib/Tools/usedir	Tue Dec 30 08:18:54 2008 +0100
    54.2 +++ b/lib/Tools/usedir	Tue Dec 30 11:10:01 2008 +0100
    54.3 @@ -1,6 +1,5 @@
    54.4  #!/usr/bin/env bash
    54.5  #
    54.6 -# $Id$
    54.7  # Author: Markus Wenzel, TU Muenchen
    54.8  #
    54.9  # DESCRIPTION: build object-logic or run examples
   54.10 @@ -40,6 +39,11 @@
   54.11    echo "  ISABELLE_USEDIR_OPTIONS=$ISABELLE_USEDIR_OPTIONS"
   54.12    echo "  HOL_USEDIR_OPTIONS=$HOL_USEDIR_OPTIONS"
   54.13    echo
   54.14 +  echo "  ML_PLATFORM=$ML_PLATFORM"
   54.15 +  echo "  ML_HOME=$ML_HOME"
   54.16 +  echo "  ML_SYSTEM=$ML_SYSTEM"
   54.17 +  echo "  ML_OPTIONS=$ML_OPTIONS"
   54.18 +  echo
   54.19    exit 1
   54.20  }
   54.21  
    55.1 --- a/lib/Tools/version	Tue Dec 30 08:18:54 2008 +0100
    55.2 +++ b/lib/Tools/version	Tue Dec 30 11:10:01 2008 +0100
    55.3 @@ -1,6 +1,5 @@
    55.4  #!/usr/bin/env bash
    55.5  #
    55.6 -# $Id$
    55.7  # Author: Stefan Berghofer, TU Muenchen
    55.8  #
    55.9  # DESCRIPTION: display Isabelle version
    56.1 --- a/lib/Tools/yxml	Tue Dec 30 08:18:54 2008 +0100
    56.2 +++ b/lib/Tools/yxml	Tue Dec 30 11:10:01 2008 +0100
    56.3 @@ -1,6 +1,5 @@
    56.4  #!/usr/bin/env bash
    56.5  #
    56.6 -# $Id$
    56.7  # Author: Makarius
    56.8  #
    56.9  # DESCRIPTION: simple XML to YXML converter
    57.1 --- a/lib/jedit/isabelle.xml	Tue Dec 30 08:18:54 2008 +0100
    57.2 +++ b/lib/jedit/isabelle.xml	Tue Dec 30 11:10:01 2008 +0100
    57.3 @@ -56,6 +56,7 @@
    57.4        <OPERATOR>atom_decl</OPERATOR>
    57.5        <LABEL>atp_info</LABEL>
    57.6        <LABEL>atp_kill</LABEL>
    57.7 +      <LABEL>atp_messages</LABEL>
    57.8        <KEYWORD4>attach</KEYWORD4>
    57.9        <OPERATOR>automaton</OPERATOR>
   57.10        <KEYWORD4>avoids</KEYWORD4>
   57.11 @@ -154,7 +155,6 @@
   57.12        <KEYWORD4>if</KEYWORD4>
   57.13        <KEYWORD4>imports</KEYWORD4>
   57.14        <KEYWORD4>in</KEYWORD4>
   57.15 -      <KEYWORD4>includes</KEYWORD4>
   57.16        <KEYWORD4>induction</KEYWORD4>
   57.17        <OPERATOR>inductive</OPERATOR>
   57.18        <KEYWORD1>inductive_cases</KEYWORD1>
   57.19 @@ -286,6 +286,7 @@
   57.20        <OPERATOR>statespace</OPERATOR>
   57.21        <KEYWORD4>structure</KEYWORD4>
   57.22        <OPERATOR>subclass</OPERATOR>
   57.23 +      <OPERATOR>sublocale</OPERATOR>
   57.24        <OPERATOR>subsect</OPERATOR>
   57.25        <OPERATOR>subsection</OPERATOR>
   57.26        <OPERATOR>subsubsect</OPERATOR>
    58.1 --- a/lib/scripts/dimacs2hol.pl	Tue Dec 30 08:18:54 2008 +0100
    58.2 +++ b/lib/scripts/dimacs2hol.pl	Tue Dec 30 11:10:01 2008 +0100
    58.3 @@ -1,5 +1,3 @@
    58.4 -#
    58.5 -# $Id$
    58.6  #
    58.7  # dimacs2hol.pl - convert files in DIMACS CNF format [1] into Isabelle/HOL
    58.8  #                 theories
    59.1 --- a/lib/scripts/feeder	Tue Dec 30 08:18:54 2008 +0100
    59.2 +++ b/lib/scripts/feeder	Tue Dec 30 11:10:01 2008 +0100
    59.3 @@ -1,6 +1,5 @@
    59.4  #!/usr/bin/env bash
    59.5  #
    59.6 -# $Id$
    59.7  # Author: Markus Wenzel, TU Muenchen
    59.8  #
    59.9  # feeder - feed isabelle session
    60.1 --- a/lib/scripts/feeder.pl	Tue Dec 30 08:18:54 2008 +0100
    60.2 +++ b/lib/scripts/feeder.pl	Tue Dec 30 11:10:01 2008 +0100
    60.3 @@ -1,5 +1,4 @@
    60.4  #
    60.5 -# $Id$
    60.6  # Author: Markus Wenzel, TU Muenchen
    60.7  #
    60.8  # feeder.pl - feed isabelle session
    61.1 --- a/lib/scripts/fileident	Tue Dec 30 08:18:54 2008 +0100
    61.2 +++ b/lib/scripts/fileident	Tue Dec 30 11:10:01 2008 +0100
    61.3 @@ -1,7 +1,5 @@
    61.4  #!/usr/bin/env bash
    61.5  #
    61.6 -# $Id$
    61.7 -#
    61.8  # fileident --- produce file identification based
    61.9  
   61.10  FILE="$1"
    62.1 --- a/lib/scripts/getsettings	Tue Dec 30 08:18:54 2008 +0100
    62.2 +++ b/lib/scripts/getsettings	Tue Dec 30 11:10:01 2008 +0100
    62.3 @@ -1,5 +1,5 @@
    62.4  # -*- shell-script -*- :mode=shellscript:
    62.5 -# $Id$
    62.6 +#
    62.7  # Author: Markus Wenzel, TU Muenchen
    62.8  #
    62.9  # getsettings - bash source script to augment current env.
    63.1 --- a/lib/scripts/keywords.pl	Tue Dec 30 08:18:54 2008 +0100
    63.2 +++ b/lib/scripts/keywords.pl	Tue Dec 30 11:10:01 2008 +0100
    63.3 @@ -1,5 +1,4 @@
    63.4  #
    63.5 -# $Id$
    63.6  # Author: Makarius
    63.7  #
    63.8  # keywords.pl - generate outer syntax keyword files from session logs
    63.9 @@ -79,8 +78,6 @@
   63.10    print ";; Generated from ${sessions}.\n";
   63.11    print ";; *** DO NOT EDIT *** DO NOT EDIT *** DO NOT EDIT ***\n";
   63.12    print ";;\n";
   63.13 -  print ";; \$", "Id\$\n";
   63.14 -  print ";;\n";
   63.15  
   63.16    for my $kind (@kinds) {
   63.17      my @names;
   63.18 @@ -154,7 +151,6 @@
   63.19  EOF
   63.20    print "<!-- Generated from ${sessions}. -->\n";
   63.21    print "<!-- *** DO NOT EDIT *** DO NOT EDIT *** DO NOT EDIT *** -->\n";
   63.22 -  print "<!-- \$", "Id\$ -->\n";
   63.23    print <<'EOF';
   63.24  <MODE>
   63.25    <PROPS>
    64.1 --- a/lib/scripts/polyml-platform	Tue Dec 30 08:18:54 2008 +0100
    64.2 +++ b/lib/scripts/polyml-platform	Tue Dec 30 11:10:01 2008 +0100
    64.3 @@ -1,7 +1,5 @@
    64.4  #!/usr/bin/env bash
    64.5  #
    64.6 -# $Id$
    64.7 -#
    64.8  # polyml-platform --- determine Poly/ML's idea of current hardware and
    64.9  # operating system type
   64.10  #
    65.1 --- a/lib/scripts/polyml-version	Tue Dec 30 08:18:54 2008 +0100
    65.2 +++ b/lib/scripts/polyml-version	Tue Dec 30 11:10:01 2008 +0100
    65.3 @@ -1,7 +1,5 @@
    65.4  #!/usr/bin/env bash
    65.5  #
    65.6 -# $Id$
    65.7 -#
    65.8  # polyml-version --- determine Poly/ML runtime system version
    65.9  
   65.10  echo -n polyml
    66.1 --- a/lib/scripts/run-mosml	Tue Dec 30 08:18:54 2008 +0100
    66.2 +++ b/lib/scripts/run-mosml	Tue Dec 30 11:10:01 2008 +0100
    66.3 @@ -1,6 +1,5 @@
    66.4  #!/usr/bin/env bash
    66.5  #
    66.6 -# $Id$
    66.7  # Author: Markus Wenzel, TU Muenchen
    66.8  #
    66.9  # Moscow ML 2.00 startup script
    67.1 --- a/lib/scripts/run-polyml	Tue Dec 30 08:18:54 2008 +0100
    67.2 +++ b/lib/scripts/run-polyml	Tue Dec 30 11:10:01 2008 +0100
    67.3 @@ -1,6 +1,5 @@
    67.4  #!/usr/bin/env bash
    67.5  #
    67.6 -# $Id$
    67.7  # Author: Makarius
    67.8  #
    67.9  # Poly/ML 5.1/5.2 startup script.
    68.1 --- a/lib/scripts/run-polyml-4.1.3	Tue Dec 30 08:18:54 2008 +0100
    68.2 +++ b/lib/scripts/run-polyml-4.1.3	Tue Dec 30 11:10:01 2008 +0100
    68.3 @@ -1,6 +1,5 @@
    68.4  #!/usr/bin/env bash
    68.5  #
    68.6 -# $Id$
    68.7  # Author: Markus Wenzel, TU Muenchen
    68.8  #
    68.9  # Poly/ML 4.x startup script.
    69.1 --- a/lib/scripts/run-polyml-4.1.4	Tue Dec 30 08:18:54 2008 +0100
    69.2 +++ b/lib/scripts/run-polyml-4.1.4	Tue Dec 30 11:10:01 2008 +0100
    69.3 @@ -1,6 +1,5 @@
    69.4  #!/usr/bin/env bash
    69.5  #
    69.6 -# $Id$
    69.7  # Author: Markus Wenzel, TU Muenchen
    69.8  #
    69.9  # Poly/ML 4.x startup script.
    70.1 --- a/lib/scripts/run-polyml-4.2.0	Tue Dec 30 08:18:54 2008 +0100
    70.2 +++ b/lib/scripts/run-polyml-4.2.0	Tue Dec 30 11:10:01 2008 +0100
    70.3 @@ -1,6 +1,5 @@
    70.4  #!/usr/bin/env bash
    70.5  #
    70.6 -# $Id$
    70.7  # Author: Markus Wenzel, TU Muenchen
    70.8  #
    70.9  # Poly/ML 4.x startup script.
    71.1 --- a/lib/scripts/run-polyml-5.0	Tue Dec 30 08:18:54 2008 +0100
    71.2 +++ b/lib/scripts/run-polyml-5.0	Tue Dec 30 11:10:01 2008 +0100
    71.3 @@ -1,6 +1,5 @@
    71.4  #!/usr/bin/env bash
    71.5  #
    71.6 -# $Id$
    71.7  # Author: Makarius
    71.8  #
    71.9  # Poly/ML 5.0 startup script.
    72.1 --- a/lib/scripts/run-smlnj	Tue Dec 30 08:18:54 2008 +0100
    72.2 +++ b/lib/scripts/run-smlnj	Tue Dec 30 11:10:01 2008 +0100
    72.3 @@ -1,6 +1,5 @@
    72.4  #!/usr/bin/env bash
    72.5  #
    72.6 -# $Id$
    72.7  # Author: Markus Wenzel, TU Muenchen
    72.8  #
    72.9  # SML/NJ startup script (for 110 or later).
    73.1 --- a/lib/scripts/system.pl	Tue Dec 30 08:18:54 2008 +0100
    73.2 +++ b/lib/scripts/system.pl	Tue Dec 30 11:10:01 2008 +0100
    73.3 @@ -1,5 +1,4 @@
    73.4  #
    73.5 -# $Id$
    73.6  # Author: Makarius
    73.7  #
    73.8  # system.pl - invoke shell command line (with robust signal handling)
    74.1 --- a/lib/scripts/timestart.bash	Tue Dec 30 08:18:54 2008 +0100
    74.2 +++ b/lib/scripts/timestart.bash	Tue Dec 30 11:10:01 2008 +0100
    74.3 @@ -1,5 +1,5 @@
    74.4  # -*- shell-script -*-
    74.5 -# $Id$
    74.6 +#
    74.7  # Author: Makarius
    74.8  #
    74.9  # timestart - setup bash environment for timing.
    75.1 --- a/lib/scripts/timestop.bash	Tue Dec 30 08:18:54 2008 +0100
    75.2 +++ b/lib/scripts/timestop.bash	Tue Dec 30 11:10:01 2008 +0100
    75.3 @@ -1,5 +1,5 @@
    75.4  # -*- shell-script -*-
    75.5 -# $Id$
    75.6 +#
    75.7  # Author: Makarius
    75.8  #
    75.9  # timestop - report timing based on environment (cf. timestart.bash)
    76.1 --- a/lib/scripts/unsymbolize.pl	Tue Dec 30 08:18:54 2008 +0100
    76.2 +++ b/lib/scripts/unsymbolize.pl	Tue Dec 30 11:10:01 2008 +0100
    76.3 @@ -1,5 +1,4 @@
    76.4  #
    76.5 -# $Id$
    76.6  # Author: Markus Wenzel, TU Muenchen
    76.7  #
    76.8  # unsymbolize.pl - remove unreadable symbol names from sources
    77.1 --- a/lib/scripts/yxml.pl	Tue Dec 30 08:18:54 2008 +0100
    77.2 +++ b/lib/scripts/yxml.pl	Tue Dec 30 11:10:01 2008 +0100
    77.3 @@ -1,5 +1,4 @@
    77.4  #
    77.5 -# $Id$
    77.6  # Author: Makarius
    77.7  #
    77.8  # yxml.pl - simple XML to YXML converter
    78.1 --- a/lib/texinputs/draft.tex	Tue Dec 30 08:18:54 2008 +0100
    78.2 +++ b/lib/texinputs/draft.tex	Tue Dec 30 11:10:01 2008 +0100
    78.3 @@ -1,5 +1,3 @@
    78.4 -%%
    78.5 -%% $Id$
    78.6  %%
    78.7  %% root for draft documents
    78.8  %%
    79.1 --- a/lib/texinputs/isabelle.sty	Tue Dec 30 08:18:54 2008 +0100
    79.2 +++ b/lib/texinputs/isabelle.sty	Tue Dec 30 11:10:01 2008 +0100
    79.3 @@ -1,5 +1,3 @@
    79.4 -%%
    79.5 -%% $Id$
    79.6  %%
    79.7  %% macros for Isabelle generated LaTeX output
    79.8  %%
    80.1 --- a/lib/texinputs/isabellesym.sty	Tue Dec 30 08:18:54 2008 +0100
    80.2 +++ b/lib/texinputs/isabellesym.sty	Tue Dec 30 11:10:01 2008 +0100
    80.3 @@ -1,5 +1,3 @@
    80.4 -%%
    80.5 -%% $Id$
    80.6  %%
    80.7  %% definitions of standard Isabelle symbols
    80.8  %%
    81.1 --- a/lib/texinputs/pdfsetup.sty	Tue Dec 30 08:18:54 2008 +0100
    81.2 +++ b/lib/texinputs/pdfsetup.sty	Tue Dec 30 11:10:01 2008 +0100
    81.3 @@ -1,5 +1,3 @@
    81.4 -%%
    81.5 -%% $Id$
    81.6  %%
    81.7  %% default hyperref setup (both for pdf and dvi output)
    81.8  %%
    82.1 --- a/src/HOL/Code_Setup.thy	Tue Dec 30 08:18:54 2008 +0100
    82.2 +++ b/src/HOL/Code_Setup.thy	Tue Dec 30 11:10:01 2008 +0100
    82.3 @@ -198,6 +198,10 @@
    82.4  
    82.5  subsection {* Evaluation and normalization by evaluation *}
    82.6  
    82.7 +setup {*
    82.8 +  Value.add_evaluator ("SML", Codegen.eval_term o ProofContext.theory_of)
    82.9 +*}
   82.10 +
   82.11  ML {*
   82.12  structure Eval_Method =
   82.13  struct
   82.14 @@ -240,6 +244,10 @@
   82.15  
   82.16  subsection {* Quickcheck *}
   82.17  
   82.18 +setup {*
   82.19 +  Quickcheck.add_generator ("SML", Codegen.test_term)
   82.20 +*}
   82.21 +
   82.22  quickcheck_params [size = 5, iterations = 50]
   82.23  
   82.24  end
    83.1 --- a/src/HOL/Complex/Fundamental_Theorem_Algebra.thy	Tue Dec 30 08:18:54 2008 +0100
    83.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    83.3 @@ -1,1329 +0,0 @@
    83.4 -(*  Title:       Fundamental_Theorem_Algebra.thy
    83.5 -    Author:      Amine Chaieb
    83.6 -*)
    83.7 -
    83.8 -header{*Fundamental Theorem of Algebra*}
    83.9 -
   83.10 -theory Fundamental_Theorem_Algebra
   83.11 -imports "~~/src/HOL/Univ_Poly" "~~/src/HOL/Library/Dense_Linear_Order" "~~/src/HOL/Complex"
   83.12 -begin
   83.13 -
   83.14 -subsection {* Square root of complex numbers *}
   83.15 -definition csqrt :: "complex \<Rightarrow> complex" where
   83.16 -"csqrt z = (if Im z = 0 then
   83.17 -            if 0 \<le> Re z then Complex (sqrt(Re z)) 0
   83.18 -            else Complex 0 (sqrt(- Re z))
   83.19 -           else Complex (sqrt((cmod z + Re z) /2))
   83.20 -                        ((Im z / abs(Im z)) * sqrt((cmod z - Re z) /2)))"
   83.21 -
   83.22 -lemma csqrt[algebra]: "csqrt z ^ 2 = z"
   83.23 -proof-
   83.24 -  obtain x y where xy: "z = Complex x y" by (cases z, simp_all)
   83.25 -  {assume y0: "y = 0"
   83.26 -    {assume x0: "x \<ge> 0" 
   83.27 -      then have ?thesis using y0 xy real_sqrt_pow2[OF x0]
   83.28 -	by (simp add: csqrt_def power2_eq_square)}
   83.29 -    moreover
   83.30 -    {assume "\<not> x \<ge> 0" hence x0: "- x \<ge> 0" by arith
   83.31 -      then have ?thesis using y0 xy real_sqrt_pow2[OF x0] 
   83.32 -	by (simp add: csqrt_def power2_eq_square) }
   83.33 -    ultimately have ?thesis by blast}
   83.34 -  moreover
   83.35 -  {assume y0: "y\<noteq>0"
   83.36 -    {fix x y
   83.37 -      let ?z = "Complex x y"
   83.38 -      from abs_Re_le_cmod[of ?z] have tha: "abs x \<le> cmod ?z" by auto
   83.39 -      hence "cmod ?z - x \<ge> 0" "cmod ?z + x \<ge> 0" by arith+ 
   83.40 -      hence "(sqrt (x * x + y * y) + x) / 2 \<ge> 0" "(sqrt (x * x + y * y) - x) / 2 \<ge> 0" by (simp_all add: power2_eq_square) }
   83.41 -    note th = this
   83.42 -    have sq4: "\<And>x::real. x^2 / 4 = (x / 2) ^ 2" 
   83.43 -      by (simp add: power2_eq_square) 
   83.44 -    from th[of x y]
   83.45 -    have sq4': "sqrt (((sqrt (x * x + y * y) + x)^2 / 4)) = (sqrt (x * x + y * y) + x) / 2" "sqrt (((sqrt (x * x + y * y) - x)^2 / 4)) = (sqrt (x * x + y * y) - x) / 2" unfolding sq4 by simp_all
   83.46 -    then have th1: "sqrt ((sqrt (x * x + y * y) + x) * (sqrt (x * x + y * y) + x) / 4) - sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) - x) / 4) = x"
   83.47 -      unfolding power2_eq_square by simp 
   83.48 -    have "sqrt 4 = sqrt (2^2)" by simp 
   83.49 -    hence sqrt4: "sqrt 4 = 2" by (simp only: real_sqrt_abs)
   83.50 -    have th2: "2 *(y * sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) + x) / 4)) / \<bar>y\<bar> = y"
   83.51 -      using iffD2[OF real_sqrt_pow2_iff sum_power2_ge_zero[of x y]] y0
   83.52 -      unfolding power2_eq_square 
   83.53 -      by (simp add: ring_simps real_sqrt_divide sqrt4)
   83.54 -     from y0 xy have ?thesis  apply (simp add: csqrt_def power2_eq_square)
   83.55 -       apply (simp add: real_sqrt_sum_squares_mult_ge_zero[of x y] real_sqrt_pow2[OF th(1)[of x y], unfolded power2_eq_square] real_sqrt_pow2[OF th(2)[of x y], unfolded power2_eq_square] real_sqrt_mult[symmetric])
   83.56 -      using th1 th2  ..}
   83.57 -  ultimately show ?thesis by blast
   83.58 -qed
   83.59 -
   83.60 -
   83.61 -subsection{* More lemmas about module of complex numbers *}
   83.62 -
   83.63 -lemma complex_of_real_power: "complex_of_real x ^ n = complex_of_real (x^n)"
   83.64 -  by (rule of_real_power [symmetric])
   83.65 -
   83.66 -lemma real_down2: "(0::real) < d1 \<Longrightarrow> 0 < d2 ==> EX e. 0 < e & e < d1 & e < d2"
   83.67 -  apply ferrack apply arith done
   83.68 -
   83.69 -text{* The triangle inequality for cmod *}
   83.70 -lemma complex_mod_triangle_sub: "cmod w \<le> cmod (w + z) + norm z"
   83.71 -  using complex_mod_triangle_ineq2[of "w + z" "-z"] by auto
   83.72 -
   83.73 -subsection{* Basic lemmas about complex polynomials *}
   83.74 -
   83.75 -lemma poly_bound_exists:
   83.76 -  shows "\<exists>m. m > 0 \<and> (\<forall>z. cmod z <= r \<longrightarrow> cmod (poly p z) \<le> m)"
   83.77 -proof(induct p)
   83.78 -  case Nil thus ?case by (rule exI[where x=1], simp) 
   83.79 -next
   83.80 -  case (Cons c cs)
   83.81 -  from Cons.hyps obtain m where m: "\<forall>z. cmod z \<le> r \<longrightarrow> cmod (poly cs z) \<le> m"
   83.82 -    by blast
   83.83 -  let ?k = " 1 + cmod c + \<bar>r * m\<bar>"
   83.84 -  have kp: "?k > 0" using abs_ge_zero[of "r*m"] norm_ge_zero[of c] by arith
   83.85 -  {fix z
   83.86 -    assume H: "cmod z \<le> r"
   83.87 -    from m H have th: "cmod (poly cs z) \<le> m" by blast
   83.88 -    from H have rp: "r \<ge> 0" using norm_ge_zero[of z] by arith
   83.89 -    have "cmod (poly (c # cs) z) \<le> cmod c + cmod (z* poly cs z)"
   83.90 -      using norm_triangle_ineq[of c "z* poly cs z"] by simp
   83.91 -    also have "\<dots> \<le> cmod c + r*m" using mult_mono[OF H th rp norm_ge_zero[of "poly cs z"]] by (simp add: norm_mult)
   83.92 -    also have "\<dots> \<le> ?k" by simp
   83.93 -    finally have "cmod (poly (c # cs) z) \<le> ?k" .}
   83.94 -  with kp show ?case by blast
   83.95 -qed
   83.96 -
   83.97 -
   83.98 -text{* Offsetting the variable in a polynomial gives another of same degree *}
   83.99 -  (* FIXME : Lemma holds also in locale --- fix it later *)
  83.100 -lemma  poly_offset_lemma:
  83.101 -  shows "\<exists>b q. (length q = length p) \<and> (\<forall>x. poly (b#q) (x::complex) = (a + x) * poly p x)"
  83.102 -proof(induct p)
  83.103 -  case Nil thus ?case by simp
  83.104 -next
  83.105 -  case (Cons c cs)
  83.106 -  from Cons.hyps obtain b q where 
  83.107 -    bq: "length q = length cs" "\<forall>x. poly (b # q) x = (a + x) * poly cs x"
  83.108 -    by blast
  83.109 -  let ?b = "a*c"
  83.110 -  let ?q = "(b+c)#q"
  83.111 -  have lg: "length ?q = length (c#cs)" using bq(1) by simp
  83.112 -  {fix x
  83.113 -    from bq(2)[rule_format, of x]
  83.114 -    have "x*poly (b # q) x = x*((a + x) * poly cs x)" by simp
  83.115 -    hence "poly (?b# ?q) x = (a + x) * poly (c # cs) x"
  83.116 -      by (simp add: ring_simps)}
  83.117 -  with lg  show ?case by blast 
  83.118 -qed
  83.119 -
  83.120 -    (* FIXME : This one too*)
  83.121 -lemma poly_offset: "\<exists> q. length q = length p \<and> (\<forall>x. poly q (x::complex) = poly p (a + x))"
  83.122 -proof (induct p)
  83.123 -  case Nil thus ?case by simp
  83.124 -next
  83.125 -  case (Cons c cs)
  83.126 -  from Cons.hyps obtain q where q: "length q = length cs" "\<forall>x. poly q x = poly cs (a + x)" by blast
  83.127 -  from poly_offset_lemma[of q a] obtain b p where 
  83.128 -    bp: "length p = length q" "\<forall>x. poly (b # p) x = (a + x) * poly q x"
  83.129 -    by blast
  83.130 -  thus ?case using q bp by - (rule exI[where x="(c + b)#p"], simp)
  83.131 -qed
  83.132 -
  83.133 -text{* An alternative useful formulation of completeness of the reals *}
  83.134 -lemma real_sup_exists: assumes ex: "\<exists>x. P x" and bz: "\<exists>z. \<forall>x. P x \<longrightarrow> x < z"
  83.135 -  shows "\<exists>(s::real). \<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < s"
  83.136 -proof-
  83.137 -  from ex bz obtain x Y where x: "P x" and Y: "\<And>x. P x \<Longrightarrow> x < Y"  by blast
  83.138 -  from ex have thx:"\<exists>x. x \<in> Collect P" by blast
  83.139 -  from bz have thY: "\<exists>Y. isUb UNIV (Collect P) Y" 
  83.140 -    by(auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def order_le_less)
  83.141 -  from reals_complete[OF thx thY] obtain L where L: "isLub UNIV (Collect P) L"
  83.142 -    by blast
  83.143 -  from Y[OF x] have xY: "x < Y" .
  83.144 -  from L have L': "\<forall>x. P x \<longrightarrow> x \<le> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)  
  83.145 -  from Y have Y': "\<forall>x. P x \<longrightarrow> x \<le> Y" 
  83.146 -    apply (clarsimp, atomize (full)) by auto 
  83.147 -  from L Y' have "L \<le> Y" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)
  83.148 -  {fix y
  83.149 -    {fix z assume z: "P z" "y < z"
  83.150 -      from L' z have "y < L" by auto }
  83.151 -    moreover
  83.152 -    {assume yL: "y < L" "\<forall>z. P z \<longrightarrow> \<not> y < z"
  83.153 -      hence nox: "\<forall>z. P z \<longrightarrow> y \<ge> z" by auto
  83.154 -      from nox L have "y \<ge> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def) 
  83.155 -      with yL(1) have False  by arith}
  83.156 -    ultimately have "(\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < L" by blast}
  83.157 -  thus ?thesis by blast
  83.158 -qed
  83.159 -
  83.160 -
  83.161 -subsection{* Some theorems about Sequences*}
  83.162 -text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
  83.163 -
  83.164 -lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
  83.165 -  unfolding Ex1_def
  83.166 -  apply (rule_tac x="nat_rec e f" in exI)
  83.167 -  apply (rule conjI)+
  83.168 -apply (rule def_nat_rec_0, simp)
  83.169 -apply (rule allI, rule def_nat_rec_Suc, simp)
  83.170 -apply (rule allI, rule impI, rule ext)
  83.171 -apply (erule conjE)
  83.172 -apply (induct_tac x)
  83.173 -apply (simp add: nat_rec_0)
  83.174 -apply (erule_tac x="n" in allE)
  83.175 -apply (simp)
  83.176 -done
  83.177 -
  83.178 - text{* An equivalent formulation of monotony -- Not used here, but might be useful *}
  83.179 -lemma mono_Suc: "mono f = (\<forall>n. (f n :: 'a :: order) \<le> f (Suc n))"
  83.180 -unfolding mono_def
  83.181 -proof auto
  83.182 -  fix A B :: nat
  83.183 -  assume H: "\<forall>n. f n \<le> f (Suc n)" "A \<le> B"
  83.184 -  hence "\<exists>k. B = A + k" apply -  apply (thin_tac "\<forall>n. f n \<le> f (Suc n)") 
  83.185 -    by presburger
  83.186 -  then obtain k where k: "B = A + k" by blast
  83.187 -  {fix a k
  83.188 -    have "f a \<le> f (a + k)"
  83.189 -    proof (induct k)
  83.190 -      case 0 thus ?case by simp
  83.191 -    next
  83.192 -      case (Suc k)
  83.193 -      from Suc.hyps H(1)[rule_format, of "a + k"] show ?case by simp
  83.194 -    qed}
  83.195 -  with k show "f A \<le> f B" by blast
  83.196 -qed
  83.197 -
  83.198 -text{* for any sequence, there is a mootonic subsequence *}
  83.199 -lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
  83.200 -proof-
  83.201 -  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
  83.202 -    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
  83.203 -    from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
  83.204 -    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
  83.205 -    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
  83.206 -      using H apply - 
  83.207 -      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
  83.208 -      unfolding order_le_less by blast 
  83.209 -    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
  83.210 -    {fix n
  83.211 -      have "?P (f (Suc n)) (f n)" 
  83.212 -	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
  83.213 -	using H apply - 
  83.214 -      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
  83.215 -      unfolding order_le_less by blast 
  83.216 -    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
  83.217 -  note fSuc = this
  83.218 -    {fix p q assume pq: "p \<ge> f q"
  83.219 -      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
  83.220 -	by (cases q, simp_all) }
  83.221 -    note pqth = this
  83.222 -    {fix q
  83.223 -      have "f (Suc q) > f q" apply (induct q) 
  83.224 -	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
  83.225 -    note fss = this
  83.226 -    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
  83.227 -    {fix a b 
  83.228 -      have "f a \<le> f (a + b)"
  83.229 -      proof(induct b)
  83.230 -	case 0 thus ?case by simp
  83.231 -      next
  83.232 -	case (Suc b)
  83.233 -	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
  83.234 -      qed}
  83.235 -    note fmon0 = this
  83.236 -    have "monoseq (\<lambda>n. s (f n))" 
  83.237 -    proof-
  83.238 -      {fix n
  83.239 -	have "s (f n) \<ge> s (f (Suc n))" 
  83.240 -	proof(cases n)
  83.241 -	  case 0
  83.242 -	  assume n0: "n = 0"
  83.243 -	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
  83.244 -	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
  83.245 -	next
  83.246 -	  case (Suc m)
  83.247 -	  assume m: "n = Suc m"
  83.248 -	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
  83.249 -	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
  83.250 -	qed}
  83.251 -      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
  83.252 -    qed
  83.253 -    with th1 have ?thesis by blast}
  83.254 -  moreover
  83.255 -  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
  83.256 -    {fix p assume p: "p \<ge> Suc N" 
  83.257 -      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
  83.258 -      have "m \<noteq> p" using m(2) by auto 
  83.259 -      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
  83.260 -    note th0 = this
  83.261 -    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
  83.262 -    from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
  83.263 -    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
  83.264 -      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
  83.265 -    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
  83.266 -      using N apply - 
  83.267 -      apply (erule allE[where x="Suc N"], clarsimp)
  83.268 -      apply (rule_tac x="m" in exI)
  83.269 -      apply auto
  83.270 -      apply (subgoal_tac "Suc N \<noteq> m")
  83.271 -      apply simp
  83.272 -      apply (rule ccontr, simp)
  83.273 -      done
  83.274 -    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
  83.275 -    {fix n
  83.276 -      have "f n > N \<and> ?P (f (Suc n)) (f n)"
  83.277 -	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
  83.278 -      proof (induct n)
  83.279 -	case 0 thus ?case
  83.280 -	  using f0 N apply auto 
  83.281 -	  apply (erule allE[where x="f 0"], clarsimp) 
  83.282 -	  apply (rule_tac x="m" in exI, simp)
  83.283 -	  by (subgoal_tac "f 0 \<noteq> m", auto)
  83.284 -      next
  83.285 -	case (Suc n)
  83.286 -	from Suc.hyps have Nfn: "N < f n" by blast
  83.287 -	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
  83.288 -	with Nfn have mN: "m > N" by arith
  83.289 -	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
  83.290 -	
  83.291 -	from key have th0: "f (Suc n) > N" by simp
  83.292 -	from N[rule_format, OF th0]
  83.293 -	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
  83.294 -	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
  83.295 -	hence "m' > f (Suc n)" using m'(1) by simp
  83.296 -	with key m'(2) show ?case by auto
  83.297 -      qed}
  83.298 -    note fSuc = this
  83.299 -    {fix n
  83.300 -      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
  83.301 -      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
  83.302 -    note thf = this
  83.303 -    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
  83.304 -    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
  83.305 -      apply -
  83.306 -      apply (rule disjI1)
  83.307 -      apply auto
  83.308 -      apply (rule order_less_imp_le)
  83.309 -      apply blast
  83.310 -      done
  83.311 -    then have ?thesis  using sqf by blast}
  83.312 -  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
  83.313 -qed
  83.314 -
  83.315 -lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
  83.316 -proof(induct n)
  83.317 -  case 0 thus ?case by simp
  83.318 -next
  83.319 -  case (Suc n)
  83.320 -  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
  83.321 -  have "n < f (Suc n)" by arith 
  83.322 -  thus ?case by arith
  83.323 -qed
  83.324 -
  83.325 -subsection {* Fundamental theorem of algebra *}
  83.326 -lemma  unimodular_reduce_norm:
  83.327 -  assumes md: "cmod z = 1"
  83.328 -  shows "cmod (z + 1) < 1 \<or> cmod (z - 1) < 1 \<or> cmod (z + ii) < 1 \<or> cmod (z - ii) < 1"
  83.329 -proof-
  83.330 -  obtain x y where z: "z = Complex x y " by (cases z, auto)
  83.331 -  from md z have xy: "x^2 + y^2 = 1" by (simp add: cmod_def)
  83.332 -  {assume C: "cmod (z + 1) \<ge> 1" "cmod (z - 1) \<ge> 1" "cmod (z + ii) \<ge> 1" "cmod (z - ii) \<ge> 1"
  83.333 -    from C z xy have "2*x \<le> 1" "2*x \<ge> -1" "2*y \<le> 1" "2*y \<ge> -1"
  83.334 -      by (simp_all add: cmod_def power2_eq_square ring_simps)
  83.335 -    hence "abs (2*x) \<le> 1" "abs (2*y) \<le> 1" by simp_all
  83.336 -    hence "(abs (2 * x))^2 <= 1^2" "(abs (2 * y)) ^2 <= 1^2"
  83.337 -      by - (rule power_mono, simp, simp)+
  83.338 -    hence th0: "4*x^2 \<le> 1" "4*y^2 \<le> 1" 
  83.339 -      by (simp_all  add: power2_abs power_mult_distrib)
  83.340 -    from add_mono[OF th0] xy have False by simp }
  83.341 -  thus ?thesis unfolding linorder_not_le[symmetric] by blast
  83.342 -qed
  83.343 -
  83.344 -text{* Hence we can always reduce modulus of @{text "1 + b z^n"} if nonzero *}
  83.345 -lemma reduce_poly_simple:
  83.346 - assumes b: "b \<noteq> 0" and n: "n\<noteq>0"
  83.347 -  shows "\<exists>z. cmod (1 + b * z^n) < 1"
  83.348 -using n
  83.349 -proof(induct n rule: nat_less_induct)
  83.350 -  fix n
  83.351 -  assume IH: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>z. cmod (1 + b * z ^ m) < 1)" and n: "n \<noteq> 0"
  83.352 -  let ?P = "\<lambda>z n. cmod (1 + b * z ^ n) < 1"
  83.353 -  {assume e: "even n"
  83.354 -    hence "\<exists>m. n = 2*m" by presburger
  83.355 -    then obtain m where m: "n = 2*m" by blast
  83.356 -    from n m have "m\<noteq>0" "m < n" by presburger+
  83.357 -    with IH[rule_format, of m] obtain z where z: "?P z m" by blast
  83.358 -    from z have "?P (csqrt z) n" by (simp add: m power_mult csqrt)
  83.359 -    hence "\<exists>z. ?P z n" ..}
  83.360 -  moreover
  83.361 -  {assume o: "odd n"
  83.362 -    from b have b': "b^2 \<noteq> 0" unfolding power2_eq_square by simp
  83.363 -    have "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
  83.364 -    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) = 
  83.365 -    ((Re (inverse b))^2 + (Im (inverse b))^2) * \<bar>Im b * Im b + Re b * Re b\<bar>" by algebra
  83.366 -    also have "\<dots> = cmod (inverse b) ^2 * cmod b ^ 2" 
  83.367 -      apply (simp add: cmod_def) using realpow_two_le_add_order[of "Re b" "Im b"]
  83.368 -      by (simp add: power2_eq_square)
  83.369 -    finally 
  83.370 -    have th0: "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
  83.371 -    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) =
  83.372 -    1" 
  83.373 -      apply (simp add: power2_eq_square norm_mult[symmetric] norm_inverse[symmetric])
  83.374 -      using right_inverse[OF b']
  83.375 -      by (simp add: power2_eq_square[symmetric] power_inverse[symmetric] ring_simps)
  83.376 -    have th0: "cmod (complex_of_real (cmod b) / b) = 1"
  83.377 -      apply (simp add: complex_Re_mult cmod_def power2_eq_square Re_complex_of_real Im_complex_of_real divide_inverse ring_simps )
  83.378 -      by (simp add: real_sqrt_mult[symmetric] th0)        
  83.379 -    from o have "\<exists>m. n = Suc (2*m)" by presburger+
  83.380 -    then obtain m where m: "n = Suc (2*m)" by blast
  83.381 -    from unimodular_reduce_norm[OF th0] o
  83.382 -    have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
  83.383 -      apply (cases "cmod (complex_of_real (cmod b) / b + 1) < 1", rule_tac x="1" in exI, simp)
  83.384 -      apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp add: diff_def)
  83.385 -      apply (cases "cmod (complex_of_real (cmod b) / b + ii) < 1")
  83.386 -      apply (cases "even m", rule_tac x="ii" in exI, simp add: m power_mult)
  83.387 -      apply (rule_tac x="- ii" in exI, simp add: m power_mult)
  83.388 -      apply (cases "even m", rule_tac x="- ii" in exI, simp add: m power_mult diff_def)
  83.389 -      apply (rule_tac x="ii" in exI, simp add: m power_mult diff_def)
  83.390 -      done
  83.391 -    then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1" by blast
  83.392 -    let ?w = "v / complex_of_real (root n (cmod b))"
  83.393 -    from odd_real_root_pow[OF o, of "cmod b"]
  83.394 -    have th1: "?w ^ n = v^n / complex_of_real (cmod b)" 
  83.395 -      by (simp add: power_divide complex_of_real_power)
  83.396 -    have th2:"cmod (complex_of_real (cmod b) / b) = 1" using b by (simp add: norm_divide)
  83.397 -    hence th3: "cmod (complex_of_real (cmod b) / b) \<ge> 0" by simp
  83.398 -    have th4: "cmod (complex_of_real (cmod b) / b) *
  83.399 -   cmod (1 + b * (v ^ n / complex_of_real (cmod b)))
  83.400 -   < cmod (complex_of_real (cmod b) / b) * 1"
  83.401 -      apply (simp only: norm_mult[symmetric] right_distrib)
  83.402 -      using b v by (simp add: th2)
  83.403 -
  83.404 -    from mult_less_imp_less_left[OF th4 th3]
  83.405 -    have "?P ?w n" unfolding th1 . 
  83.406 -    hence "\<exists>z. ?P z n" .. }
  83.407 -  ultimately show "\<exists>z. ?P z n" by blast
  83.408 -qed
  83.409 -
  83.410 -
  83.411 -text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
  83.412 -
  83.413 -lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
  83.414 -  using real_sqrt_sum_squares_triangle_ineq[of "Re x - Re y" 0 0 "Im x - Im y" ]
  83.415 -  unfolding cmod_def by simp
  83.416 -
  83.417 -lemma bolzano_weierstrass_complex_disc:
  83.418 -  assumes r: "\<forall>n. cmod (s n) \<le> r"
  83.419 -  shows "\<exists>f z. subseq f \<and> (\<forall>e >0. \<exists>N. \<forall>n \<ge> N. cmod (s (f n) - z) < e)"
  83.420 -proof-
  83.421 -  from seq_monosub[of "Re o s"] 
  83.422 -  obtain f g where f: "subseq f" "monoseq (\<lambda>n. Re (s (f n)))" 
  83.423 -    unfolding o_def by blast
  83.424 -  from seq_monosub[of "Im o s o f"] 
  83.425 -  obtain g where g: "subseq g" "monoseq (\<lambda>n. Im (s(f(g n))))" unfolding o_def by blast  
  83.426 -  let ?h = "f o g"
  83.427 -  from r[rule_format, of 0] have rp: "r \<ge> 0" using norm_ge_zero[of "s 0"] by arith 
  83.428 -  have th:"\<forall>n. r + 1 \<ge> \<bar> Re (s n)\<bar>" 
  83.429 -  proof
  83.430 -    fix n
  83.431 -    from abs_Re_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Re (s n)\<bar> \<le> r + 1" by arith
  83.432 -  qed
  83.433 -  have conv1: "convergent (\<lambda>n. Re (s ( f n)))"
  83.434 -    apply (rule Bseq_monoseq_convergent)
  83.435 -    apply (simp add: Bseq_def)
  83.436 -    apply (rule exI[where x= "r + 1"])
  83.437 -    using th rp apply simp
  83.438 -    using f(2) .
  83.439 -  have th:"\<forall>n. r + 1 \<ge> \<bar> Im (s n)\<bar>" 
  83.440 -  proof
  83.441 -    fix n
  83.442 -    from abs_Im_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Im (s n)\<bar> \<le> r + 1" by arith
  83.443 -  qed
  83.444 -
  83.445 -  have conv2: "convergent (\<lambda>n. Im (s (f (g n))))"
  83.446 -    apply (rule Bseq_monoseq_convergent)
  83.447 -    apply (simp add: Bseq_def)
  83.448 -    apply (rule exI[where x= "r + 1"])
  83.449 -    using th rp apply simp
  83.450 -    using g(2) .
  83.451 -
  83.452 -  from conv1[unfolded convergent_def] obtain x where "LIMSEQ (\<lambda>n. Re (s (f n))) x" 
  83.453 -    by blast 
  83.454 -  hence  x: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Re (s (f n)) - x \<bar> < r" 
  83.455 -    unfolding LIMSEQ_def real_norm_def .
  83.456 -
  83.457 -  from conv2[unfolded convergent_def] obtain y where "LIMSEQ (\<lambda>n. Im (s (f (g n)))) y" 
  83.458 -    by blast 
  83.459 -  hence  y: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Im (s (f (g n))) - y \<bar> < r" 
  83.460 -    unfolding LIMSEQ_def real_norm_def .
  83.461 -  let ?w = "Complex x y"
  83.462 -  from f(1) g(1) have hs: "subseq ?h" unfolding subseq_def by auto 
  83.463 -  {fix e assume ep: "e > (0::real)"
  83.464 -    hence e2: "e/2 > 0" by simp
  83.465 -    from x[rule_format, OF e2] y[rule_format, OF e2]
  83.466 -    obtain N1 N2 where N1: "\<forall>n\<ge>N1. \<bar>Re (s (f n)) - x\<bar> < e / 2" and N2: "\<forall>n\<ge>N2. \<bar>Im (s (f (g n))) - y\<bar> < e / 2" by blast
  83.467 -    {fix n assume nN12: "n \<ge> N1 + N2"
  83.468 -      hence nN1: "g n \<ge> N1" and nN2: "n \<ge> N2" using seq_suble[OF g(1), of n] by arith+
  83.469 -      from add_strict_mono[OF N1[rule_format, OF nN1] N2[rule_format, OF nN2]]
  83.470 -      have "cmod (s (?h n) - ?w) < e" 
  83.471 -	using metric_bound_lemma[of "s (f (g n))" ?w] by simp }
  83.472 -    hence "\<exists>N. \<forall>n\<ge>N. cmod (s (?h n) - ?w) < e" by blast }
  83.473 -  with hs show ?thesis  by blast  
  83.474 -qed
  83.475 -
  83.476 -text{* Polynomial is continuous. *}
  83.477 -
  83.478 -lemma poly_cont:
  83.479 -  assumes ep: "e > 0" 
  83.480 -  shows "\<exists>d >0. \<forall>w. 0 < cmod (w - z) \<and> cmod (w - z) < d \<longrightarrow> cmod (poly p w - poly p z) < e"
  83.481 -proof-
  83.482 -  from poly_offset[of p z] obtain q where q: "length q = length p" "\<And>x. poly q x = poly p (z + x)" by blast
  83.483 -  {fix w
  83.484 -    note q(2)[of "w - z", simplified]}
  83.485 -  note th = this
  83.486 -  show ?thesis unfolding th[symmetric]
  83.487 -  proof(induct q)
  83.488 -    case Nil thus ?case  using ep by auto
  83.489 -  next
  83.490 -    case (Cons c cs)
  83.491 -    from poly_bound_exists[of 1 "cs"] 
  83.492 -    obtain m where m: "m > 0" "\<And>z. cmod z \<le> 1 \<Longrightarrow> cmod (poly cs z) \<le> m" by blast
  83.493 -    from ep m(1) have em0: "e/m > 0" by (simp add: field_simps)
  83.494 -    have one0: "1 > (0::real)"  by arith
  83.495 -    from real_lbound_gt_zero[OF one0 em0] 
  83.496 -    obtain d where d: "d >0" "d < 1" "d < e / m" by blast
  83.497 -    from d(1,3) m(1) have dm: "d*m > 0" "d*m < e" 
  83.498 -      by (simp_all add: field_simps real_mult_order)
  83.499 -    show ?case 
  83.500 -      proof(rule ex_forward[OF real_lbound_gt_zero[OF one0 em0]], clarsimp simp add: norm_mult)
  83.501 -	fix d w
  83.502 -	assume H: "d > 0" "d < 1" "d < e/m" "w\<noteq>z" "cmod (w-z) < d"
  83.503 -	hence d1: "cmod (w-z) \<le> 1" "d \<ge> 0" by simp_all
  83.504 -	from H(3) m(1) have dme: "d*m < e" by (simp add: field_simps)
  83.505 -	from H have th: "cmod (w-z) \<le> d" by simp 
  83.506 -	from mult_mono[OF th m(2)[OF d1(1)] d1(2) norm_ge_zero] dme
  83.507 -	show "cmod (w - z) * cmod (poly cs (w - z)) < e" by simp
  83.508 -      qed  
  83.509 -    qed
  83.510 -qed
  83.511 -
  83.512 -text{* Hence a polynomial attains minimum on a closed disc 
  83.513 -  in the complex plane. *}
  83.514 -lemma  poly_minimum_modulus_disc:
  83.515 -  "\<exists>z. \<forall>w. cmod w \<le> r \<longrightarrow> cmod (poly p z) \<le> cmod (poly p w)"
  83.516 -proof-
  83.517 -  {assume "\<not> r \<ge> 0" hence ?thesis unfolding linorder_not_le
  83.518 -      apply -
  83.519 -      apply (rule exI[where x=0]) 
  83.520 -      apply auto
  83.521 -      apply (subgoal_tac "cmod w < 0")
  83.522 -      apply simp
  83.523 -      apply arith
  83.524 -      done }
  83.525 -  moreover
  83.526 -  {assume rp: "r \<ge> 0"
  83.527 -    from rp have "cmod 0 \<le> r \<and> cmod (poly p 0) = - (- cmod (poly p 0))" by simp 
  83.528 -    hence mth1: "\<exists>x z. cmod z \<le> r \<and> cmod (poly p z) = - x"  by blast
  83.529 -    {fix x z
  83.530 -      assume H: "cmod z \<le> r" "cmod (poly p z) = - x" "\<not>x < 1"
  83.531 -      hence "- x < 0 " by arith
  83.532 -      with H(2) norm_ge_zero[of "poly p z"]  have False by simp }
  83.533 -    then have mth2: "\<exists>z. \<forall>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<longrightarrow> x < z" by blast
  83.534 -    from real_sup_exists[OF mth1 mth2] obtain s where 
  83.535 -      s: "\<forall>y. (\<exists>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<and> y < x) \<longleftrightarrow>(y < s)" by blast
  83.536 -    let ?m = "-s"
  83.537 -    {fix y
  83.538 -      from s[rule_format, of "-y"] have 
  83.539 -    "(\<exists>z x. cmod z \<le> r \<and> -(- cmod (poly p z)) < y) \<longleftrightarrow> ?m < y" 
  83.540 -	unfolding minus_less_iff[of y ] equation_minus_iff by blast }
  83.541 -    note s1 = this[unfolded minus_minus]
  83.542 -    from s1[of ?m] have s1m: "\<And>z x. cmod z \<le> r \<Longrightarrow> cmod (poly p z) \<ge> ?m" 
  83.543 -      by auto
  83.544 -    {fix n::nat
  83.545 -      from s1[rule_format, of "?m + 1/real (Suc n)"] 
  83.546 -      have "\<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)"
  83.547 -	by simp}
  83.548 -    hence th: "\<forall>n. \<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)" ..
  83.549 -    from choice[OF th] obtain g where 
  83.550 -      g: "\<forall>n. cmod (g n) \<le> r" "\<forall>n. cmod (poly p (g n)) <?m+1 /real(Suc n)" 
  83.551 -      by blast
  83.552 -    from bolzano_weierstrass_complex_disc[OF g(1)] 
  83.553 -    obtain f z where fz: "subseq f" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. cmod (g (f n) - z) < e"
  83.554 -      by blast    
  83.555 -    {fix w 
  83.556 -      assume wr: "cmod w \<le> r"
  83.557 -      let ?e = "\<bar>cmod (poly p z) - ?m\<bar>"
  83.558 -      {assume e: "?e > 0"
  83.559 -	hence e2: "?e/2 > 0" by simp
  83.560 -	from poly_cont[OF e2, of z p] obtain d where
  83.561 -	  d: "d>0" "\<forall>w. 0<cmod (w - z)\<and> cmod(w - z) < d \<longrightarrow> cmod(poly p w - poly p z) < ?e/2" by blast
  83.562 -	{fix w assume w: "cmod (w - z) < d"
  83.563 -	  have "cmod(poly p w - poly p z) < ?e / 2"
  83.564 -	    using d(2)[rule_format, of w] w e by (cases "w=z", simp_all)}
  83.565 -	note th1 = this
  83.566 -	
  83.567 -	from fz(2)[rule_format, OF d(1)] obtain N1 where 
  83.568 -	  N1: "\<forall>n\<ge>N1. cmod (g (f n) - z) < d" by blast
  83.569 -	from reals_Archimedean2[of "2/?e"] obtain N2::nat where
  83.570 -	  N2: "2/?e < real N2" by blast
  83.571 -	have th2: "cmod(poly p (g(f(N1 + N2))) - poly p z) < ?e/2"
  83.572 -	  using N1[rule_format, of "N1 + N2"] th1 by simp
  83.573 -	{fix a b e2 m :: real
  83.574 -	have "a < e2 \<Longrightarrow> abs(b - m) < e2 \<Longrightarrow> 2 * e2 <= abs(b - m) + a
  83.575 -          ==> False" by arith}
  83.576 -      note th0 = this
  83.577 -      have ath: 
  83.578 -	"\<And>m x e. m <= x \<Longrightarrow>  x < m + e ==> abs(x - m::real) < e" by arith
  83.579 -      from s1m[OF g(1)[rule_format]]
  83.580 -      have th31: "?m \<le> cmod(poly p (g (f (N1 + N2))))" .
  83.581 -      from seq_suble[OF fz(1), of "N1+N2"]
  83.582 -      have th00: "real (Suc (N1+N2)) \<le> real (Suc (f (N1+N2)))" by simp
  83.583 -      have th000: "0 \<le> (1::real)" "(1::real) \<le> 1" "real (Suc (N1+N2)) > 0"  
  83.584 -	using N2 by auto
  83.585 -      from frac_le[OF th000 th00] have th00: "?m +1 / real (Suc (f (N1 + N2))) \<le> ?m + 1 / real (Suc (N1 + N2))" by simp
  83.586 -      from g(2)[rule_format, of "f (N1 + N2)"]
  83.587 -      have th01:"cmod (poly p (g (f (N1 + N2)))) < - s + 1 / real (Suc (f (N1 + N2)))" .
  83.588 -      from order_less_le_trans[OF th01 th00]
  83.589 -      have th32: "cmod(poly p (g (f (N1 + N2)))) < ?m + (1/ real(Suc (N1 + N2)))" .
  83.590 -      from N2 have "2/?e < real (Suc (N1 + N2))" by arith
  83.591 -      with e2 less_imp_inverse_less[of "2/?e" "real (Suc (N1 + N2))"]
  83.592 -      have "?e/2 > 1/ real (Suc (N1 + N2))" by (simp add: inverse_eq_divide)
  83.593 -      with ath[OF th31 th32]
  83.594 -      have thc1:"\<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar>< ?e/2" by arith  
  83.595 -      have ath2: "\<And>(a::real) b c m. \<bar>a - b\<bar> <= c ==> \<bar>b - m\<bar> <= \<bar>a - m\<bar> + c" 
  83.596 -	by arith
  83.597 -      have th22: "\<bar>cmod (poly p (g (f (N1 + N2)))) - cmod (poly p z)\<bar>
  83.598 -\<le> cmod (poly p (g (f (N1 + N2))) - poly p z)" 
  83.599 -	by (simp add: norm_triangle_ineq3)
  83.600 -      from ath2[OF th22, of ?m]
  83.601 -      have thc2: "2*(?e/2) \<le> \<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar> + cmod (poly p (g (f (N1 + N2))) - poly p z)" by simp
  83.602 -      from th0[OF th2 thc1 thc2] have False .}
  83.603 -      hence "?e = 0" by auto
  83.604 -      then have "cmod (poly p z) = ?m" by simp  
  83.605 -      with s1m[OF wr]
  83.606 -      have "cmod (poly p z) \<le> cmod (poly p w)" by simp }
  83.607 -    hence ?thesis by blast}
  83.608 -  ultimately show ?thesis by blast
  83.609 -qed
  83.610 -
  83.611 -lemma "(rcis (sqrt (abs r)) (a/2)) ^ 2 = rcis (abs r) a"
  83.612 -  unfolding power2_eq_square
  83.613 -  apply (simp add: rcis_mult)
  83.614 -  apply (simp add: power2_eq_square[symmetric])
  83.615 -  done
  83.616 -
  83.617 -lemma cispi: "cis pi = -1" 
  83.618 -  unfolding cis_def
  83.619 -  by simp
  83.620 -
  83.621 -lemma "(rcis (sqrt (abs r)) ((pi + a)/2)) ^ 2 = rcis (- abs r) a"
  83.622 -  unfolding power2_eq_square
  83.623 -  apply (simp add: rcis_mult add_divide_distrib)
  83.624 -  apply (simp add: power2_eq_square[symmetric] rcis_def cispi cis_mult[symmetric])
  83.625 -  done
  83.626 -
  83.627 -text {* Nonzero polynomial in z goes to infinity as z does. *}
  83.628 -
  83.629 -instance complex::idom_char_0 by (intro_classes)
  83.630 -instance complex :: recpower_idom_char_0 by intro_classes
  83.631 -
  83.632 -lemma poly_infinity:
  83.633 -  assumes ex: "list_ex (\<lambda>c. c \<noteq> 0) p"
  83.634 -  shows "\<exists>r. \<forall>z. r \<le> cmod z \<longrightarrow> d \<le> cmod (poly (a#p) z)"
  83.635 -using ex
  83.636 -proof(induct p arbitrary: a d)
  83.637 -  case (Cons c cs a d) 
  83.638 -  {assume H: "list_ex (\<lambda>c. c\<noteq>0) cs"
  83.639 -    with Cons.hyps obtain r where r: "\<forall>z. r \<le> cmod z \<longrightarrow> d + cmod a \<le> cmod (poly (c # cs) z)" by blast
  83.640 -    let ?r = "1 + \<bar>r\<bar>"
  83.641 -    {fix z assume h: "1 + \<bar>r\<bar> \<le> cmod z"
  83.642 -      have r0: "r \<le> cmod z" using h by arith
  83.643 -      from r[rule_format, OF r0]
  83.644 -      have th0: "d + cmod a \<le> 1 * cmod(poly (c#cs) z)" by arith
  83.645 -      from h have z1: "cmod z \<ge> 1" by arith
  83.646 -      from order_trans[OF th0 mult_right_mono[OF z1 norm_ge_zero[of "poly (c#cs) z"]]]
  83.647 -      have th1: "d \<le> cmod(z * poly (c#cs) z) - cmod a"
  83.648 -	unfolding norm_mult by (simp add: ring_simps)
  83.649 -      from complex_mod_triangle_sub[of "z * poly (c#cs) z" a]
  83.650 -      have th2: "cmod(z * poly (c#cs) z) - cmod a \<le> cmod (poly (a#c#cs) z)" 
  83.651 -	by (simp add: diff_le_eq ring_simps) 
  83.652 -      from th1 th2 have "d \<le> cmod (poly (a#c#cs) z)"  by arith}
  83.653 -    hence ?case by blast}
  83.654 -  moreover
  83.655 -  {assume cs0: "\<not> (list_ex (\<lambda>c. c \<noteq> 0) cs)"
  83.656 -    with Cons.prems have c0: "c \<noteq> 0" by simp
  83.657 -    from cs0 have cs0': "list_all (\<lambda>c. c = 0) cs" 
  83.658 -      by (auto simp add: list_all_iff list_ex_iff)
  83.659 -    {fix z
  83.660 -      assume h: "(\<bar>d\<bar> + cmod a) / cmod c \<le> cmod z"
  83.661 -      from c0 have "cmod c > 0" by simp
  83.662 -      from h c0 have th0: "\<bar>d\<bar> + cmod a \<le> cmod (z*c)" 
  83.663 -	by (simp add: field_simps norm_mult)
  83.664 -      have ath: "\<And>mzh mazh ma. mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh" by arith
  83.665 -      from complex_mod_triangle_sub[of "z*c" a ]
  83.666 -      have th1: "cmod (z * c) \<le> cmod (a + z * c) + cmod a"
  83.667 -	by (simp add: ring_simps)
  83.668 -      from ath[OF th1 th0] have "d \<le> cmod (poly (a # c # cs) z)" 
  83.669 -	using poly_0[OF cs0'] by simp}
  83.670 -    then have ?case  by blast}
  83.671 -  ultimately show ?case by blast
  83.672 -qed simp
  83.673 -
  83.674 -text {* Hence polynomial's modulus attains its minimum somewhere. *}
  83.675 -lemma poly_minimum_modulus:
  83.676 -  "\<exists>z.\<forall>w. cmod (poly p z) \<le> cmod (poly p w)"
  83.677 -proof(induct p)
  83.678 -  case (Cons c cs) 
  83.679 -  {assume cs0: "list_ex (\<lambda>c. c \<noteq> 0) cs"
  83.680 -    from poly_infinity[OF cs0, of "cmod (poly (c#cs) 0)" c]
  83.681 -    obtain r where r: "\<And>z. r \<le> cmod z \<Longrightarrow> cmod (poly (c # cs) 0) \<le> cmod (poly (c # cs) z)" by blast
  83.682 -    have ath: "\<And>z r. r \<le> cmod z \<or> cmod z \<le> \<bar>r\<bar>" by arith
  83.683 -    from poly_minimum_modulus_disc[of "\<bar>r\<bar>" "c#cs"] 
  83.684 -    obtain v where v: "\<And>w. cmod w \<le> \<bar>r\<bar> \<Longrightarrow> cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) w)" by blast
  83.685 -    {fix z assume z: "r \<le> cmod z"
  83.686 -      from v[of 0] r[OF z] 
  83.687 -      have "cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) z)"
  83.688 -	by simp }
  83.689 -    note v0 = this
  83.690 -    from v0 v ath[of r] have ?case by blast}
  83.691 -  moreover
  83.692 -  {assume cs0: "\<not> (list_ex (\<lambda>c. c\<noteq>0) cs)"
  83.693 -    hence th:"list_all (\<lambda>c. c = 0) cs" by (simp add: list_all_iff list_ex_iff)
  83.694 -    from poly_0[OF th] Cons.hyps have ?case by simp}
  83.695 -  ultimately show ?case by blast
  83.696 -qed simp
  83.697 -
  83.698 -text{* Constant function (non-syntactic characterization). *}
  83.699 -definition "constant f = (\<forall>x y. f x = f y)"
  83.700 -
  83.701 -lemma nonconstant_length: "\<not> (constant (poly p)) \<Longrightarrow> length p \<ge> 2"
  83.702 -  unfolding constant_def
  83.703 -  apply (induct p, auto)
  83.704 -  apply (unfold not_less[symmetric])
  83.705 -  apply simp
  83.706 -  apply (rule ccontr)
  83.707 -  apply auto
  83.708 -  done
  83.709 - 
  83.710 -lemma poly_replicate_append:
  83.711 -  "poly ((replicate n 0)@p) (x::'a::{recpower, comm_ring}) = x^n * poly p x"
  83.712 -  by(induct n, auto simp add: power_Suc ring_simps)
  83.713 -
  83.714 -text {* Decomposition of polynomial, skipping zero coefficients 
  83.715 -  after the first.  *}
  83.716 -
  83.717 -lemma poly_decompose_lemma:
  83.718 - assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{recpower,idom}))"
  83.719 -  shows "\<exists>k a q. a\<noteq>0 \<and> Suc (length q + k) = length p \<and> 
  83.720 -                 (\<forall>z. poly p z = z^k * poly (a#q) z)"
  83.721 -using nz
  83.722 -proof(induct p)
  83.723 -  case Nil thus ?case by simp
  83.724 -next
  83.725 -  case (Cons c cs)
  83.726 -  {assume c0: "c = 0"
  83.727 -    
  83.728 -    from Cons.hyps Cons.prems c0 have ?case apply auto
  83.729 -      apply (rule_tac x="k+1" in exI)
  83.730 -      apply (rule_tac x="a" in exI, clarsimp)
  83.731 -      apply (rule_tac x="q" in exI)
  83.732 -      by (auto simp add: power_Suc)}
  83.733 -  moreover
  83.734 -  {assume c0: "c\<noteq>0"
  83.735 -    hence ?case apply-
  83.736 -      apply (rule exI[where x=0])
  83.737 -      apply (rule exI[where x=c], clarsimp)
  83.738 -      apply (rule exI[where x=cs])
  83.739 -      apply auto
  83.740 -      done}
  83.741 -  ultimately show ?case by blast
  83.742 -qed
  83.743 -
  83.744 -lemma poly_decompose:
  83.745 -  assumes nc: "~constant(poly p)"
  83.746 -  shows "\<exists>k a q. a\<noteq>(0::'a::{recpower,idom}) \<and> k\<noteq>0 \<and>
  83.747 -               length q + k + 1 = length p \<and> 
  83.748 -              (\<forall>z. poly p z = poly p 0 + z^k * poly (a#q) z)"
  83.749 -using nc 
  83.750 -proof(induct p)
  83.751 -  case Nil thus ?case by (simp add: constant_def)
  83.752 -next
  83.753 -  case (Cons c cs)
  83.754 -  {assume C:"\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0"
  83.755 -    {fix x y
  83.756 -      from C have "poly (c#cs) x = poly (c#cs) y" by (cases "x=0", auto)}
  83.757 -    with Cons.prems have False by (auto simp add: constant_def)}
  83.758 -  hence th: "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0)" ..
  83.759 -  from poly_decompose_lemma[OF th] 
  83.760 -  show ?case 
  83.761 -    apply clarsimp    
  83.762 -    apply (rule_tac x="k+1" in exI)
  83.763 -    apply (rule_tac x="a" in exI)
  83.764 -    apply simp
  83.765 -    apply (rule_tac x="q" in exI)
  83.766 -    apply (auto simp add: power_Suc)
  83.767 -    done
  83.768 -qed
  83.769 -
  83.770 -text{* Fundamental theorem of algebral *}
  83.771 -
  83.772 -lemma fundamental_theorem_of_algebra:
  83.773 -  assumes nc: "~constant(poly p)"
  83.774 -  shows "\<exists>z::complex. poly p z = 0"
  83.775 -using nc
  83.776 -proof(induct n\<equiv> "length p" arbitrary: p rule: nat_less_induct)
  83.777 -  fix n fix p :: "complex list"
  83.778 -  let ?p = "poly p"
  83.779 -  assume H: "\<forall>m<n. \<forall>p. \<not> constant (poly p) \<longrightarrow> m = length p \<longrightarrow> (\<exists>(z::complex). poly p z = 0)" and nc: "\<not> constant ?p" and n: "n = length p"
  83.780 -  let ?ths = "\<exists>z. ?p z = 0"
  83.781 -
  83.782 -  from nonconstant_length[OF nc] have n2: "n\<ge> 2" by (simp add: n)
  83.783 -  from poly_minimum_modulus obtain c where 
  83.784 -    c: "\<forall>w. cmod (?p c) \<le> cmod (?p w)" by blast
  83.785 -  {assume pc: "?p c = 0" hence ?ths by blast}
  83.786 -  moreover
  83.787 -  {assume pc0: "?p c \<noteq> 0"
  83.788 -    from poly_offset[of p c] obtain q where
  83.789 -      q: "length q = length p" "\<forall>x. poly q x = ?p (c+x)" by blast
  83.790 -    {assume h: "constant (poly q)"
  83.791 -      from q(2) have th: "\<forall>x. poly q (x - c) = ?p x" by auto
  83.792 -      {fix x y
  83.793 -	from th have "?p x = poly q (x - c)" by auto 
  83.794 -	also have "\<dots> = poly q (y - c)" 
  83.795 -	  using h unfolding constant_def by blast
  83.796 -	also have "\<dots> = ?p y" using th by auto
  83.797 -	finally have "?p x = ?p y" .}
  83.798 -      with nc have False unfolding constant_def by blast }
  83.799 -    hence qnc: "\<not> constant (poly q)" by blast
  83.800 -    from q(2) have pqc0: "?p c = poly q 0" by simp
  83.801 -    from c pqc0 have cq0: "\<forall>w. cmod (poly q 0) \<le> cmod (?p w)" by simp 
  83.802 -    let ?a0 = "poly q 0"
  83.803 -    from pc0 pqc0 have a00: "?a0 \<noteq> 0" by simp 
  83.804 -    from a00 
  83.805 -    have qr: "\<forall>z. poly q z = poly (map (op * (inverse ?a0)) q) z * ?a0"
  83.806 -      by (simp add: poly_cmult_map)
  83.807 -    let ?r = "map (op * (inverse ?a0)) q"
  83.808 -    have lgqr: "length q = length ?r" by simp 
  83.809 -    {assume h: "\<And>x y. poly ?r x = poly ?r y"
  83.810 -      {fix x y
  83.811 -	from qr[rule_format, of x] 
  83.812 -	have "poly q x = poly ?r x * ?a0" by auto
  83.813 -	also have "\<dots> = poly ?r y * ?a0" using h by simp
  83.814 -	also have "\<dots> = poly q y" using qr[rule_format, of y] by simp
  83.815 -	finally have "poly q x = poly q y" .} 
  83.816 -      with qnc have False unfolding constant_def by blast}
  83.817 -    hence rnc: "\<not> constant (poly ?r)" unfolding constant_def by blast
  83.818 -    from qr[rule_format, of 0] a00  have r01: "poly ?r 0 = 1" by auto
  83.819 -    {fix w 
  83.820 -      have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w / ?a0) < 1"
  83.821 -	using qr[rule_format, of w] a00 by simp
  83.822 -      also have "\<dots> \<longleftrightarrow> cmod (poly q w) < cmod ?a0"
  83.823 -	using a00 unfolding norm_divide by (simp add: field_simps)
  83.824 -      finally have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w) < cmod ?a0" .}
  83.825 -    note mrmq_eq = this
  83.826 -    from poly_decompose[OF rnc] obtain k a s where 
  83.827 -      kas: "a\<noteq>0" "k\<noteq>0" "length s + k + 1 = length ?r" 
  83.828 -      "\<forall>z. poly ?r z = poly ?r 0 + z^k* poly (a#s) z" by blast
  83.829 -    {assume "k + 1 = n"
  83.830 -      with kas(3) lgqr[symmetric] q(1) n[symmetric] have s0:"s=[]" by auto
  83.831 -      {fix w
  83.832 -	have "cmod (poly ?r w) = cmod (1 + a * w ^ k)" 
  83.833 -	  using kas(4)[rule_format, of w] s0 r01 by (simp add: ring_simps)}
  83.834 -      note hth = this [symmetric]
  83.835 -	from reduce_poly_simple[OF kas(1,2)] 
  83.836 -      have "\<exists>w. cmod (poly ?r w) < 1" unfolding hth by blast}
  83.837 -    moreover
  83.838 -    {assume kn: "k+1 \<noteq> n"
  83.839 -      from kn kas(3) q(1) n[symmetric] have k1n: "k + 1 < n" by simp
  83.840 -      have th01: "\<not> constant (poly (1#((replicate (k - 1) 0)@[a])))" 
  83.841 -	unfolding constant_def poly_Nil poly_Cons poly_replicate_append
  83.842 -	using kas(1) apply simp 
  83.843 -	by (rule exI[where x=0], rule exI[where x=1], simp)
  83.844 -      from kas(2) have th02: "k+1 = length (1#((replicate (k - 1) 0)@[a]))" 
  83.845 -	by simp
  83.846 -      from H[rule_format, OF k1n th01 th02]
  83.847 -      obtain w where w: "1 + w^k * a = 0"
  83.848 -	unfolding poly_Nil poly_Cons poly_replicate_append
  83.849 -	using kas(2) by (auto simp add: power_Suc[symmetric, of _ "k - Suc 0"] 
  83.850 -	  mult_assoc[of _ _ a, symmetric])
  83.851 -      from poly_bound_exists[of "cmod w" s] obtain m where 
  83.852 -	m: "m > 0" "\<forall>z. cmod z \<le> cmod w \<longrightarrow> cmod (poly s z) \<le> m" by blast
  83.853 -      have w0: "w\<noteq>0" using kas(2) w by (auto simp add: power_0_left)
  83.854 -      from w have "(1 + w ^ k * a) - 1 = 0 - 1" by simp
  83.855 -      then have wm1: "w^k * a = - 1" by simp
  83.856 -      have inv0: "0 < inverse (cmod w ^ (k + 1) * m)" 
  83.857 -	using norm_ge_zero[of w] w0 m(1)
  83.858 -	  by (simp add: inverse_eq_divide zero_less_mult_iff)
  83.859 -      with real_down2[OF zero_less_one] obtain t where
  83.860 -	t: "t > 0" "t < 1" "t < inverse (cmod w ^ (k + 1) * m)" by blast
  83.861 -      let ?ct = "complex_of_real t"
  83.862 -      let ?w = "?ct * w"
  83.863 -      have "1 + ?w^k * (a + ?w * poly s ?w) = 1 + ?ct^k * (w^k * a) + ?w^k * ?w * poly s ?w" using kas(1) by (simp add: ring_simps power_mult_distrib)
  83.864 -      also have "\<dots> = complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w"
  83.865 -	unfolding wm1 by (simp)
  83.866 -      finally have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) = cmod (complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w)" 
  83.867 -	apply -
  83.868 -	apply (rule cong[OF refl[of cmod]])
  83.869 -	apply assumption
  83.870 -	done
  83.871 -      with norm_triangle_ineq[of "complex_of_real (1 - t^k)" "?w^k * ?w * poly s ?w"] 
  83.872 -      have th11: "cmod (1 + ?w^k * (a + ?w * poly s ?w)) \<le> \<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w)" unfolding norm_of_real by simp 
  83.873 -      have ath: "\<And>x (t::real). 0\<le> x \<Longrightarrow> x < t \<Longrightarrow> t\<le>1 \<Longrightarrow> \<bar>1 - t\<bar> + x < 1" by arith
  83.874 -      have "t *cmod w \<le> 1 * cmod w" apply (rule mult_mono) using t(1,2) by auto
  83.875 -      then have tw: "cmod ?w \<le> cmod w" using t(1) by (simp add: norm_mult) 
  83.876 -      from t inv0 have "t* (cmod w ^ (k + 1) * m) < 1"
  83.877 -	by (simp add: inverse_eq_divide field_simps)
  83.878 -      with zero_less_power[OF t(1), of k] 
  83.879 -      have th30: "t^k * (t* (cmod w ^ (k + 1) * m)) < t^k * 1" 
  83.880 -	apply - apply (rule mult_strict_left_mono) by simp_all
  83.881 -      have "cmod (?w^k * ?w * poly s ?w) = t^k * (t* (cmod w ^ (k+1) * cmod (poly s ?w)))"  using w0 t(1)
  83.882 -	by (simp add: ring_simps power_mult_distrib norm_of_real norm_power norm_mult)
  83.883 -      then have "cmod (?w^k * ?w * poly s ?w) \<le> t^k * (t* (cmod w ^ (k + 1) * m))"
  83.884 -	using t(1,2) m(2)[rule_format, OF tw] w0
  83.885 -	apply (simp only: )
  83.886 -	apply auto
  83.887 -	apply (rule mult_mono, simp_all add: norm_ge_zero)+
  83.888 -	apply (simp add: zero_le_mult_iff zero_le_power)
  83.889 -	done
  83.890 -      with th30 have th120: "cmod (?w^k * ?w * poly s ?w) < t^k" by simp 
  83.891 -      from power_strict_mono[OF t(2), of k] t(1) kas(2) have th121: "t^k \<le> 1" 
  83.892 -	by auto
  83.893 -      from ath[OF norm_ge_zero[of "?w^k * ?w * poly s ?w"] th120 th121]
  83.894 -      have th12: "\<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w) < 1" . 
  83.895 -      from th11 th12
  83.896 -      have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) < 1"  by arith 
  83.897 -      then have "cmod (poly ?r ?w) < 1" 
  83.898 -	unfolding kas(4)[rule_format, of ?w] r01 by simp 
  83.899 -      then have "\<exists>w. cmod (poly ?r w) < 1" by blast}
  83.900 -    ultimately have cr0_contr: "\<exists>w. cmod (poly ?r w) < 1" by blast
  83.901 -    from cr0_contr cq0 q(2)
  83.902 -    have ?ths unfolding mrmq_eq not_less[symmetric] by auto}
  83.903 -  ultimately show ?ths by blast
  83.904 -qed
  83.905 -
  83.906 -text {* Alternative version with a syntactic notion of constant polynomial. *}
  83.907 -
  83.908 -lemma fundamental_theorem_of_algebra_alt:
  83.909 -  assumes nc: "~(\<exists>a l. a\<noteq> 0 \<and> list_all(\<lambda>b. b = 0) l \<and> p = a#l)"
  83.910 -  shows "\<exists>z. poly p z = (0::complex)"
  83.911 -using nc
  83.912 -proof(induct p)
  83.913 -  case (Cons c cs)
  83.914 -  {assume "c=0" hence ?case by auto}
  83.915 -  moreover
  83.916 -  {assume c0: "c\<noteq>0"
  83.917 -    {assume nc: "constant (poly (c#cs))"
  83.918 -      from nc[unfolded constant_def, rule_format, of 0] 
  83.919 -      have "\<forall>w. w \<noteq> 0 \<longrightarrow> poly cs w = 0" by auto 
  83.920 -      hence "list_all (\<lambda>c. c=0) cs"
  83.921 -	proof(induct cs)
  83.922 -	  case (Cons d ds)
  83.923 -	  {assume "d=0" hence ?case using Cons.prems Cons.hyps by simp}
  83.924 -	  moreover
  83.925 -	  {assume d0: "d\<noteq>0"
  83.926 -	    from poly_bound_exists[of 1 ds] obtain m where 
  83.927 -	      m: "m > 0" "\<forall>z. \<forall>z. cmod z \<le> 1 \<longrightarrow> cmod (poly ds z) \<le> m" by blast
  83.928 -	    have dm: "cmod d / m > 0" using d0 m(1) by (simp add: field_simps)
  83.929 -	    from real_down2[OF dm zero_less_one] obtain x where 
  83.930 -	      x: "x > 0" "x < cmod d / m" "x < 1" by blast
  83.931 -	    let ?x = "complex_of_real x"
  83.932 -	    from x have cx: "?x \<noteq> 0"  "cmod ?x \<le> 1" by simp_all
  83.933 -	    from Cons.prems[rule_format, OF cx(1)]
  83.934 -	    have cth: "cmod (?x*poly ds ?x) = cmod d" by (simp add: eq_diff_eq[symmetric])
  83.935 -	    from m(2)[rule_format, OF cx(2)] x(1)
  83.936 -	    have th0: "cmod (?x*poly ds ?x) \<le> x*m"
  83.937 -	      by (simp add: norm_mult)
  83.938 -	    from x(2) m(1) have "x*m < cmod d" by (simp add: field_simps)
  83.939 -	    with th0 have "cmod (?x*poly ds ?x) \<noteq> cmod d" by auto
  83.940 -	    with cth  have ?case by blast}
  83.941 -	  ultimately show ?case by blast 
  83.942 -	qed simp}
  83.943 -      then have nc: "\<not> constant (poly (c#cs))" using Cons.prems c0 
  83.944 -	by blast
  83.945 -      from fundamental_theorem_of_algebra[OF nc] have ?case .}
  83.946 -  ultimately show ?case by blast  
  83.947 -qed simp
  83.948 -
  83.949 -subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
  83.950 -
  83.951 -lemma nullstellensatz_lemma:
  83.952 -  fixes p :: "complex list"
  83.953 -  assumes "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
  83.954 -  and "degree p = n" and "n \<noteq> 0"
  83.955 -  shows "p divides (pexp q n)"
  83.956 -using prems
  83.957 -proof(induct n arbitrary: p q rule: nat_less_induct)
  83.958 -  fix n::nat fix p q :: "complex list"
  83.959 -  assume IH: "\<forall>m<n. \<forall>p q.
  83.960 -                 (\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longrightarrow>
  83.961 -                 degree p = m \<longrightarrow> m \<noteq> 0 \<longrightarrow> p divides (q %^ m)"
  83.962 -    and pq0: "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0" 
  83.963 -    and dpn: "degree p = n" and n0: "n \<noteq> 0"
  83.964 -  let ?ths = "p divides (q %^ n)"
  83.965 -  {fix a assume a: "poly p a = 0"
  83.966 -    {assume p0: "poly p = poly []" 
  83.967 -      hence ?ths unfolding divides_def  using pq0 n0
  83.968 -	apply - apply (rule exI[where x="[]"], rule ext)
  83.969 -	by (auto simp add: poly_mult poly_exp)}
  83.970 -    moreover
  83.971 -    {assume p0: "poly p \<noteq> poly []" 
  83.972 -      and oa: "order  a p \<noteq> 0"
  83.973 -      from p0 have pne: "p \<noteq> []" by auto
  83.974 -      let ?op = "order a p"
  83.975 -      from p0 have ap: "([- a, 1] %^ ?op) divides p" 
  83.976 -	"\<not> pexp [- a, 1] (Suc ?op) divides p" using order by blast+ 
  83.977 -      note oop = order_degree[OF p0, unfolded dpn]
  83.978 -      {assume q0: "q = []"
  83.979 -	hence ?ths using n0 unfolding divides_def 
  83.980 -	  apply simp
  83.981 -	  apply (rule exI[where x="[]"], rule ext)
  83.982 -	  by (simp add: divides_def poly_exp poly_mult)}
  83.983 -      moreover
  83.984 -      {assume q0: "q\<noteq>[]"
  83.985 -	from pq0[rule_format, OF a, unfolded poly_linear_divides] q0
  83.986 -	obtain r where r: "q = pmult [- a, 1] r" by blast
  83.987 -	from ap[unfolded divides_def] obtain s where
  83.988 -	  s: "poly p = poly (pmult (pexp [- a, 1] ?op) s)" by blast
  83.989 -	have s0: "poly s \<noteq> poly []"
  83.990 -	  using s p0 by (simp add: poly_entire)
  83.991 -	hence pns0: "poly (pnormalize s) \<noteq> poly []" and sne: "s\<noteq>[]" by auto
  83.992 -	{assume ds0: "degree s = 0"
  83.993 -	  from ds0 pns0 have "\<exists>k. pnormalize s = [k]" unfolding degree_def 
  83.994 -	    by (cases "pnormalize s", auto)
  83.995 -	  then obtain k where kpn: "pnormalize s = [k]" by blast
  83.996 -	  from pns0[unfolded poly_zero] kpn have k: "k \<noteq>0" "poly s = poly [k]"
  83.997 -	    using poly_normalize[of s] by simp_all
  83.998 -	  let ?w = "pmult (pmult [1/k] (pexp [-a,1] (n - ?op))) (pexp r n)"
  83.999 -	  from k r s oop have "poly (pexp q n) = poly (pmult p ?w)"
 83.1000 -	    by - (rule ext, simp add: poly_mult poly_exp poly_cmult poly_add power_add[symmetric] ring_simps power_mult_distrib[symmetric])
 83.1001 -	  hence ?ths unfolding divides_def by blast}
 83.1002 -	moreover
 83.1003 -	{assume ds0: "degree s \<noteq> 0"
 83.1004 -	  from ds0 s0 dpn degree_unique[OF s, unfolded linear_pow_mul_degree] oa
 83.1005 -	    have dsn: "degree s < n" by auto 
 83.1006 -	    {fix x assume h: "poly s x = 0"
 83.1007 -	      {assume xa: "x = a"
 83.1008 -		from h[unfolded xa poly_linear_divides] sne obtain u where
 83.1009 -		  u: "s = pmult [- a, 1] u" by blast
 83.1010 -		have "poly p = poly (pmult (pexp [- a, 1] (Suc ?op)) u)"
 83.1011 -		  unfolding s u
 83.1012 -		  apply (rule ext)
 83.1013 -		  by (simp add: ring_simps power_mult_distrib[symmetric] poly_mult poly_cmult poly_add poly_exp)
 83.1014 -		with ap(2)[unfolded divides_def] have False by blast}
 83.1015 -	      note xa = this
 83.1016 -	      from h s have "poly p x = 0" by (simp add: poly_mult)
 83.1017 -	      with pq0 have "poly q x = 0" by blast
 83.1018 -	      with r xa have "poly r x = 0"
 83.1019 -		by (auto simp add: poly_mult poly_add poly_cmult eq_diff_eq[symmetric])}
 83.1020 -	    note impth = this
 83.1021 -	    from IH[rule_format, OF dsn, of s r] impth ds0
 83.1022 -	    have "s divides (pexp r (degree s))" by blast
 83.1023 -	    then obtain u where u: "poly (pexp r (degree s)) = poly (pmult s u)"
 83.1024 -	      unfolding divides_def by blast
 83.1025 -	    hence u': "\<And>x. poly s x * poly u x = poly r x ^ degree s"
 83.1026 -	      by (simp add: poly_mult[symmetric] poly_exp[symmetric])
 83.1027 -	    let ?w = "pmult (pmult u (pexp [-a,1] (n - ?op))) (pexp r (n - degree s))"
 83.1028 -	    from u' s r oop[of a] dsn have "poly (pexp q n) = poly (pmult p ?w)"
 83.1029 -	      apply - apply (rule ext)
 83.1030 -	      apply (simp only:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult ring_simps)
 83.1031 -	      
 83.1032 -	      apply (simp add:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult mult_assoc[symmetric])
 83.1033 -	      done
 83.1034 -	    hence ?ths unfolding divides_def by blast}
 83.1035 -      ultimately have ?ths by blast }
 83.1036 -      ultimately have ?ths by blast}
 83.1037 -    ultimately have ?ths using a order_root by blast}
 83.1038 -  moreover
 83.1039 -  {assume exa: "\<not> (\<exists>a. poly p a = 0)"
 83.1040 -    from fundamental_theorem_of_algebra_alt[of p] exa obtain c cs where
 83.1041 -      ccs: "c\<noteq>0" "list_all (\<lambda>c. c = 0) cs" "p = c#cs" by blast
 83.1042 -    
 83.1043 -    from poly_0[OF ccs(2)] ccs(3) 
 83.1044 -    have pp: "\<And>x. poly p x =  c" by simp
 83.1045 -    let ?w = "pmult [1/c] (pexp q n)"
 83.1046 -    from pp ccs(1) 
 83.1047 -    have "poly (pexp q n) = poly (pmult p ?w) "
 83.1048 -      apply - apply (rule ext)
 83.1049 -      unfolding poly_mult_assoc[symmetric] by (simp add: poly_mult)
 83.1050 -    hence ?ths unfolding divides_def by blast}
 83.1051 -  ultimately show ?ths by blast
 83.1052 -qed
 83.1053 -
 83.1054 -lemma nullstellensatz_univariate:
 83.1055 -  "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> 
 83.1056 -    p divides (q %^ (degree p)) \<or> (poly p = poly [] \<and> poly q = poly [])"
 83.1057 -proof-
 83.1058 -  {assume pe: "poly p = poly []"
 83.1059 -    hence eq: "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> poly q = poly []"
 83.1060 -      apply auto
 83.1061 -      by (rule ext, simp)
 83.1062 -    {assume "p divides (pexp q (degree p))"
 83.1063 -      then obtain r where r: "poly (pexp q (degree p)) = poly (pmult p r)" 
 83.1064 -	unfolding divides_def by blast
 83.1065 -      from cong[OF r refl] pe degree_unique[OF pe]
 83.1066 -      have False by (simp add: poly_mult degree_def)}
 83.1067 -    with eq pe have ?thesis by blast}
 83.1068 -  moreover
 83.1069 -  {assume pe: "poly p \<noteq> poly []"
 83.1070 -    have p0: "poly [0] = poly []" by (rule ext, simp)
 83.1071 -    {assume dp: "degree p = 0"
 83.1072 -      then obtain k where "pnormalize p = [k]" using pe poly_normalize[of p]
 83.1073 -	unfolding degree_def by (cases "pnormalize p", auto)
 83.1074 -      hence k: "pnormalize p = [k]" "poly p = poly [k]" "k\<noteq>0"
 83.1075 -	using pe poly_normalize[of p] by (auto simp add: p0)
 83.1076 -      hence th1: "\<forall>x. poly p x \<noteq> 0" by simp
 83.1077 -      from k(2,3) dp have "poly (pexp q (degree p)) = poly (pmult p [1/k]) "
 83.1078 -	by - (rule ext, simp add: poly_mult poly_exp)
 83.1079 -      hence th2: "p divides (pexp q (degree p))" unfolding divides_def by blast
 83.1080 -      from th1 th2 pe have ?thesis by blast}
 83.1081 -    moreover
 83.1082 -    {assume dp: "degree p \<noteq> 0"
 83.1083 -      then obtain n where n: "degree p = Suc n " by (cases "degree p", auto)
 83.1084 -      {assume "p divides (pexp q (Suc n))"
 83.1085 -	then obtain u where u: "poly (pexp q (Suc n)) = poly (pmult p u)"
 83.1086 -	  unfolding divides_def by blast
 83.1087 -	hence u' :"\<And>x. poly (pexp q (Suc n)) x = poly (pmult p u) x" by simp_all
 83.1088 -	{fix x assume h: "poly p x = 0" "poly q x \<noteq> 0"
 83.1089 -	  hence "poly (pexp q (Suc n)) x \<noteq> 0" by (simp only: poly_exp) simp	  
 83.1090 -	  hence False using u' h(1) by (simp only: poly_mult poly_exp) simp}}
 83.1091 -	with n nullstellensatz_lemma[of p q "degree p"] dp 
 83.1092 -	have ?thesis by auto}
 83.1093 -    ultimately have ?thesis by blast}
 83.1094 -  ultimately show ?thesis by blast
 83.1095 -qed
 83.1096 -
 83.1097 -text{* Useful lemma *}
 83.1098 -
 83.1099 -lemma (in idom_char_0) constant_degree: "constant (poly p) \<longleftrightarrow> degree p = 0" (is "?lhs = ?rhs")
 83.1100 -proof
 83.1101 -  assume l: ?lhs
 83.1102 -  from l[unfolded constant_def, rule_format, of _ "zero"]
 83.1103 -  have th: "poly p = poly [poly p 0]" apply - by (rule ext, simp)
 83.1104 -  from degree_unique[OF th] show ?rhs by (simp add: degree_def)
 83.1105 -next
 83.1106 -  assume r: ?rhs
 83.1107 -  from r have "pnormalize p = [] \<or> (\<exists>k. pnormalize p = [k])"
 83.1108 -    unfolding degree_def by (cases "pnormalize p", auto)
 83.1109 -  then show ?lhs unfolding constant_def poly_normalize[of p, symmetric]
 83.1110 -    by (auto simp del: poly_normalize)
 83.1111 -qed
 83.1112 -
 83.1113 -(* It would be nicer to prove this without using algebraic closure...        *)
 83.1114 -
 83.1115 -lemma divides_degree_lemma: assumes dpn: "degree (p::complex list) = n"
 83.1116 -  shows "n \<le> degree (p *** q) \<or> poly (p *** q) = poly []"
 83.1117 -  using dpn
 83.1118 -proof(induct n arbitrary: p q)
 83.1119 -  case 0 thus ?case by simp
 83.1120 -next
 83.1121 -  case (Suc n p q)
 83.1122 -  from Suc.prems fundamental_theorem_of_algebra[of p] constant_degree[of p]
 83.1123 -  obtain a where a: "poly p a = 0" by auto
 83.1124 -  then obtain r where r: "p = pmult [-a, 1] r" unfolding poly_linear_divides
 83.1125 -    using Suc.prems by (auto simp add: degree_def)
 83.1126 -  {assume h: "poly (pmult r q) = poly []"
 83.1127 -    hence "poly (pmult p q) = poly []" using r
 83.1128 -      apply - apply (rule ext)  by (auto simp add: poly_entire poly_mult poly_add poly_cmult) hence ?case by blast}
 83.1129 -  moreover
 83.1130 -  {assume h: "poly (pmult r q) \<noteq> poly []" 
 83.1131 -    hence r0: "poly r \<noteq> poly []" and q0: "poly q \<noteq> poly []"
 83.1132 -      by (auto simp add: poly_entire)
 83.1133 -    have eq: "poly (pmult p q) = poly (pmult [-a, 1] (pmult r q))"
 83.1134 -      apply - apply (rule ext)
 83.1135 -      by (simp add: r poly_mult poly_add poly_cmult ring_simps)
 83.1136 -    from linear_mul_degree[OF h, of "- a"]
 83.1137 -    have dqe: "degree (pmult p q) = degree (pmult r q) + 1"
 83.1138 -      unfolding degree_unique[OF eq] .
 83.1139 -    from linear_mul_degree[OF r0, of "- a", unfolded r[symmetric]] r Suc.prems 
 83.1140 -    have dr: "degree r = n" by auto
 83.1141 -    from  Suc.hyps[OF dr, of q] have "Suc n \<le> degree (pmult p q)"
 83.1142 -      unfolding dqe using h by (auto simp del: poly.simps) 
 83.1143 -    hence ?case by blast}
 83.1144 -  ultimately show ?case by blast
 83.1145 -qed
 83.1146 -
 83.1147 -lemma divides_degree: assumes pq: "p divides (q:: complex list)"
 83.1148 -  shows "degree p \<le> degree q \<or> poly q = poly []"
 83.1149 -using pq  divides_degree_lemma[OF refl, of p]
 83.1150 -apply (auto simp add: divides_def poly_entire)
 83.1151 -apply atomize
 83.1152 -apply (erule_tac x="qa" in allE, auto)
 83.1153 -apply (subgoal_tac "degree q = degree (p *** qa)", simp)
 83.1154 -apply (rule degree_unique, simp)
 83.1155 -done
 83.1156 -
 83.1157 -(* Arithmetic operations on multivariate polynomials.                        *)
 83.1158 -
 83.1159 -lemma mpoly_base_conv: 
 83.1160 -  "(0::complex) \<equiv> poly [] x" "c \<equiv> poly [c] x" "x \<equiv> poly [0,1] x" by simp_all
 83.1161 -
 83.1162 -lemma mpoly_norm_conv: 
 83.1163 -  "poly [0] (x::complex) \<equiv> poly [] x" "poly [poly [] y] x \<equiv> poly [] x" by simp_all
 83.1164 -
 83.1165 -lemma mpoly_sub_conv: 
 83.1166 -  "poly p (x::complex) - poly q x \<equiv> poly p x + -1 * poly q x"
 83.1167 -  by (simp add: diff_def)
 83.1168 -
 83.1169 -lemma poly_pad_rule: "poly p x = 0 ==> poly (0#p) x = (0::complex)" by simp
 83.1170 -
 83.1171 -lemma poly_cancel_eq_conv: "p = (0::complex) \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (q = 0) \<equiv> (a * q - b * p = 0)" apply (atomize (full)) by auto
 83.1172 -
 83.1173 -lemma resolve_eq_raw:  "poly [] x \<equiv> 0" "poly [c] x \<equiv> (c::complex)" by auto
 83.1174 -lemma  resolve_eq_then: "(P \<Longrightarrow> (Q \<equiv> Q1)) \<Longrightarrow> (\<not>P \<Longrightarrow> (Q \<equiv> Q2))
 83.1175 -  \<Longrightarrow> Q \<equiv> P \<and> Q1 \<or> \<not>P\<and> Q2" apply (atomize (full)) by blast 
 83.1176 -lemma expand_ex_beta_conv: "list_ex P [c] \<equiv> P c" by simp
 83.1177 -
 83.1178 -lemma poly_divides_pad_rule: 
 83.1179 -  fixes p q :: "complex list"
 83.1180 -  assumes pq: "p divides q"
 83.1181 -  shows "p divides ((0::complex)#q)"
 83.1182 -proof-
 83.1183 -  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
 83.1184 -  hence "poly (0#q) = poly (p *** ([0,1] *** r))" 
 83.1185 -    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
 83.1186 -  thus ?thesis unfolding divides_def by blast
 83.1187 -qed
 83.1188 -
 83.1189 -lemma poly_divides_pad_const_rule: 
 83.1190 -  fixes p q :: "complex list"
 83.1191 -  assumes pq: "p divides q"
 83.1192 -  shows "p divides (a %* q)"
 83.1193 -proof-
 83.1194 -  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
 83.1195 -  hence "poly (a %* q) = poly (p *** (a %* r))" 
 83.1196 -    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
 83.1197 -  thus ?thesis unfolding divides_def by blast
 83.1198 -qed
 83.1199 -
 83.1200 -
 83.1201 -lemma poly_divides_conv0:  
 83.1202 -  fixes p :: "complex list"
 83.1203 -  assumes lgpq: "length q < length p" and lq:"last p \<noteq> 0"
 83.1204 -  shows "p divides q \<equiv> (\<not> (list_ex (\<lambda>c. c \<noteq> 0) q))" (is "?lhs \<equiv> ?rhs")
 83.1205 -proof-
 83.1206 -  {assume r: ?rhs 
 83.1207 -    hence eq: "poly q = poly []" unfolding poly_zero 
 83.1208 -      by (simp add: list_all_iff list_ex_iff)
 83.1209 -    hence "poly q = poly (p *** [])" by - (rule ext, simp add: poly_mult)
 83.1210 -    hence ?lhs unfolding divides_def  by blast}
 83.1211 -  moreover
 83.1212 -  {assume l: ?lhs
 83.1213 -    have ath: "\<And>lq lp dq::nat. lq < lp ==> lq \<noteq> 0 \<Longrightarrow> dq <= lq - 1 ==> dq < lp - 1"
 83.1214 -      by arith
 83.1215 -    {assume q0: "length q = 0"
 83.1216 -      hence "q = []" by simp
 83.1217 -      hence ?rhs by simp}
 83.1218 -    moreover
 83.1219 -    {assume lgq0: "length q \<noteq> 0"
 83.1220 -      from pnormalize_length[of q] have dql: "degree q \<le> length q - 1" 
 83.1221 -	unfolding degree_def by simp
 83.1222 -      from ath[OF lgpq lgq0 dql, unfolded pnormal_degree[OF lq, symmetric]] divides_degree[OF l] have "poly q = poly []" by auto
 83.1223 -      hence ?rhs unfolding poly_zero by (simp add: list_all_iff list_ex_iff)}
 83.1224 -    ultimately have ?rhs by blast }
 83.1225 -  ultimately show "?lhs \<equiv> ?rhs" by - (atomize (full), blast) 
 83.1226 -qed
 83.1227 -
 83.1228 -lemma poly_divides_conv1: 
 83.1229 -  assumes a0: "a\<noteq> (0::complex)" and pp': "(p::complex list) divides p'"
 83.1230 -  and qrp': "\<And>x. a * poly q x - poly p' x \<equiv> poly r x"
 83.1231 -  shows "p divides q \<equiv> p divides (r::complex list)" (is "?lhs \<equiv> ?rhs")
 83.1232 -proof-
 83.1233 -  {
 83.1234 -  from pp' obtain t where t: "poly p' = poly (p *** t)" 
 83.1235 -    unfolding divides_def by blast
 83.1236 -  {assume l: ?lhs
 83.1237 -    then obtain u where u: "poly q = poly (p *** u)" unfolding divides_def by blast
 83.1238 -     have "poly r = poly (p *** ((a %* u) +++ (-- t)))"
 83.1239 -       using u qrp' t
 83.1240 -       by - (rule ext, 
 83.1241 -	 simp add: poly_add poly_mult poly_cmult poly_minus ring_simps)
 83.1242 -     then have ?rhs unfolding divides_def by blast}
 83.1243 -  moreover
 83.1244 -  {assume r: ?rhs
 83.1245 -    then obtain u where u: "poly r = poly (p *** u)" unfolding divides_def by blast
 83.1246 -    from u t qrp' a0 have "poly q = poly (p *** ((1/a) %* (u +++ t)))"
 83.1247 -      by - (rule ext, atomize (full), simp add: poly_mult poly_add poly_cmult field_simps)
 83.1248 -    hence ?lhs  unfolding divides_def by blast}
 83.1249 -  ultimately have "?lhs = ?rhs" by blast }
 83.1250 -thus "?lhs \<equiv> ?rhs"  by - (atomize(full), blast) 
 83.1251 -qed
 83.1252 -
 83.1253 -lemma basic_cqe_conv1:
 83.1254 -  "(\<exists>x. poly p x = 0 \<and> poly [] x \<noteq> 0) \<equiv> False"
 83.1255 -  "(\<exists>x. poly [] x \<noteq> 0) \<equiv> False"
 83.1256 -  "(\<exists>x. poly [c] x \<noteq> 0) \<equiv> c\<noteq>0"
 83.1257 -  "(\<exists>x. poly [] x = 0) \<equiv> True"
 83.1258 -  "(\<exists>x. poly [c] x = 0) \<equiv> c = 0" by simp_all
 83.1259 -
 83.1260 -lemma basic_cqe_conv2: 
 83.1261 -  assumes l:"last (a#b#p) \<noteq> 0" 
 83.1262 -  shows "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True"
 83.1263 -proof-
 83.1264 -  {fix h t
 83.1265 -    assume h: "h\<noteq>0" "list_all (\<lambda>c. c=(0::complex)) t"  "a#b#p = h#t"
 83.1266 -    hence "list_all (\<lambda>c. c= 0) (b#p)" by simp
 83.1267 -    moreover have "last (b#p) \<in> set (b#p)" by simp
 83.1268 -    ultimately have "last (b#p) = 0" by (simp add: list_all_iff)
 83.1269 -    with l have False by simp}
 83.1270 -  hence th: "\<not> (\<exists> h t. h\<noteq>0 \<and> list_all (\<lambda>c. c=0) t \<and> a#b#p = h#t)"
 83.1271 -    by blast
 83.1272 -  from fundamental_theorem_of_algebra_alt[OF th] 
 83.1273 -  show "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True" by auto
 83.1274 -qed
 83.1275 -
 83.1276 -lemma  basic_cqe_conv_2b: "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
 83.1277 -proof-
 83.1278 -  have "\<not> (list_ex (\<lambda>c. c \<noteq> 0) p) \<longleftrightarrow> poly p = poly []" 
 83.1279 -    by (simp add: poly_zero list_all_iff list_ex_iff)
 83.1280 -  also have "\<dots> \<longleftrightarrow> (\<not> (\<exists>x. poly p x \<noteq> 0))" by (auto intro: ext)
 83.1281 -  finally show "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
 83.1282 -    by - (atomize (full), blast)
 83.1283 -qed
 83.1284 -
 83.1285 -lemma basic_cqe_conv3:
 83.1286 -  fixes p q :: "complex list"
 83.1287 -  assumes l: "last (a#p) \<noteq> 0" 
 83.1288 -  shows "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
 83.1289 -proof-
 83.1290 -  note np = pnormalize_eq[OF l]
 83.1291 -  {assume "poly (a#p) = poly []" hence False using l
 83.1292 -      unfolding poly_zero apply (auto simp add: list_all_iff del: last.simps)
 83.1293 -      apply (cases p, simp_all) done}
 83.1294 -  then have p0: "poly (a#p) \<noteq> poly []"  by blast
 83.1295 -  from np have dp:"degree (a#p) = length p" by (simp add: degree_def)
 83.1296 -  from nullstellensatz_univariate[of "a#p" q] p0 dp
 83.1297 -  show "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
 83.1298 -    by - (atomize (full), auto)
 83.1299 -qed
 83.1300 -
 83.1301 -lemma basic_cqe_conv4:
 83.1302 -  fixes p q :: "complex list"
 83.1303 -  assumes h: "\<And>x. poly (q %^ n) x \<equiv> poly r x"
 83.1304 -  shows "p divides (q %^ n) \<equiv> p divides r"
 83.1305 -proof-
 83.1306 -  from h have "poly (q %^ n) = poly r" by (auto intro: ext)  
 83.1307 -  thus "p divides (q %^ n) \<equiv> p divides r" unfolding divides_def by simp
 83.1308 -qed
 83.1309 -
 83.1310 -lemma pmult_Cons_Cons: "((a::complex)#b#p) *** q = (a %*q) +++ (0#((b#p) *** q))"
 83.1311 -  by simp
 83.1312 -
 83.1313 -lemma elim_neg_conv: "- z \<equiv> (-1) * (z::complex)" by simp
 83.1314 -lemma eqT_intr: "PROP P \<Longrightarrow> (True \<Longrightarrow> PROP P )" "PROP P \<Longrightarrow> True" by blast+
 83.1315 -lemma negate_negate_rule: "Trueprop P \<equiv> \<not> P \<equiv> False" by (atomize (full), auto)
 83.1316 -lemma last_simps: "last [x] = x" "last (x#y#ys) = last (y#ys)" by simp_all
 83.1317 -lemma length_simps: "length [] = 0" "length (x#y#xs) = length xs + 2" "length [x] = 1" by simp_all
 83.1318 -
 83.1319 -lemma complex_entire: "(z::complex) \<noteq> 0 \<and> w \<noteq> 0 \<equiv> z*w \<noteq> 0" by simp
 83.1320 -lemma resolve_eq_ne: "(P \<equiv> True) \<equiv> (\<not>P \<equiv> False)" "(P \<equiv> False) \<equiv> (\<not>P \<equiv> True)" 
 83.1321 -  by (atomize (full)) simp_all
 83.1322 -lemma cqe_conv1: "poly [] x = 0 \<longleftrightarrow> True"  by simp
 83.1323 -lemma cqe_conv2: "(p \<Longrightarrow> (q \<equiv> r)) \<equiv> ((p \<and> q) \<equiv> (p \<and> r))"  (is "?l \<equiv> ?r")
 83.1324 -proof
 83.1325 -  assume "p \<Longrightarrow> q \<equiv> r" thus "p \<and> q \<equiv> p \<and> r" apply - apply (atomize (full)) by blast
 83.1326 -next
 83.1327 -  assume "p \<and> q \<equiv> p \<and> r" "p"
 83.1328 -  thus "q \<equiv> r" apply - apply (atomize (full)) apply blast done
 83.1329 -qed
 83.1330 -lemma poly_const_conv: "poly [c] (x::complex) = y \<longleftrightarrow> c = y" by simp
 83.1331 -
 83.1332 -end
 83.1333 \ No newline at end of file
    84.1 --- a/src/HOL/Complex/README.html	Tue Dec 30 08:18:54 2008 +0100
    84.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    84.3 @@ -1,67 +0,0 @@
    84.4 -<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">
    84.5 -
    84.6 -<!-- $Id$ -->
    84.7 -
    84.8 -<HTML>
    84.9 -
   84.10 -<HEAD>
   84.11 -  <meta http-equiv="content-type" content="text/html;charset=iso-8859-1">
   84.12 -  <TITLE>HOL/Complex/README</TITLE>
   84.13 -</HEAD>
   84.14 -
   84.15 -<BODY>
   84.16 -
   84.17 -<H1>Complex: The Complex Numbers</H1>
   84.18 -		<P>This directory defines the type <KBD>complex</KBD> of the complex numbers,
   84.19 -with numeric constants and some complex analysis.  The development includes
   84.20 -nonstandard analysis for the complex numbers.  Note that the image
   84.21 -<KBD>HOL-Complex</KBD> includes theories from the directories 
   84.22 -<KBD><a href="#Anchor-Real">HOL/Real</a></KBD>  and <KBD><a href="#Anchor-Hyperreal">HOL/Hyperreal</a></KBD>. They define other types including <kbd>real</kbd> (the real numbers) and <kbd>hypreal</kbd> (the hyperreal or non-standard reals).
   84.23 -
   84.24 -<ul>
   84.25 -<li><a href="CLim.html">CLim</a> Limits, continuous functions, and derivatives for the complex numbers
   84.26 -<li><a href="CSeries.html">CSeries</a> Finite summation and infinite series for the complex numbers
   84.27 -<li><a href="CStar.html">CStar</a> Star-transforms for the complex numbers, to form non-standard extensions of sets and functions
   84.28 -<li><a href="Complex.html">Complex</a> The complex numbers
   84.29 -<li><a href="NSCA.html">NSCA</a> Nonstandard complex analysis
   84.30 -<li><a href="NSComplex.html">NSComplex</a> Ultrapower construction of the nonstandard complex numbers
   84.31 -</ul>
   84.32 -
   84.33 -<h2><a name="Anchor-Real" id="Anchor-Real"></a>Real: Dedekind Cut Construction of the Real Line</h2>
   84.34 -
   84.35 -<ul>
   84.36 -<li><a href="Lubs.html">Lubs</a> Definition of upper bounds, lubs and so on, to support completeness proofs.
   84.37 -<li><a href="PReal.html">PReal</a> The positive reals constructed using Dedekind cuts
   84.38 -<li><a href="Rational.html">Rational</a> The rational numbers constructed as equivalence classes of integers
   84.39 -<li><a href="RComplete.html">RComplete</a> The reals are complete: they satisfy the supremum property. They also have the Archimedean property.
   84.40 -<li><a href="RealDef.html">RealDef</a> The real numbers, their ordering properties, and embedding of the integers and the natural numbers
   84.41 -<li><a href="RealPow.html">RealPow</a> Real numbers raised to natural number powers
   84.42 -</ul>
   84.43 -<h2><a name="Anchor-Hyperreal" id="Anchor-Hyperreal"></a>Hyperreal: Ultrafilter Construction of the Non-Standard Reals</h2>
   84.44 -See J. D. Fleuriot and L. C. Paulson. Mechanizing Nonstandard Real Analysis. LMS J. Computation and Mathematics 3 (2000), 140-190.
   84.45 -<ul>
   84.46 -<li><a href="Filter.html">Filter</a> Theory of Filters and Ultrafilters. Main result is a version of the Ultrafilter Theorem proved using Zorn's Lemma.
   84.47 -<li><a href="HLog.html">HLog</a> Non-standard logarithms
   84.48 -<li><a href="HSeries.html">HSeries</a> Non-standard theory of finite summation and infinite series
   84.49 -<li><a href="HTranscendental.html">HTranscendental</a> Non-standard extensions of transcendental functions
   84.50 -<li><a href="HyperDef.html">HyperDef</a> Ultrapower construction of the hyperreals
   84.51 -<li><a href="HyperNat.html">HyperNat</a> Ultrapower construction of the hypernaturals
   84.52 -<li><a href="HyperPow.html">HyperPow</a> Powers theory for the hyperreals
   84.53 -<!-- <li><a href="IntFloor.html">IntFloor</a> Floor and Ceiling functions relating the reals and integers -->
   84.54 -<li><a href="Integration.html">Integration</a> Gage integrals
   84.55 -<li><a href="Lim.html">Lim</a> Theory of limits, continuous functions, and derivatives
   84.56 -<li><a href="Log.html">Log</a> Logarithms for the reals
   84.57 -<li><a href="MacLaurin.html">MacLaurin</a> MacLaurin series
   84.58 -<li><a href="NatStar.html">NatStar</a> Star-transforms for the hypernaturals, to form non-standard extensions of sets and functions involving the naturals or reals
   84.59 -<li><a href="NthRoot.html">NthRoot</a> Existence of n-th roots of real numbers
   84.60 -<li><a href="NSA.html">NSA</a> Theory defining sets of infinite numbers, infinitesimals, the infinitely close relation, and their various algebraic properties.
   84.61 -<li><a href="Poly.html">Poly</a> Univariate real polynomials
   84.62 -<li><a href="SEQ.html">SEQ</a> Convergence of sequences and series using standard and nonstandard analysis
   84.63 -<li><a href="Series.html">Series</a> Finite summation and infinite series for the reals
   84.64 -<li><a href="Star.html">Star</a> Nonstandard extensions of real sets and real functions
   84.65 -<li><a href="Transcendental.html">Transcendental</a> Power series and transcendental functions
   84.66 -</ul>
   84.67 -<HR>
   84.68 -<P>Last modified $Date$
   84.69 -</BODY>
   84.70 -</HTML>
    85.1 --- a/src/HOL/Complex/document/root.tex	Tue Dec 30 08:18:54 2008 +0100
    85.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    85.3 @@ -1,32 +0,0 @@
    85.4 -
    85.5 -% $Id$
    85.6 -
    85.7 -\documentclass[11pt,a4paper]{article}
    85.8 -\usepackage{graphicx,isabelle,isabellesym,latexsym}
    85.9 -\usepackage[latin1]{inputenc}
   85.10 -\usepackage{pdfsetup}
   85.11 -
   85.12 -\urlstyle{rm}
   85.13 -\isabellestyle{it}
   85.14 -\pagestyle{myheadings}
   85.15 -
   85.16 -\begin{document}
   85.17 -
   85.18 -\title{Isabelle/HOL-Complex --- Higher-Order Logic with Complex Numbers}
   85.19 -\maketitle
   85.20 -
   85.21 -\tableofcontents
   85.22 -
   85.23 -\begin{center}
   85.24 -  \includegraphics[width=\textwidth,height=\textheight,keepaspectratio]{session_graph}
   85.25 -\end{center}
   85.26 -
   85.27 -\newpage
   85.28 -
   85.29 -\renewcommand{\isamarkupheader}[1]%
   85.30 -{\section{\isabellecontext: #1}\markright{THEORY~``\isabellecontext''}}
   85.31 -
   85.32 -\parindent 0pt\parskip 0.5ex
   85.33 -\input{session}
   85.34 -
   85.35 -\end{document}
    86.1 --- a/src/HOL/Complex_Main.thy	Tue Dec 30 08:18:54 2008 +0100
    86.2 +++ b/src/HOL/Complex_Main.thy	Tue Dec 30 11:10:01 2008 +0100
    86.3 @@ -9,7 +9,7 @@
    86.4  imports
    86.5    Main
    86.6    Real
    86.7 -  "~~/src/HOL/Complex/Fundamental_Theorem_Algebra"
    86.8 +  Fundamental_Theorem_Algebra
    86.9    Log
   86.10    Ln
   86.11    Taylor
    87.1 --- a/src/HOL/Datatype.thy	Tue Dec 30 08:18:54 2008 +0100
    87.2 +++ b/src/HOL/Datatype.thy	Tue Dec 30 11:10:01 2008 +0100
    87.3 @@ -578,7 +578,13 @@
    87.4  lemma Sumr_inject: "Sumr f = Sumr g ==> f = g"
    87.5    by (unfold Sumr_def) (erule sum_case_inject)
    87.6  
    87.7 -hide (open) const Suml Sumr
    87.8 +primrec Projl :: "'a + 'b => 'a"
    87.9 +where Projl_Inl: "Projl (Inl x) = x"
   87.10 +
   87.11 +primrec Projr :: "'a + 'b => 'b"
   87.12 +where Projr_Inr: "Projr (Inr x) = x"
   87.13 +
   87.14 +hide (open) const Suml Sumr Projl Projr
   87.15  
   87.16  
   87.17  subsection {* The option datatype *}
    88.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    88.2 +++ b/src/HOL/Dense_Linear_Order.thy	Tue Dec 30 11:10:01 2008 +0100
    88.3 @@ -0,0 +1,877 @@
    88.4 +(* Author: Amine Chaieb, TU Muenchen *)
    88.5 +
    88.6 +header {* Dense linear order without endpoints
    88.7 +  and a quantifier elimination procedure in Ferrante and Rackoff style *}
    88.8 +
    88.9 +theory Dense_Linear_Order
   88.10 +imports Plain Groebner_Basis
   88.11 +uses
   88.12 +  "~~/src/HOL/Tools/Qelim/langford_data.ML"
   88.13 +  "~~/src/HOL/Tools/Qelim/ferrante_rackoff_data.ML"
   88.14 +  ("~~/src/HOL/Tools/Qelim/langford.ML")
   88.15 +  ("~~/src/HOL/Tools/Qelim/ferrante_rackoff.ML")
   88.16 +begin
   88.17 +
   88.18 +setup {* Langford_Data.setup #> Ferrante_Rackoff_Data.setup *}
   88.19 +
   88.20 +context linorder
   88.21 +begin
   88.22 +
   88.23 +lemma less_not_permute: "\<not> (x < y \<and> y < x)" by (simp add: not_less linear)
   88.24 +
   88.25 +lemma gather_simps: 
   88.26 +  shows 
   88.27 +  "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> x < u \<and> P x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> (insert u U). x < y) \<and> P x)"
   88.28 +  and "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> l < x \<and> P x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> (insert l L). y < x) \<and> (\<forall>y \<in> U. x < y) \<and> P x)"
   88.29 +  "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> x < u) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> (insert u U). x < y))"
   88.30 +  and "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y) \<and> l < x) \<longleftrightarrow> (\<exists>x. (\<forall>y \<in> (insert l L). y < x) \<and> (\<forall>y \<in> U. x < y))"  by auto
   88.31 +
   88.32 +lemma 
   88.33 +  gather_start: "(\<exists>x. P x) \<equiv> (\<exists>x. (\<forall>y \<in> {}. y < x) \<and> (\<forall>y\<in> {}. x < y) \<and> P x)" 
   88.34 +  by simp
   88.35 +
   88.36 +text{* Theorems for @{text "\<exists>z. \<forall>x. x < z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>-\<infinity>\<^esub>)"}*}
   88.37 +lemma minf_lt:  "\<exists>z . \<forall>x. x < z \<longrightarrow> (x < t \<longleftrightarrow> True)" by auto
   88.38 +lemma minf_gt: "\<exists>z . \<forall>x. x < z \<longrightarrow>  (t < x \<longleftrightarrow>  False)"
   88.39 +  by (simp add: not_less) (rule exI[where x="t"], auto simp add: less_le)
   88.40 +
   88.41 +lemma minf_le: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x \<le> t \<longleftrightarrow> True)" by (auto simp add: less_le)
   88.42 +lemma minf_ge: "\<exists>z. \<forall>x. x < z \<longrightarrow> (t \<le> x \<longleftrightarrow> False)"
   88.43 +  by (auto simp add: less_le not_less not_le)
   88.44 +lemma minf_eq: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x = t \<longleftrightarrow> False)" by auto
   88.45 +lemma minf_neq: "\<exists>z. \<forall>x. x < z \<longrightarrow> (x \<noteq> t \<longleftrightarrow> True)" by auto
   88.46 +lemma minf_P: "\<exists>z. \<forall>x. x < z \<longrightarrow> (P \<longleftrightarrow> P)" by blast
   88.47 +
   88.48 +text{* Theorems for @{text "\<exists>z. \<forall>x. x < z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>+\<infinity>\<^esub>)"}*}
   88.49 +lemma pinf_gt:  "\<exists>z . \<forall>x. z < x \<longrightarrow> (t < x \<longleftrightarrow> True)" by auto
   88.50 +lemma pinf_lt: "\<exists>z . \<forall>x. z < x \<longrightarrow>  (x < t \<longleftrightarrow>  False)"
   88.51 +  by (simp add: not_less) (rule exI[where x="t"], auto simp add: less_le)
   88.52 +
   88.53 +lemma pinf_ge: "\<exists>z. \<forall>x. z < x \<longrightarrow> (t \<le> x \<longleftrightarrow> True)" by (auto simp add: less_le)
   88.54 +lemma pinf_le: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x \<le> t \<longleftrightarrow> False)"
   88.55 +  by (auto simp add: less_le not_less not_le)
   88.56 +lemma pinf_eq: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x = t \<longleftrightarrow> False)" by auto
   88.57 +lemma pinf_neq: "\<exists>z. \<forall>x. z < x \<longrightarrow> (x \<noteq> t \<longleftrightarrow> True)" by auto
   88.58 +lemma pinf_P: "\<exists>z. \<forall>x. z < x \<longrightarrow> (P \<longleftrightarrow> P)" by blast
   88.59 +
   88.60 +lemma nmi_lt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x < t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.61 +lemma nmi_gt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and> t < x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)"
   88.62 +  by (auto simp add: le_less)
   88.63 +lemma  nmi_le: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x\<le> t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.64 +lemma  nmi_ge: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and> t\<le> x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.65 +lemma  nmi_eq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x = t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.66 +lemma  nmi_neq: "t \<in> U \<Longrightarrow>\<forall>x. \<not>True \<and> x \<noteq> t \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.67 +lemma  nmi_P: "\<forall> x. ~P \<and> P \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.68 +lemma  nmi_conj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x) ;
   88.69 +  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)\<rbrakk> \<Longrightarrow>
   88.70 +  \<forall>x. \<not>(P1' \<and> P2') \<and> (P1 x \<and> P2 x) \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.71 +lemma  nmi_disj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x) ;
   88.72 +  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)\<rbrakk> \<Longrightarrow>
   88.73 +  \<forall>x. \<not>(P1' \<or> P2') \<and> (P1 x \<or> P2 x) \<longrightarrow>  (\<exists> u\<in> U. u \<le> x)" by auto
   88.74 +
   88.75 +lemma  npi_lt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x < t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by (auto simp add: le_less)
   88.76 +lemma  npi_gt: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> t < x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
   88.77 +lemma  npi_le: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x \<le> t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
   88.78 +lemma  npi_ge: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> t \<le> x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
   88.79 +lemma  npi_eq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>False \<and>  x = t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
   88.80 +lemma  npi_neq: "t \<in> U \<Longrightarrow> \<forall>x. \<not>True \<and> x \<noteq> t \<longrightarrow>  (\<exists> u\<in> U. x \<le> u )" by auto
   88.81 +lemma  npi_P: "\<forall> x. ~P \<and> P \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
   88.82 +lemma  npi_conj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u) ;  \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)\<rbrakk>
   88.83 +  \<Longrightarrow>  \<forall>x. \<not>(P1' \<and> P2') \<and> (P1 x \<and> P2 x) \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
   88.84 +lemma  npi_disj: "\<lbrakk>\<forall>x. \<not>P1' \<and> P1 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u) ; \<forall>x. \<not>P2' \<and> P2 x \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)\<rbrakk>
   88.85 +  \<Longrightarrow> \<forall>x. \<not>(P1' \<or> P2') \<and> (P1 x \<or> P2 x) \<longrightarrow>  (\<exists> u\<in> U. x \<le> u)" by auto
   88.86 +
   88.87 +lemma lin_dense_lt: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t < u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x < t \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y < t)"
   88.88 +proof(clarsimp)
   88.89 +  fix x l u y  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x"
   88.90 +    and xu: "x<u"  and px: "x < t" and ly: "l<y" and yu:"y < u"
   88.91 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
   88.92 +  {assume H: "t < y"
   88.93 +    from less_trans[OF lx px] less_trans[OF H yu]
   88.94 +    have "l < t \<and> t < u"  by simp
   88.95 +    with tU noU have "False" by auto}
   88.96 +  hence "\<not> t < y"  by auto hence "y \<le> t" by (simp add: not_less)
   88.97 +  thus "y < t" using tny by (simp add: less_le)
   88.98 +qed
   88.99 +
  88.100 +lemma lin_dense_gt: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l < x \<and> x < u \<and> t < x \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> t < y)"
  88.101 +proof(clarsimp)
  88.102 +  fix x l u y
  88.103 +  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
  88.104 +  and px: "t < x" and ly: "l<y" and yu:"y < u"
  88.105 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
  88.106 +  {assume H: "y< t"
  88.107 +    from less_trans[OF ly H] less_trans[OF px xu] have "l < t \<and> t < u" by simp
  88.108 +    with tU noU have "False" by auto}
  88.109 +  hence "\<not> y<t"  by auto hence "t \<le> y" by (auto simp add: not_less)
  88.110 +  thus "t < y" using tny by (simp add:less_le)
  88.111 +qed
  88.112 +
  88.113 +lemma lin_dense_le: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x \<le> t \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y\<le> t)"
  88.114 +proof(clarsimp)
  88.115 +  fix x l u y
  88.116 +  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
  88.117 +  and px: "x \<le> t" and ly: "l<y" and yu:"y < u"
  88.118 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
  88.119 +  {assume H: "t < y"
  88.120 +    from less_le_trans[OF lx px] less_trans[OF H yu]
  88.121 +    have "l < t \<and> t < u" by simp
  88.122 +    with tU noU have "False" by auto}
  88.123 +  hence "\<not> t < y"  by auto thus "y \<le> t" by (simp add: not_less)
  88.124 +qed
  88.125 +
  88.126 +lemma lin_dense_ge: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> t \<le> x \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> t \<le> y)"
  88.127 +proof(clarsimp)
  88.128 +  fix x l u y
  88.129 +  assume tU: "t \<in> U" and noU: "\<forall>t. l < t \<and> t < u \<longrightarrow> t \<notin> U" and lx: "l < x" and xu: "x<u"
  88.130 +  and px: "t \<le> x" and ly: "l<y" and yu:"y < u"
  88.131 +  from tU noU ly yu have tny: "t\<noteq>y" by auto
  88.132 +  {assume H: "y< t"
  88.133 +    from less_trans[OF ly H] le_less_trans[OF px xu]
  88.134 +    have "l < t \<and> t < u" by simp
  88.135 +    with tU noU have "False" by auto}
  88.136 +  hence "\<not> y<t"  by auto thus "t \<le> y" by (simp add: not_less)
  88.137 +qed
  88.138 +lemma lin_dense_eq: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x = t   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y= t)"  by auto
  88.139 +lemma lin_dense_neq: "t \<in> U \<Longrightarrow> \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> x \<noteq> t   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> y\<noteq> t)"  by auto
  88.140 +lemma lin_dense_P: "\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P   \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P)"  by auto
  88.141 +
  88.142 +lemma lin_dense_conj:
  88.143 +  "\<lbrakk>\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P1 x
  88.144 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P1 y) ;
  88.145 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P2 x
  88.146 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P2 y)\<rbrakk> \<Longrightarrow>
  88.147 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> (P1 x \<and> P2 x)
  88.148 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> (P1 y \<and> P2 y))"
  88.149 +  by blast
  88.150 +lemma lin_dense_disj:
  88.151 +  "\<lbrakk>\<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P1 x
  88.152 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P1 y) ;
  88.153 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> P2 x
  88.154 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> P2 y)\<rbrakk> \<Longrightarrow>
  88.155 +  \<forall>x l u. (\<forall> t. l < t \<and> t< u \<longrightarrow> t \<notin> U) \<and> l< x \<and> x < u \<and> (P1 x \<or> P2 x)
  88.156 +  \<longrightarrow> (\<forall> y. l < y \<and> y < u \<longrightarrow> (P1 y \<or> P2 y))"
  88.157 +  by blast
  88.158 +
  88.159 +lemma npmibnd: "\<lbrakk>\<forall>x. \<not> MP \<and> P x \<longrightarrow> (\<exists> u\<in> U. u \<le> x); \<forall>x. \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. x \<le> u)\<rbrakk>
  88.160 +  \<Longrightarrow> \<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<le> x \<and> x \<le> u')"
  88.161 +by auto
  88.162 +
  88.163 +lemma finite_set_intervals:
  88.164 +  assumes px: "P x" and lx: "l \<le> x" and xu: "x \<le> u" and linS: "l\<in> S"
  88.165 +  and uinS: "u \<in> S" and fS:"finite S" and lS: "\<forall> x\<in> S. l \<le> x" and Su: "\<forall> x\<in> S. x \<le> u"
  88.166 +  shows "\<exists> a \<in> S. \<exists> b \<in> S. (\<forall> y. a < y \<and> y < b \<longrightarrow> y \<notin> S) \<and> a \<le> x \<and> x \<le> b \<and> P x"
  88.167 +proof-
  88.168 +  let ?Mx = "{y. y\<in> S \<and> y \<le> x}"
  88.169 +  let ?xM = "{y. y\<in> S \<and> x \<le> y}"
  88.170 +  let ?a = "Max ?Mx"
  88.171 +  let ?b = "Min ?xM"
  88.172 +  have MxS: "?Mx \<subseteq> S" by blast
  88.173 +  hence fMx: "finite ?Mx" using fS finite_subset by auto
  88.174 +  from lx linS have linMx: "l \<in> ?Mx" by blast
  88.175 +  hence Mxne: "?Mx \<noteq> {}" by blast
  88.176 +  have xMS: "?xM \<subseteq> S" by blast
  88.177 +  hence fxM: "finite ?xM" using fS finite_subset by auto
  88.178 +  from xu uinS have linxM: "u \<in> ?xM" by blast
  88.179 +  hence xMne: "?xM \<noteq> {}" by blast
  88.180 +  have ax:"?a \<le> x" using Mxne fMx by auto
  88.181 +  have xb:"x \<le> ?b" using xMne fxM by auto
  88.182 +  have "?a \<in> ?Mx" using Max_in[OF fMx Mxne] by simp hence ainS: "?a \<in> S" using MxS by blast
  88.183 +  have "?b \<in> ?xM" using Min_in[OF fxM xMne] by simp hence binS: "?b \<in> S" using xMS by blast
  88.184 +  have noy:"\<forall> y. ?a < y \<and> y < ?b \<longrightarrow> y \<notin> S"
  88.185 +  proof(clarsimp)
  88.186 +    fix y   assume ay: "?a < y" and yb: "y < ?b" and yS: "y \<in> S"
  88.187 +    from yS have "y\<in> ?Mx \<or> y\<in> ?xM" by (auto simp add: linear)
  88.188 +    moreover {assume "y \<in> ?Mx" hence "y \<le> ?a" using Mxne fMx by auto with ay have "False" by (simp add: not_le[symmetric])}
  88.189 +    moreover {assume "y \<in> ?xM" hence "?b \<le> y" using xMne fxM by auto with yb have "False" by (simp add: not_le[symmetric])}
  88.190 +    ultimately show "False" by blast
  88.191 +  qed
  88.192 +  from ainS binS noy ax xb px show ?thesis by blast
  88.193 +qed
  88.194 +
  88.195 +lemma finite_set_intervals2:
  88.196 +  assumes px: "P x" and lx: "l \<le> x" and xu: "x \<le> u" and linS: "l\<in> S"
  88.197 +  and uinS: "u \<in> S" and fS:"finite S" and lS: "\<forall> x\<in> S. l \<le> x" and Su: "\<forall> x\<in> S. x \<le> u"
  88.198 +  shows "(\<exists> s\<in> S. P s) \<or> (\<exists> a \<in> S. \<exists> b \<in> S. (\<forall> y. a < y \<and> y < b \<longrightarrow> y \<notin> S) \<and> a < x \<and> x < b \<and> P x)"
  88.199 +proof-
  88.200 +  from finite_set_intervals[where P="P", OF px lx xu linS uinS fS lS Su]
  88.201 +  obtain a and b where
  88.202 +    as: "a\<in> S" and bs: "b\<in> S" and noS:"\<forall>y. a < y \<and> y < b \<longrightarrow> y \<notin> S"
  88.203 +    and axb: "a \<le> x \<and> x \<le> b \<and> P x"  by auto
  88.204 +  from axb have "x= a \<or> x= b \<or> (a < x \<and> x < b)" by (auto simp add: le_less)
  88.205 +  thus ?thesis using px as bs noS by blast
  88.206 +qed
  88.207 +
  88.208 +end
  88.209 +
  88.210 +section {* The classical QE after Langford for dense linear orders *}
  88.211 +
  88.212 +context dense_linear_order
  88.213 +begin
  88.214 +
  88.215 +lemma interval_empty_iff:
  88.216 +  "{y. x < y \<and> y < z} = {} \<longleftrightarrow> \<not> x < z"
  88.217 +  by (auto dest: dense)
  88.218 +
  88.219 +lemma dlo_qe_bnds: 
  88.220 +  assumes ne: "L \<noteq> {}" and neU: "U \<noteq> {}" and fL: "finite L" and fU: "finite U"
  88.221 +  shows "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> U. x < y)) \<equiv> (\<forall> l \<in> L. \<forall>u \<in> U. l < u)"
  88.222 +proof (simp only: atomize_eq, rule iffI)
  88.223 +  assume H: "\<exists>x. (\<forall>y\<in>L. y < x) \<and> (\<forall>y\<in>U. x < y)"
  88.224 +  then obtain x where xL: "\<forall>y\<in>L. y < x" and xU: "\<forall>y\<in>U. x < y" by blast
  88.225 +  {fix l u assume l: "l \<in> L" and u: "u \<in> U"
  88.226 +    have "l < x" using xL l by blast
  88.227 +    also have "x < u" using xU u by blast
  88.228 +    finally (less_trans) have "l < u" .}
  88.229 +  thus "\<forall>l\<in>L. \<forall>u\<in>U. l < u" by blast
  88.230 +next
  88.231 +  assume H: "\<forall>l\<in>L. \<forall>u\<in>U. l < u"
  88.232 +  let ?ML = "Max L"
  88.233 +  let ?MU = "Min U"  
  88.234 +  from fL ne have th1: "?ML \<in> L" and th1': "\<forall>l\<in>L. l \<le> ?ML" by auto
  88.235 +  from fU neU have th2: "?MU \<in> U" and th2': "\<forall>u\<in>U. ?MU \<le> u" by auto
  88.236 +  from th1 th2 H have "?ML < ?MU" by auto
  88.237 +  with dense obtain w where th3: "?ML < w" and th4: "w < ?MU" by blast
  88.238 +  from th3 th1' have "\<forall>l \<in> L. l < w" by auto
  88.239 +  moreover from th4 th2' have "\<forall>u \<in> U. w < u" by auto
  88.240 +  ultimately show "\<exists>x. (\<forall>y\<in>L. y < x) \<and> (\<forall>y\<in>U. x < y)" by auto
  88.241 +qed
  88.242 +
  88.243 +lemma dlo_qe_noub: 
  88.244 +  assumes ne: "L \<noteq> {}" and fL: "finite L"
  88.245 +  shows "(\<exists>x. (\<forall>y \<in> L. y < x) \<and> (\<forall>y \<in> {}. x < y)) \<equiv> True"
  88.246 +proof(simp add: atomize_eq)
  88.247 +  from gt_ex[of "Max L"] obtain M where M: "Max L < M" by blast
  88.248 +  from ne fL have "\<forall>x \<in> L. x \<le> Max L" by simp
  88.249 +  with M have "\<forall>x\<in>L. x < M" by (auto intro: le_less_trans)
  88.250 +  thus "\<exists>x. \<forall>y\<in>L. y < x" by blast
  88.251 +qed
  88.252 +
  88.253 +lemma dlo_qe_nolb: 
  88.254 +  assumes ne: "U \<noteq> {}" and fU: "finite U"
  88.255 +  shows "(\<exists>x. (\<forall>y \<in> {}. y < x) \<and> (\<forall>y \<in> U. x < y)) \<equiv> True"
  88.256 +proof(simp add: atomize_eq)
  88.257 +  from lt_ex[of "Min U"] obtain M where M: "M < Min U" by blast
  88.258 +  from ne fU have "\<forall>x \<in> U. Min U \<le> x" by simp
  88.259 +  with M have "\<forall>x\<in>U. M < x" by (auto intro: less_le_trans)
  88.260 +  thus "\<exists>x. \<forall>y\<in>U. x < y" by blast
  88.261 +qed
  88.262 +
  88.263 +lemma exists_neq: "\<exists>(x::'a). x \<noteq> t" "\<exists>(x::'a). t \<noteq> x" 
  88.264 +  using gt_ex[of t] by auto
  88.265 +
  88.266 +lemmas dlo_simps = order_refl less_irrefl not_less not_le exists_neq 
  88.267 +  le_less neq_iff linear less_not_permute
  88.268 +
  88.269 +lemma axiom: "dense_linear_order (op \<le>) (op <)" by (rule dense_linear_order_axioms)
  88.270 +lemma atoms:
  88.271 +  shows "TERM (less :: 'a \<Rightarrow> _)"
  88.272 +    and "TERM (less_eq :: 'a \<Rightarrow> _)"
  88.273 +    and "TERM (op = :: 'a \<Rightarrow> _)" .
  88.274 +
  88.275 +declare axiom[langford qe: dlo_qe_bnds dlo_qe_nolb dlo_qe_noub gather: gather_start gather_simps atoms: atoms]
  88.276 +declare dlo_simps[langfordsimp]
  88.277 +
  88.278 +end
  88.279 +
  88.280 +(* FIXME: Move to HOL -- together with the conj_aci_rule in langford.ML *)
  88.281 +lemma dnf:
  88.282 +  "(P & (Q | R)) = ((P&Q) | (P&R))" 
  88.283 +  "((Q | R) & P) = ((Q&P) | (R&P))"
  88.284 +  by blast+
  88.285 +
  88.286 +lemmas weak_dnf_simps = simp_thms dnf
  88.287 +
  88.288 +lemma nnf_simps:
  88.289 +    "(\<not>(P \<and> Q)) = (\<not>P \<or> \<not>Q)" "(\<not>(P \<or> Q)) = (\<not>P \<and> \<not>Q)" "(P \<longrightarrow> Q) = (\<not>P \<or> Q)"
  88.290 +    "(P = Q) = ((P \<and> Q) \<or> (\<not>P \<and> \<not> Q))" "(\<not> \<not>(P)) = P"
  88.291 +  by blast+
  88.292 +
  88.293 +lemma ex_distrib: "(\<exists>x. P x \<or> Q x) \<longleftrightarrow> ((\<exists>x. P x) \<or> (\<exists>x. Q x))" by blast
  88.294 +
  88.295 +lemmas dnf_simps = weak_dnf_simps nnf_simps ex_distrib
  88.296 +
  88.297 +use "~~/src/HOL/Tools/Qelim/langford.ML"
  88.298 +method_setup dlo = {*
  88.299 +  Method.ctxt_args (Method.SIMPLE_METHOD' o LangfordQE.dlo_tac)
  88.300 +*} "Langford's algorithm for quantifier elimination in dense linear orders"
  88.301 +
  88.302 +
  88.303 +section {* Contructive dense linear orders yield QE for linear arithmetic over ordered Fields -- see @{text "Arith_Tools.thy"} *}
  88.304 +
  88.305 +text {* Linear order without upper bounds *}
  88.306 +
  88.307 +class_locale linorder_stupid_syntax = linorder
  88.308 +begin
  88.309 +notation
  88.310 +  less_eq  ("op \<sqsubseteq>") and
  88.311 +  less_eq  ("(_/ \<sqsubseteq> _)" [51, 51] 50) and
  88.312 +  less  ("op \<sqsubset>") and
  88.313 +  less  ("(_/ \<sqsubset> _)"  [51, 51] 50)
  88.314 +
  88.315 +end
  88.316 +
  88.317 +class_locale linorder_no_ub = linorder_stupid_syntax +
  88.318 +  assumes gt_ex: "\<exists>y. less x y"
  88.319 +begin
  88.320 +lemma ge_ex: "\<exists>y. x \<sqsubseteq> y" using gt_ex by auto
  88.321 +
  88.322 +text {* Theorems for @{text "\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>+\<infinity>\<^esub>)"} *}
  88.323 +lemma pinf_conj:
  88.324 +  assumes ex1: "\<exists>z1. \<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
  88.325 +  and ex2: "\<exists>z2. \<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
  88.326 +  shows "\<exists>z. \<forall>x. z \<sqsubset>  x \<longrightarrow> ((P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2'))"
  88.327 +proof-
  88.328 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
  88.329 +     and z2: "\<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
  88.330 +  from gt_ex obtain z where z:"ord.max less_eq z1 z2 \<sqsubset> z" by blast
  88.331 +  from z have zz1: "z1 \<sqsubset> z" and zz2: "z2 \<sqsubset> z" by simp_all
  88.332 +  {fix x assume H: "z \<sqsubset> x"
  88.333 +    from less_trans[OF zz1 H] less_trans[OF zz2 H]
  88.334 +    have "(P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2')"  using z1 zz1 z2 zz2 by auto
  88.335 +  }
  88.336 +  thus ?thesis by blast
  88.337 +qed
  88.338 +
  88.339 +lemma pinf_disj:
  88.340 +  assumes ex1: "\<exists>z1. \<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
  88.341 +  and ex2: "\<exists>z2. \<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
  88.342 +  shows "\<exists>z. \<forall>x. z \<sqsubset>  x \<longrightarrow> ((P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2'))"
  88.343 +proof-
  88.344 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. z1 \<sqsubset> x \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
  88.345 +     and z2: "\<forall>x. z2 \<sqsubset> x \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
  88.346 +  from gt_ex obtain z where z:"ord.max less_eq z1 z2 \<sqsubset> z" by blast
  88.347 +  from z have zz1: "z1 \<sqsubset> z" and zz2: "z2 \<sqsubset> z" by simp_all
  88.348 +  {fix x assume H: "z \<sqsubset> x"
  88.349 +    from less_trans[OF zz1 H] less_trans[OF zz2 H]
  88.350 +    have "(P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2')"  using z1 zz1 z2 zz2 by auto
  88.351 +  }
  88.352 +  thus ?thesis by blast
  88.353 +qed
  88.354 +
  88.355 +lemma pinf_ex: assumes ex:"\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P1)" and p1: P1 shows "\<exists> x. P x"
  88.356 +proof-
  88.357 +  from ex obtain z where z: "\<forall>x. z \<sqsubset> x \<longrightarrow> (P x \<longleftrightarrow> P1)" by blast
  88.358 +  from gt_ex obtain x where x: "z \<sqsubset> x" by blast
  88.359 +  from z x p1 show ?thesis by blast
  88.360 +qed
  88.361 +
  88.362 +end
  88.363 +
  88.364 +text {* Linear order without upper bounds *}
  88.365 +
  88.366 +class_locale linorder_no_lb = linorder_stupid_syntax +
  88.367 +  assumes lt_ex: "\<exists>y. less y x"
  88.368 +begin
  88.369 +lemma le_ex: "\<exists>y. y \<sqsubseteq> x" using lt_ex by auto
  88.370 +
  88.371 +
  88.372 +text {* Theorems for @{text "\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P\<^bsub>-\<infinity>\<^esub>)"} *}
  88.373 +lemma minf_conj:
  88.374 +  assumes ex1: "\<exists>z1. \<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
  88.375 +  and ex2: "\<exists>z2. \<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
  88.376 +  shows "\<exists>z. \<forall>x. x \<sqsubset>  z \<longrightarrow> ((P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2'))"
  88.377 +proof-
  88.378 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"and z2: "\<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
  88.379 +  from lt_ex obtain z where z:"z \<sqsubset> ord.min less_eq z1 z2" by blast
  88.380 +  from z have zz1: "z \<sqsubset> z1" and zz2: "z \<sqsubset> z2" by simp_all
  88.381 +  {fix x assume H: "x \<sqsubset> z"
  88.382 +    from less_trans[OF H zz1] less_trans[OF H zz2]
  88.383 +    have "(P1 x \<and> P2 x) \<longleftrightarrow> (P1' \<and> P2')"  using z1 zz1 z2 zz2 by auto
  88.384 +  }
  88.385 +  thus ?thesis by blast
  88.386 +qed
  88.387 +
  88.388 +lemma minf_disj:
  88.389 +  assumes ex1: "\<exists>z1. \<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"
  88.390 +  and ex2: "\<exists>z2. \<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')"
  88.391 +  shows "\<exists>z. \<forall>x. x \<sqsubset>  z \<longrightarrow> ((P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2'))"
  88.392 +proof-
  88.393 +  from ex1 ex2 obtain z1 and z2 where z1: "\<forall>x. x \<sqsubset> z1 \<longrightarrow> (P1 x \<longleftrightarrow> P1')"and z2: "\<forall>x. x \<sqsubset> z2 \<longrightarrow> (P2 x \<longleftrightarrow> P2')" by blast
  88.394 +  from lt_ex obtain z where z:"z \<sqsubset> ord.min less_eq z1 z2" by blast
  88.395 +  from z have zz1: "z \<sqsubset> z1" and zz2: "z \<sqsubset> z2" by simp_all
  88.396 +  {fix x assume H: "x \<sqsubset> z"
  88.397 +    from less_trans[OF H zz1] less_trans[OF H zz2]
  88.398 +    have "(P1 x \<or> P2 x) \<longleftrightarrow> (P1' \<or> P2')"  using z1 zz1 z2 zz2 by auto
  88.399 +  }
  88.400 +  thus ?thesis by blast
  88.401 +qed
  88.402 +
  88.403 +lemma minf_ex: assumes ex:"\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P1)" and p1: P1 shows "\<exists> x. P x"
  88.404 +proof-
  88.405 +  from ex obtain z where z: "\<forall>x. x \<sqsubset> z \<longrightarrow> (P x \<longleftrightarrow> P1)" by blast
  88.406 +  from lt_ex obtain x where x: "x \<sqsubset> z" by blast
  88.407 +  from z x p1 show ?thesis by blast
  88.408 +qed
  88.409 +
  88.410 +end
  88.411 +
  88.412 +
  88.413 +class_locale constr_dense_linear_order = linorder_no_lb + linorder_no_ub +
  88.414 +  fixes between
  88.415 +  assumes between_less: "less x y \<Longrightarrow> less x (between x y) \<and> less (between x y) y"
  88.416 +     and  between_same: "between x x = x"
  88.417 +
  88.418 +class_interpretation  constr_dense_linear_order < dense_linear_order 
  88.419 +  apply unfold_locales
  88.420 +  using gt_ex lt_ex between_less
  88.421 +    by (auto, rule_tac x="between x y" in exI, simp)
  88.422 +
  88.423 +context  constr_dense_linear_order
  88.424 +begin
  88.425 +
  88.426 +lemma rinf_U:
  88.427 +  assumes fU: "finite U"
  88.428 +  and lin_dense: "\<forall>x l u. (\<forall> t. l \<sqsubset> t \<and> t\<sqsubset> u \<longrightarrow> t \<notin> U) \<and> l\<sqsubset> x \<and> x \<sqsubset> u \<and> P x
  88.429 +  \<longrightarrow> (\<forall> y. l \<sqsubset> y \<and> y \<sqsubset> u \<longrightarrow> P y )"
  88.430 +  and nmpiU: "\<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u')"
  88.431 +  and nmi: "\<not> MP"  and npi: "\<not> PP"  and ex: "\<exists> x.  P x"
  88.432 +  shows "\<exists> u\<in> U. \<exists> u' \<in> U. P (between u u')"
  88.433 +proof-
  88.434 +  from ex obtain x where px: "P x" by blast
  88.435 +  from px nmi npi nmpiU have "\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u'" by auto
  88.436 +  then obtain u and u' where uU:"u\<in> U" and uU': "u' \<in> U" and ux:"u \<sqsubseteq> x" and xu':"x \<sqsubseteq> u'" by auto
  88.437 +  from uU have Une: "U \<noteq> {}" by auto
  88.438 +  term "linorder.Min less_eq"
  88.439 +  let ?l = "linorder.Min less_eq U"
  88.440 +  let ?u = "linorder.Max less_eq U"
  88.441 +  have linM: "?l \<in> U" using fU Une by simp
  88.442 +  have uinM: "?u \<in> U" using fU Une by simp
  88.443 +  have lM: "\<forall> t\<in> U. ?l \<sqsubseteq> t" using Une fU by auto
  88.444 +  have Mu: "\<forall> t\<in> U. t \<sqsubseteq> ?u" using Une fU by auto
  88.445 +  have th:"?l \<sqsubseteq> u" using uU Une lM by auto
  88.446 +  from order_trans[OF th ux] have lx: "?l \<sqsubseteq> x" .
  88.447 +  have th: "u' \<sqsubseteq> ?u" using uU' Une Mu by simp
  88.448 +  from order_trans[OF xu' th] have xu: "x \<sqsubseteq> ?u" .
  88.449 +  from finite_set_intervals2[where P="P",OF px lx xu linM uinM fU lM Mu]
  88.450 +  have "(\<exists> s\<in> U. P s) \<or>
  88.451 +      (\<exists> t1\<in> U. \<exists> t2 \<in> U. (\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U) \<and> t1 \<sqsubset> x \<and> x \<sqsubset> t2 \<and> P x)" .
  88.452 +  moreover { fix u assume um: "u\<in>U" and pu: "P u"
  88.453 +    have "between u u = u" by (simp add: between_same)
  88.454 +    with um pu have "P (between u u)" by simp
  88.455 +    with um have ?thesis by blast}
  88.456 +  moreover{
  88.457 +    assume "\<exists> t1\<in> U. \<exists> t2 \<in> U. (\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U) \<and> t1 \<sqsubset> x \<and> x \<sqsubset> t2 \<and> P x"
  88.458 +      then obtain t1 and t2 where t1M: "t1 \<in> U" and t2M: "t2\<in> U"
  88.459 +        and noM: "\<forall> y. t1 \<sqsubset> y \<and> y \<sqsubset> t2 \<longrightarrow> y \<notin> U" and t1x: "t1 \<sqsubset> x" and xt2: "x \<sqsubset> t2" and px: "P x"
  88.460 +        by blast
  88.461 +      from less_trans[OF t1x xt2] have t1t2: "t1 \<sqsubset> t2" .
  88.462 +      let ?u = "between t1 t2"
  88.463 +      from between_less t1t2 have t1lu: "t1 \<sqsubset> ?u" and ut2: "?u \<sqsubset> t2" by auto
  88.464 +      from lin_dense noM t1x xt2 px t1lu ut2 have "P ?u" by blast
  88.465 +      with t1M t2M have ?thesis by blast}
  88.466 +    ultimately show ?thesis by blast
  88.467 +  qed
  88.468 +
  88.469 +theorem fr_eq:
  88.470 +  assumes fU: "finite U"
  88.471 +  and lin_dense: "\<forall>x l u. (\<forall> t. l \<sqsubset> t \<and> t\<sqsubset> u \<longrightarrow> t \<notin> U) \<and> l\<sqsubset> x \<and> x \<sqsubset> u \<and> P x
  88.472 +   \<longrightarrow> (\<forall> y. l \<sqsubset> y \<and> y \<sqsubset> u \<longrightarrow> P y )"
  88.473 +  and nmibnd: "\<forall>x. \<not> MP \<and> P x \<longrightarrow> (\<exists> u\<in> U. u \<sqsubseteq> x)"
  88.474 +  and npibnd: "\<forall>x. \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. x \<sqsubseteq> u)"
  88.475 +  and mi: "\<exists>z. \<forall>x. x \<sqsubset> z \<longrightarrow> (P x = MP)"  and pi: "\<exists>z. \<forall>x. z \<sqsubset> x \<longrightarrow> (P x = PP)"
  88.476 +  shows "(\<exists> x. P x) \<equiv> (MP \<or> PP \<or> (\<exists> u \<in> U. \<exists> u'\<in> U. P (between u u')))"
  88.477 +  (is "_ \<equiv> (_ \<or> _ \<or> ?F)" is "?E \<equiv> ?D")
  88.478 +proof-
  88.479 + {
  88.480 +   assume px: "\<exists> x. P x"
  88.481 +   have "MP \<or> PP \<or> (\<not> MP \<and> \<not> PP)" by blast
  88.482 +   moreover {assume "MP \<or> PP" hence "?D" by blast}
  88.483 +   moreover {assume nmi: "\<not> MP" and npi: "\<not> PP"
  88.484 +     from npmibnd[OF nmibnd npibnd]
  88.485 +     have nmpiU: "\<forall>x. \<not> MP \<and> \<not>PP \<and> P x \<longrightarrow> (\<exists> u\<in> U. \<exists> u' \<in> U. u \<sqsubseteq> x \<and> x \<sqsubseteq> u')" .
  88.486 +     from rinf_U[OF fU lin_dense nmpiU nmi npi px] have "?D" by blast}
  88.487 +   ultimately have "?D" by blast}
  88.488 + moreover
  88.489 + { assume "?D"
  88.490 +   moreover {assume m:"MP" from minf_ex[OF mi m] have "?E" .}
  88.491 +   moreover {assume p: "PP" from pinf_ex[OF pi p] have "?E" . }
  88.492 +   moreover {assume f:"?F" hence "?E" by blast}
  88.493 +   ultimately have "?E" by blast}
  88.494 + ultimately have "?E = ?D" by blast thus "?E \<equiv> ?D" by simp
  88.495 +qed
  88.496 +
  88.497 +lemmas minf_thms = minf_conj minf_disj minf_eq minf_neq minf_lt minf_le minf_gt minf_ge minf_P
  88.498 +lemmas pinf_thms = pinf_conj pinf_disj pinf_eq pinf_neq pinf_lt pinf_le pinf_gt pinf_ge pinf_P
  88.499 +
  88.500 +lemmas nmi_thms = nmi_conj nmi_disj nmi_eq nmi_neq nmi_lt nmi_le nmi_gt nmi_ge nmi_P
  88.501 +lemmas npi_thms = npi_conj npi_disj npi_eq npi_neq npi_lt npi_le npi_gt npi_ge npi_P
  88.502 +lemmas lin_dense_thms = lin_dense_conj lin_dense_disj lin_dense_eq lin_dense_neq lin_dense_lt lin_dense_le lin_dense_gt lin_dense_ge lin_dense_P
  88.503 +
  88.504 +lemma ferrack_axiom: "constr_dense_linear_order less_eq less between"
  88.505 +  by (rule constr_dense_linear_order_axioms)
  88.506 +lemma atoms:
  88.507 +  shows "TERM (less :: 'a \<Rightarrow> _)"
  88.508 +    and "TERM (less_eq :: 'a \<Rightarrow> _)"
  88.509 +    and "TERM (op = :: 'a \<Rightarrow> _)" .
  88.510 +
  88.511 +declare ferrack_axiom [ferrack minf: minf_thms pinf: pinf_thms
  88.512 +    nmi: nmi_thms npi: npi_thms lindense:
  88.513 +    lin_dense_thms qe: fr_eq atoms: atoms]
  88.514 +
  88.515 +declaration {*
  88.516 +let
  88.517 +fun simps phi = map (Morphism.thm phi) [@{thm "not_less"}, @{thm "not_le"}]
  88.518 +fun generic_whatis phi =
  88.519 + let
  88.520 +  val [lt, le] = map (Morphism.term phi) [@{term "op \<sqsubset>"}, @{term "op \<sqsubseteq>"}]
  88.521 +  fun h x t =
  88.522 +   case term_of t of
  88.523 +     Const("op =", _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
  88.524 +                            else Ferrante_Rackoff_Data.Nox
  88.525 +   | @{term "Not"}$(Const("op =", _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
  88.526 +                            else Ferrante_Rackoff_Data.Nox
  88.527 +   | b$y$z => if Term.could_unify (b, lt) then
  88.528 +                 if term_of x aconv y then Ferrante_Rackoff_Data.Lt
  88.529 +                 else if term_of x aconv z then Ferrante_Rackoff_Data.Gt
  88.530 +                 else Ferrante_Rackoff_Data.Nox
  88.531 +             else if Term.could_unify (b, le) then
  88.532 +                 if term_of x aconv y then Ferrante_Rackoff_Data.Le
  88.533 +                 else if term_of x aconv z then Ferrante_Rackoff_Data.Ge
  88.534 +                 else Ferrante_Rackoff_Data.Nox
  88.535 +             else Ferrante_Rackoff_Data.Nox
  88.536 +   | _ => Ferrante_Rackoff_Data.Nox
  88.537 + in h end
  88.538 + fun ss phi = HOL_ss addsimps (simps phi)
  88.539 +in
  88.540 + Ferrante_Rackoff_Data.funs  @{thm "ferrack_axiom"}
  88.541 +  {isolate_conv = K (K (K Thm.reflexive)), whatis = generic_whatis, simpset = ss}
  88.542 +end
  88.543 +*}
  88.544 +
  88.545 +end
  88.546 +
  88.547 +use "~~/src/HOL/Tools/Qelim/ferrante_rackoff.ML"
  88.548 +
  88.549 +method_setup ferrack = {*
  88.550 +  Method.ctxt_args (Method.SIMPLE_METHOD' o FerranteRackoff.dlo_tac)
  88.551 +*} "Ferrante and Rackoff's algorithm for quantifier elimination in dense linear orders"
  88.552 +
  88.553 +subsection {* Ferrante and Rackoff algorithm over ordered fields *}
  88.554 +
  88.555 +lemma neg_prod_lt:"(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x < 0) == (x > 0))"
  88.556 +proof-
  88.557 +  assume H: "c < 0"
  88.558 +  have "c*x < 0 = (0/c < x)" by (simp only: neg_divide_less_eq[OF H] ring_simps)
  88.559 +  also have "\<dots> = (0 < x)" by simp
  88.560 +  finally show  "(c*x < 0) == (x > 0)" by simp
  88.561 +qed
  88.562 +
  88.563 +lemma pos_prod_lt:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x < 0) == (x < 0))"
  88.564 +proof-
  88.565 +  assume H: "c > 0"
  88.566 +  hence "c*x < 0 = (0/c > x)" by (simp only: pos_less_divide_eq[OF H] ring_simps)
  88.567 +  also have "\<dots> = (0 > x)" by simp
  88.568 +  finally show  "(c*x < 0) == (x < 0)" by simp
  88.569 +qed
  88.570 +
  88.571 +lemma neg_prod_sum_lt: "(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x + t< 0) == (x > (- 1/c)*t))"
  88.572 +proof-
  88.573 +  assume H: "c < 0"
  88.574 +  have "c*x + t< 0 = (c*x < -t)" by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp)
  88.575 +  also have "\<dots> = (-t/c < x)" by (simp only: neg_divide_less_eq[OF H] ring_simps)
  88.576 +  also have "\<dots> = ((- 1/c)*t < x)" by simp
  88.577 +  finally show  "(c*x + t < 0) == (x > (- 1/c)*t)" by simp
  88.578 +qed
  88.579 +
  88.580 +lemma pos_prod_sum_lt:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x + t < 0) == (x < (- 1/c)*t))"
  88.581 +proof-
  88.582 +  assume H: "c > 0"
  88.583 +  have "c*x + t< 0 = (c*x < -t)"  by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp)
  88.584 +  also have "\<dots> = (-t/c > x)" by (simp only: pos_less_divide_eq[OF H] ring_simps)
  88.585 +  also have "\<dots> = ((- 1/c)*t > x)" by simp
  88.586 +  finally show  "(c*x + t < 0) == (x < (- 1/c)*t)" by simp
  88.587 +qed
  88.588 +
  88.589 +lemma sum_lt:"((x::'a::pordered_ab_group_add) + t < 0) == (x < - t)"
  88.590 +  using less_diff_eq[where a= x and b=t and c=0] by simp
  88.591 +
  88.592 +lemma neg_prod_le:"(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x <= 0) == (x >= 0))"
  88.593 +proof-
  88.594 +  assume H: "c < 0"
  88.595 +  have "c*x <= 0 = (0/c <= x)" by (simp only: neg_divide_le_eq[OF H] ring_simps)
  88.596 +  also have "\<dots> = (0 <= x)" by simp
  88.597 +  finally show  "(c*x <= 0) == (x >= 0)" by simp
  88.598 +qed
  88.599 +
  88.600 +lemma pos_prod_le:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x <= 0) == (x <= 0))"
  88.601 +proof-
  88.602 +  assume H: "c > 0"
  88.603 +  hence "c*x <= 0 = (0/c >= x)" by (simp only: pos_le_divide_eq[OF H] ring_simps)
  88.604 +  also have "\<dots> = (0 >= x)" by simp
  88.605 +  finally show  "(c*x <= 0) == (x <= 0)" by simp
  88.606 +qed
  88.607 +
  88.608 +lemma neg_prod_sum_le: "(c\<Colon>'a\<Colon>ordered_field) < 0 \<Longrightarrow> ((c*x + t <= 0) == (x >= (- 1/c)*t))"
  88.609 +proof-
  88.610 +  assume H: "c < 0"
  88.611 +  have "c*x + t <= 0 = (c*x <= -t)"  by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp)
  88.612 +  also have "\<dots> = (-t/c <= x)" by (simp only: neg_divide_le_eq[OF H] ring_simps)
  88.613 +  also have "\<dots> = ((- 1/c)*t <= x)" by simp
  88.614 +  finally show  "(c*x + t <= 0) == (x >= (- 1/c)*t)" by simp
  88.615 +qed
  88.616 +
  88.617 +lemma pos_prod_sum_le:"(c\<Colon>'a\<Colon>ordered_field) > 0 \<Longrightarrow> ((c*x + t <= 0) == (x <= (- 1/c)*t))"
  88.618 +proof-
  88.619 +  assume H: "c > 0"
  88.620 +  have "c*x + t <= 0 = (c*x <= -t)" by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp)
  88.621 +  also have "\<dots> = (-t/c >= x)" by (simp only: pos_le_divide_eq[OF H] ring_simps)
  88.622 +  also have "\<dots> = ((- 1/c)*t >= x)" by simp
  88.623 +  finally show  "(c*x + t <= 0) == (x <= (- 1/c)*t)" by simp
  88.624 +qed
  88.625 +
  88.626 +lemma sum_le:"((x::'a::pordered_ab_group_add) + t <= 0) == (x <= - t)"
  88.627 +  using le_diff_eq[where a= x and b=t and c=0] by simp
  88.628 +
  88.629 +lemma nz_prod_eq:"(c\<Colon>'a\<Colon>ordered_field) \<noteq> 0 \<Longrightarrow> ((c*x = 0) == (x = 0))" by simp
  88.630 +lemma nz_prod_sum_eq: "(c\<Colon>'a\<Colon>ordered_field) \<noteq> 0 \<Longrightarrow> ((c*x + t = 0) == (x = (- 1/c)*t))"
  88.631 +proof-
  88.632 +  assume H: "c \<noteq> 0"
  88.633 +  have "c*x + t = 0 = (c*x = -t)" by (subst eq_iff_diff_eq_0 [of "c*x" "-t"], simp)
  88.634 +  also have "\<dots> = (x = -t/c)" by (simp only: nonzero_eq_divide_eq[OF H] ring_simps)
  88.635 +  finally show  "(c*x + t = 0) == (x = (- 1/c)*t)" by simp
  88.636 +qed
  88.637 +lemma sum_eq:"((x::'a::pordered_ab_group_add) + t = 0) == (x = - t)"
  88.638 +  using eq_diff_eq[where a= x and b=t and c=0] by simp
  88.639 +
  88.640 +
  88.641 +class_interpretation class_ordered_field_dense_linear_order: constr_dense_linear_order
  88.642 + ["op <=" "op <"
  88.643 +   "\<lambda> x y. 1/2 * ((x::'a::{ordered_field,recpower,number_ring}) + y)"]
  88.644 +proof (unfold_locales, dlo, dlo, auto)
  88.645 +  fix x y::'a assume lt: "x < y"
  88.646 +  from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
  88.647 +next
  88.648 +  fix x y::'a assume lt: "x < y"
  88.649 +  from  gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
  88.650 +qed
  88.651 +
  88.652 +declaration{*
  88.653 +let
  88.654 +fun earlier [] x y = false
  88.655 +        | earlier (h::t) x y =
  88.656 +    if h aconvc y then false else if h aconvc x then true else earlier t x y;
  88.657 +
  88.658 +fun dest_frac ct = case term_of ct of
  88.659 +   Const (@{const_name "HOL.divide"},_) $ a $ b=>
  88.660 +    Rat.rat_of_quotient (snd (HOLogic.dest_number a), snd (HOLogic.dest_number b))
  88.661 + | t => Rat.rat_of_int (snd (HOLogic.dest_number t))
  88.662 +
  88.663 +fun mk_frac phi cT x =
  88.664 + let val (a, b) = Rat.quotient_of_rat x
  88.665 + in if b = 1 then Numeral.mk_cnumber cT a
  88.666 +    else Thm.capply
  88.667 +         (Thm.capply (Drule.cterm_rule (instantiate' [SOME cT] []) @{cpat "op /"})
  88.668 +                     (Numeral.mk_cnumber cT a))
  88.669 +         (Numeral.mk_cnumber cT b)
  88.670 + end
  88.671 +
  88.672 +fun whatis x ct = case term_of ct of
  88.673 +  Const(@{const_name "HOL.plus"}, _)$(Const(@{const_name "HOL.times"},_)$_$y)$_ =>
  88.674 +     if y aconv term_of x then ("c*x+t",[(funpow 2 Thm.dest_arg1) ct, Thm.dest_arg ct])
  88.675 +     else ("Nox",[])
  88.676 +| Const(@{const_name "HOL.plus"}, _)$y$_ =>
  88.677 +     if y aconv term_of x then ("x+t",[Thm.dest_arg ct])
  88.678 +     else ("Nox",[])
  88.679 +| Const(@{const_name "HOL.times"}, _)$_$y =>
  88.680 +     if y aconv term_of x then ("c*x",[Thm.dest_arg1 ct])
  88.681 +     else ("Nox",[])
  88.682 +| t => if t aconv term_of x then ("x",[]) else ("Nox",[]);
  88.683 +
  88.684 +fun xnormalize_conv ctxt [] ct = reflexive ct
  88.685 +| xnormalize_conv ctxt (vs as (x::_)) ct =
  88.686 +   case term_of ct of
  88.687 +   Const(@{const_name HOL.less},_)$_$Const(@{const_name "HOL.zero"},_) =>
  88.688 +    (case whatis x (Thm.dest_arg1 ct) of
  88.689 +    ("c*x+t",[c,t]) =>
  88.690 +       let
  88.691 +        val cr = dest_frac c
  88.692 +        val clt = Thm.dest_fun2 ct
  88.693 +        val cz = Thm.dest_arg ct
  88.694 +        val neg = cr </ Rat.zero
  88.695 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
  88.696 +               (Thm.capply @{cterm "Trueprop"}
  88.697 +                  (if neg then Thm.capply (Thm.capply clt c) cz
  88.698 +                    else Thm.capply (Thm.capply clt cz) c))
  88.699 +        val cth = equal_elim (symmetric cthp) TrueI
  88.700 +        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x,t])
  88.701 +             (if neg then @{thm neg_prod_sum_lt} else @{thm pos_prod_sum_lt})) cth
  88.702 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
  88.703 +                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
  88.704 +      in rth end
  88.705 +    | ("x+t",[t]) =>
  88.706 +       let
  88.707 +        val T = ctyp_of_term x
  88.708 +        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_lt"}
  88.709 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
  88.710 +              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
  88.711 +       in  rth end
  88.712 +    | ("c*x",[c]) =>
  88.713 +       let
  88.714 +        val cr = dest_frac c
  88.715 +        val clt = Thm.dest_fun2 ct
  88.716 +        val cz = Thm.dest_arg ct
  88.717 +        val neg = cr </ Rat.zero
  88.718 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
  88.719 +               (Thm.capply @{cterm "Trueprop"}
  88.720 +                  (if neg then Thm.capply (Thm.capply clt c) cz
  88.721 +                    else Thm.capply (Thm.capply clt cz) c))
  88.722 +        val cth = equal_elim (symmetric cthp) TrueI
  88.723 +        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x])
  88.724 +             (if neg then @{thm neg_prod_lt} else @{thm pos_prod_lt})) cth
  88.725 +        val rth = th
  88.726 +      in rth end
  88.727 +    | _ => reflexive ct)
  88.728 +
  88.729 +
  88.730 +|  Const(@{const_name HOL.less_eq},_)$_$Const(@{const_name "HOL.zero"},_) =>
  88.731 +   (case whatis x (Thm.dest_arg1 ct) of
  88.732 +    ("c*x+t",[c,t]) =>
  88.733 +       let
  88.734 +        val T = ctyp_of_term x
  88.735 +        val cr = dest_frac c
  88.736 +        val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
  88.737 +        val cz = Thm.dest_arg ct
  88.738 +        val neg = cr </ Rat.zero
  88.739 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
  88.740 +               (Thm.capply @{cterm "Trueprop"}
  88.741 +                  (if neg then Thm.capply (Thm.capply clt c) cz
  88.742 +                    else Thm.capply (Thm.capply clt cz) c))
  88.743 +        val cth = equal_elim (symmetric cthp) TrueI
  88.744 +        val th = implies_elim (instantiate' [SOME T] (map SOME [c,x,t])
  88.745 +             (if neg then @{thm neg_prod_sum_le} else @{thm pos_prod_sum_le})) cth
  88.746 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
  88.747 +                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
  88.748 +      in rth end
  88.749 +    | ("x+t",[t]) =>
  88.750 +       let
  88.751 +        val T = ctyp_of_term x
  88.752 +        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_le"}
  88.753 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
  88.754 +              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
  88.755 +       in  rth end
  88.756 +    | ("c*x",[c]) =>
  88.757 +       let
  88.758 +        val T = ctyp_of_term x
  88.759 +        val cr = dest_frac c
  88.760 +        val clt = Drule.cterm_rule (instantiate' [SOME T] []) @{cpat "op <"}
  88.761 +        val cz = Thm.dest_arg ct
  88.762 +        val neg = cr </ Rat.zero
  88.763 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
  88.764 +               (Thm.capply @{cterm "Trueprop"}
  88.765 +                  (if neg then Thm.capply (Thm.capply clt c) cz
  88.766 +                    else Thm.capply (Thm.capply clt cz) c))
  88.767 +        val cth = equal_elim (symmetric cthp) TrueI
  88.768 +        val th = implies_elim (instantiate' [SOME (ctyp_of_term x)] (map SOME [c,x])
  88.769 +             (if neg then @{thm neg_prod_le} else @{thm pos_prod_le})) cth
  88.770 +        val rth = th
  88.771 +      in rth end
  88.772 +    | _ => reflexive ct)
  88.773 +
  88.774 +|  Const("op =",_)$_$Const(@{const_name "HOL.zero"},_) =>
  88.775 +   (case whatis x (Thm.dest_arg1 ct) of
  88.776 +    ("c*x+t",[c,t]) =>
  88.777 +       let
  88.778 +        val T = ctyp_of_term x
  88.779 +        val cr = dest_frac c
  88.780 +        val ceq = Thm.dest_fun2 ct
  88.781 +        val cz = Thm.dest_arg ct
  88.782 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
  88.783 +            (Thm.capply @{cterm "Trueprop"}
  88.784 +             (Thm.capply @{cterm "Not"} (Thm.capply (Thm.capply ceq c) cz)))
  88.785 +        val cth = equal_elim (symmetric cthp) TrueI
  88.786 +        val th = implies_elim
  88.787 +                 (instantiate' [SOME T] (map SOME [c,x,t]) @{thm nz_prod_sum_eq}) cth
  88.788 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
  88.789 +                   (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
  88.790 +      in rth end
  88.791 +    | ("x+t",[t]) =>
  88.792 +       let
  88.793 +        val T = ctyp_of_term x
  88.794 +        val th = instantiate' [SOME T] [SOME x, SOME t] @{thm "sum_eq"}
  88.795 +        val rth = Conv.fconv_rule (Conv.arg_conv (Conv.binop_conv
  88.796 +              (Normalizer.semiring_normalize_ord_conv ctxt (earlier vs)))) th
  88.797 +       in  rth end
  88.798 +    | ("c*x",[c]) =>
  88.799 +       let
  88.800 +        val T = ctyp_of_term x
  88.801 +        val cr = dest_frac c
  88.802 +        val ceq = Thm.dest_fun2 ct
  88.803 +        val cz = Thm.dest_arg ct
  88.804 +        val cthp = Simplifier.rewrite (local_simpset_of ctxt)
  88.805 +            (Thm.capply @{cterm "Trueprop"}
  88.806 +             (Thm.capply @{cterm "Not"} (Thm.capply (Thm.capply ceq c) cz)))
  88.807 +        val cth = equal_elim (symmetric cthp) TrueI
  88.808 +        val rth = implies_elim
  88.809 +                 (instantiate' [SOME T] (map SOME [c,x]) @{thm nz_prod_eq}) cth
  88.810 +      in rth end
  88.811 +    | _ => reflexive ct);
  88.812 +
  88.813 +local
  88.814 +  val less_iff_diff_less_0 = mk_meta_eq @{thm "less_iff_diff_less_0"}
  88.815 +  val le_iff_diff_le_0 = mk_meta_eq @{thm "le_iff_diff_le_0"}
  88.816 +  val eq_iff_diff_eq_0 = mk_meta_eq @{thm "eq_iff_diff_eq_0"}
  88.817 +in
  88.818 +fun field_isolate_conv phi ctxt vs ct = case term_of ct of
  88.819 +  Const(@{const_name HOL.less},_)$a$b =>
  88.820 +   let val (ca,cb) = Thm.dest_binop ct
  88.821 +       val T = ctyp_of_term ca
  88.822 +       val th = instantiate' [SOME T] [SOME ca, SOME cb] less_iff_diff_less_0
  88.823 +       val nth = Conv.fconv_rule
  88.824 +         (Conv.arg_conv (Conv.arg1_conv
  88.825 +              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
  88.826 +       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
  88.827 +   in rth end
  88.828 +| Const(@{const_name HOL.less_eq},_)$a$b =>
  88.829 +   let val (ca,cb) = Thm.dest_binop ct
  88.830 +       val T = ctyp_of_term ca
  88.831 +       val th = instantiate' [SOME T] [SOME ca, SOME cb] le_iff_diff_le_0
  88.832 +       val nth = Conv.fconv_rule
  88.833 +         (Conv.arg_conv (Conv.arg1_conv
  88.834 +              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
  88.835 +       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
  88.836 +   in rth end
  88.837 +
  88.838 +| Const("op =",_)$a$b =>
  88.839 +   let val (ca,cb) = Thm.dest_binop ct
  88.840 +       val T = ctyp_of_term ca
  88.841 +       val th = instantiate' [SOME T] [SOME ca, SOME cb] eq_iff_diff_eq_0
  88.842 +       val nth = Conv.fconv_rule
  88.843 +         (Conv.arg_conv (Conv.arg1_conv
  88.844 +              (Normalizer.semiring_normalize_ord_conv @{context} (earlier vs)))) th
  88.845 +       val rth = transitive nth (xnormalize_conv ctxt vs (Thm.rhs_of nth))
  88.846 +   in rth end
  88.847 +| @{term "Not"} $(Const("op =",_)$a$b) => Conv.arg_conv (field_isolate_conv phi ctxt vs) ct
  88.848 +| _ => reflexive ct
  88.849 +end;
  88.850 +
  88.851 +fun classfield_whatis phi =
  88.852 + let
  88.853 +  fun h x t =
  88.854 +   case term_of t of
  88.855 +     Const("op =", _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq
  88.856 +                            else Ferrante_Rackoff_Data.Nox
  88.857 +   | @{term "Not"}$(Const("op =", _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq
  88.858 +                            else Ferrante_Rackoff_Data.Nox
  88.859 +   | Const(@{const_name HOL.less},_)$y$z =>
  88.860 +       if term_of x aconv y then Ferrante_Rackoff_Data.Lt
  88.861 +        else if term_of x aconv z then Ferrante_Rackoff_Data.Gt
  88.862 +        else Ferrante_Rackoff_Data.Nox
  88.863 +   | Const (@{const_name HOL.less_eq},_)$y$z =>
  88.864 +         if term_of x aconv y then Ferrante_Rackoff_Data.Le
  88.865 +         else if term_of x aconv z then Ferrante_Rackoff_Data.Ge
  88.866 +         else Ferrante_Rackoff_Data.Nox
  88.867 +   | _ => Ferrante_Rackoff_Data.Nox
  88.868 + in h end;
  88.869 +fun class_field_ss phi =
  88.870 +   HOL_basic_ss addsimps ([@{thm "linorder_not_less"}, @{thm "linorder_not_le"}])
  88.871 +   addsplits [@{thm "abs_split"},@{thm "split_max"}, @{thm "split_min"}]
  88.872 +
  88.873 +in
  88.874 +Ferrante_Rackoff_Data.funs @{thm "class_ordered_field_dense_linear_order.ferrack_axiom"}
  88.875 +  {isolate_conv = field_isolate_conv, whatis = classfield_whatis, simpset = class_field_ss}
  88.876 +end
  88.877 +*}
  88.878 +
  88.879 +
  88.880 +end 
    89.1 --- a/src/HOL/Deriv.thy	Tue Dec 30 08:18:54 2008 +0100
    89.2 +++ b/src/HOL/Deriv.thy	Tue Dec 30 11:10:01 2008 +0100
    89.3 @@ -20,12 +20,6 @@
    89.4            ("(DERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60) where
    89.5    "DERIV f x :> D = ((%h. (f(x + h) - f x) / h) -- 0 --> D)"
    89.6  
    89.7 -definition
    89.8 -  differentiable :: "['a::real_normed_field \<Rightarrow> 'a, 'a] \<Rightarrow> bool"
    89.9 -    (infixl "differentiable" 60) where
   89.10 -  "f differentiable x = (\<exists>D. DERIV f x :> D)"
   89.11 -
   89.12 -
   89.13  consts
   89.14    Bolzano_bisect :: "[real*real=>bool, real, real, nat] => (real*real)"
   89.15  primrec
   89.16 @@ -316,63 +310,104 @@
   89.17  
   89.18  subsection {* Differentiability predicate *}
   89.19  
   89.20 +definition
   89.21 +  differentiable :: "['a::real_normed_field \<Rightarrow> 'a, 'a] \<Rightarrow> bool"
   89.22 +    (infixl "differentiable" 60) where
   89.23 +  "f differentiable x = (\<exists>D. DERIV f x :> D)"
   89.24 +
   89.25 +lemma differentiableE [elim?]:
   89.26 +  assumes "f differentiable x"
   89.27 +  obtains df where "DERIV f x :> df"
   89.28 +  using prems unfolding differentiable_def ..
   89.29 +
   89.30  lemma differentiableD: "f differentiable x ==> \<exists>D. DERIV f x :> D"
   89.31  by (simp add: differentiable_def)
   89.32  
   89.33  lemma differentiableI: "DERIV f x :> D ==> f differentiable x"
   89.34  by (force simp add: differentiable_def)
   89.35  
   89.36 -lemma differentiable_const: "(\<lambda>z. a) differentiable x"
   89.37 -  apply (unfold differentiable_def)
   89.38 -  apply (rule_tac x=0 in exI)
   89.39 -  apply simp
   89.40 -  done
   89.41 +lemma differentiable_ident [simp]: "(\<lambda>x. x) differentiable x"
   89.42 +  by (rule DERIV_ident [THEN differentiableI])
   89.43 +
   89.44 +lemma differentiable_const [simp]: "(\<lambda>z. a) differentiable x"
   89.45 +  by (rule DERIV_const [THEN differentiableI])
   89.46  
   89.47 -lemma differentiable_sum:
   89.48 +lemma differentiable_compose:
   89.49 +  assumes f: "f differentiable (g x)"
   89.50 +  assumes g: "g differentiable x"
   89.51 +  shows "(\<lambda>x. f (g x)) differentiable x"
   89.52 +proof -
   89.53 +  from `f differentiable (g x)` obtain df where "DERIV f (g x) :> df" ..
   89.54 +  moreover
   89.55 +  from `g differentiable x` obtain dg where "DERIV g x :> dg" ..
   89.56 +  ultimately
   89.57 +  have "DERIV (\<lambda>x. f (g x)) x :> df * dg" by (rule DERIV_chain2)
   89.58 +  thus ?thesis by (rule differentiableI)
   89.59 +qed
   89.60 +
   89.61 +lemma differentiable_sum [simp]:
   89.62    assumes "f differentiable x"
   89.63    and "g differentiable x"
   89.64    shows "(\<lambda>x. f x + g x) differentiable x"
   89.65  proof -
   89.66 -  from prems have "\<exists>D. DERIV f x :> D" by (unfold differentiable_def)
   89.67 -  then obtain df where "DERIV f x :> df" ..
   89.68 -  moreover from prems have "\<exists>D. DERIV g x :> D" by (unfold differentiable_def)
   89.69 -  then obtain dg where "DERIV g x :> dg" ..
   89.70 -  ultimately have "DERIV (\<lambda>x. f x + g x) x :> df + dg" by (rule DERIV_add)
   89.71 -  hence "\<exists>D. DERIV (\<lambda>x. f x + g x) x :> D" by auto
   89.72 -  thus ?thesis by (fold differentiable_def)
   89.73 +  from `f differentiable x` obtain df where "DERIV f x :> df" ..
   89.74 +  moreover
   89.75 +  from `g differentiable x` obtain dg where "DERIV g x :> dg" ..
   89.76 +  ultimately
   89.77 +  have "DERIV (\<lambda>x. f x + g x) x :> df + dg" by (rule DERIV_add)
   89.78 +  thus ?thesis by (rule differentiableI)
   89.79 +qed
   89.80 +
   89.81 +lemma differentiable_minus [simp]:
   89.82 +  assumes "f differentiable x"
   89.83 +  shows "(\<lambda>x. - f x) differentiable x"
   89.84 +proof -
   89.85 +  from `f differentiable x` obtain df where "DERIV f x :> df" ..
   89.86 +  hence "DERIV (\<lambda>x. - f x) x :> - df" by (rule DERIV_minus)
   89.87 +  thus ?thesis by (rule differentiableI)
   89.88  qed
   89.89  
   89.90 -lemma differentiable_diff:
   89.91 +lemma differentiable_diff [simp]:
   89.92    assumes "f differentiable x"
   89.93 -  and "g differentiable x"
   89.94 +  assumes "g differentiable x"
   89.95    shows "(\<lambda>x. f x - g x) differentiable x"
   89.96 +  unfolding diff_minus using prems by simp
   89.97 +
   89.98 +lemma differentiable_mult [simp]:
   89.99 +  assumes "f differentiable x"
  89.100 +  assumes "g differentiable x"
  89.101 +  shows "(\<lambda>x. f x * g x) differentiable x"
  89.102  proof -
  89.103 -  from prems have "f differentiable x" by simp
  89.104 +  from `f differentiable x` obtain df where "DERIV f x :> df" ..
  89.105    moreover
  89.106 -  from prems have "\<exists>D. DERIV g x :> D" by (unfold differentiable_def)
  89.107 -  then obtain dg where "DERIV g x :> dg" ..
  89.108 -  then have "DERIV (\<lambda>x. - g x) x :> -dg" by (rule DERIV_minus)
  89.109 -  hence "\<exists>D. DERIV (\<lambda>x. - g x) x :> D" by auto
  89.110 -  hence "(\<lambda>x. - g x) differentiable x" by (fold differentiable_def)
  89.111 -  ultimately 
  89.112 -  show ?thesis
  89.113 -    by (auto simp: diff_def dest: differentiable_sum)
  89.114 +  from `g differentiable x` obtain dg where "DERIV g x :> dg" ..
  89.115 +  ultimately
  89.116 +  have "DERIV (\<lambda>x. f x * g x) x :> df * g x + dg * f x" by (rule DERIV_mult)
  89.117 +  thus ?thesis by (rule differentiableI)
  89.118  qed
  89.119  
  89.120 -lemma differentiable_mult:
  89.121 -  assumes "f differentiable x"
  89.122 -  and "g differentiable x"
  89.123 -  shows "(\<lambda>x. f x * g x) differentiable x"
  89.124 +lemma differentiable_inverse [simp]:
  89.125 +  assumes "f differentiable x" and "f x \<noteq> 0"
  89.126 +  shows "(\<lambda>x. inverse (f x)) differentiable x"
  89.127  proof -
  89.128 -  from prems have "\<exists>D. DERIV f x :> D" by (unfold differentiable_def)
  89.129 -  then obtain df where "DERIV f x :> df" ..
  89.130 -  moreover from prems have "\<exists>D. DERIV g x :> D" by (unfold differentiable_def)
  89.131 -  then obtain dg where "DERIV g x :> dg" ..
  89.132 -  ultimately have "DERIV (\<lambda>x. f x * g x) x :> df * g x + dg * f x" by (simp add: DERIV_mult)
  89.133 -  hence "\<exists>D. DERIV (\<lambda>x. f x * g x) x :> D" by auto
  89.134 -  thus ?thesis by (fold differentiable_def)
  89.135 +  from `f differentiable x` obtain df where "DERIV f x :> df" ..
  89.136 +  hence "DERIV (\<lambda>x. inverse (f x)) x :> - (inverse (f x) * df * inverse (f x))"
  89.137 +    using `f x \<noteq> 0` by (rule DERIV_inverse')
  89.138 +  thus ?thesis by (rule differentiableI)
  89.139  qed
  89.140  
  89.141 +lemma differentiable_divide [simp]:
  89.142 +  assumes "f differentiable x"
  89.143 +  assumes "g differentiable x" and "g x \<noteq> 0"
  89.144 +  shows "(\<lambda>x. f x / g x) differentiable x"
  89.145 +  unfolding divide_inverse using prems by simp
  89.146 +
  89.147 +lemma differentiable_power [simp]:
  89.148 +  fixes f :: "'a::{recpower,real_normed_field} \<Rightarrow> 'a"
  89.149 +  assumes "f differentiable x"
  89.150 +  shows "(\<lambda>x. f x ^ n) differentiable x"
  89.151 +  by (induct n, simp, simp add: power_Suc prems)
  89.152 +
  89.153  
  89.154  subsection {* Nested Intervals and Bisection *}
  89.155  
  89.156 @@ -1722,4 +1757,60 @@
  89.157  apply (simp add: poly_entire del: pmult_Cons)
  89.158  done
  89.159  
  89.160 +
  89.161 +subsection {* Theorems about Limits *}
  89.162 +
  89.163 +(* need to rename second isCont_inverse *)
  89.164 +
  89.165 +lemma isCont_inv_fun:
  89.166 +  fixes f g :: "real \<Rightarrow> real"
  89.167 +  shows "[| 0 < d; \<forall>z. \<bar>z - x\<bar> \<le> d --> g(f(z)) = z;  
  89.168 +         \<forall>z. \<bar>z - x\<bar> \<le> d --> isCont f z |]  
  89.169 +      ==> isCont g (f x)"
  89.170 +by (rule isCont_inverse_function)
  89.171 +
  89.172 +lemma isCont_inv_fun_inv:
  89.173 +  fixes f g :: "real \<Rightarrow> real"
  89.174 +  shows "[| 0 < d;  
  89.175 +         \<forall>z. \<bar>z - x\<bar> \<le> d --> g(f(z)) = z;  
  89.176 +         \<forall>z. \<bar>z - x\<bar> \<le> d --> isCont f z |]  
  89.177 +       ==> \<exists>e. 0 < e &  
  89.178 +             (\<forall>y. 0 < \<bar>y - f(x)\<bar> & \<bar>y - f(x)\<bar> < e --> f(g(y)) = y)"
  89.179 +apply (drule isCont_inj_range)
  89.180 +prefer 2 apply (assumption, assumption, auto)
  89.181 +apply (rule_tac x = e in exI, auto)
  89.182 +apply (rotate_tac 2)
  89.183 +apply (drule_tac x = y in spec, auto)
  89.184 +done
  89.185 +
  89.186 +
  89.187 +text{*Bartle/Sherbert: Introduction to Real Analysis, Theorem 4.2.9, p. 110*}
  89.188 +lemma LIM_fun_gt_zero:
  89.189 +     "[| f -- c --> (l::real); 0 < l |]  
  89.190 +         ==> \<exists>r. 0 < r & (\<forall>x::real. x \<noteq> c & \<bar>c - x\<bar> < r --> 0 < f x)"
  89.191 +apply (auto simp add: LIM_def)
  89.192 +apply (drule_tac x = "l/2" in spec, safe, force)
  89.193 +apply (rule_tac x = s in exI)
  89.194 +apply (auto simp only: abs_less_iff)
  89.195 +done
  89.196 +
  89.197 +lemma LIM_fun_less_zero:
  89.198 +     "[| f -- c --> (l::real); l < 0 |]  
  89.199 +      ==> \<exists>r. 0 < r & (\<forall>x::real. x \<noteq> c & \<bar>c - x\<bar> < r --> f x < 0)"
  89.200 +apply (auto simp add: LIM_def)
  89.201 +apply (drule_tac x = "-l/2" in spec, safe, force)
  89.202 +apply (rule_tac x = s in exI)
  89.203 +apply (auto simp only: abs_less_iff)
  89.204 +done
  89.205 +
  89.206 +
  89.207 +lemma LIM_fun_not_zero:
  89.208 +     "[| f -- c --> (l::real); l \<noteq> 0 |] 
  89.209 +      ==> \<exists>r. 0 < r & (\<forall>x::real. x \<noteq> c & \<bar>c - x\<bar> < r --> f x \<noteq> 0)"
  89.210 +apply (cut_tac x = l and y = 0 in linorder_less_linear, auto)
  89.211 +apply (drule LIM_fun_less_zero)
  89.212 +apply (drule_tac [3] LIM_fun_gt_zero)
  89.213 +apply force+
  89.214 +done
  89.215 +
  89.216  end
    90.1 --- a/src/HOL/Divides.thy	Tue Dec 30 08:18:54 2008 +0100
    90.2 +++ b/src/HOL/Divides.thy	Tue Dec 30 11:10:01 2008 +0100
    90.3 @@ -127,7 +127,7 @@
    90.4    note that ultimately show thesis by blast
    90.5  qed
    90.6  
    90.7 -lemma dvd_eq_mod_eq_0 [code]: "a dvd b \<longleftrightarrow> b mod a = 0"
    90.8 +lemma dvd_eq_mod_eq_0 [code unfold]: "a dvd b \<longleftrightarrow> b mod a = 0"
    90.9  proof
   90.10    assume "b mod a = 0"
   90.11    with mod_div_equality [of b a] have "b div a * a = b" by simp
    91.1 --- a/src/HOL/FunDef.thy	Tue Dec 30 08:18:54 2008 +0100
    91.2 +++ b/src/HOL/FunDef.thy	Tue Dec 30 11:10:01 2008 +0100
    91.3 @@ -3,11 +3,13 @@
    91.4      Author:     Alexander Krauss, TU Muenchen
    91.5  *)
    91.6  
    91.7 -header {* General recursive function definitions *}
    91.8 +header {* Function Definitions and Termination Proofs *}
    91.9  
   91.10  theory FunDef
   91.11  imports Wellfounded
   91.12  uses
   91.13 +  "Tools/prop_logic.ML"
   91.14 +  "Tools/sat_solver.ML"
   91.15    ("Tools/function_package/fundef_lib.ML")
   91.16    ("Tools/function_package/fundef_common.ML")
   91.17    ("Tools/function_package/inductive_wrap.ML")
   91.18 @@ -22,9 +24,14 @@
   91.19    ("Tools/function_package/lexicographic_order.ML")
   91.20    ("Tools/function_package/fundef_datatype.ML")
   91.21    ("Tools/function_package/induction_scheme.ML")
   91.22 +  ("Tools/function_package/termination.ML")
   91.23 +  ("Tools/function_package/decompose.ML")
   91.24 +  ("Tools/function_package/descent.ML")
   91.25 +  ("Tools/function_package/scnp_solve.ML")
   91.26 +  ("Tools/function_package/scnp_reconstruct.ML")
   91.27  begin
   91.28  
   91.29 -text {* Definitions with default value. *}
   91.30 +subsection {* Definitions with default value. *}
   91.31  
   91.32  definition
   91.33    THE_default :: "'a \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a" where
   91.34 @@ -97,9 +104,6 @@
   91.35    "wf R \<Longrightarrow> wfP (in_rel R)"
   91.36    by (simp add: wfP_def)
   91.37  
   91.38 -inductive is_measure :: "('a \<Rightarrow> nat) \<Rightarrow> bool"
   91.39 -where is_measure_trivial: "is_measure f"
   91.40 -
   91.41  use "Tools/function_package/fundef_lib.ML"
   91.42  use "Tools/function_package/fundef_common.ML"
   91.43  use "Tools/function_package/inductive_wrap.ML"
   91.44 @@ -110,19 +114,37 @@
   91.45  use "Tools/function_package/pattern_split.ML"
   91.46  use "Tools/function_package/auto_term.ML"
   91.47  use "Tools/function_package/fundef_package.ML"
   91.48 -use "Tools/function_package/measure_functions.ML"
   91.49 -use "Tools/function_package/lexicographic_order.ML"
   91.50  use "Tools/function_package/fundef_datatype.ML"
   91.51  use "Tools/function_package/induction_scheme.ML"
   91.52  
   91.53  setup {* 
   91.54    FundefPackage.setup 
   91.55 +  #> FundefDatatype.setup
   91.56    #> InductionScheme.setup
   91.57 -  #> MeasureFunctions.setup
   91.58 -  #> LexicographicOrder.setup 
   91.59 -  #> FundefDatatype.setup
   91.60  *}
   91.61  
   91.62 +subsection {* Measure Functions *}
   91.63 +
   91.64 +inductive is_measure :: "('a \<Rightarrow> nat) \<Rightarrow> bool"
   91.65 +where is_measure_trivial: "is_measure f"
   91.66 +
   91.67 +use "Tools/function_package/measure_functions.ML"
   91.68 +setup MeasureFunctions.setup
   91.69 +
   91.70 +lemma measure_size[measure_function]: "is_measure size"
   91.71 +by (rule is_measure_trivial)
   91.72 +
   91.73 +lemma measure_fst[measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (fst p))"
   91.74 +by (rule is_measure_trivial)
   91.75 +lemma measure_snd[measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (snd p))"
   91.76 +by (rule is_measure_trivial)
   91.77 +
   91.78 +use "Tools/function_package/lexicographic_order.ML"
   91.79 +setup LexicographicOrder.setup 
   91.80 +
   91.81 +
   91.82 +subsection {* Congruence Rules *}
   91.83 +
   91.84  lemma let_cong [fundef_cong]:
   91.85    "M = N \<Longrightarrow> (\<And>x. x = N \<Longrightarrow> f x = g x) \<Longrightarrow> Let M f = Let N g"
   91.86    unfolding Let_def by blast
   91.87 @@ -140,17 +162,7 @@
   91.88    "f (g x) = f' (g' x') \<Longrightarrow> (f o g) x = (f' o g') x'"
   91.89    unfolding o_apply .
   91.90  
   91.91 -subsection {* Setup for termination proofs *}
   91.92 -
   91.93 -text {* Rules for generating measure functions *}
   91.94 -
   91.95 -lemma [measure_function]: "is_measure size"
   91.96 -by (rule is_measure_trivial)
   91.97 -
   91.98 -lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (fst p))"
   91.99 -by (rule is_measure_trivial)
  91.100 -lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (\<lambda>p. f (snd p))"
  91.101 -by (rule is_measure_trivial)
  91.102 +subsection {* Simp rules for termination proofs *}
  91.103  
  91.104  lemma termination_basic_simps[termination_simp]:
  91.105    "x < (y::nat) \<Longrightarrow> x < y + z" 
  91.106 @@ -166,5 +178,150 @@
  91.107    "prod_size f g p = f (fst p) + g (snd p) + Suc 0"
  91.108  by (induct p) auto
  91.109  
  91.110 +subsection {* Decomposition *}
  91.111 +
  91.112 +lemma less_by_empty: 
  91.113 +  "A = {} \<Longrightarrow> A \<subseteq> B"
  91.114 +and  union_comp_emptyL:
  91.115 +  "\<lbrakk> A O C = {}; B O C = {} \<rbrakk> \<Longrightarrow> (A \<union> B) O C = {}"
  91.116 +and union_comp_emptyR:
  91.117 +  "\<lbrakk> A O B = {}; A O C = {} \<rbrakk> \<Longrightarrow> A O (B \<union> C) = {}"
  91.118 +and wf_no_loop: 
  91.119 +  "R O R = {} \<Longrightarrow> wf R"
  91.120 +by (auto simp add: wf_comp_self[of R])
  91.121 +
  91.122 +
  91.123 +subsection {* Reduction Pairs *}
  91.124 +
  91.125 +definition
  91.126 +  "reduction_pair P = (wf (fst P) \<and> snd P O fst P \<subseteq> fst P)"
  91.127 +
  91.128 +lemma reduction_pairI[intro]: "wf R \<Longrightarrow> S O R \<subseteq> R \<Longrightarrow> reduction_pair (R, S)"
  91.129 +unfolding reduction_pair_def by auto
  91.130 +
  91.131 +lemma reduction_pair_lemma:
  91.132 +  assumes rp: "reduction_pair P"
  91.133 +  assumes "R \<subseteq> fst P"
  91.134 +  assumes "S \<subseteq> snd P"
  91.135 +  assumes "wf S"
  91.136 +  shows "wf (R \<union> S)"
  91.137 +proof -
  91.138 +  from rp `S \<subseteq> snd P` have "wf (fst P)" "S O fst P \<subseteq> fst P"
  91.139 +    unfolding reduction_pair_def by auto
  91.140 +  with `wf S` have "wf (fst P \<union> S)" 
  91.141 +    by (auto intro: wf_union_compatible)
  91.142 +  moreover from `R \<subseteq> fst P` have "R \<union> S \<subseteq> fst P \<union> S" by auto
  91.143 +  ultimately show ?thesis by (rule wf_subset) 
  91.144 +qed
  91.145 +
  91.146 +definition
  91.147 +  "rp_inv_image = (\<lambda>(R,S) f. (inv_image R f, inv_image S f))"
  91.148 +
  91.149 +lemma rp_inv_image_rp:
  91.150 +  "reduction_pair P \<Longrightarrow> reduction_pair (rp_inv_image P f)"
  91.151 +  unfolding reduction_pair_def rp_inv_image_def split_def
  91.152 +  by force
  91.153 +
  91.154 +
  91.155 +subsection {* Concrete orders for SCNP termination proofs *}
  91.156 +
  91.157 +definition "pair_less = less_than <*lex*> less_than"
  91.158 +definition "pair_leq = pair_less^="
  91.159 +definition "max_strict = max_ext pair_less"
  91.160 +definition "max_weak = max_ext pair_leq \<union> {({}, {})}"
  91.161 +definition "min_strict = min_ext pair_less"
  91.162 +definition "min_weak = min_ext pair_leq \<union> {({}, {})}"
  91.163 +
  91.164 +lemma wf_pair_less[simp]: "wf pair_less"
  91.165 +  by (auto simp: pair_less_def)
  91.166 +
  91.167 +text {* Introduction rules for @{text pair_less}/@{text pair_leq} *}
  91.168 +lemma pair_leqI1: "a < b \<Longrightarrow> ((a, s), (b, t)) \<in> pair_leq"
  91.169 +  and pair_leqI2: "a \<le> b \<Longrightarrow> s \<le> t \<Longrightarrow> ((a, s), (b, t)) \<in> pair_leq"
  91.170 +  and pair_lessI1: "a < b  \<Longrightarrow> ((a, s), (b, t)) \<in> pair_less"
  91.171 +  and pair_lessI2: "a \<le> b \<Longrightarrow> s < t \<Longrightarrow> ((a, s), (b, t)) \<in> pair_less"
  91.172 +  unfolding pair_leq_def pair_less_def by auto
  91.173 +
  91.174 +text {* Introduction rules for max *}
  91.175 +lemma smax_emptyI: 
  91.176 +  "finite Y \<Longrightarrow> Y \<noteq> {} \<Longrightarrow> ({}, Y) \<in> max_strict" 
  91.177 +  and smax_insertI: 
  91.178 +  "\<lbrakk>y \<in> Y; (x, y) \<in> pair_less; (X, Y) \<in> max_strict\<rbrakk> \<Longrightarrow> (insert x X, Y) \<in> max_strict"
  91.179 +  and wmax_emptyI: 
  91.180 +  "finite X \<Longrightarrow> ({}, X) \<in> max_weak" 
  91.181 +  and wmax_insertI:
  91.182 +  "\<lbrakk>y \<in> YS; (x, y) \<in> pair_leq; (XS, YS) \<in> max_weak\<rbrakk> \<Longrightarrow> (insert x XS, YS) \<in> max_weak" 
  91.183 +unfolding max_strict_def max_weak_def by (auto elim!: max_ext.cases)
  91.184 +
  91.185 +text {* Introduction rules for min *}
  91.186 +lemma smin_emptyI: 
  91.187 +  "X \<noteq> {} \<Longrightarrow> (X, {}) \<in> min_strict" 
  91.188 +  and smin_insertI: 
  91.189 +  "\<lbrakk>x \<in> XS; (x, y) \<in> pair_less; (XS, YS) \<in> min_strict\<rbrakk> \<Longrightarrow> (XS, insert y YS) \<in> min_strict"
  91.190 +  and wmin_emptyI: 
  91.191 +  "(X, {}) \<in> min_weak" 
  91.192 +  and wmin_insertI: 
  91.193 +  "\<lbrakk>x \<in> XS; (x, y) \<in> pair_leq; (XS, YS) \<in> min_weak\<rbrakk> \<Longrightarrow> (XS, insert y YS) \<in> min_weak" 
  91.194 +by (auto simp: min_strict_def min_weak_def min_ext_def)
  91.195 +
  91.196 +text {* Reduction Pairs *}
  91.197 +
  91.198 +lemma max_ext_compat: 
  91.199 +  assumes "S O R \<subseteq> R"
  91.200 +  shows "(max_ext S \<union> {({},{})}) O max_ext R \<subseteq> max_ext R"
  91.201 +using assms 
  91.202 +apply auto
  91.203 +apply (elim max_ext.cases)
  91.204 +apply rule
  91.205 +apply auto[3]
  91.206 +apply (drule_tac x=xa in meta_spec)
  91.207 +apply simp
  91.208 +apply (erule bexE)
  91.209 +apply (drule_tac x=xb in meta_spec)
  91.210 +by auto
  91.211 +
  91.212 +lemma max_rpair_set: "reduction_pair (max_strict, max_weak)"
  91.213 +  unfolding max_strict_def max_weak_def 
  91.214 +apply (intro reduction_pairI max_ext_wf)
  91.215 +apply simp
  91.216 +apply (rule max_ext_compat)
  91.217 +by (auto simp: pair_less_def pair_leq_def)
  91.218 +
  91.219 +lemma min_ext_compat: 
  91.220 +  assumes "S O R \<subseteq> R"
  91.221 +  shows "(min_ext S \<union> {({},{})}) O min_ext R \<subseteq> min_ext R"
  91.222 +using assms 
  91.223 +apply (auto simp: min_ext_def)
  91.224 +apply (drule_tac x=ya in bspec, assumption)
  91.225 +apply (erule bexE)
  91.226 +apply (drule_tac x=xc in bspec)
  91.227 +apply assumption
  91.228 +by auto
  91.229 +
  91.230 +lemma min_rpair_set: "reduction_pair (min_strict, min_weak)"
  91.231 +  unfolding min_strict_def min_weak_def 
  91.232 +apply (intro reduction_pairI min_ext_wf)
  91.233 +apply simp
  91.234 +apply (rule min_ext_compat)
  91.235 +by (auto simp: pair_less_def pair_leq_def)
  91.236 +
  91.237 +
  91.238 +subsection {* Tool setup *}
  91.239 +
  91.240 +use "Tools/function_package/termination.ML"
  91.241 +use "Tools/function_package/decompose.ML"
  91.242 +use "Tools/function_package/descent.ML"
  91.243 +use "Tools/function_package/scnp_solve.ML"
  91.244 +use "Tools/function_package/scnp_reconstruct.ML"
  91.245 +
  91.246 +setup {* ScnpReconstruct.setup *}
  91.247 +(*
  91.248 +setup {*
  91.249 +  Context.theory_map (FundefCommon.set_termination_prover (ScnpReconstruct.decomp_scnp 
  91.250 +  [ScnpSolve.MAX, ScnpSolve.MIN, ScnpSolve.MS])) 
  91.251 +*}
  91.252 +*)
  91.253 +
  91.254 +
  91.255  
  91.256  end
    92.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    92.2 +++ b/src/HOL/Fundamental_Theorem_Algebra.thy	Tue Dec 30 11:10:01 2008 +0100
    92.3 @@ -0,0 +1,1327 @@
    92.4 +(* Author: Amine Chaieb, TU Muenchen *)
    92.5 +
    92.6 +header{*Fundamental Theorem of Algebra*}
    92.7 +
    92.8 +theory Fundamental_Theorem_Algebra
    92.9 +imports Univ_Poly Dense_Linear_Order Complex
   92.10 +begin
   92.11 +
   92.12 +subsection {* Square root of complex numbers *}
   92.13 +definition csqrt :: "complex \<Rightarrow> complex" where
   92.14 +"csqrt z = (if Im z = 0 then
   92.15 +            if 0 \<le> Re z then Complex (sqrt(Re z)) 0
   92.16 +            else Complex 0 (sqrt(- Re z))
   92.17 +           else Complex (sqrt((cmod z + Re z) /2))
   92.18 +                        ((Im z / abs(Im z)) * sqrt((cmod z - Re z) /2)))"
   92.19 +
   92.20 +lemma csqrt[algebra]: "csqrt z ^ 2 = z"
   92.21 +proof-
   92.22 +  obtain x y where xy: "z = Complex x y" by (cases z, simp_all)
   92.23 +  {assume y0: "y = 0"
   92.24 +    {assume x0: "x \<ge> 0" 
   92.25 +      then have ?thesis using y0 xy real_sqrt_pow2[OF x0]
   92.26 +	by (simp add: csqrt_def power2_eq_square)}
   92.27 +    moreover
   92.28 +    {assume "\<not> x \<ge> 0" hence x0: "- x \<ge> 0" by arith
   92.29 +      then have ?thesis using y0 xy real_sqrt_pow2[OF x0] 
   92.30 +	by (simp add: csqrt_def power2_eq_square) }
   92.31 +    ultimately have ?thesis by blast}
   92.32 +  moreover
   92.33 +  {assume y0: "y\<noteq>0"
   92.34 +    {fix x y
   92.35 +      let ?z = "Complex x y"
   92.36 +      from abs_Re_le_cmod[of ?z] have tha: "abs x \<le> cmod ?z" by auto
   92.37 +      hence "cmod ?z - x \<ge> 0" "cmod ?z + x \<ge> 0" by arith+ 
   92.38 +      hence "(sqrt (x * x + y * y) + x) / 2 \<ge> 0" "(sqrt (x * x + y * y) - x) / 2 \<ge> 0" by (simp_all add: power2_eq_square) }
   92.39 +    note th = this
   92.40 +    have sq4: "\<And>x::real. x^2 / 4 = (x / 2) ^ 2" 
   92.41 +      by (simp add: power2_eq_square) 
   92.42 +    from th[of x y]
   92.43 +    have sq4': "sqrt (((sqrt (x * x + y * y) + x)^2 / 4)) = (sqrt (x * x + y * y) + x) / 2" "sqrt (((sqrt (x * x + y * y) - x)^2 / 4)) = (sqrt (x * x + y * y) - x) / 2" unfolding sq4 by simp_all
   92.44 +    then have th1: "sqrt ((sqrt (x * x + y * y) + x) * (sqrt (x * x + y * y) + x) / 4) - sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) - x) / 4) = x"
   92.45 +      unfolding power2_eq_square by simp 
   92.46 +    have "sqrt 4 = sqrt (2^2)" by simp 
   92.47 +    hence sqrt4: "sqrt 4 = 2" by (simp only: real_sqrt_abs)
   92.48 +    have th2: "2 *(y * sqrt ((sqrt (x * x + y * y) - x) * (sqrt (x * x + y * y) + x) / 4)) / \<bar>y\<bar> = y"
   92.49 +      using iffD2[OF real_sqrt_pow2_iff sum_power2_ge_zero[of x y]] y0
   92.50 +      unfolding power2_eq_square 
   92.51 +      by (simp add: ring_simps real_sqrt_divide sqrt4)
   92.52 +     from y0 xy have ?thesis  apply (simp add: csqrt_def power2_eq_square)
   92.53 +       apply (simp add: real_sqrt_sum_squares_mult_ge_zero[of x y] real_sqrt_pow2[OF th(1)[of x y], unfolded power2_eq_square] real_sqrt_pow2[OF th(2)[of x y], unfolded power2_eq_square] real_sqrt_mult[symmetric])
   92.54 +      using th1 th2  ..}
   92.55 +  ultimately show ?thesis by blast
   92.56 +qed
   92.57 +
   92.58 +
   92.59 +subsection{* More lemmas about module of complex numbers *}
   92.60 +
   92.61 +lemma complex_of_real_power: "complex_of_real x ^ n = complex_of_real (x^n)"
   92.62 +  by (rule of_real_power [symmetric])
   92.63 +
   92.64 +lemma real_down2: "(0::real) < d1 \<Longrightarrow> 0 < d2 ==> EX e. 0 < e & e < d1 & e < d2"
   92.65 +  apply ferrack apply arith done
   92.66 +
   92.67 +text{* The triangle inequality for cmod *}
   92.68 +lemma complex_mod_triangle_sub: "cmod w \<le> cmod (w + z) + norm z"
   92.69 +  using complex_mod_triangle_ineq2[of "w + z" "-z"] by auto
   92.70 +
   92.71 +subsection{* Basic lemmas about complex polynomials *}
   92.72 +
   92.73 +lemma poly_bound_exists:
   92.74 +  shows "\<exists>m. m > 0 \<and> (\<forall>z. cmod z <= r \<longrightarrow> cmod (poly p z) \<le> m)"
   92.75 +proof(induct p)
   92.76 +  case Nil thus ?case by (rule exI[where x=1], simp) 
   92.77 +next
   92.78 +  case (Cons c cs)
   92.79 +  from Cons.hyps obtain m where m: "\<forall>z. cmod z \<le> r \<longrightarrow> cmod (poly cs z) \<le> m"
   92.80 +    by blast
   92.81 +  let ?k = " 1 + cmod c + \<bar>r * m\<bar>"
   92.82 +  have kp: "?k > 0" using abs_ge_zero[of "r*m"] norm_ge_zero[of c] by arith
   92.83 +  {fix z
   92.84 +    assume H: "cmod z \<le> r"
   92.85 +    from m H have th: "cmod (poly cs z) \<le> m" by blast
   92.86 +    from H have rp: "r \<ge> 0" using norm_ge_zero[of z] by arith
   92.87 +    have "cmod (poly (c # cs) z) \<le> cmod c + cmod (z* poly cs z)"
   92.88 +      using norm_triangle_ineq[of c "z* poly cs z"] by simp
   92.89 +    also have "\<dots> \<le> cmod c + r*m" using mult_mono[OF H th rp norm_ge_zero[of "poly cs z"]] by (simp add: norm_mult)
   92.90 +    also have "\<dots> \<le> ?k" by simp
   92.91 +    finally have "cmod (poly (c # cs) z) \<le> ?k" .}
   92.92 +  with kp show ?case by blast
   92.93 +qed
   92.94 +
   92.95 +
   92.96 +text{* Offsetting the variable in a polynomial gives another of same degree *}
   92.97 +  (* FIXME : Lemma holds also in locale --- fix it later *)
   92.98 +lemma  poly_offset_lemma:
   92.99 +  shows "\<exists>b q. (length q = length p) \<and> (\<forall>x. poly (b#q) (x::complex) = (a + x) * poly p x)"
  92.100 +proof(induct p)
  92.101 +  case Nil thus ?case by simp
  92.102 +next
  92.103 +  case (Cons c cs)
  92.104 +  from Cons.hyps obtain b q where 
  92.105 +    bq: "length q = length cs" "\<forall>x. poly (b # q) x = (a + x) * poly cs x"
  92.106 +    by blast
  92.107 +  let ?b = "a*c"
  92.108 +  let ?q = "(b+c)#q"
  92.109 +  have lg: "length ?q = length (c#cs)" using bq(1) by simp
  92.110 +  {fix x
  92.111 +    from bq(2)[rule_format, of x]
  92.112 +    have "x*poly (b # q) x = x*((a + x) * poly cs x)" by simp
  92.113 +    hence "poly (?b# ?q) x = (a + x) * poly (c # cs) x"
  92.114 +      by (simp add: ring_simps)}
  92.115 +  with lg  show ?case by blast 
  92.116 +qed
  92.117 +
  92.118 +    (* FIXME : This one too*)
  92.119 +lemma poly_offset: "\<exists> q. length q = length p \<and> (\<forall>x. poly q (x::complex) = poly p (a + x))"
  92.120 +proof (induct p)
  92.121 +  case Nil thus ?case by simp
  92.122 +next
  92.123 +  case (Cons c cs)
  92.124 +  from Cons.hyps obtain q where q: "length q = length cs" "\<forall>x. poly q x = poly cs (a + x)" by blast
  92.125 +  from poly_offset_lemma[of q a] obtain b p where 
  92.126 +    bp: "length p = length q" "\<forall>x. poly (b # p) x = (a + x) * poly q x"
  92.127 +    by blast
  92.128 +  thus ?case using q bp by - (rule exI[where x="(c + b)#p"], simp)
  92.129 +qed
  92.130 +
  92.131 +text{* An alternative useful formulation of completeness of the reals *}
  92.132 +lemma real_sup_exists: assumes ex: "\<exists>x. P x" and bz: "\<exists>z. \<forall>x. P x \<longrightarrow> x < z"
  92.133 +  shows "\<exists>(s::real). \<forall>y. (\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < s"
  92.134 +proof-
  92.135 +  from ex bz obtain x Y where x: "P x" and Y: "\<And>x. P x \<Longrightarrow> x < Y"  by blast
  92.136 +  from ex have thx:"\<exists>x. x \<in> Collect P" by blast
  92.137 +  from bz have thY: "\<exists>Y. isUb UNIV (Collect P) Y" 
  92.138 +    by(auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def order_le_less)
  92.139 +  from reals_complete[OF thx thY] obtain L where L: "isLub UNIV (Collect P) L"
  92.140 +    by blast
  92.141 +  from Y[OF x] have xY: "x < Y" .
  92.142 +  from L have L': "\<forall>x. P x \<longrightarrow> x \<le> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)  
  92.143 +  from Y have Y': "\<forall>x. P x \<longrightarrow> x \<le> Y" 
  92.144 +    apply (clarsimp, atomize (full)) by auto 
  92.145 +  from L Y' have "L \<le> Y" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def)
  92.146 +  {fix y
  92.147 +    {fix z assume z: "P z" "y < z"
  92.148 +      from L' z have "y < L" by auto }
  92.149 +    moreover
  92.150 +    {assume yL: "y < L" "\<forall>z. P z \<longrightarrow> \<not> y < z"
  92.151 +      hence nox: "\<forall>z. P z \<longrightarrow> y \<ge> z" by auto
  92.152 +      from nox L have "y \<ge> L" by (auto simp add: isUb_def isLub_def setge_def setle_def leastP_def Ball_def) 
  92.153 +      with yL(1) have False  by arith}
  92.154 +    ultimately have "(\<exists>x. P x \<and> y < x) \<longleftrightarrow> y < L" by blast}
  92.155 +  thus ?thesis by blast
  92.156 +qed
  92.157 +
  92.158 +
  92.159 +subsection{* Some theorems about Sequences*}
  92.160 +text{* Given a binary function @{text "f:: nat \<Rightarrow> 'a \<Rightarrow> 'a"}, its values are uniquely determined by a function g *}
  92.161 +
  92.162 +lemma num_Axiom: "EX! g. g 0 = e \<and> (\<forall>n. g (Suc n) = f n (g n))"
  92.163 +  unfolding Ex1_def
  92.164 +  apply (rule_tac x="nat_rec e f" in exI)
  92.165 +  apply (rule conjI)+
  92.166 +apply (rule def_nat_rec_0, simp)
  92.167 +apply (rule allI, rule def_nat_rec_Suc, simp)
  92.168 +apply (rule allI, rule impI, rule ext)
  92.169 +apply (erule conjE)
  92.170 +apply (induct_tac x)
  92.171 +apply (simp add: nat_rec_0)
  92.172 +apply (erule_tac x="n" in allE)
  92.173 +apply (simp)
  92.174 +done
  92.175 +
  92.176 + text{* An equivalent formulation of monotony -- Not used here, but might be useful *}
  92.177 +lemma mono_Suc: "mono f = (\<forall>n. (f n :: 'a :: order) \<le> f (Suc n))"
  92.178 +unfolding mono_def
  92.179 +proof auto
  92.180 +  fix A B :: nat
  92.181 +  assume H: "\<forall>n. f n \<le> f (Suc n)" "A \<le> B"
  92.182 +  hence "\<exists>k. B = A + k" apply -  apply (thin_tac "\<forall>n. f n \<le> f (Suc n)") 
  92.183 +    by presburger
  92.184 +  then obtain k where k: "B = A + k" by blast
  92.185 +  {fix a k
  92.186 +    have "f a \<le> f (a + k)"
  92.187 +    proof (induct k)
  92.188 +      case 0 thus ?case by simp
  92.189 +    next
  92.190 +      case (Suc k)
  92.191 +      from Suc.hyps H(1)[rule_format, of "a + k"] show ?case by simp
  92.192 +    qed}
  92.193 +  with k show "f A \<le> f B" by blast
  92.194 +qed
  92.195 +
  92.196 +text{* for any sequence, there is a mootonic subsequence *}
  92.197 +lemma seq_monosub: "\<exists>f. subseq f \<and> monoseq (\<lambda> n. (s (f n)))"
  92.198 +proof-
  92.199 +  {assume H: "\<forall>n. \<exists>p >n. \<forall> m\<ge>p. s m \<le> s p"
  92.200 +    let ?P = "\<lambda> p n. p > n \<and> (\<forall>m \<ge> p. s m \<le> s p)"
  92.201 +    from num_Axiom[of "SOME p. ?P p 0" "\<lambda>p n. SOME p. ?P p n"]
  92.202 +    obtain f where f: "f 0 = (SOME p. ?P p 0)" "\<forall>n. f (Suc n) = (SOME p. ?P p (f n))" by blast
  92.203 +    have "?P (f 0) 0"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p 0"]
  92.204 +      using H apply - 
  92.205 +      apply (erule allE[where x=0], erule exE, rule_tac x="p" in exI) 
  92.206 +      unfolding order_le_less by blast 
  92.207 +    hence f0: "f 0 > 0" "\<forall>m \<ge> f 0. s m \<le> s (f 0)" by blast+
  92.208 +    {fix n
  92.209 +      have "?P (f (Suc n)) (f n)" 
  92.210 +	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
  92.211 +	using H apply - 
  92.212 +      apply (erule allE[where x="f n"], erule exE, rule_tac x="p" in exI) 
  92.213 +      unfolding order_le_less by blast 
  92.214 +    hence "f (Suc n) > f n" "\<forall>m \<ge> f (Suc n). s m \<le> s (f (Suc n))" by blast+}
  92.215 +  note fSuc = this
  92.216 +    {fix p q assume pq: "p \<ge> f q"
  92.217 +      have "s p \<le> s(f(q))"  using f0(2)[rule_format, of p] pq fSuc
  92.218 +	by (cases q, simp_all) }
  92.219 +    note pqth = this
  92.220 +    {fix q
  92.221 +      have "f (Suc q) > f q" apply (induct q) 
  92.222 +	using f0(1) fSuc(1)[of 0] apply simp by (rule fSuc(1))}
  92.223 +    note fss = this
  92.224 +    from fss have th1: "subseq f" unfolding subseq_Suc_iff ..
  92.225 +    {fix a b 
  92.226 +      have "f a \<le> f (a + b)"
  92.227 +      proof(induct b)
  92.228 +	case 0 thus ?case by simp
  92.229 +      next
  92.230 +	case (Suc b)
  92.231 +	from fSuc(1)[of "a + b"] Suc.hyps show ?case by simp
  92.232 +      qed}
  92.233 +    note fmon0 = this
  92.234 +    have "monoseq (\<lambda>n. s (f n))" 
  92.235 +    proof-
  92.236 +      {fix n
  92.237 +	have "s (f n) \<ge> s (f (Suc n))" 
  92.238 +	proof(cases n)
  92.239 +	  case 0
  92.240 +	  assume n0: "n = 0"
  92.241 +	  from fSuc(1)[of 0] have th0: "f 0 \<le> f (Suc 0)" by simp
  92.242 +	  from f0(2)[rule_format, OF th0] show ?thesis  using n0 by simp
  92.243 +	next
  92.244 +	  case (Suc m)
  92.245 +	  assume m: "n = Suc m"
  92.246 +	  from fSuc(1)[of n] m have th0: "f (Suc m) \<le> f (Suc (Suc m))" by simp
  92.247 +	  from m fSuc(2)[rule_format, OF th0] show ?thesis by simp 
  92.248 +	qed}
  92.249 +      thus "monoseq (\<lambda>n. s (f n))" unfolding monoseq_Suc by blast 
  92.250 +    qed
  92.251 +    with th1 have ?thesis by blast}
  92.252 +  moreover
  92.253 +  {fix N assume N: "\<forall>p >N. \<exists> m\<ge>p. s m > s p"
  92.254 +    {fix p assume p: "p \<ge> Suc N" 
  92.255 +      hence pN: "p > N" by arith with N obtain m where m: "m \<ge> p" "s m > s p" by blast
  92.256 +      have "m \<noteq> p" using m(2) by auto 
  92.257 +      with m have "\<exists>m>p. s p < s m" by - (rule exI[where x=m], auto)}
  92.258 +    note th0 = this
  92.259 +    let ?P = "\<lambda>m x. m > x \<and> s x < s m"
  92.260 +    from num_Axiom[of "SOME x. ?P x (Suc N)" "\<lambda>m x. SOME y. ?P y x"]
  92.261 +    obtain f where f: "f 0 = (SOME x. ?P x (Suc N))" 
  92.262 +      "\<forall>n. f (Suc n) = (SOME m. ?P m (f n))" by blast
  92.263 +    have "?P (f 0) (Suc N)"  unfolding f(1) some_eq_ex[of "\<lambda>p. ?P p (Suc N)"]
  92.264 +      using N apply - 
  92.265 +      apply (erule allE[where x="Suc N"], clarsimp)
  92.266 +      apply (rule_tac x="m" in exI)
  92.267 +      apply auto
  92.268 +      apply (subgoal_tac "Suc N \<noteq> m")
  92.269 +      apply simp
  92.270 +      apply (rule ccontr, simp)
  92.271 +      done
  92.272 +    hence f0: "f 0 > Suc N" "s (Suc N) < s (f 0)" by blast+
  92.273 +    {fix n
  92.274 +      have "f n > N \<and> ?P (f (Suc n)) (f n)"
  92.275 +	unfolding f(2)[rule_format, of n] some_eq_ex[of "\<lambda>p. ?P p (f n)"]
  92.276 +      proof (induct n)
  92.277 +	case 0 thus ?case
  92.278 +	  using f0 N apply auto 
  92.279 +	  apply (erule allE[where x="f 0"], clarsimp) 
  92.280 +	  apply (rule_tac x="m" in exI, simp)
  92.281 +	  by (subgoal_tac "f 0 \<noteq> m", auto)
  92.282 +      next
  92.283 +	case (Suc n)
  92.284 +	from Suc.hyps have Nfn: "N < f n" by blast
  92.285 +	from Suc.hyps obtain m where m: "m > f n" "s (f n) < s m" by blast
  92.286 +	with Nfn have mN: "m > N" by arith
  92.287 +	note key = Suc.hyps[unfolded some_eq_ex[of "\<lambda>p. ?P p (f n)", symmetric] f(2)[rule_format, of n, symmetric]]
  92.288 +	
  92.289 +	from key have th0: "f (Suc n) > N" by simp
  92.290 +	from N[rule_format, OF th0]
  92.291 +	obtain m' where m': "m' \<ge> f (Suc n)" "s (f (Suc n)) < s m'" by blast
  92.292 +	have "m' \<noteq> f (Suc (n))" apply (rule ccontr) using m'(2) by auto
  92.293 +	hence "m' > f (Suc n)" using m'(1) by simp
  92.294 +	with key m'(2) show ?case by auto
  92.295 +      qed}
  92.296 +    note fSuc = this
  92.297 +    {fix n
  92.298 +      have "f n \<ge> Suc N \<and> f(Suc n) > f n \<and> s(f n) < s(f(Suc n))" using fSuc[of n] by auto 
  92.299 +      hence "f n \<ge> Suc N" "f(Suc n) > f n" "s(f n) < s(f(Suc n))" by blast+}
  92.300 +    note thf = this
  92.301 +    have sqf: "subseq f" unfolding subseq_Suc_iff using thf by simp
  92.302 +    have "monoseq (\<lambda>n. s (f n))"  unfolding monoseq_Suc using thf
  92.303 +      apply -
  92.304 +      apply (rule disjI1)
  92.305 +      apply auto
  92.306 +      apply (rule order_less_imp_le)
  92.307 +      apply blast
  92.308 +      done
  92.309 +    then have ?thesis  using sqf by blast}
  92.310 +  ultimately show ?thesis unfolding linorder_not_less[symmetric] by blast
  92.311 +qed
  92.312 +
  92.313 +lemma seq_suble: assumes sf: "subseq f" shows "n \<le> f n"
  92.314 +proof(induct n)
  92.315 +  case 0 thus ?case by simp
  92.316 +next
  92.317 +  case (Suc n)
  92.318 +  from sf[unfolded subseq_Suc_iff, rule_format, of n] Suc.hyps
  92.319 +  have "n < f (Suc n)" by arith 
  92.320 +  thus ?case by arith
  92.321 +qed
  92.322 +
  92.323 +subsection {* Fundamental theorem of algebra *}
  92.324 +lemma  unimodular_reduce_norm:
  92.325 +  assumes md: "cmod z = 1"
  92.326 +  shows "cmod (z + 1) < 1 \<or> cmod (z - 1) < 1 \<or> cmod (z + ii) < 1 \<or> cmod (z - ii) < 1"
  92.327 +proof-
  92.328 +  obtain x y where z: "z = Complex x y " by (cases z, auto)
  92.329 +  from md z have xy: "x^2 + y^2 = 1" by (simp add: cmod_def)
  92.330 +  {assume C: "cmod (z + 1) \<ge> 1" "cmod (z - 1) \<ge> 1" "cmod (z + ii) \<ge> 1" "cmod (z - ii) \<ge> 1"
  92.331 +    from C z xy have "2*x \<le> 1" "2*x \<ge> -1" "2*y \<le> 1" "2*y \<ge> -1"
  92.332 +      by (simp_all add: cmod_def power2_eq_square ring_simps)
  92.333 +    hence "abs (2*x) \<le> 1" "abs (2*y) \<le> 1" by simp_all
  92.334 +    hence "(abs (2 * x))^2 <= 1^2" "(abs (2 * y)) ^2 <= 1^2"
  92.335 +      by - (rule power_mono, simp, simp)+
  92.336 +    hence th0: "4*x^2 \<le> 1" "4*y^2 \<le> 1" 
  92.337 +      by (simp_all  add: power2_abs power_mult_distrib)
  92.338 +    from add_mono[OF th0] xy have False by simp }
  92.339 +  thus ?thesis unfolding linorder_not_le[symmetric] by blast
  92.340 +qed
  92.341 +
  92.342 +text{* Hence we can always reduce modulus of @{text "1 + b z^n"} if nonzero *}
  92.343 +lemma reduce_poly_simple:
  92.344 + assumes b: "b \<noteq> 0" and n: "n\<noteq>0"
  92.345 +  shows "\<exists>z. cmod (1 + b * z^n) < 1"
  92.346 +using n
  92.347 +proof(induct n rule: nat_less_induct)
  92.348 +  fix n
  92.349 +  assume IH: "\<forall>m<n. m \<noteq> 0 \<longrightarrow> (\<exists>z. cmod (1 + b * z ^ m) < 1)" and n: "n \<noteq> 0"
  92.350 +  let ?P = "\<lambda>z n. cmod (1 + b * z ^ n) < 1"
  92.351 +  {assume e: "even n"
  92.352 +    hence "\<exists>m. n = 2*m" by presburger
  92.353 +    then obtain m where m: "n = 2*m" by blast
  92.354 +    from n m have "m\<noteq>0" "m < n" by presburger+
  92.355 +    with IH[rule_format, of m] obtain z where z: "?P z m" by blast
  92.356 +    from z have "?P (csqrt z) n" by (simp add: m power_mult csqrt)
  92.357 +    hence "\<exists>z. ?P z n" ..}
  92.358 +  moreover
  92.359 +  {assume o: "odd n"
  92.360 +    from b have b': "b^2 \<noteq> 0" unfolding power2_eq_square by simp
  92.361 +    have "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
  92.362 +    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) = 
  92.363 +    ((Re (inverse b))^2 + (Im (inverse b))^2) * \<bar>Im b * Im b + Re b * Re b\<bar>" by algebra
  92.364 +    also have "\<dots> = cmod (inverse b) ^2 * cmod b ^ 2" 
  92.365 +      apply (simp add: cmod_def) using realpow_two_le_add_order[of "Re b" "Im b"]
  92.366 +      by (simp add: power2_eq_square)
  92.367 +    finally 
  92.368 +    have th0: "Im (inverse b) * (Im (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) +
  92.369 +    Re (inverse b) * (Re (inverse b) * \<bar>Im b * Im b + Re b * Re b\<bar>) =
  92.370 +    1" 
  92.371 +      apply (simp add: power2_eq_square norm_mult[symmetric] norm_inverse[symmetric])
  92.372 +      using right_inverse[OF b']
  92.373 +      by (simp add: power2_eq_square[symmetric] power_inverse[symmetric] ring_simps)
  92.374 +    have th0: "cmod (complex_of_real (cmod b) / b) = 1"
  92.375 +      apply (simp add: complex_Re_mult cmod_def power2_eq_square Re_complex_of_real Im_complex_of_real divide_inverse ring_simps )
  92.376 +      by (simp add: real_sqrt_mult[symmetric] th0)        
  92.377 +    from o have "\<exists>m. n = Suc (2*m)" by presburger+
  92.378 +    then obtain m where m: "n = Suc (2*m)" by blast
  92.379 +    from unimodular_reduce_norm[OF th0] o
  92.380 +    have "\<exists>v. cmod (complex_of_real (cmod b) / b + v^n) < 1"
  92.381 +      apply (cases "cmod (complex_of_real (cmod b) / b + 1) < 1", rule_tac x="1" in exI, simp)
  92.382 +      apply (cases "cmod (complex_of_real (cmod b) / b - 1) < 1", rule_tac x="-1" in exI, simp add: diff_def)
  92.383 +      apply (cases "cmod (complex_of_real (cmod b) / b + ii) < 1")
  92.384 +      apply (cases "even m", rule_tac x="ii" in exI, simp add: m power_mult)
  92.385 +      apply (rule_tac x="- ii" in exI, simp add: m power_mult)
  92.386 +      apply (cases "even m", rule_tac x="- ii" in exI, simp add: m power_mult diff_def)
  92.387 +      apply (rule_tac x="ii" in exI, simp add: m power_mult diff_def)
  92.388 +      done
  92.389 +    then obtain v where v: "cmod (complex_of_real (cmod b) / b + v^n) < 1" by blast
  92.390 +    let ?w = "v / complex_of_real (root n (cmod b))"
  92.391 +    from odd_real_root_pow[OF o, of "cmod b"]
  92.392 +    have th1: "?w ^ n = v^n / complex_of_real (cmod b)" 
  92.393 +      by (simp add: power_divide complex_of_real_power)
  92.394 +    have th2:"cmod (complex_of_real (cmod b) / b) = 1" using b by (simp add: norm_divide)
  92.395 +    hence th3: "cmod (complex_of_real (cmod b) / b) \<ge> 0" by simp
  92.396 +    have th4: "cmod (complex_of_real (cmod b) / b) *
  92.397 +   cmod (1 + b * (v ^ n / complex_of_real (cmod b)))
  92.398 +   < cmod (complex_of_real (cmod b) / b) * 1"
  92.399 +      apply (simp only: norm_mult[symmetric] right_distrib)
  92.400 +      using b v by (simp add: th2)
  92.401 +
  92.402 +    from mult_less_imp_less_left[OF th4 th3]
  92.403 +    have "?P ?w n" unfolding th1 . 
  92.404 +    hence "\<exists>z. ?P z n" .. }
  92.405 +  ultimately show "\<exists>z. ?P z n" by blast
  92.406 +qed
  92.407 +
  92.408 +
  92.409 +text{* Bolzano-Weierstrass type property for closed disc in complex plane. *}
  92.410 +
  92.411 +lemma metric_bound_lemma: "cmod (x - y) <= \<bar>Re x - Re y\<bar> + \<bar>Im x - Im y\<bar>"
  92.412 +  using real_sqrt_sum_squares_triangle_ineq[of "Re x - Re y" 0 0 "Im x - Im y" ]
  92.413 +  unfolding cmod_def by simp
  92.414 +
  92.415 +lemma bolzano_weierstrass_complex_disc:
  92.416 +  assumes r: "\<forall>n. cmod (s n) \<le> r"
  92.417 +  shows "\<exists>f z. subseq f \<and> (\<forall>e >0. \<exists>N. \<forall>n \<ge> N. cmod (s (f n) - z) < e)"
  92.418 +proof-
  92.419 +  from seq_monosub[of "Re o s"] 
  92.420 +  obtain f g where f: "subseq f" "monoseq (\<lambda>n. Re (s (f n)))" 
  92.421 +    unfolding o_def by blast
  92.422 +  from seq_monosub[of "Im o s o f"] 
  92.423 +  obtain g where g: "subseq g" "monoseq (\<lambda>n. Im (s(f(g n))))" unfolding o_def by blast  
  92.424 +  let ?h = "f o g"
  92.425 +  from r[rule_format, of 0] have rp: "r \<ge> 0" using norm_ge_zero[of "s 0"] by arith 
  92.426 +  have th:"\<forall>n. r + 1 \<ge> \<bar> Re (s n)\<bar>" 
  92.427 +  proof
  92.428 +    fix n
  92.429 +    from abs_Re_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Re (s n)\<bar> \<le> r + 1" by arith
  92.430 +  qed
  92.431 +  have conv1: "convergent (\<lambda>n. Re (s ( f n)))"
  92.432 +    apply (rule Bseq_monoseq_convergent)
  92.433 +    apply (simp add: Bseq_def)
  92.434 +    apply (rule exI[where x= "r + 1"])
  92.435 +    using th rp apply simp
  92.436 +    using f(2) .
  92.437 +  have th:"\<forall>n. r + 1 \<ge> \<bar> Im (s n)\<bar>" 
  92.438 +  proof
  92.439 +    fix n
  92.440 +    from abs_Im_le_cmod[of "s n"] r[rule_format, of n]  show "\<bar>Im (s n)\<bar> \<le> r + 1" by arith
  92.441 +  qed
  92.442 +
  92.443 +  have conv2: "convergent (\<lambda>n. Im (s (f (g n))))"
  92.444 +    apply (rule Bseq_monoseq_convergent)
  92.445 +    apply (simp add: Bseq_def)
  92.446 +    apply (rule exI[where x= "r + 1"])
  92.447 +    using th rp apply simp
  92.448 +    using g(2) .
  92.449 +
  92.450 +  from conv1[unfolded convergent_def] obtain x where "LIMSEQ (\<lambda>n. Re (s (f n))) x" 
  92.451 +    by blast 
  92.452 +  hence  x: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Re (s (f n)) - x \<bar> < r" 
  92.453 +    unfolding LIMSEQ_def real_norm_def .
  92.454 +
  92.455 +  from conv2[unfolded convergent_def] obtain y where "LIMSEQ (\<lambda>n. Im (s (f (g n)))) y" 
  92.456 +    by blast 
  92.457 +  hence  y: "\<forall>r>0. \<exists>n0. \<forall>n\<ge>n0. \<bar> Im (s (f (g n))) - y \<bar> < r" 
  92.458 +    unfolding LIMSEQ_def real_norm_def .
  92.459 +  let ?w = "Complex x y"
  92.460 +  from f(1) g(1) have hs: "subseq ?h" unfolding subseq_def by auto 
  92.461 +  {fix e assume ep: "e > (0::real)"
  92.462 +    hence e2: "e/2 > 0" by simp
  92.463 +    from x[rule_format, OF e2] y[rule_format, OF e2]
  92.464 +    obtain N1 N2 where N1: "\<forall>n\<ge>N1. \<bar>Re (s (f n)) - x\<bar> < e / 2" and N2: "\<forall>n\<ge>N2. \<bar>Im (s (f (g n))) - y\<bar> < e / 2" by blast
  92.465 +    {fix n assume nN12: "n \<ge> N1 + N2"
  92.466 +      hence nN1: "g n \<ge> N1" and nN2: "n \<ge> N2" using seq_suble[OF g(1), of n] by arith+
  92.467 +      from add_strict_mono[OF N1[rule_format, OF nN1] N2[rule_format, OF nN2]]
  92.468 +      have "cmod (s (?h n) - ?w) < e" 
  92.469 +	using metric_bound_lemma[of "s (f (g n))" ?w] by simp }
  92.470 +    hence "\<exists>N. \<forall>n\<ge>N. cmod (s (?h n) - ?w) < e" by blast }
  92.471 +  with hs show ?thesis  by blast  
  92.472 +qed
  92.473 +
  92.474 +text{* Polynomial is continuous. *}
  92.475 +
  92.476 +lemma poly_cont:
  92.477 +  assumes ep: "e > 0" 
  92.478 +  shows "\<exists>d >0. \<forall>w. 0 < cmod (w - z) \<and> cmod (w - z) < d \<longrightarrow> cmod (poly p w - poly p z) < e"
  92.479 +proof-
  92.480 +  from poly_offset[of p z] obtain q where q: "length q = length p" "\<And>x. poly q x = poly p (z + x)" by blast
  92.481 +  {fix w
  92.482 +    note q(2)[of "w - z", simplified]}
  92.483 +  note th = this
  92.484 +  show ?thesis unfolding th[symmetric]
  92.485 +  proof(induct q)
  92.486 +    case Nil thus ?case  using ep by auto
  92.487 +  next
  92.488 +    case (Cons c cs)
  92.489 +    from poly_bound_exists[of 1 "cs"] 
  92.490 +    obtain m where m: "m > 0" "\<And>z. cmod z \<le> 1 \<Longrightarrow> cmod (poly cs z) \<le> m" by blast
  92.491 +    from ep m(1) have em0: "e/m > 0" by (simp add: field_simps)
  92.492 +    have one0: "1 > (0::real)"  by arith
  92.493 +    from real_lbound_gt_zero[OF one0 em0] 
  92.494 +    obtain d where d: "d >0" "d < 1" "d < e / m" by blast
  92.495 +    from d(1,3) m(1) have dm: "d*m > 0" "d*m < e" 
  92.496 +      by (simp_all add: field_simps real_mult_order)
  92.497 +    show ?case 
  92.498 +      proof(rule ex_forward[OF real_lbound_gt_zero[OF one0 em0]], clarsimp simp add: norm_mult)
  92.499 +	fix d w
  92.500 +	assume H: "d > 0" "d < 1" "d < e/m" "w\<noteq>z" "cmod (w-z) < d"
  92.501 +	hence d1: "cmod (w-z) \<le> 1" "d \<ge> 0" by simp_all
  92.502 +	from H(3) m(1) have dme: "d*m < e" by (simp add: field_simps)
  92.503 +	from H have th: "cmod (w-z) \<le> d" by simp 
  92.504 +	from mult_mono[OF th m(2)[OF d1(1)] d1(2) norm_ge_zero] dme
  92.505 +	show "cmod (w - z) * cmod (poly cs (w - z)) < e" by simp
  92.506 +      qed  
  92.507 +    qed
  92.508 +qed
  92.509 +
  92.510 +text{* Hence a polynomial attains minimum on a closed disc 
  92.511 +  in the complex plane. *}
  92.512 +lemma  poly_minimum_modulus_disc:
  92.513 +  "\<exists>z. \<forall>w. cmod w \<le> r \<longrightarrow> cmod (poly p z) \<le> cmod (poly p w)"
  92.514 +proof-
  92.515 +  {assume "\<not> r \<ge> 0" hence ?thesis unfolding linorder_not_le
  92.516 +      apply -
  92.517 +      apply (rule exI[where x=0]) 
  92.518 +      apply auto
  92.519 +      apply (subgoal_tac "cmod w < 0")
  92.520 +      apply simp
  92.521 +      apply arith
  92.522 +      done }
  92.523 +  moreover
  92.524 +  {assume rp: "r \<ge> 0"
  92.525 +    from rp have "cmod 0 \<le> r \<and> cmod (poly p 0) = - (- cmod (poly p 0))" by simp 
  92.526 +    hence mth1: "\<exists>x z. cmod z \<le> r \<and> cmod (poly p z) = - x"  by blast
  92.527 +    {fix x z
  92.528 +      assume H: "cmod z \<le> r" "cmod (poly p z) = - x" "\<not>x < 1"
  92.529 +      hence "- x < 0 " by arith
  92.530 +      with H(2) norm_ge_zero[of "poly p z"]  have False by simp }
  92.531 +    then have mth2: "\<exists>z. \<forall>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<longrightarrow> x < z" by blast
  92.532 +    from real_sup_exists[OF mth1 mth2] obtain s where 
  92.533 +      s: "\<forall>y. (\<exists>x. (\<exists>z. cmod z \<le> r \<and> cmod (poly p z) = - x) \<and> y < x) \<longleftrightarrow>(y < s)" by blast
  92.534 +    let ?m = "-s"
  92.535 +    {fix y
  92.536 +      from s[rule_format, of "-y"] have 
  92.537 +    "(\<exists>z x. cmod z \<le> r \<and> -(- cmod (poly p z)) < y) \<longleftrightarrow> ?m < y" 
  92.538 +	unfolding minus_less_iff[of y ] equation_minus_iff by blast }
  92.539 +    note s1 = this[unfolded minus_minus]
  92.540 +    from s1[of ?m] have s1m: "\<And>z x. cmod z \<le> r \<Longrightarrow> cmod (poly p z) \<ge> ?m" 
  92.541 +      by auto
  92.542 +    {fix n::nat
  92.543 +      from s1[rule_format, of "?m + 1/real (Suc n)"] 
  92.544 +      have "\<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)"
  92.545 +	by simp}
  92.546 +    hence th: "\<forall>n. \<exists>z. cmod z \<le> r \<and> cmod (poly p z) < - s + 1 / real (Suc n)" ..
  92.547 +    from choice[OF th] obtain g where 
  92.548 +      g: "\<forall>n. cmod (g n) \<le> r" "\<forall>n. cmod (poly p (g n)) <?m+1 /real(Suc n)" 
  92.549 +      by blast
  92.550 +    from bolzano_weierstrass_complex_disc[OF g(1)] 
  92.551 +    obtain f z where fz: "subseq f" "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. cmod (g (f n) - z) < e"
  92.552 +      by blast    
  92.553 +    {fix w 
  92.554 +      assume wr: "cmod w \<le> r"
  92.555 +      let ?e = "\<bar>cmod (poly p z) - ?m\<bar>"
  92.556 +      {assume e: "?e > 0"
  92.557 +	hence e2: "?e/2 > 0" by simp
  92.558 +	from poly_cont[OF e2, of z p] obtain d where
  92.559 +	  d: "d>0" "\<forall>w. 0<cmod (w - z)\<and> cmod(w - z) < d \<longrightarrow> cmod(poly p w - poly p z) < ?e/2" by blast
  92.560 +	{fix w assume w: "cmod (w - z) < d"
  92.561 +	  have "cmod(poly p w - poly p z) < ?e / 2"
  92.562 +	    using d(2)[rule_format, of w] w e by (cases "w=z", simp_all)}
  92.563 +	note th1 = this
  92.564 +	
  92.565 +	from fz(2)[rule_format, OF d(1)] obtain N1 where 
  92.566 +	  N1: "\<forall>n\<ge>N1. cmod (g (f n) - z) < d" by blast
  92.567 +	from reals_Archimedean2[of "2/?e"] obtain N2::nat where
  92.568 +	  N2: "2/?e < real N2" by blast
  92.569 +	have th2: "cmod(poly p (g(f(N1 + N2))) - poly p z) < ?e/2"
  92.570 +	  using N1[rule_format, of "N1 + N2"] th1 by simp
  92.571 +	{fix a b e2 m :: real
  92.572 +	have "a < e2 \<Longrightarrow> abs(b - m) < e2 \<Longrightarrow> 2 * e2 <= abs(b - m) + a
  92.573 +          ==> False" by arith}
  92.574 +      note th0 = this
  92.575 +      have ath: 
  92.576 +	"\<And>m x e. m <= x \<Longrightarrow>  x < m + e ==> abs(x - m::real) < e" by arith
  92.577 +      from s1m[OF g(1)[rule_format]]
  92.578 +      have th31: "?m \<le> cmod(poly p (g (f (N1 + N2))))" .
  92.579 +      from seq_suble[OF fz(1), of "N1+N2"]
  92.580 +      have th00: "real (Suc (N1+N2)) \<le> real (Suc (f (N1+N2)))" by simp
  92.581 +      have th000: "0 \<le> (1::real)" "(1::real) \<le> 1" "real (Suc (N1+N2)) > 0"  
  92.582 +	using N2 by auto
  92.583 +      from frac_le[OF th000 th00] have th00: "?m +1 / real (Suc (f (N1 + N2))) \<le> ?m + 1 / real (Suc (N1 + N2))" by simp
  92.584 +      from g(2)[rule_format, of "f (N1 + N2)"]
  92.585 +      have th01:"cmod (poly p (g (f (N1 + N2)))) < - s + 1 / real (Suc (f (N1 + N2)))" .
  92.586 +      from order_less_le_trans[OF th01 th00]
  92.587 +      have th32: "cmod(poly p (g (f (N1 + N2)))) < ?m + (1/ real(Suc (N1 + N2)))" .
  92.588 +      from N2 have "2/?e < real (Suc (N1 + N2))" by arith
  92.589 +      with e2 less_imp_inverse_less[of "2/?e" "real (Suc (N1 + N2))"]
  92.590 +      have "?e/2 > 1/ real (Suc (N1 + N2))" by (simp add: inverse_eq_divide)
  92.591 +      with ath[OF th31 th32]
  92.592 +      have thc1:"\<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar>< ?e/2" by arith  
  92.593 +      have ath2: "\<And>(a::real) b c m. \<bar>a - b\<bar> <= c ==> \<bar>b - m\<bar> <= \<bar>a - m\<bar> + c" 
  92.594 +	by arith
  92.595 +      have th22: "\<bar>cmod (poly p (g (f (N1 + N2)))) - cmod (poly p z)\<bar>
  92.596 +\<le> cmod (poly p (g (f (N1 + N2))) - poly p z)" 
  92.597 +	by (simp add: norm_triangle_ineq3)
  92.598 +      from ath2[OF th22, of ?m]
  92.599 +      have thc2: "2*(?e/2) \<le> \<bar>cmod(poly p (g (f (N1 + N2)))) - ?m\<bar> + cmod (poly p (g (f (N1 + N2))) - poly p z)" by simp
  92.600 +      from th0[OF th2 thc1 thc2] have False .}
  92.601 +      hence "?e = 0" by auto
  92.602 +      then have "cmod (poly p z) = ?m" by simp  
  92.603 +      with s1m[OF wr]
  92.604 +      have "cmod (poly p z) \<le> cmod (poly p w)" by simp }
  92.605 +    hence ?thesis by blast}
  92.606 +  ultimately show ?thesis by blast
  92.607 +qed
  92.608 +
  92.609 +lemma "(rcis (sqrt (abs r)) (a/2)) ^ 2 = rcis (abs r) a"
  92.610 +  unfolding power2_eq_square
  92.611 +  apply (simp add: rcis_mult)
  92.612 +  apply (simp add: power2_eq_square[symmetric])
  92.613 +  done
  92.614 +
  92.615 +lemma cispi: "cis pi = -1" 
  92.616 +  unfolding cis_def
  92.617 +  by simp
  92.618 +
  92.619 +lemma "(rcis (sqrt (abs r)) ((pi + a)/2)) ^ 2 = rcis (- abs r) a"
  92.620 +  unfolding power2_eq_square
  92.621 +  apply (simp add: rcis_mult add_divide_distrib)
  92.622 +  apply (simp add: power2_eq_square[symmetric] rcis_def cispi cis_mult[symmetric])
  92.623 +  done
  92.624 +
  92.625 +text {* Nonzero polynomial in z goes to infinity as z does. *}
  92.626 +
  92.627 +instance complex::idom_char_0 by (intro_classes)
  92.628 +instance complex :: recpower_idom_char_0 by intro_classes
  92.629 +
  92.630 +lemma poly_infinity:
  92.631 +  assumes ex: "list_ex (\<lambda>c. c \<noteq> 0) p"
  92.632 +  shows "\<exists>r. \<forall>z. r \<le> cmod z \<longrightarrow> d \<le> cmod (poly (a#p) z)"
  92.633 +using ex
  92.634 +proof(induct p arbitrary: a d)
  92.635 +  case (Cons c cs a d) 
  92.636 +  {assume H: "list_ex (\<lambda>c. c\<noteq>0) cs"
  92.637 +    with Cons.hyps obtain r where r: "\<forall>z. r \<le> cmod z \<longrightarrow> d + cmod a \<le> cmod (poly (c # cs) z)" by blast
  92.638 +    let ?r = "1 + \<bar>r\<bar>"
  92.639 +    {fix z assume h: "1 + \<bar>r\<bar> \<le> cmod z"
  92.640 +      have r0: "r \<le> cmod z" using h by arith
  92.641 +      from r[rule_format, OF r0]
  92.642 +      have th0: "d + cmod a \<le> 1 * cmod(poly (c#cs) z)" by arith
  92.643 +      from h have z1: "cmod z \<ge> 1" by arith
  92.644 +      from order_trans[OF th0 mult_right_mono[OF z1 norm_ge_zero[of "poly (c#cs) z"]]]
  92.645 +      have th1: "d \<le> cmod(z * poly (c#cs) z) - cmod a"
  92.646 +	unfolding norm_mult by (simp add: ring_simps)
  92.647 +      from complex_mod_triangle_sub[of "z * poly (c#cs) z" a]
  92.648 +      have th2: "cmod(z * poly (c#cs) z) - cmod a \<le> cmod (poly (a#c#cs) z)" 
  92.649 +	by (simp add: diff_le_eq ring_simps) 
  92.650 +      from th1 th2 have "d \<le> cmod (poly (a#c#cs) z)"  by arith}
  92.651 +    hence ?case by blast}
  92.652 +  moreover
  92.653 +  {assume cs0: "\<not> (list_ex (\<lambda>c. c \<noteq> 0) cs)"
  92.654 +    with Cons.prems have c0: "c \<noteq> 0" by simp
  92.655 +    from cs0 have cs0': "list_all (\<lambda>c. c = 0) cs" 
  92.656 +      by (auto simp add: list_all_iff list_ex_iff)
  92.657 +    {fix z
  92.658 +      assume h: "(\<bar>d\<bar> + cmod a) / cmod c \<le> cmod z"
  92.659 +      from c0 have "cmod c > 0" by simp
  92.660 +      from h c0 have th0: "\<bar>d\<bar> + cmod a \<le> cmod (z*c)" 
  92.661 +	by (simp add: field_simps norm_mult)
  92.662 +      have ath: "\<And>mzh mazh ma. mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh" by arith
  92.663 +      from complex_mod_triangle_sub[of "z*c" a ]
  92.664 +      have th1: "cmod (z * c) \<le> cmod (a + z * c) + cmod a"
  92.665 +	by (simp add: ring_simps)
  92.666 +      from ath[OF th1 th0] have "d \<le> cmod (poly (a # c # cs) z)" 
  92.667 +	using poly_0[OF cs0'] by simp}
  92.668 +    then have ?case  by blast}
  92.669 +  ultimately show ?case by blast
  92.670 +qed simp
  92.671 +
  92.672 +text {* Hence polynomial's modulus attains its minimum somewhere. *}
  92.673 +lemma poly_minimum_modulus:
  92.674 +  "\<exists>z.\<forall>w. cmod (poly p z) \<le> cmod (poly p w)"
  92.675 +proof(induct p)
  92.676 +  case (Cons c cs) 
  92.677 +  {assume cs0: "list_ex (\<lambda>c. c \<noteq> 0) cs"
  92.678 +    from poly_infinity[OF cs0, of "cmod (poly (c#cs) 0)" c]
  92.679 +    obtain r where r: "\<And>z. r \<le> cmod z \<Longrightarrow> cmod (poly (c # cs) 0) \<le> cmod (poly (c # cs) z)" by blast
  92.680 +    have ath: "\<And>z r. r \<le> cmod z \<or> cmod z \<le> \<bar>r\<bar>" by arith
  92.681 +    from poly_minimum_modulus_disc[of "\<bar>r\<bar>" "c#cs"] 
  92.682 +    obtain v where v: "\<And>w. cmod w \<le> \<bar>r\<bar> \<Longrightarrow> cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) w)" by blast
  92.683 +    {fix z assume z: "r \<le> cmod z"
  92.684 +      from v[of 0] r[OF z] 
  92.685 +      have "cmod (poly (c # cs) v) \<le> cmod (poly (c # cs) z)"
  92.686 +	by simp }
  92.687 +    note v0 = this
  92.688 +    from v0 v ath[of r] have ?case by blast}
  92.689 +  moreover
  92.690 +  {assume cs0: "\<not> (list_ex (\<lambda>c. c\<noteq>0) cs)"
  92.691 +    hence th:"list_all (\<lambda>c. c = 0) cs" by (simp add: list_all_iff list_ex_iff)
  92.692 +    from poly_0[OF th] Cons.hyps have ?case by simp}
  92.693 +  ultimately show ?case by blast
  92.694 +qed simp
  92.695 +
  92.696 +text{* Constant function (non-syntactic characterization). *}
  92.697 +definition "constant f = (\<forall>x y. f x = f y)"
  92.698 +
  92.699 +lemma nonconstant_length: "\<not> (constant (poly p)) \<Longrightarrow> length p \<ge> 2"
  92.700 +  unfolding constant_def
  92.701 +  apply (induct p, auto)
  92.702 +  apply (unfold not_less[symmetric])
  92.703 +  apply simp
  92.704 +  apply (rule ccontr)
  92.705 +  apply auto
  92.706 +  done
  92.707 + 
  92.708 +lemma poly_replicate_append:
  92.709 +  "poly ((replicate n 0)@p) (x::'a::{recpower, comm_ring}) = x^n * poly p x"
  92.710 +  by(induct n, auto simp add: power_Suc ring_simps)
  92.711 +
  92.712 +text {* Decomposition of polynomial, skipping zero coefficients 
  92.713 +  after the first.  *}
  92.714 +
  92.715 +lemma poly_decompose_lemma:
  92.716 + assumes nz: "\<not>(\<forall>z. z\<noteq>0 \<longrightarrow> poly p z = (0::'a::{recpower,idom}))"
  92.717 +  shows "\<exists>k a q. a\<noteq>0 \<and> Suc (length q + k) = length p \<and> 
  92.718 +                 (\<forall>z. poly p z = z^k * poly (a#q) z)"
  92.719 +using nz
  92.720 +proof(induct p)
  92.721 +  case Nil thus ?case by simp
  92.722 +next
  92.723 +  case (Cons c cs)
  92.724 +  {assume c0: "c = 0"
  92.725 +    
  92.726 +    from Cons.hyps Cons.prems c0 have ?case apply auto
  92.727 +      apply (rule_tac x="k+1" in exI)
  92.728 +      apply (rule_tac x="a" in exI, clarsimp)
  92.729 +      apply (rule_tac x="q" in exI)
  92.730 +      by (auto simp add: power_Suc)}
  92.731 +  moreover
  92.732 +  {assume c0: "c\<noteq>0"
  92.733 +    hence ?case apply-
  92.734 +      apply (rule exI[where x=0])
  92.735 +      apply (rule exI[where x=c], clarsimp)
  92.736 +      apply (rule exI[where x=cs])
  92.737 +      apply auto
  92.738 +      done}
  92.739 +  ultimately show ?case by blast
  92.740 +qed
  92.741 +
  92.742 +lemma poly_decompose:
  92.743 +  assumes nc: "~constant(poly p)"
  92.744 +  shows "\<exists>k a q. a\<noteq>(0::'a::{recpower,idom}) \<and> k\<noteq>0 \<and>
  92.745 +               length q + k + 1 = length p \<and> 
  92.746 +              (\<forall>z. poly p z = poly p 0 + z^k * poly (a#q) z)"
  92.747 +using nc 
  92.748 +proof(induct p)
  92.749 +  case Nil thus ?case by (simp add: constant_def)
  92.750 +next
  92.751 +  case (Cons c cs)
  92.752 +  {assume C:"\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0"
  92.753 +    {fix x y
  92.754 +      from C have "poly (c#cs) x = poly (c#cs) y" by (cases "x=0", auto)}
  92.755 +    with Cons.prems have False by (auto simp add: constant_def)}
  92.756 +  hence th: "\<not> (\<forall>z. z \<noteq> 0 \<longrightarrow> poly cs z = 0)" ..
  92.757 +  from poly_decompose_lemma[OF th] 
  92.758 +  show ?case 
  92.759 +    apply clarsimp    
  92.760 +    apply (rule_tac x="k+1" in exI)
  92.761 +    apply (rule_tac x="a" in exI)
  92.762 +    apply simp
  92.763 +    apply (rule_tac x="q" in exI)
  92.764 +    apply (auto simp add: power_Suc)
  92.765 +    done
  92.766 +qed
  92.767 +
  92.768 +text{* Fundamental theorem of algebral *}
  92.769 +
  92.770 +lemma fundamental_theorem_of_algebra:
  92.771 +  assumes nc: "~constant(poly p)"
  92.772 +  shows "\<exists>z::complex. poly p z = 0"
  92.773 +using nc
  92.774 +proof(induct n\<equiv> "length p" arbitrary: p rule: nat_less_induct)
  92.775 +  fix n fix p :: "complex list"
  92.776 +  let ?p = "poly p"
  92.777 +  assume H: "\<forall>m<n. \<forall>p. \<not> constant (poly p) \<longrightarrow> m = length p \<longrightarrow> (\<exists>(z::complex). poly p z = 0)" and nc: "\<not> constant ?p" and n: "n = length p"
  92.778 +  let ?ths = "\<exists>z. ?p z = 0"
  92.779 +
  92.780 +  from nonconstant_length[OF nc] have n2: "n\<ge> 2" by (simp add: n)
  92.781 +  from poly_minimum_modulus obtain c where 
  92.782 +    c: "\<forall>w. cmod (?p c) \<le> cmod (?p w)" by blast
  92.783 +  {assume pc: "?p c = 0" hence ?ths by blast}
  92.784 +  moreover
  92.785 +  {assume pc0: "?p c \<noteq> 0"
  92.786 +    from poly_offset[of p c] obtain q where
  92.787 +      q: "length q = length p" "\<forall>x. poly q x = ?p (c+x)" by blast
  92.788 +    {assume h: "constant (poly q)"
  92.789 +      from q(2) have th: "\<forall>x. poly q (x - c) = ?p x" by auto
  92.790 +      {fix x y
  92.791 +	from th have "?p x = poly q (x - c)" by auto 
  92.792 +	also have "\<dots> = poly q (y - c)" 
  92.793 +	  using h unfolding constant_def by blast
  92.794 +	also have "\<dots> = ?p y" using th by auto
  92.795 +	finally have "?p x = ?p y" .}
  92.796 +      with nc have False unfolding constant_def by blast }
  92.797 +    hence qnc: "\<not> constant (poly q)" by blast
  92.798 +    from q(2) have pqc0: "?p c = poly q 0" by simp
  92.799 +    from c pqc0 have cq0: "\<forall>w. cmod (poly q 0) \<le> cmod (?p w)" by simp 
  92.800 +    let ?a0 = "poly q 0"
  92.801 +    from pc0 pqc0 have a00: "?a0 \<noteq> 0" by simp 
  92.802 +    from a00 
  92.803 +    have qr: "\<forall>z. poly q z = poly (map (op * (inverse ?a0)) q) z * ?a0"
  92.804 +      by (simp add: poly_cmult_map)
  92.805 +    let ?r = "map (op * (inverse ?a0)) q"
  92.806 +    have lgqr: "length q = length ?r" by simp 
  92.807 +    {assume h: "\<And>x y. poly ?r x = poly ?r y"
  92.808 +      {fix x y
  92.809 +	from qr[rule_format, of x] 
  92.810 +	have "poly q x = poly ?r x * ?a0" by auto
  92.811 +	also have "\<dots> = poly ?r y * ?a0" using h by simp
  92.812 +	also have "\<dots> = poly q y" using qr[rule_format, of y] by simp
  92.813 +	finally have "poly q x = poly q y" .} 
  92.814 +      with qnc have False unfolding constant_def by blast}
  92.815 +    hence rnc: "\<not> constant (poly ?r)" unfolding constant_def by blast
  92.816 +    from qr[rule_format, of 0] a00  have r01: "poly ?r 0 = 1" by auto
  92.817 +    {fix w 
  92.818 +      have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w / ?a0) < 1"
  92.819 +	using qr[rule_format, of w] a00 by simp
  92.820 +      also have "\<dots> \<longleftrightarrow> cmod (poly q w) < cmod ?a0"
  92.821 +	using a00 unfolding norm_divide by (simp add: field_simps)
  92.822 +      finally have "cmod (poly ?r w) < 1 \<longleftrightarrow> cmod (poly q w) < cmod ?a0" .}
  92.823 +    note mrmq_eq = this
  92.824 +    from poly_decompose[OF rnc] obtain k a s where 
  92.825 +      kas: "a\<noteq>0" "k\<noteq>0" "length s + k + 1 = length ?r" 
  92.826 +      "\<forall>z. poly ?r z = poly ?r 0 + z^k* poly (a#s) z" by blast
  92.827 +    {assume "k + 1 = n"
  92.828 +      with kas(3) lgqr[symmetric] q(1) n[symmetric] have s0:"s=[]" by auto
  92.829 +      {fix w
  92.830 +	have "cmod (poly ?r w) = cmod (1 + a * w ^ k)" 
  92.831 +	  using kas(4)[rule_format, of w] s0 r01 by (simp add: ring_simps)}
  92.832 +      note hth = this [symmetric]
  92.833 +	from reduce_poly_simple[OF kas(1,2)] 
  92.834 +      have "\<exists>w. cmod (poly ?r w) < 1" unfolding hth by blast}
  92.835 +    moreover
  92.836 +    {assume kn: "k+1 \<noteq> n"
  92.837 +      from kn kas(3) q(1) n[symmetric] have k1n: "k + 1 < n" by simp
  92.838 +      have th01: "\<not> constant (poly (1#((replicate (k - 1) 0)@[a])))" 
  92.839 +	unfolding constant_def poly_Nil poly_Cons poly_replicate_append
  92.840 +	using kas(1) apply simp 
  92.841 +	by (rule exI[where x=0], rule exI[where x=1], simp)
  92.842 +      from kas(2) have th02: "k+1 = length (1#((replicate (k - 1) 0)@[a]))" 
  92.843 +	by simp
  92.844 +      from H[rule_format, OF k1n th01 th02]
  92.845 +      obtain w where w: "1 + w^k * a = 0"
  92.846 +	unfolding poly_Nil poly_Cons poly_replicate_append
  92.847 +	using kas(2) by (auto simp add: power_Suc[symmetric, of _ "k - Suc 0"] 
  92.848 +	  mult_assoc[of _ _ a, symmetric])
  92.849 +      from poly_bound_exists[of "cmod w" s] obtain m where 
  92.850 +	m: "m > 0" "\<forall>z. cmod z \<le> cmod w \<longrightarrow> cmod (poly s z) \<le> m" by blast
  92.851 +      have w0: "w\<noteq>0" using kas(2) w by (auto simp add: power_0_left)
  92.852 +      from w have "(1 + w ^ k * a) - 1 = 0 - 1" by simp
  92.853 +      then have wm1: "w^k * a = - 1" by simp
  92.854 +      have inv0: "0 < inverse (cmod w ^ (k + 1) * m)" 
  92.855 +	using norm_ge_zero[of w] w0 m(1)
  92.856 +	  by (simp add: inverse_eq_divide zero_less_mult_iff)
  92.857 +      with real_down2[OF zero_less_one] obtain t where
  92.858 +	t: "t > 0" "t < 1" "t < inverse (cmod w ^ (k + 1) * m)" by blast
  92.859 +      let ?ct = "complex_of_real t"
  92.860 +      let ?w = "?ct * w"
  92.861 +      have "1 + ?w^k * (a + ?w * poly s ?w) = 1 + ?ct^k * (w^k * a) + ?w^k * ?w * poly s ?w" using kas(1) by (simp add: ring_simps power_mult_distrib)
  92.862 +      also have "\<dots> = complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w"
  92.863 +	unfolding wm1 by (simp)
  92.864 +      finally have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) = cmod (complex_of_real (1 - t^k) + ?w^k * ?w * poly s ?w)" 
  92.865 +	apply -
  92.866 +	apply (rule cong[OF refl[of cmod]])
  92.867 +	apply assumption
  92.868 +	done
  92.869 +      with norm_triangle_ineq[of "complex_of_real (1 - t^k)" "?w^k * ?w * poly s ?w"] 
  92.870 +      have th11: "cmod (1 + ?w^k * (a + ?w * poly s ?w)) \<le> \<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w)" unfolding norm_of_real by simp 
  92.871 +      have ath: "\<And>x (t::real). 0\<le> x \<Longrightarrow> x < t \<Longrightarrow> t\<le>1 \<Longrightarrow> \<bar>1 - t\<bar> + x < 1" by arith
  92.872 +      have "t *cmod w \<le> 1 * cmod w" apply (rule mult_mono) using t(1,2) by auto
  92.873 +      then have tw: "cmod ?w \<le> cmod w" using t(1) by (simp add: norm_mult) 
  92.874 +      from t inv0 have "t* (cmod w ^ (k + 1) * m) < 1"
  92.875 +	by (simp add: inverse_eq_divide field_simps)
  92.876 +      with zero_less_power[OF t(1), of k] 
  92.877 +      have th30: "t^k * (t* (cmod w ^ (k + 1) * m)) < t^k * 1" 
  92.878 +	apply - apply (rule mult_strict_left_mono) by simp_all
  92.879 +      have "cmod (?w^k * ?w * poly s ?w) = t^k * (t* (cmod w ^ (k+1) * cmod (poly s ?w)))"  using w0 t(1)
  92.880 +	by (simp add: ring_simps power_mult_distrib norm_of_real norm_power norm_mult)
  92.881 +      then have "cmod (?w^k * ?w * poly s ?w) \<le> t^k * (t* (cmod w ^ (k + 1) * m))"
  92.882 +	using t(1,2) m(2)[rule_format, OF tw] w0
  92.883 +	apply (simp only: )
  92.884 +	apply auto
  92.885 +	apply (rule mult_mono, simp_all add: norm_ge_zero)+
  92.886 +	apply (simp add: zero_le_mult_iff zero_le_power)
  92.887 +	done
  92.888 +      with th30 have th120: "cmod (?w^k * ?w * poly s ?w) < t^k" by simp 
  92.889 +      from power_strict_mono[OF t(2), of k] t(1) kas(2) have th121: "t^k \<le> 1" 
  92.890 +	by auto
  92.891 +      from ath[OF norm_ge_zero[of "?w^k * ?w * poly s ?w"] th120 th121]
  92.892 +      have th12: "\<bar>1 - t^k\<bar> + cmod (?w^k * ?w * poly s ?w) < 1" . 
  92.893 +      from th11 th12
  92.894 +      have "cmod (1 + ?w^k * (a + ?w * poly s ?w)) < 1"  by arith 
  92.895 +      then have "cmod (poly ?r ?w) < 1" 
  92.896 +	unfolding kas(4)[rule_format, of ?w] r01 by simp 
  92.897 +      then have "\<exists>w. cmod (poly ?r w) < 1" by blast}
  92.898 +    ultimately have cr0_contr: "\<exists>w. cmod (poly ?r w) < 1" by blast
  92.899 +    from cr0_contr cq0 q(2)
  92.900 +    have ?ths unfolding mrmq_eq not_less[symmetric] by auto}
  92.901 +  ultimately show ?ths by blast
  92.902 +qed
  92.903 +
  92.904 +text {* Alternative version with a syntactic notion of constant polynomial. *}
  92.905 +
  92.906 +lemma fundamental_theorem_of_algebra_alt:
  92.907 +  assumes nc: "~(\<exists>a l. a\<noteq> 0 \<and> list_all(\<lambda>b. b = 0) l \<and> p = a#l)"
  92.908 +  shows "\<exists>z. poly p z = (0::complex)"
  92.909 +using nc
  92.910 +proof(induct p)
  92.911 +  case (Cons c cs)
  92.912 +  {assume "c=0" hence ?case by auto}
  92.913 +  moreover
  92.914 +  {assume c0: "c\<noteq>0"
  92.915 +    {assume nc: "constant (poly (c#cs))"
  92.916 +      from nc[unfolded constant_def, rule_format, of 0] 
  92.917 +      have "\<forall>w. w \<noteq> 0 \<longrightarrow> poly cs w = 0" by auto 
  92.918 +      hence "list_all (\<lambda>c. c=0) cs"
  92.919 +	proof(induct cs)
  92.920 +	  case (Cons d ds)
  92.921 +	  {assume "d=0" hence ?case using Cons.prems Cons.hyps by simp}
  92.922 +	  moreover
  92.923 +	  {assume d0: "d\<noteq>0"
  92.924 +	    from poly_bound_exists[of 1 ds] obtain m where 
  92.925 +	      m: "m > 0" "\<forall>z. \<forall>z. cmod z \<le> 1 \<longrightarrow> cmod (poly ds z) \<le> m" by blast
  92.926 +	    have dm: "cmod d / m > 0" using d0 m(1) by (simp add: field_simps)
  92.927 +	    from real_down2[OF dm zero_less_one] obtain x where 
  92.928 +	      x: "x > 0" "x < cmod d / m" "x < 1" by blast
  92.929 +	    let ?x = "complex_of_real x"
  92.930 +	    from x have cx: "?x \<noteq> 0"  "cmod ?x \<le> 1" by simp_all
  92.931 +	    from Cons.prems[rule_format, OF cx(1)]
  92.932 +	    have cth: "cmod (?x*poly ds ?x) = cmod d" by (simp add: eq_diff_eq[symmetric])
  92.933 +	    from m(2)[rule_format, OF cx(2)] x(1)
  92.934 +	    have th0: "cmod (?x*poly ds ?x) \<le> x*m"
  92.935 +	      by (simp add: norm_mult)
  92.936 +	    from x(2) m(1) have "x*m < cmod d" by (simp add: field_simps)
  92.937 +	    with th0 have "cmod (?x*poly ds ?x) \<noteq> cmod d" by auto
  92.938 +	    with cth  have ?case by blast}
  92.939 +	  ultimately show ?case by blast 
  92.940 +	qed simp}
  92.941 +      then have nc: "\<not> constant (poly (c#cs))" using Cons.prems c0 
  92.942 +	by blast
  92.943 +      from fundamental_theorem_of_algebra[OF nc] have ?case .}
  92.944 +  ultimately show ?case by blast  
  92.945 +qed simp
  92.946 +
  92.947 +subsection{* Nullstellenstatz, degrees and divisibility of polynomials *}
  92.948 +
  92.949 +lemma nullstellensatz_lemma:
  92.950 +  fixes p :: "complex list"
  92.951 +  assumes "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0"
  92.952 +  and "degree p = n" and "n \<noteq> 0"
  92.953 +  shows "p divides (pexp q n)"
  92.954 +using prems
  92.955 +proof(induct n arbitrary: p q rule: nat_less_induct)
  92.956 +  fix n::nat fix p q :: "complex list"
  92.957 +  assume IH: "\<forall>m<n. \<forall>p q.
  92.958 +                 (\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longrightarrow>
  92.959 +                 degree p = m \<longrightarrow> m \<noteq> 0 \<longrightarrow> p divides (q %^ m)"
  92.960 +    and pq0: "\<forall>x. poly p x = 0 \<longrightarrow> poly q x = 0" 
  92.961 +    and dpn: "degree p = n" and n0: "n \<noteq> 0"
  92.962 +  let ?ths = "p divides (q %^ n)"
  92.963 +  {fix a assume a: "poly p a = 0"
  92.964 +    {assume p0: "poly p = poly []" 
  92.965 +      hence ?ths unfolding divides_def  using pq0 n0
  92.966 +	apply - apply (rule exI[where x="[]"], rule ext)
  92.967 +	by (auto simp add: poly_mult poly_exp)}
  92.968 +    moreover
  92.969 +    {assume p0: "poly p \<noteq> poly []" 
  92.970 +      and oa: "order  a p \<noteq> 0"
  92.971 +      from p0 have pne: "p \<noteq> []" by auto
  92.972 +      let ?op = "order a p"
  92.973 +      from p0 have ap: "([- a, 1] %^ ?op) divides p" 
  92.974 +	"\<not> pexp [- a, 1] (Suc ?op) divides p" using order by blast+ 
  92.975 +      note oop = order_degree[OF p0, unfolded dpn]
  92.976 +      {assume q0: "q = []"
  92.977 +	hence ?ths using n0 unfolding divides_def 
  92.978 +	  apply simp
  92.979 +	  apply (rule exI[where x="[]"], rule ext)
  92.980 +	  by (simp add: divides_def poly_exp poly_mult)}
  92.981 +      moreover
  92.982 +      {assume q0: "q\<noteq>[]"
  92.983 +	from pq0[rule_format, OF a, unfolded poly_linear_divides] q0
  92.984 +	obtain r where r: "q = pmult [- a, 1] r" by blast
  92.985 +	from ap[unfolded divides_def] obtain s where
  92.986 +	  s: "poly p = poly (pmult (pexp [- a, 1] ?op) s)" by blast
  92.987 +	have s0: "poly s \<noteq> poly []"
  92.988 +	  using s p0 by (simp add: poly_entire)
  92.989 +	hence pns0: "poly (pnormalize s) \<noteq> poly []" and sne: "s\<noteq>[]" by auto
  92.990 +	{assume ds0: "degree s = 0"
  92.991 +	  from ds0 pns0 have "\<exists>k. pnormalize s = [k]" unfolding degree_def 
  92.992 +	    by (cases "pnormalize s", auto)
  92.993 +	  then obtain k where kpn: "pnormalize s = [k]" by blast
  92.994 +	  from pns0[unfolded poly_zero] kpn have k: "k \<noteq>0" "poly s = poly [k]"
  92.995 +	    using poly_normalize[of s] by simp_all
  92.996 +	  let ?w = "pmult (pmult [1/k] (pexp [-a,1] (n - ?op))) (pexp r n)"
  92.997 +	  from k r s oop have "poly (pexp q n) = poly (pmult p ?w)"
  92.998 +	    by - (rule ext, simp add: poly_mult poly_exp poly_cmult poly_add power_add[symmetric] ring_simps power_mult_distrib[symmetric])
  92.999 +	  hence ?ths unfolding divides_def by blast}
 92.1000 +	moreover
 92.1001 +	{assume ds0: "degree s \<noteq> 0"
 92.1002 +	  from ds0 s0 dpn degree_unique[OF s, unfolded linear_pow_mul_degree] oa
 92.1003 +	    have dsn: "degree s < n" by auto 
 92.1004 +	    {fix x assume h: "poly s x = 0"
 92.1005 +	      {assume xa: "x = a"
 92.1006 +		from h[unfolded xa poly_linear_divides] sne obtain u where
 92.1007 +		  u: "s = pmult [- a, 1] u" by blast
 92.1008 +		have "poly p = poly (pmult (pexp [- a, 1] (Suc ?op)) u)"
 92.1009 +		  unfolding s u
 92.1010 +		  apply (rule ext)
 92.1011 +		  by (simp add: ring_simps power_mult_distrib[symmetric] poly_mult poly_cmult poly_add poly_exp)
 92.1012 +		with ap(2)[unfolded divides_def] have False by blast}
 92.1013 +	      note xa = this
 92.1014 +	      from h s have "poly p x = 0" by (simp add: poly_mult)
 92.1015 +	      with pq0 have "poly q x = 0" by blast
 92.1016 +	      with r xa have "poly r x = 0"
 92.1017 +		by (auto simp add: poly_mult poly_add poly_cmult eq_diff_eq[symmetric])}
 92.1018 +	    note impth = this
 92.1019 +	    from IH[rule_format, OF dsn, of s r] impth ds0
 92.1020 +	    have "s divides (pexp r (degree s))" by blast
 92.1021 +	    then obtain u where u: "poly (pexp r (degree s)) = poly (pmult s u)"
 92.1022 +	      unfolding divides_def by blast
 92.1023 +	    hence u': "\<And>x. poly s x * poly u x = poly r x ^ degree s"
 92.1024 +	      by (simp add: poly_mult[symmetric] poly_exp[symmetric])
 92.1025 +	    let ?w = "pmult (pmult u (pexp [-a,1] (n - ?op))) (pexp r (n - degree s))"
 92.1026 +	    from u' s r oop[of a] dsn have "poly (pexp q n) = poly (pmult p ?w)"
 92.1027 +	      apply - apply (rule ext)
 92.1028 +	      apply (simp only:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult ring_simps)
 92.1029 +	      
 92.1030 +	      apply (simp add:  power_mult_distrib power_add[symmetric] poly_add poly_mult poly_exp poly_cmult mult_assoc[symmetric])
 92.1031 +	      done
 92.1032 +	    hence ?ths unfolding divides_def by blast}
 92.1033 +      ultimately have ?ths by blast }
 92.1034 +      ultimately have ?ths by blast}
 92.1035 +    ultimately have ?ths using a order_root by blast}
 92.1036 +  moreover
 92.1037 +  {assume exa: "\<not> (\<exists>a. poly p a = 0)"
 92.1038 +    from fundamental_theorem_of_algebra_alt[of p] exa obtain c cs where
 92.1039 +      ccs: "c\<noteq>0" "list_all (\<lambda>c. c = 0) cs" "p = c#cs" by blast
 92.1040 +    
 92.1041 +    from poly_0[OF ccs(2)] ccs(3) 
 92.1042 +    have pp: "\<And>x. poly p x =  c" by simp
 92.1043 +    let ?w = "pmult [1/c] (pexp q n)"
 92.1044 +    from pp ccs(1) 
 92.1045 +    have "poly (pexp q n) = poly (pmult p ?w) "
 92.1046 +      apply - apply (rule ext)
 92.1047 +      unfolding poly_mult_assoc[symmetric] by (simp add: poly_mult)
 92.1048 +    hence ?ths unfolding divides_def by blast}
 92.1049 +  ultimately show ?ths by blast
 92.1050 +qed
 92.1051 +
 92.1052 +lemma nullstellensatz_univariate:
 92.1053 +  "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> 
 92.1054 +    p divides (q %^ (degree p)) \<or> (poly p = poly [] \<and> poly q = poly [])"
 92.1055 +proof-
 92.1056 +  {assume pe: "poly p = poly []"
 92.1057 +    hence eq: "(\<forall>x. poly p x = (0::complex) \<longrightarrow> poly q x = 0) \<longleftrightarrow> poly q = poly []"
 92.1058 +      apply auto
 92.1059 +      by (rule ext, simp)
 92.1060 +    {assume "p divides (pexp q (degree p))"
 92.1061 +      then obtain r where r: "poly (pexp q (degree p)) = poly (pmult p r)" 
 92.1062 +	unfolding divides_def by blast
 92.1063 +      from cong[OF r refl] pe degree_unique[OF pe]
 92.1064 +      have False by (simp add: poly_mult degree_def)}
 92.1065 +    with eq pe have ?thesis by blast}
 92.1066 +  moreover
 92.1067 +  {assume pe: "poly p \<noteq> poly []"
 92.1068 +    have p0: "poly [0] = poly []" by (rule ext, simp)
 92.1069 +    {assume dp: "degree p = 0"
 92.1070 +      then obtain k where "pnormalize p = [k]" using pe poly_normalize[of p]
 92.1071 +	unfolding degree_def by (cases "pnormalize p", auto)
 92.1072 +      hence k: "pnormalize p = [k]" "poly p = poly [k]" "k\<noteq>0"
 92.1073 +	using pe poly_normalize[of p] by (auto simp add: p0)
 92.1074 +      hence th1: "\<forall>x. poly p x \<noteq> 0" by simp
 92.1075 +      from k(2,3) dp have "poly (pexp q (degree p)) = poly (pmult p [1/k]) "
 92.1076 +	by - (rule ext, simp add: poly_mult poly_exp)
 92.1077 +      hence th2: "p divides (pexp q (degree p))" unfolding divides_def by blast
 92.1078 +      from th1 th2 pe have ?thesis by blast}
 92.1079 +    moreover
 92.1080 +    {assume dp: "degree p \<noteq> 0"
 92.1081 +      then obtain n where n: "degree p = Suc n " by (cases "degree p", auto)
 92.1082 +      {assume "p divides (pexp q (Suc n))"
 92.1083 +	then obtain u where u: "poly (pexp q (Suc n)) = poly (pmult p u)"
 92.1084 +	  unfolding divides_def by blast
 92.1085 +	hence u' :"\<And>x. poly (pexp q (Suc n)) x = poly (pmult p u) x" by simp_all
 92.1086 +	{fix x assume h: "poly p x = 0" "poly q x \<noteq> 0"
 92.1087 +	  hence "poly (pexp q (Suc n)) x \<noteq> 0" by (simp only: poly_exp) simp	  
 92.1088 +	  hence False using u' h(1) by (simp only: poly_mult poly_exp) simp}}
 92.1089 +	with n nullstellensatz_lemma[of p q "degree p"] dp 
 92.1090 +	have ?thesis by auto}
 92.1091 +    ultimately have ?thesis by blast}
 92.1092 +  ultimately show ?thesis by blast
 92.1093 +qed
 92.1094 +
 92.1095 +text{* Useful lemma *}
 92.1096 +
 92.1097 +lemma (in idom_char_0) constant_degree: "constant (poly p) \<longleftrightarrow> degree p = 0" (is "?lhs = ?rhs")
 92.1098 +proof
 92.1099 +  assume l: ?lhs
 92.1100 +  from l[unfolded constant_def, rule_format, of _ "zero"]
 92.1101 +  have th: "poly p = poly [poly p 0]" apply - by (rule ext, simp)
 92.1102 +  from degree_unique[OF th] show ?rhs by (simp add: degree_def)
 92.1103 +next
 92.1104 +  assume r: ?rhs
 92.1105 +  from r have "pnormalize p = [] \<or> (\<exists>k. pnormalize p = [k])"
 92.1106 +    unfolding degree_def by (cases "pnormalize p", auto)
 92.1107 +  then show ?lhs unfolding constant_def poly_normalize[of p, symmetric]
 92.1108 +    by (auto simp del: poly_normalize)
 92.1109 +qed
 92.1110 +
 92.1111 +(* It would be nicer to prove this without using algebraic closure...        *)
 92.1112 +
 92.1113 +lemma divides_degree_lemma: assumes dpn: "degree (p::complex list) = n"
 92.1114 +  shows "n \<le> degree (p *** q) \<or> poly (p *** q) = poly []"
 92.1115 +  using dpn
 92.1116 +proof(induct n arbitrary: p q)
 92.1117 +  case 0 thus ?case by simp
 92.1118 +next
 92.1119 +  case (Suc n p q)
 92.1120 +  from Suc.prems fundamental_theorem_of_algebra[of p] constant_degree[of p]
 92.1121 +  obtain a where a: "poly p a = 0" by auto
 92.1122 +  then obtain r where r: "p = pmult [-a, 1] r" unfolding poly_linear_divides
 92.1123 +    using Suc.prems by (auto simp add: degree_def)
 92.1124 +  {assume h: "poly (pmult r q) = poly []"
 92.1125 +    hence "poly (pmult p q) = poly []" using r
 92.1126 +      apply - apply (rule ext)  by (auto simp add: poly_entire poly_mult poly_add poly_cmult) hence ?case by blast}
 92.1127 +  moreover
 92.1128 +  {assume h: "poly (pmult r q) \<noteq> poly []" 
 92.1129 +    hence r0: "poly r \<noteq> poly []" and q0: "poly q \<noteq> poly []"
 92.1130 +      by (auto simp add: poly_entire)
 92.1131 +    have eq: "poly (pmult p q) = poly (pmult [-a, 1] (pmult r q))"
 92.1132 +      apply - apply (rule ext)
 92.1133 +      by (simp add: r poly_mult poly_add poly_cmult ring_simps)
 92.1134 +    from linear_mul_degree[OF h, of "- a"]
 92.1135 +    have dqe: "degree (pmult p q) = degree (pmult r q) + 1"
 92.1136 +      unfolding degree_unique[OF eq] .
 92.1137 +    from linear_mul_degree[OF r0, of "- a", unfolded r[symmetric]] r Suc.prems 
 92.1138 +    have dr: "degree r = n" by auto
 92.1139 +    from  Suc.hyps[OF dr, of q] have "Suc n \<le> degree (pmult p q)"
 92.1140 +      unfolding dqe using h by (auto simp del: poly.simps) 
 92.1141 +    hence ?case by blast}
 92.1142 +  ultimately show ?case by blast
 92.1143 +qed
 92.1144 +
 92.1145 +lemma divides_degree: assumes pq: "p divides (q:: complex list)"
 92.1146 +  shows "degree p \<le> degree q \<or> poly q = poly []"
 92.1147 +using pq  divides_degree_lemma[OF refl, of p]
 92.1148 +apply (auto simp add: divides_def poly_entire)
 92.1149 +apply atomize
 92.1150 +apply (erule_tac x="qa" in allE, auto)
 92.1151 +apply (subgoal_tac "degree q = degree (p *** qa)", simp)
 92.1152 +apply (rule degree_unique, simp)
 92.1153 +done
 92.1154 +
 92.1155 +(* Arithmetic operations on multivariate polynomials.                        *)
 92.1156 +
 92.1157 +lemma mpoly_base_conv: 
 92.1158 +  "(0::complex) \<equiv> poly [] x" "c \<equiv> poly [c] x" "x \<equiv> poly [0,1] x" by simp_all
 92.1159 +
 92.1160 +lemma mpoly_norm_conv: 
 92.1161 +  "poly [0] (x::complex) \<equiv> poly [] x" "poly [poly [] y] x \<equiv> poly [] x" by simp_all
 92.1162 +
 92.1163 +lemma mpoly_sub_conv: 
 92.1164 +  "poly p (x::complex) - poly q x \<equiv> poly p x + -1 * poly q x"
 92.1165 +  by (simp add: diff_def)
 92.1166 +
 92.1167 +lemma poly_pad_rule: "poly p x = 0 ==> poly (0#p) x = (0::complex)" by simp
 92.1168 +
 92.1169 +lemma poly_cancel_eq_conv: "p = (0::complex) \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> (q = 0) \<equiv> (a * q - b * p = 0)" apply (atomize (full)) by auto
 92.1170 +
 92.1171 +lemma resolve_eq_raw:  "poly [] x \<equiv> 0" "poly [c] x \<equiv> (c::complex)" by auto
 92.1172 +lemma  resolve_eq_then: "(P \<Longrightarrow> (Q \<equiv> Q1)) \<Longrightarrow> (\<not>P \<Longrightarrow> (Q \<equiv> Q2))
 92.1173 +  \<Longrightarrow> Q \<equiv> P \<and> Q1 \<or> \<not>P\<and> Q2" apply (atomize (full)) by blast 
 92.1174 +lemma expand_ex_beta_conv: "list_ex P [c] \<equiv> P c" by simp
 92.1175 +
 92.1176 +lemma poly_divides_pad_rule: 
 92.1177 +  fixes p q :: "complex list"
 92.1178 +  assumes pq: "p divides q"
 92.1179 +  shows "p divides ((0::complex)#q)"
 92.1180 +proof-
 92.1181 +  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
 92.1182 +  hence "poly (0#q) = poly (p *** ([0,1] *** r))" 
 92.1183 +    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
 92.1184 +  thus ?thesis unfolding divides_def by blast
 92.1185 +qed
 92.1186 +
 92.1187 +lemma poly_divides_pad_const_rule: 
 92.1188 +  fixes p q :: "complex list"
 92.1189 +  assumes pq: "p divides q"
 92.1190 +  shows "p divides (a %* q)"
 92.1191 +proof-
 92.1192 +  from pq obtain r where r: "poly q = poly (p *** r)" unfolding divides_def by blast
 92.1193 +  hence "poly (a %* q) = poly (p *** (a %* r))" 
 92.1194 +    by - (rule ext, simp add: poly_mult poly_cmult poly_add)
 92.1195 +  thus ?thesis unfolding divides_def by blast
 92.1196 +qed
 92.1197 +
 92.1198 +
 92.1199 +lemma poly_divides_conv0:  
 92.1200 +  fixes p :: "complex list"
 92.1201 +  assumes lgpq: "length q < length p" and lq:"last p \<noteq> 0"
 92.1202 +  shows "p divides q \<equiv> (\<not> (list_ex (\<lambda>c. c \<noteq> 0) q))" (is "?lhs \<equiv> ?rhs")
 92.1203 +proof-
 92.1204 +  {assume r: ?rhs 
 92.1205 +    hence eq: "poly q = poly []" unfolding poly_zero 
 92.1206 +      by (simp add: list_all_iff list_ex_iff)
 92.1207 +    hence "poly q = poly (p *** [])" by - (rule ext, simp add: poly_mult)
 92.1208 +    hence ?lhs unfolding divides_def  by blast}
 92.1209 +  moreover
 92.1210 +  {assume l: ?lhs
 92.1211 +    have ath: "\<And>lq lp dq::nat. lq < lp ==> lq \<noteq> 0 \<Longrightarrow> dq <= lq - 1 ==> dq < lp - 1"
 92.1212 +      by arith
 92.1213 +    {assume q0: "length q = 0"
 92.1214 +      hence "q = []" by simp
 92.1215 +      hence ?rhs by simp}
 92.1216 +    moreover
 92.1217 +    {assume lgq0: "length q \<noteq> 0"
 92.1218 +      from pnormalize_length[of q] have dql: "degree q \<le> length q - 1" 
 92.1219 +	unfolding degree_def by simp
 92.1220 +      from ath[OF lgpq lgq0 dql, unfolded pnormal_degree[OF lq, symmetric]] divides_degree[OF l] have "poly q = poly []" by auto
 92.1221 +      hence ?rhs unfolding poly_zero by (simp add: list_all_iff list_ex_iff)}
 92.1222 +    ultimately have ?rhs by blast }
 92.1223 +  ultimately show "?lhs \<equiv> ?rhs" by - (atomize (full), blast) 
 92.1224 +qed
 92.1225 +
 92.1226 +lemma poly_divides_conv1: 
 92.1227 +  assumes a0: "a\<noteq> (0::complex)" and pp': "(p::complex list) divides p'"
 92.1228 +  and qrp': "\<And>x. a * poly q x - poly p' x \<equiv> poly r x"
 92.1229 +  shows "p divides q \<equiv> p divides (r::complex list)" (is "?lhs \<equiv> ?rhs")
 92.1230 +proof-
 92.1231 +  {
 92.1232 +  from pp' obtain t where t: "poly p' = poly (p *** t)" 
 92.1233 +    unfolding divides_def by blast
 92.1234 +  {assume l: ?lhs
 92.1235 +    then obtain u where u: "poly q = poly (p *** u)" unfolding divides_def by blast
 92.1236 +     have "poly r = poly (p *** ((a %* u) +++ (-- t)))"
 92.1237 +       using u qrp' t
 92.1238 +       by - (rule ext, 
 92.1239 +	 simp add: poly_add poly_mult poly_cmult poly_minus ring_simps)
 92.1240 +     then have ?rhs unfolding divides_def by blast}
 92.1241 +  moreover
 92.1242 +  {assume r: ?rhs
 92.1243 +    then obtain u where u: "poly r = poly (p *** u)" unfolding divides_def by blast
 92.1244 +    from u t qrp' a0 have "poly q = poly (p *** ((1/a) %* (u +++ t)))"
 92.1245 +      by - (rule ext, atomize (full), simp add: poly_mult poly_add poly_cmult field_simps)
 92.1246 +    hence ?lhs  unfolding divides_def by blast}
 92.1247 +  ultimately have "?lhs = ?rhs" by blast }
 92.1248 +thus "?lhs \<equiv> ?rhs"  by - (atomize(full), blast) 
 92.1249 +qed
 92.1250 +
 92.1251 +lemma basic_cqe_conv1:
 92.1252 +  "(\<exists>x. poly p x = 0 \<and> poly [] x \<noteq> 0) \<equiv> False"
 92.1253 +  "(\<exists>x. poly [] x \<noteq> 0) \<equiv> False"
 92.1254 +  "(\<exists>x. poly [c] x \<noteq> 0) \<equiv> c\<noteq>0"
 92.1255 +  "(\<exists>x. poly [] x = 0) \<equiv> True"
 92.1256 +  "(\<exists>x. poly [c] x = 0) \<equiv> c = 0" by simp_all
 92.1257 +
 92.1258 +lemma basic_cqe_conv2: 
 92.1259 +  assumes l:"last (a#b#p) \<noteq> 0" 
 92.1260 +  shows "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True"
 92.1261 +proof-
 92.1262 +  {fix h t
 92.1263 +    assume h: "h\<noteq>0" "list_all (\<lambda>c. c=(0::complex)) t"  "a#b#p = h#t"
 92.1264 +    hence "list_all (\<lambda>c. c= 0) (b#p)" by simp
 92.1265 +    moreover have "last (b#p) \<in> set (b#p)" by simp
 92.1266 +    ultimately have "last (b#p) = 0" by (simp add: list_all_iff)
 92.1267 +    with l have False by simp}
 92.1268 +  hence th: "\<not> (\<exists> h t. h\<noteq>0 \<and> list_all (\<lambda>c. c=0) t \<and> a#b#p = h#t)"
 92.1269 +    by blast
 92.1270 +  from fundamental_theorem_of_algebra_alt[OF th] 
 92.1271 +  show "(\<exists>x. poly (a#b#p) x = (0::complex)) \<equiv> True" by auto
 92.1272 +qed
 92.1273 +
 92.1274 +lemma  basic_cqe_conv_2b: "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
 92.1275 +proof-
 92.1276 +  have "\<not> (list_ex (\<lambda>c. c \<noteq> 0) p) \<longleftrightarrow> poly p = poly []" 
 92.1277 +    by (simp add: poly_zero list_all_iff list_ex_iff)
 92.1278 +  also have "\<dots> \<longleftrightarrow> (\<not> (\<exists>x. poly p x \<noteq> 0))" by (auto intro: ext)
 92.1279 +  finally show "(\<exists>x. poly p x \<noteq> (0::complex)) \<equiv> (list_ex (\<lambda>c. c \<noteq> 0) p)"
 92.1280 +    by - (atomize (full), blast)
 92.1281 +qed
 92.1282 +
 92.1283 +lemma basic_cqe_conv3:
 92.1284 +  fixes p q :: "complex list"
 92.1285 +  assumes l: "last (a#p) \<noteq> 0" 
 92.1286 +  shows "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
 92.1287 +proof-
 92.1288 +  note np = pnormalize_eq[OF l]
 92.1289 +  {assume "poly (a#p) = poly []" hence False using l
 92.1290 +      unfolding poly_zero apply (auto simp add: list_all_iff del: last.simps)
 92.1291 +      apply (cases p, simp_all) done}
 92.1292 +  then have p0: "poly (a#p) \<noteq> poly []"  by blast
 92.1293 +  from np have dp:"degree (a#p) = length p" by (simp add: degree_def)
 92.1294 +  from nullstellensatz_univariate[of "a#p" q] p0 dp
 92.1295 +  show "(\<exists>x. poly (a#p) x =0 \<and> poly q x \<noteq> 0) \<equiv> \<not> ((a#p) divides (q %^ (length p)))"
 92.1296 +    by - (atomize (full), auto)
 92.1297 +qed
 92.1298 +
 92.1299 +lemma basic_cqe_conv4:
 92.1300 +  fixes p q :: "complex list"
 92.1301 +  assumes h: "\<And>x. poly (q %^ n) x \<equiv> poly r x"
 92.1302 +  shows "p divides (q %^ n) \<equiv> p divides r"
 92.1303 +proof-
 92.1304 +  from h have "poly (q %^ n) = poly r" by (auto intro: ext)  
 92.1305 +  thus "p divides (q %^ n) \<equiv> p divides r" unfolding divides_def by simp
 92.1306 +qed
 92.1307 +
 92.1308 +lemma pmult_Cons_Cons: "((a::complex)#b#p) *** q = (a %*q) +++ (0#((b#p) *** q))"
 92.1309 +  by simp
 92.1310 +
 92.1311 +lemma elim_neg_conv: "- z \<equiv> (-1) * (z::complex)" by simp
 92.1312 +lemma eqT_intr: "PROP P \<Longrightarrow> (True \<Longrightarrow> PROP P )" "PROP P \<Longrightarrow> True" by blast+
 92.1313 +lemma negate_negate_rule: "Trueprop P \<equiv> \<not> P \<equiv> False" by (atomize (full), auto)
 92.1314 +lemma last_simps: "last [x] = x" "last (x#y#ys) = last (y#ys)" by simp_all
 92.1315 +lemma length_simps: "length [] = 0" "length (x#y#xs) = length xs + 2" "length [x] = 1" by simp_all
 92.1316 +
 92.1317 +lemma complex_entire: "(z::complex) \<noteq> 0 \<and> w \<noteq> 0 \<equiv> z*w \<noteq> 0" by simp
 92.1318 +lemma resolve_eq_ne: "(P \<equiv> True) \<equiv> (\<not>P \<equiv> False)" "(P \<equiv> False) \<equiv> (\<not>P \<equiv> True)" 
 92.1319 +  by (atomize (full)) simp_all
 92.1320 +lemma cqe_conv1: "poly [] x = 0 \<longleftrightarrow> True"  by simp
 92.1321 +lemma cqe_conv2: "(p \<Longrightarrow> (q \<equiv> r)) \<equiv> ((p \<and> q) \<equiv> (p \<and> r))"  (is "?l \<equiv> ?r")
 92.1322 +proof
 92.1323 +  assume "p \<Longrightarrow> q \<equiv> r" thus "p \<and> q \<equiv> p \<and> r" apply - apply (atomize (full)) by blast
 92.1324 +next
 92.1325 +  assume "p \<and> q \<equiv> p \<and> r" "p"
 92.1326 +  thus "q \<equiv> r" apply - apply (atomize (full)) apply blast done
 92.1327 +qed
 92.1328 +lemma poly_const_conv: "poly [c] (x::complex) = y \<longleftrightarrow> c = y" by simp
 92.1329 +
 92.1330 +end
 92.1331 \ No newline at end of file
    93.1 --- a/src/HOL/HOL.thy	Tue Dec 30 08:18:54 2008 +0100
    93.2 +++ b/src/HOL/HOL.thy	Tue Dec 30 11:10:01 2008 +0100
    93.3 @@ -26,6 +26,7 @@
    93.4    "~~/src/Tools/atomize_elim.ML"
    93.5    "~~/src/Tools/induct.ML"
    93.6    ("~~/src/Tools/induct_tacs.ML")
    93.7 +  "~~/src/Tools/value.ML"
    93.8    "~~/src/Tools/code/code_name.ML"
    93.9    "~~/src/Tools/code/code_funcgr.ML"
   93.10    "~~/src/Tools/code/code_thingol.ML"
    94.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    94.2 +++ b/src/HOL/HahnBanach/Bounds.thy	Tue Dec 30 11:10:01 2008 +0100
    94.3 @@ -0,0 +1,82 @@
    94.4 +(*  Title:      HOL/Real/HahnBanach/Bounds.thy
    94.5 +    Author:     Gertrud Bauer, TU Munich
    94.6 +*)
    94.7 +
    94.8 +header {* Bounds *}
    94.9 +
   94.10 +theory Bounds
   94.11 +imports Main ContNotDenum
   94.12 +begin
   94.13 +
   94.14 +locale lub =
   94.15 +  fixes A and x
   94.16 +  assumes least [intro?]: "(\<And>a. a \<in> A \<Longrightarrow> a \<le> b) \<Longrightarrow> x \<le> b"
   94.17 +    and upper [intro?]: "a \<in> A \<Longrightarrow> a \<le> x"
   94.18 +
   94.19 +lemmas [elim?] = lub.least lub.upper
   94.20 +
   94.21 +definition
   94.22 +  the_lub :: "'a::order set \<Rightarrow> 'a" where
   94.23 +  "the_lub A = The (lub A)"
   94.24 +
   94.25 +notation (xsymbols)
   94.26 +  the_lub  ("\<Squnion>_" [90] 90)
   94.27 +
   94.28 +lemma the_lub_equality [elim?]:
   94.29 +  assumes "lub A x"
   94.30 +  shows "\<Squnion>A = (x::'a::order)"
   94.31 +proof -
   94.32 +  interpret lub A x by fact
   94.33 +  show ?thesis
   94.34 +  proof (unfold the_lub_def)
   94.35 +    from `lub A x` show "The (lub A) = x"
   94.36 +    proof
   94.37 +      fix x' assume lub': "lub A x'"
   94.38 +      show "x' = x"
   94.39 +      proof (rule order_antisym)
   94.40 +	from lub' show "x' \<le> x"
   94.41 +	proof
   94.42 +          fix a assume "a \<in> A"
   94.43 +          then show "a \<le> x" ..
   94.44 +	qed
   94.45 +	show "x \<le> x'"
   94.46 +	proof
   94.47 +          fix a assume "a \<in> A"
   94.48 +          with lub' show "a \<le> x'" ..
   94.49 +	qed
   94.50 +      qed
   94.51 +    qed
   94.52 +  qed
   94.53 +qed
   94.54 +
   94.55 +lemma the_lubI_ex:
   94.56 +  assumes ex: "\<exists>x. lub A x"
   94.57 +  shows "lub A (\<Squnion>A)"
   94.58 +proof -
   94.59 +  from ex obtain x where x: "lub A x" ..
   94.60 +  also from x have [symmetric]: "\<Squnion>A = x" ..
   94.61 +  finally show ?thesis .
   94.62 +qed
   94.63 +
   94.64 +lemma lub_compat: "lub A x = isLub UNIV A x"
   94.65 +proof -
   94.66 +  have "isUb UNIV A = (\<lambda>x. A *<= x \<and> x \<in> UNIV)"
   94.67 +    by (rule ext) (simp only: isUb_def)
   94.68 +  then show ?thesis
   94.69 +    by (simp only: lub_def isLub_def leastP_def setge_def setle_def) blast
   94.70 +qed
   94.71 +
   94.72 +lemma real_complete:
   94.73 +  fixes A :: "real set"
   94.74 +  assumes nonempty: "\<exists>a. a \<in> A"
   94.75 +    and ex_upper: "\<exists>y. \<forall>a \<in> A. a \<le> y"
   94.76 +  shows "\<exists>x. lub A x"
   94.77 +proof -
   94.78 +  from ex_upper have "\<exists>y. isUb UNIV A y"
   94.79 +    unfolding isUb_def setle_def by blast
   94.80 +  with nonempty have "\<exists>x. isLub UNIV A x"
   94.81 +    by (rule reals_complete)
   94.82 +  then show ?thesis by (simp only: lub_compat)
   94.83 +qed
   94.84 +
   94.85 +end
    95.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    95.2 +++ b/src/HOL/HahnBanach/FunctionNorm.thy	Tue Dec 30 11:10:01 2008 +0100
    95.3 @@ -0,0 +1,278 @@
    95.4 +(*  Title:      HOL/Real/HahnBanach/FunctionNorm.thy
    95.5 +    Author:     Gertrud Bauer, TU Munich
    95.6 +*)
    95.7 +
    95.8 +header {* The norm of a function *}
    95.9 +
   95.10 +theory FunctionNorm
   95.11 +imports NormedSpace FunctionOrder
   95.12 +begin
   95.13 +
   95.14 +subsection {* Continuous linear forms*}
   95.15 +
   95.16 +text {*
   95.17 +  A linear form @{text f} on a normed vector space @{text "(V, \<parallel>\<cdot>\<parallel>)"}
   95.18 +  is \emph{continuous}, iff it is bounded, i.e.
   95.19 +  \begin{center}
   95.20 +  @{text "\<exists>c \<in> R. \<forall>x \<in> V. \<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
   95.21 +  \end{center}
   95.22 +  In our application no other functions than linear forms are
   95.23 +  considered, so we can define continuous linear forms as bounded
   95.24 +  linear forms:
   95.25 +*}
   95.26 +
   95.27 +locale continuous = var_V + norm_syntax + linearform +
   95.28 +  assumes bounded: "\<exists>c. \<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>"
   95.29 +
   95.30 +declare continuous.intro [intro?] continuous_axioms.intro [intro?]
   95.31 +
   95.32 +lemma continuousI [intro]:
   95.33 +  fixes norm :: "_ \<Rightarrow> real"  ("\<parallel>_\<parallel>")
   95.34 +  assumes "linearform V f"
   95.35 +  assumes r: "\<And>x. x \<in> V \<Longrightarrow> \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>"
   95.36 +  shows "continuous V norm f"
   95.37 +proof
   95.38 +  show "linearform V f" by fact
   95.39 +  from r have "\<exists>c. \<forall>x\<in>V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" by blast
   95.40 +  then show "continuous_axioms V norm f" ..
   95.41 +qed
   95.42 +
   95.43 +
   95.44 +subsection {* The norm of a linear form *}
   95.45 +
   95.46 +text {*
   95.47 +  The least real number @{text c} for which holds
   95.48 +  \begin{center}
   95.49 +  @{text "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
   95.50 +  \end{center}
   95.51 +  is called the \emph{norm} of @{text f}.
   95.52 +
   95.53 +  For non-trivial vector spaces @{text "V \<noteq> {0}"} the norm can be
   95.54 +  defined as
   95.55 +  \begin{center}
   95.56 +  @{text "\<parallel>f\<parallel> = \<sup>x \<noteq> 0. \<bar>f x\<bar> / \<parallel>x\<parallel>"}
   95.57 +  \end{center}
   95.58 +
   95.59 +  For the case @{text "V = {0}"} the supremum would be taken from an
   95.60 +  empty set. Since @{text \<real>} is unbounded, there would be no supremum.
   95.61 +  To avoid this situation it must be guaranteed that there is an
   95.62 +  element in this set. This element must be @{text "{} \<ge> 0"} so that
   95.63 +  @{text fn_norm} has the norm properties. Furthermore it does not
   95.64 +  have to change the norm in all other cases, so it must be @{text 0},
   95.65 +  as all other elements are @{text "{} \<ge> 0"}.
   95.66 +
   95.67 +  Thus we define the set @{text B} where the supremum is taken from as
   95.68 +  follows:
   95.69 +  \begin{center}
   95.70 +  @{text "{0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel>. x \<noteq> 0 \<and> x \<in> F}"}
   95.71 +  \end{center}
   95.72 +
   95.73 +  @{text fn_norm} is equal to the supremum of @{text B}, if the
   95.74 +  supremum exists (otherwise it is undefined).
   95.75 +*}
   95.76 +
   95.77 +locale fn_norm = norm_syntax +
   95.78 +  fixes B defines "B V f \<equiv> {0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel> | x. x \<noteq> 0 \<and> x \<in> V}"
   95.79 +  fixes fn_norm ("\<parallel>_\<parallel>\<hyphen>_" [0, 1000] 999)
   95.80 +  defines "\<parallel>f\<parallel>\<hyphen>V \<equiv> \<Squnion>(B V f)"
   95.81 +
   95.82 +locale normed_vectorspace_with_fn_norm = normed_vectorspace + fn_norm
   95.83 +
   95.84 +lemma (in fn_norm) B_not_empty [intro]: "0 \<in> B V f"
   95.85 +  by (simp add: B_def)
   95.86 +
   95.87 +text {*
   95.88 +  The following lemma states that every continuous linear form on a
   95.89 +  normed space @{text "(V, \<parallel>\<cdot>\<parallel>)"} has a function norm.
   95.90 +*}
   95.91 +
   95.92 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_works:
   95.93 +  assumes "continuous V norm f"
   95.94 +  shows "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
   95.95 +proof -
   95.96 +  interpret continuous V norm f by fact
   95.97 +  txt {* The existence of the supremum is shown using the
   95.98 +    completeness of the reals. Completeness means, that every
   95.99 +    non-empty bounded set of reals has a supremum. *}
  95.100 +  have "\<exists>a. lub (B V f) a"
  95.101 +  proof (rule real_complete)
  95.102 +    txt {* First we have to show that @{text B} is non-empty: *}
  95.103 +    have "0 \<in> B V f" ..
  95.104 +    then show "\<exists>x. x \<in> B V f" ..
  95.105 +
  95.106 +    txt {* Then we have to show that @{text B} is bounded: *}
  95.107 +    show "\<exists>c. \<forall>y \<in> B V f. y \<le> c"
  95.108 +    proof -
  95.109 +      txt {* We know that @{text f} is bounded by some value @{text c}. *}
  95.110 +      from bounded obtain c where c: "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
  95.111 +
  95.112 +      txt {* To prove the thesis, we have to show that there is some
  95.113 +        @{text b}, such that @{text "y \<le> b"} for all @{text "y \<in>
  95.114 +        B"}. Due to the definition of @{text B} there are two cases. *}
  95.115 +
  95.116 +      def b \<equiv> "max c 0"
  95.117 +      have "\<forall>y \<in> B V f. y \<le> b"
  95.118 +      proof
  95.119 +        fix y assume y: "y \<in> B V f"
  95.120 +        show "y \<le> b"
  95.121 +        proof cases
  95.122 +          assume "y = 0"
  95.123 +          then show ?thesis unfolding b_def by arith
  95.124 +        next
  95.125 +          txt {* The second case is @{text "y = \<bar>f x\<bar> / \<parallel>x\<parallel>"} for some
  95.126 +            @{text "x \<in> V"} with @{text "x \<noteq> 0"}. *}
  95.127 +          assume "y \<noteq> 0"
  95.128 +          with y obtain x where y_rep: "y = \<bar>f x\<bar> * inverse \<parallel>x\<parallel>"
  95.129 +              and x: "x \<in> V" and neq: "x \<noteq> 0"
  95.130 +            by (auto simp add: B_def real_divide_def)
  95.131 +          from x neq have gt: "0 < \<parallel>x\<parallel>" ..
  95.132 +
  95.133 +          txt {* The thesis follows by a short calculation using the
  95.134 +            fact that @{text f} is bounded. *}
  95.135 +
  95.136 +          note y_rep
  95.137 +          also have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> (c * \<parallel>x\<parallel>) * inverse \<parallel>x\<parallel>"
  95.138 +          proof (rule mult_right_mono)
  95.139 +            from c x show "\<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
  95.140 +            from gt have "0 < inverse \<parallel>x\<parallel>" 
  95.141 +              by (rule positive_imp_inverse_positive)
  95.142 +            then show "0 \<le> inverse \<parallel>x\<parallel>" by (rule order_less_imp_le)
  95.143 +          qed
  95.144 +          also have "\<dots> = c * (\<parallel>x\<parallel> * inverse \<parallel>x\<parallel>)"
  95.145 +            by (rule real_mult_assoc)
  95.146 +          also
  95.147 +          from gt have "\<parallel>x\<parallel> \<noteq> 0" by simp
  95.148 +          then have "\<parallel>x\<parallel> * inverse \<parallel>x\<parallel> = 1" by simp 
  95.149 +          also have "c * 1 \<le> b" by (simp add: b_def le_maxI1)
  95.150 +          finally show "y \<le> b" .
  95.151 +        qed
  95.152 +      qed
  95.153 +      then show ?thesis ..
  95.154 +    qed
  95.155 +  qed
  95.156 +  then show ?thesis unfolding fn_norm_def by (rule the_lubI_ex)
  95.157 +qed
  95.158 +
  95.159 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_ub [iff?]:
  95.160 +  assumes "continuous V norm f"
  95.161 +  assumes b: "b \<in> B V f"
  95.162 +  shows "b \<le> \<parallel>f\<parallel>\<hyphen>V"
  95.163 +proof -
  95.164 +  interpret continuous V norm f by fact
  95.165 +  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
  95.166 +    using `continuous V norm f` by (rule fn_norm_works)
  95.167 +  from this and b show ?thesis ..
  95.168 +qed
  95.169 +
  95.170 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_leastB:
  95.171 +  assumes "continuous V norm f"
  95.172 +  assumes b: "\<And>b. b \<in> B V f \<Longrightarrow> b \<le> y"
  95.173 +  shows "\<parallel>f\<parallel>\<hyphen>V \<le> y"
  95.174 +proof -
  95.175 +  interpret continuous V norm f by fact
  95.176 +  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
  95.177 +    using `continuous V norm f` by (rule fn_norm_works)
  95.178 +  from this and b show ?thesis ..
  95.179 +qed
  95.180 +
  95.181 +text {* The norm of a continuous function is always @{text "\<ge> 0"}. *}
  95.182 +
  95.183 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_ge_zero [iff]:
  95.184 +  assumes "continuous V norm f"
  95.185 +  shows "0 \<le> \<parallel>f\<parallel>\<hyphen>V"
  95.186 +proof -
  95.187 +  interpret continuous V norm f by fact
  95.188 +  txt {* The function norm is defined as the supremum of @{text B}.
  95.189 +    So it is @{text "\<ge> 0"} if all elements in @{text B} are @{text "\<ge>
  95.190 +    0"}, provided the supremum exists and @{text B} is not empty. *}
  95.191 +  have "lub (B V f) (\<parallel>f\<parallel>\<hyphen>V)"
  95.192 +    using `continuous V norm f` by (rule fn_norm_works)
  95.193 +  moreover have "0 \<in> B V f" ..
  95.194 +  ultimately show ?thesis ..
  95.195 +qed
  95.196 +
  95.197 +text {*
  95.198 +  \medskip The fundamental property of function norms is:
  95.199 +  \begin{center}
  95.200 +  @{text "\<bar>f x\<bar> \<le> \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"}
  95.201 +  \end{center}
  95.202 +*}
  95.203 +
  95.204 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_le_cong:
  95.205 +  assumes "continuous V norm f" "linearform V f"
  95.206 +  assumes x: "x \<in> V"
  95.207 +  shows "\<bar>f x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>"
  95.208 +proof -
  95.209 +  interpret continuous V norm f by fact
  95.210 +  interpret linearform V f .
  95.211 +  show ?thesis
  95.212 +  proof cases
  95.213 +    assume "x = 0"
  95.214 +    then have "\<bar>f x\<bar> = \<bar>f 0\<bar>" by simp
  95.215 +    also have "f 0 = 0" by rule unfold_locales
  95.216 +    also have "\<bar>\<dots>\<bar> = 0" by simp
  95.217 +    also have a: "0 \<le> \<parallel>f\<parallel>\<hyphen>V"
  95.218 +      using `continuous V norm f` by (rule fn_norm_ge_zero)
  95.219 +    from x have "0 \<le> norm x" ..
  95.220 +    with a have "0 \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>" by (simp add: zero_le_mult_iff)
  95.221 +    finally show "\<bar>f x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>" .
  95.222 +  next
  95.223 +    assume "x \<noteq> 0"
  95.224 +    with x have neq: "\<parallel>x\<parallel> \<noteq> 0" by simp
  95.225 +    then have "\<bar>f x\<bar> = (\<bar>f x\<bar> * inverse \<parallel>x\<parallel>) * \<parallel>x\<parallel>" by simp
  95.226 +    also have "\<dots> \<le>  \<parallel>f\<parallel>\<hyphen>V * \<parallel>x\<parallel>"
  95.227 +    proof (rule mult_right_mono)
  95.228 +      from x show "0 \<le> \<parallel>x\<parallel>" ..
  95.229 +      from x and neq have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<in> B V f"
  95.230 +	by (auto simp add: B_def real_divide_def)
  95.231 +      with `continuous V norm f` show "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> \<parallel>f\<parallel>\<hyphen>V"
  95.232 +	by (rule fn_norm_ub)
  95.233 +    qed
  95.234 +    finally show ?thesis .
  95.235 +  qed
  95.236 +qed
  95.237 +
  95.238 +text {*
  95.239 +  \medskip The function norm is the least positive real number for
  95.240 +  which the following inequation holds:
  95.241 +  \begin{center}
  95.242 +    @{text "\<bar>f x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
  95.243 +  \end{center}
  95.244 +*}
  95.245 +
  95.246 +lemma (in normed_vectorspace_with_fn_norm) fn_norm_least [intro?]:
  95.247 +  assumes "continuous V norm f"
  95.248 +  assumes ineq: "\<forall>x \<in> V. \<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" and ge: "0 \<le> c"
  95.249 +  shows "\<parallel>f\<parallel>\<hyphen>V \<le> c"
  95.250 +proof -
  95.251 +  interpret continuous V norm f by fact
  95.252 +  show ?thesis
  95.253 +  proof (rule fn_norm_leastB [folded B_def fn_norm_def])
  95.254 +    fix b assume b: "b \<in> B V f"
  95.255 +    show "b \<le> c"
  95.256 +    proof cases
  95.257 +      assume "b = 0"
  95.258 +      with ge show ?thesis by simp
  95.259 +    next
  95.260 +      assume "b \<noteq> 0"
  95.261 +      with b obtain x where b_rep: "b = \<bar>f x\<bar> * inverse \<parallel>x\<parallel>"
  95.262 +        and x_neq: "x \<noteq> 0" and x: "x \<in> V"
  95.263 +	by (auto simp add: B_def real_divide_def)
  95.264 +      note b_rep
  95.265 +      also have "\<bar>f x\<bar> * inverse \<parallel>x\<parallel> \<le> (c * \<parallel>x\<parallel>) * inverse \<parallel>x\<parallel>"
  95.266 +      proof (rule mult_right_mono)
  95.267 +	have "0 < \<parallel>x\<parallel>" using x x_neq ..
  95.268 +	then show "0 \<le> inverse \<parallel>x\<parallel>" by simp
  95.269 +	from ineq and x show "\<bar>f x\<bar> \<le> c * \<parallel>x\<parallel>" ..
  95.270 +      qed
  95.271 +      also have "\<dots> = c"
  95.272 +      proof -
  95.273 +	from x_neq and x have "\<parallel>x\<parallel> \<noteq> 0" by simp
  95.274 +	then show ?thesis by simp
  95.275 +      qed
  95.276 +      finally show ?thesis .
  95.277 +    qed
  95.278 +  qed (insert `continuous V norm f`, simp_all add: continuous_def)
  95.279 +qed
  95.280 +
  95.281 +end
    96.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    96.2 +++ b/src/HOL/HahnBanach/FunctionOrder.thy	Tue Dec 30 11:10:01 2008 +0100
    96.3 @@ -0,0 +1,142 @@
    96.4 +(*  Title:      HOL/Real/HahnBanach/FunctionOrder.thy
    96.5 +    ID:         $Id$
    96.6 +    Author:     Gertrud Bauer, TU Munich
    96.7 +*)
    96.8 +
    96.9 +header {* An order on functions *}
   96.10 +
   96.11 +theory FunctionOrder
   96.12 +imports Subspace Linearform
   96.13 +begin
   96.14 +
   96.15 +subsection {* The graph of a function *}
   96.16 +
   96.17 +text {*
   96.18 +  We define the \emph{graph} of a (real) function @{text f} with
   96.19 +  domain @{text F} as the set
   96.20 +  \begin{center}
   96.21 +  @{text "{(x, f x). x \<in> F}"}
   96.22 +  \end{center}
   96.23 +  So we are modeling partial functions by specifying the domain and
   96.24 +  the mapping function. We use the term ``function'' also for its
   96.25 +  graph.
   96.26 +*}
   96.27 +
   96.28 +types 'a graph = "('a \<times> real) set"
   96.29 +
   96.30 +definition
   96.31 +  graph :: "'a set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> 'a graph" where
   96.32 +  "graph F f = {(x, f x) | x. x \<in> F}"
   96.33 +
   96.34 +lemma graphI [intro]: "x \<in> F \<Longrightarrow> (x, f x) \<in> graph F f"
   96.35 +  unfolding graph_def by blast
   96.36 +
   96.37 +lemma graphI2 [intro?]: "x \<in> F \<Longrightarrow> \<exists>t \<in> graph F f. t = (x, f x)"
   96.38 +  unfolding graph_def by blast
   96.39 +
   96.40 +lemma graphE [elim?]:
   96.41 +    "(x, y) \<in> graph F f \<Longrightarrow> (x \<in> F \<Longrightarrow> y = f x \<Longrightarrow> C) \<Longrightarrow> C"
   96.42 +  unfolding graph_def by blast
   96.43 +
   96.44 +
   96.45 +subsection {* Functions ordered by domain extension *}
   96.46 +
   96.47 +text {*
   96.48 +  A function @{text h'} is an extension of @{text h}, iff the graph of
   96.49 +  @{text h} is a subset of the graph of @{text h'}.
   96.50 +*}
   96.51 +
   96.52 +lemma graph_extI:
   96.53 +  "(\<And>x. x \<in> H \<Longrightarrow> h x = h' x) \<Longrightarrow> H \<subseteq> H'
   96.54 +    \<Longrightarrow> graph H h \<subseteq> graph H' h'"
   96.55 +  unfolding graph_def by blast
   96.56 +
   96.57 +lemma graph_extD1 [dest?]:
   96.58 +  "graph H h \<subseteq> graph H' h' \<Longrightarrow> x \<in> H \<Longrightarrow> h x = h' x"
   96.59 +  unfolding graph_def by blast
   96.60 +
   96.61 +lemma graph_extD2 [dest?]:
   96.62 +  "graph H h \<subseteq> graph H' h' \<Longrightarrow> H \<subseteq> H'"
   96.63 +  unfolding graph_def by blast
   96.64 +
   96.65 +
   96.66 +subsection {* Domain and function of a graph *}
   96.67 +
   96.68 +text {*
   96.69 +  The inverse functions to @{text graph} are @{text domain} and @{text
   96.70 +  funct}.
   96.71 +*}
   96.72 +
   96.73 +definition
   96.74 +  "domain" :: "'a graph \<Rightarrow> 'a set" where
   96.75 +  "domain g = {x. \<exists>y. (x, y) \<in> g}"
   96.76 +
   96.77 +definition
   96.78 +  funct :: "'a graph \<Rightarrow> ('a \<Rightarrow> real)" where
   96.79 +  "funct g = (\<lambda>x. (SOME y. (x, y) \<in> g))"
   96.80 +
   96.81 +text {*
   96.82 +  The following lemma states that @{text g} is the graph of a function
   96.83 +  if the relation induced by @{text g} is unique.
   96.84 +*}
   96.85 +
   96.86 +lemma graph_domain_funct:
   96.87 +  assumes uniq: "\<And>x y z. (x, y) \<in> g \<Longrightarrow> (x, z) \<in> g \<Longrightarrow> z = y"
   96.88 +  shows "graph (domain g) (funct g) = g"
   96.89 +  unfolding domain_def funct_def graph_def
   96.90 +proof auto  (* FIXME !? *)
   96.91 +  fix a b assume g: "(a, b) \<in> g"
   96.92 +  from g show "(a, SOME y. (a, y) \<in> g) \<in> g" by (rule someI2)
   96.93 +  from g show "\<exists>y. (a, y) \<in> g" ..
   96.94 +  from g show "b = (SOME y. (a, y) \<in> g)"
   96.95 +  proof (rule some_equality [symmetric])
   96.96 +    fix y assume "(a, y) \<in> g"
   96.97 +    with g show "y = b" by (rule uniq)
   96.98 +  qed
   96.99 +qed
  96.100 +
  96.101 +
  96.102 +subsection {* Norm-preserving extensions of a function *}
  96.103 +
  96.104 +text {*
  96.105 +  Given a linear form @{text f} on the space @{text F} and a seminorm
  96.106 +  @{text p} on @{text E}. The set of all linear extensions of @{text
  96.107 +  f}, to superspaces @{text H} of @{text F}, which are bounded by
  96.108 +  @{text p}, is defined as follows.
  96.109 +*}
  96.110 +
  96.111 +definition
  96.112 +  norm_pres_extensions ::
  96.113 +    "'a::{plus, minus, uminus, zero} set \<Rightarrow> ('a \<Rightarrow> real) \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> real)
  96.114 +      \<Rightarrow> 'a graph set" where
  96.115 +    "norm_pres_extensions E p F f
  96.116 +      = {g. \<exists>H h. g = graph H h
  96.117 +          \<and> linearform H h
  96.118 +          \<and> H \<unlhd> E
  96.119 +          \<and> F \<unlhd> H
  96.120 +          \<and> graph F f \<subseteq> graph H h
  96.121 +          \<and> (\<forall>x \<in> H. h x \<le> p x)}"
  96.122 +
  96.123 +lemma norm_pres_extensionE [elim]:
  96.124 +  "g \<in> norm_pres_extensions E p F f
  96.125 +  \<Longrightarrow> (\<And>H h. g = graph H h \<Longrightarrow> linearform H h
  96.126 +        \<Longrightarrow> H \<unlhd> E \<Longrightarrow> F \<unlhd> H \<Longrightarrow> graph F f \<subseteq> graph H h
  96.127 +        \<Longrightarrow> \<forall>x \<in> H. h x \<le> p x \<Longrightarrow> C) \<Longrightarrow> C"
  96.128 +  unfolding norm_pres_extensions_def by blast
  96.129 +
  96.130 +lemma norm_pres_extensionI2 [intro]:
  96.131 +  "linearform H h \<Longrightarrow> H \<unlhd> E \<Longrightarrow> F \<unlhd> H
  96.132 +    \<Longrightarrow> graph F f \<subseteq> graph H h \<Longrightarrow> \<forall>x \<in> H. h x \<le> p x
  96.133 +    \<Longrightarrow> graph H h \<in> norm_pres_extensions E p F f"
  96.134 +  unfolding norm_pres_extensions_def by blast
  96.135 +
  96.136 +lemma norm_pres_extensionI:  (* FIXME ? *)
  96.137 +  "\<exists>H h. g = graph H h
  96.138 +    \<and> linearform H h
  96.139 +    \<and> H \<unlhd> E
  96.140 +    \<and> F \<unlhd> H
  96.141 +    \<and> graph F f \<subseteq> graph H h
  96.142 +    \<and> (\<forall>x \<in> H. h x \<le> p x) \<Longrightarrow> g \<in> norm_pres_extensions E p F f"
  96.143 +  unfolding norm_pres_extensions_def by blast
  96.144 +
  96.145 +end
    97.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    97.2 +++ b/src/HOL/HahnBanach/HahnBanach.thy	Tue Dec 30 11:10:01 2008 +0100
    97.3 @@ -0,0 +1,509 @@
    97.4 +(*  Title:      HOL/Real/HahnBanach/HahnBanach.thy
    97.5 +    Author:     Gertrud Bauer, TU Munich
    97.6 +*)
    97.7 +
    97.8 +header {* The Hahn-Banach Theorem *}
    97.9 +
   97.10 +theory HahnBanach
   97.11 +imports HahnBanachLemmas
   97.12 +begin
   97.13 +
   97.14 +text {*
   97.15 +  We present the proof of two different versions of the Hahn-Banach
   97.16 +  Theorem, closely following \cite[\S36]{Heuser:1986}.
   97.17 +*}
   97.18 +
   97.19 +subsection {* The Hahn-Banach Theorem for vector spaces *}
   97.20 +
   97.21 +text {*
   97.22 +  \textbf{Hahn-Banach Theorem.} Let @{text F} be a subspace of a real
   97.23 +  vector space @{text E}, let @{text p} be a semi-norm on @{text E},
   97.24 +  and @{text f} be a linear form defined on @{text F} such that @{text
   97.25 +  f} is bounded by @{text p}, i.e.  @{text "\<forall>x \<in> F. f x \<le> p x"}.  Then
   97.26 +  @{text f} can be extended to a linear form @{text h} on @{text E}
   97.27 +  such that @{text h} is norm-preserving, i.e. @{text h} is also
   97.28 +  bounded by @{text p}.
   97.29 +
   97.30 +  \bigskip
   97.31 +  \textbf{Proof Sketch.}
   97.32 +  \begin{enumerate}
   97.33 +
   97.34 +  \item Define @{text M} as the set of norm-preserving extensions of
   97.35 +  @{text f} to subspaces of @{text E}. The linear forms in @{text M}
   97.36 +  are ordered by domain extension.
   97.37 +
   97.38 +  \item We show that every non-empty chain in @{text M} has an upper
   97.39 +  bound in @{text M}.
   97.40 +
   97.41 +  \item With Zorn's Lemma we conclude that there is a maximal function
   97.42 +  @{text g} in @{text M}.
   97.43 +
   97.44 +  \item The domain @{text H} of @{text g} is the whole space @{text
   97.45 +  E}, as shown by classical contradiction:
   97.46 +
   97.47 +  \begin{itemize}
   97.48 +
   97.49 +  \item Assuming @{text g} is not defined on whole @{text E}, it can
   97.50 +  still be extended in a norm-preserving way to a super-space @{text
   97.51 +  H'} of @{text H}.
   97.52 +
   97.53 +  \item Thus @{text g} can not be maximal. Contradiction!
   97.54 +
   97.55 +  \end{itemize}
   97.56 +  \end{enumerate}
   97.57 +*}
   97.58 +
   97.59 +theorem HahnBanach:
   97.60 +  assumes E: "vectorspace E" and "subspace F E"
   97.61 +    and "seminorm E p" and "linearform F f"
   97.62 +  assumes fp: "\<forall>x \<in> F. f x \<le> p x"
   97.63 +  shows "\<exists>h. linearform E h \<and> (\<forall>x \<in> F. h x = f x) \<and> (\<forall>x \<in> E. h x \<le> p x)"
   97.64 +    -- {* Let @{text E} be a vector space, @{text F} a subspace of @{text E}, @{text p} a seminorm on @{text E}, *}
   97.65 +    -- {* and @{text f} a linear form on @{text F} such that @{text f} is bounded by @{text p}, *}
   97.66 +    -- {* then @{text f} can be extended to a linear form @{text h} on @{text E} in a norm-preserving way. \skp *}
   97.67 +proof -
   97.68 +  interpret vectorspace E by fact
   97.69 +  interpret subspace F E by fact
   97.70 +  interpret seminorm E p by fact
   97.71 +  interpret linearform F f by fact
   97.72 +  def M \<equiv> "norm_pres_extensions E p F f"
   97.73 +  then have M: "M = \<dots>" by (simp only:)
   97.74 +  from E have F: "vectorspace F" ..
   97.75 +  note FE = `F \<unlhd> E`
   97.76 +  {
   97.77 +    fix c assume cM: "c \<in> chain M" and ex: "\<exists>x. x \<in> c"
   97.78 +    have "\<Union>c \<in> M"
   97.79 +      -- {* Show that every non-empty chain @{text c} of @{text M} has an upper bound in @{text M}: *}
   97.80 +      -- {* @{text "\<Union>c"} is greater than any element of the chain @{text c}, so it suffices to show @{text "\<Union>c \<in> M"}. *}
   97.81 +      unfolding M_def
   97.82 +    proof (rule norm_pres_extensionI)
   97.83 +      let ?H = "domain (\<Union>c)"
   97.84 +      let ?h = "funct (\<Union>c)"
   97.85 +
   97.86 +      have a: "graph ?H ?h = \<Union>c"
   97.87 +      proof (rule graph_domain_funct)
   97.88 +        fix x y z assume "(x, y) \<in> \<Union>c" and "(x, z) \<in> \<Union>c"
   97.89 +        with M_def cM show "z = y" by (rule sup_definite)
   97.90 +      qed
   97.91 +      moreover from M cM a have "linearform ?H ?h"
   97.92 +        by (rule sup_lf)
   97.93 +      moreover from a M cM ex FE E have "?H \<unlhd> E"
   97.94 +        by (rule sup_subE)
   97.95 +      moreover from a M cM ex FE have "F \<unlhd> ?H"
   97.96 +        by (rule sup_supF)
   97.97 +      moreover from a M cM ex have "graph F f \<subseteq> graph ?H ?h"
   97.98 +        by (rule sup_ext)
   97.99 +      moreover from a M cM have "\<forall>x \<in> ?H. ?h x \<le> p x"
  97.100 +        by (rule sup_norm_pres)
  97.101 +      ultimately show "\<exists>H h. \<Union>c = graph H h
  97.102 +          \<and> linearform H h
  97.103 +          \<and> H \<unlhd> E
  97.104 +          \<and> F \<unlhd> H
  97.105 +          \<and> graph F f \<subseteq> graph H h
  97.106 +          \<and> (\<forall>x \<in> H. h x \<le> p x)" by blast
  97.107 +    qed
  97.108 +  }
  97.109 +  then have "\<exists>g \<in> M. \<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x"
  97.110 +  -- {* With Zorn's Lemma we can conclude that there is a maximal element in @{text M}. \skp *}
  97.111 +  proof (rule Zorn's_Lemma)
  97.112 +      -- {* We show that @{text M} is non-empty: *}
  97.113 +    show "graph F f \<in> M"
  97.114 +      unfolding M_def
  97.115 +    proof (rule norm_pres_extensionI2)
  97.116 +      show "linearform F f" by fact
  97.117 +      show "F \<unlhd> E" by fact
  97.118 +      from F show "F \<unlhd> F" by (rule vectorspace.subspace_refl)
  97.119 +      show "graph F f \<subseteq> graph F f" ..
  97.120 +      show "\<forall>x\<in>F. f x \<le> p x" by fact
  97.121 +    qed
  97.122 +  qed
  97.123 +  then obtain g where gM: "g \<in> M" and gx: "\<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x"
  97.124 +    by blast
  97.125 +  from gM obtain H h where
  97.126 +      g_rep: "g = graph H h"
  97.127 +    and linearform: "linearform H h"
  97.128 +    and HE: "H \<unlhd> E" and FH: "F \<unlhd> H"
  97.129 +    and graphs: "graph F f \<subseteq> graph H h"
  97.130 +    and hp: "\<forall>x \<in> H. h x \<le> p x" unfolding M_def ..
  97.131 +      -- {* @{text g} is a norm-preserving extension of @{text f}, in other words: *}
  97.132 +      -- {* @{text g} is the graph of some linear form @{text h} defined on a subspace @{text H} of @{text E}, *}
  97.133 +      -- {* and @{text h} is an extension of @{text f} that is again bounded by @{text p}. \skp *}
  97.134 +  from HE E have H: "vectorspace H"
  97.135 +    by (rule subspace.vectorspace)
  97.136 +
  97.137 +  have HE_eq: "H = E"
  97.138 +    -- {* We show that @{text h} is defined on whole @{text E} by classical contradiction. \skp *}
  97.139 +  proof (rule classical)
  97.140 +    assume neq: "H \<noteq> E"
  97.141 +      -- {* Assume @{text h} is not defined on whole @{text E}. Then show that @{text h} can be extended *}
  97.142 +      -- {* in a norm-preserving way to a function @{text h'} with the graph @{text g'}. \skp *}
  97.143 +    have "\<exists>g' \<in> M. g \<subseteq> g' \<and> g \<noteq> g'"
  97.144 +    proof -
  97.145 +      from HE have "H \<subseteq> E" ..
  97.146 +      with neq obtain x' where x'E: "x' \<in> E" and "x' \<notin> H" by blast
  97.147 +      obtain x': "x' \<noteq> 0"
  97.148 +      proof
  97.149 +        show "x' \<noteq> 0"
  97.150 +        proof
  97.151 +          assume "x' = 0"
  97.152 +          with H have "x' \<in> H" by (simp only: vectorspace.zero)
  97.153 +          with `x' \<notin> H` show False by contradiction
  97.154 +        qed
  97.155 +      qed
  97.156 +
  97.157 +      def H' \<equiv> "H + lin x'"
  97.158 +        -- {* Define @{text H'} as the direct sum of @{text H} and the linear closure of @{text x'}. \skp *}
  97.159 +      have HH': "H \<unlhd> H'"
  97.160 +      proof (unfold H'_def)
  97.161 +        from x'E have "vectorspace (lin x')" ..
  97.162 +        with H show "H \<unlhd> H + lin x'" ..
  97.163 +      qed
  97.164 +
  97.165 +      obtain xi where
  97.166 +        xi: "\<forall>y \<in> H. - p (y + x') - h y \<le> xi
  97.167 +          \<and> xi \<le> p (y + x') - h y"
  97.168 +        -- {* Pick a real number @{text \<xi>} that fulfills certain inequations; this will *}
  97.169 +        -- {* be used to establish that @{text h'} is a norm-preserving extension of @{text h}.
  97.170 +           \label{ex-xi-use}\skp *}
  97.171 +      proof -
  97.172 +        from H have "\<exists>xi. \<forall>y \<in> H. - p (y + x') - h y \<le> xi
  97.173 +            \<and> xi \<le> p (y + x') - h y"
  97.174 +        proof (rule ex_xi)
  97.175 +          fix u v assume u: "u \<in> H" and v: "v \<in> H"
  97.176 +          with HE have uE: "u \<in> E" and vE: "v \<in> E" by auto
  97.177 +          from H u v linearform have "h v - h u = h (v - u)"
  97.178 +            by (simp add: linearform.diff)
  97.179 +          also from hp and H u v have "\<dots> \<le> p (v - u)"
  97.180 +            by (simp only: vectorspace.diff_closed)
  97.181 +          also from x'E uE vE have "v - u = x' + - x' + v + - u"
  97.182 +            by (simp add: diff_eq1)
  97.183 +          also from x'E uE vE have "\<dots> = v + x' + - (u + x')"
  97.184 +            by (simp add: add_ac)
  97.185 +          also from x'E uE vE have "\<dots> = (v + x') - (u + x')"
  97.186 +            by (simp add: diff_eq1)
  97.187 +          also from x'E uE vE E have "p \<dots> \<le> p (v + x') + p (u + x')"
  97.188 +            by (simp add: diff_subadditive)
  97.189 +          finally have "h v - h u \<le> p (v + x') + p (u + x')" .
  97.190 +          then show "- p (u + x') - h u \<le> p (v + x') - h v" by simp
  97.191 +        qed
  97.192 +        then show thesis by (blast intro: that)
  97.193 +      qed
  97.194 +
  97.195 +      def h' \<equiv> "\<lambda>x. let (y, a) =
  97.196 +          SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H in h y + a * xi"
  97.197 +        -- {* Define the extension @{text h'} of @{text h} to @{text H'} using @{text \<xi>}. \skp *}
  97.198 +
  97.199 +      have "g \<subseteq> graph H' h' \<and> g \<noteq> graph H' h'"
  97.200 +        -- {* @{text h'} is an extension of @{text h} \dots \skp *}
  97.201 +      proof
  97.202 +        show "g \<subseteq> graph H' h'"
  97.203 +        proof -
  97.204 +          have  "graph H h \<subseteq> graph H' h'"
  97.205 +          proof (rule graph_extI)
  97.206 +            fix t assume t: "t \<in> H"
  97.207 +            from E HE t have "(SOME (y, a). t = y + a \<cdot> x' \<and> y \<in> H) = (t, 0)"
  97.208 +	      using `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` by (rule decomp_H'_H)
  97.209 +            with h'_def show "h t = h' t" by (simp add: Let_def)
  97.210 +          next
  97.211 +            from HH' show "H \<subseteq> H'" ..
  97.212 +          qed
  97.213 +          with g_rep show ?thesis by (simp only:)
  97.214 +        qed
  97.215 +
  97.216 +        show "g \<noteq> graph H' h'"
  97.217 +        proof -
  97.218 +          have "graph H h \<noteq> graph H' h'"
  97.219 +          proof
  97.220 +            assume eq: "graph H h = graph H' h'"
  97.221 +            have "x' \<in> H'"
  97.222 +	      unfolding H'_def
  97.223 +            proof
  97.224 +              from H show "0 \<in> H" by (rule vectorspace.zero)
  97.225 +              from x'E show "x' \<in> lin x'" by (rule x_lin_x)
  97.226 +              from x'E show "x' = 0 + x'" by simp
  97.227 +            qed
  97.228 +            then have "(x', h' x') \<in> graph H' h'" ..
  97.229 +            with eq have "(x', h' x') \<in> graph H h" by (simp only:)
  97.230 +            then have "x' \<in> H" ..
  97.231 +            with `x' \<notin> H` show False by contradiction
  97.232 +          qed
  97.233 +          with g_rep show ?thesis by simp
  97.234 +        qed
  97.235 +      qed
  97.236 +      moreover have "graph H' h' \<in> M"
  97.237 +        -- {* and @{text h'} is norm-preserving. \skp *}
  97.238 +      proof (unfold M_def)
  97.239 +        show "graph H' h' \<in> norm_pres_extensions E p F f"
  97.240 +        proof (rule norm_pres_extensionI2)
  97.241 +          show "linearform H' h'"
  97.242 +	    using h'_def H'_def HE linearform `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` E
  97.243 +	    by (rule h'_lf)
  97.244 +          show "H' \<unlhd> E"
  97.245 +	  unfolding H'_def
  97.246 +          proof
  97.247 +            show "H \<unlhd> E" by fact
  97.248 +            show "vectorspace E" by fact
  97.249 +            from x'E show "lin x' \<unlhd> E" ..
  97.250 +          qed
  97.251 +          from H `F \<unlhd> H` HH' show FH': "F \<unlhd> H'"
  97.252 +            by (rule vectorspace.subspace_trans)
  97.253 +          show "graph F f \<subseteq> graph H' h'"
  97.254 +          proof (rule graph_extI)
  97.255 +            fix x assume x: "x \<in> F"
  97.256 +            with graphs have "f x = h x" ..
  97.257 +            also have "\<dots> = h x + 0 * xi" by simp
  97.258 +            also have "\<dots> = (let (y, a) = (x, 0) in h y + a * xi)"
  97.259 +              by (simp add: Let_def)
  97.260 +            also have "(x, 0) =
  97.261 +                (SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H)"
  97.262 +	      using E HE
  97.263 +            proof (rule decomp_H'_H [symmetric])
  97.264 +              from FH x show "x \<in> H" ..
  97.265 +              from x' show "x' \<noteq> 0" .
  97.266 +	      show "x' \<notin> H" by fact
  97.267 +	      show "x' \<in> E" by fact
  97.268 +            qed
  97.269 +            also have
  97.270 +              "(let (y, a) = (SOME (y, a). x = y + a \<cdot> x' \<and> y \<in> H)
  97.271 +              in h y + a * xi) = h' x" by (simp only: h'_def)
  97.272 +            finally show "f x = h' x" .
  97.273 +          next
  97.274 +            from FH' show "F \<subseteq> H'" ..
  97.275 +          qed
  97.276 +          show "\<forall>x \<in> H'. h' x \<le> p x"
  97.277 +	    using h'_def H'_def `x' \<notin> H` `x' \<in> E` `x' \<noteq> 0` E HE
  97.278 +	      `seminorm E p` linearform and hp xi
  97.279 +	    by (rule h'_norm_pres)
  97.280 +        qed
  97.281 +      qed
  97.282 +      ultimately show ?thesis ..
  97.283 +    qed
  97.284 +    then have "\<not> (\<forall>x \<in> M. g \<subseteq> x \<longrightarrow> g = x)" by simp
  97.285 +      -- {* So the graph @{text g} of @{text h} cannot be maximal. Contradiction! \skp *}
  97.286 +    with gx show "H = E" by contradiction
  97.287 +  qed
  97.288 +
  97.289 +  from HE_eq and linearform have "linearform E h"
  97.290 +    by (simp only:)
  97.291 +  moreover have "\<forall>x \<in> F. h x = f x"
  97.292 +  proof
  97.293 +    fix x assume "x \<in> F"
  97.294 +    with graphs have "f x = h x" ..
  97.295 +    then show "h x = f x" ..
  97.296 +  qed
  97.297 +  moreover from HE_eq and hp have "\<forall>x \<in> E. h x \<le> p x"
  97.298 +    by (simp only:)
  97.299 +  ultimately show ?thesis by blast
  97.300 +qed
  97.301 +
  97.302 +
  97.303 +subsection  {* Alternative formulation *}
  97.304 +
  97.305 +text {*
  97.306 +  The following alternative formulation of the Hahn-Banach
  97.307 +  Theorem\label{abs-HahnBanach} uses the fact that for a real linear
  97.308 +  form @{text f} and a seminorm @{text p} the following inequations
  97.309 +  are equivalent:\footnote{This was shown in lemma @{thm [source]
  97.310 +  abs_ineq_iff} (see page \pageref{abs-ineq-iff}).}
  97.311 +  \begin{center}
  97.312 +  \begin{tabular}{lll}
  97.313 +  @{text "\<forall>x \<in> H. \<bar>h x\<bar> \<le> p x"} & and &
  97.314 +  @{text "\<forall>x \<in> H. h x \<le> p x"} \\
  97.315 +  \end{tabular}
  97.316 +  \end{center}
  97.317 +*}
  97.318 +
  97.319 +theorem abs_HahnBanach:
  97.320 +  assumes E: "vectorspace E" and FE: "subspace F E"
  97.321 +    and lf: "linearform F f" and sn: "seminorm E p"
  97.322 +  assumes fp: "\<forall>x \<in> F. \<bar>f x\<bar> \<le> p x"
  97.323 +  shows "\<exists>g. linearform E g
  97.324 +    \<and> (\<forall>x \<in> F. g x = f x)
  97.325 +    \<and> (\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x)"
  97.326 +proof -
  97.327 +  interpret vectorspace E by fact
  97.328 +  interpret subspace F E by fact
  97.329 +  interpret linearform F f by fact
  97.330 +  interpret seminorm E p by fact
  97.331 +  have "\<exists>g. linearform E g \<and> (\<forall>x \<in> F. g x = f x) \<and> (\<forall>x \<in> E. g x \<le> p x)"
  97.332 +    using E FE sn lf
  97.333 +  proof (rule HahnBanach)
  97.334 +    show "\<forall>x \<in> F. f x \<le> p x"
  97.335 +      using FE E sn lf and fp by (rule abs_ineq_iff [THEN iffD1])
  97.336 +  qed
  97.337 +  then obtain g where lg: "linearform E g" and *: "\<forall>x \<in> F. g x = f x"
  97.338 +      and **: "\<forall>x \<in> E. g x \<le> p x" by blast
  97.339 +  have "\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x"
  97.340 +    using _ E sn lg **
  97.341 +  proof (rule abs_ineq_iff [THEN iffD2])
  97.342 +    show "E \<unlhd> E" ..
  97.343 +  qed
  97.344 +  with lg * show ?thesis by blast
  97.345 +qed
  97.346 +
  97.347 +
  97.348 +subsection {* The Hahn-Banach Theorem for normed spaces *}
  97.349 +
  97.350 +text {*
  97.351 +  Every continuous linear form @{text f} on a subspace @{text F} of a
  97.352 +  norm space @{text E}, can be extended to a continuous linear form
  97.353 +  @{text g} on @{text E} such that @{text "\<parallel>f\<parallel> = \<parallel>g\<parallel>"}.
  97.354 +*}
  97.355 +
  97.356 +theorem norm_HahnBanach:
  97.357 +  fixes V and norm ("\<parallel>_\<parallel>")
  97.358 +  fixes B defines "\<And>V f. B V f \<equiv> {0} \<union> {\<bar>f x\<bar> / \<parallel>x\<parallel> | x. x \<noteq> 0 \<and> x \<in> V}"
  97.359 +  fixes fn_norm ("\<parallel>_\<parallel>\<hyphen>_" [0, 1000] 999)
  97.360 +  defines "\<And>V f. \<parallel>f\<parallel>\<hyphen>V \<equiv> \<Squnion>(B V f)"
  97.361 +  assumes E_norm: "normed_vectorspace E norm" and FE: "subspace F E"
  97.362 +    and linearform: "linearform F f" and "continuous F norm f"
  97.363 +  shows "\<exists>g. linearform E g
  97.364 +     \<and> continuous E norm g
  97.365 +     \<and> (\<forall>x \<in> F. g x = f x)
  97.366 +     \<and> \<parallel>g\<parallel>\<hyphen>E = \<parallel>f\<parallel>\<hyphen>F"
  97.367 +proof -
  97.368 +  interpret normed_vectorspace E norm by fact
  97.369 +  interpret normed_vectorspace_with_fn_norm E norm B fn_norm
  97.370 +    by (auto simp: B_def fn_norm_def) intro_locales
  97.371 +  interpret subspace F E by fact
  97.372 +  interpret linearform F f by fact
  97.373 +  interpret continuous F norm f by fact
  97.374 +  have E: "vectorspace E" by intro_locales
  97.375 +  have F: "vectorspace F" by rule intro_locales
  97.376 +  have F_norm: "normed_vectorspace F norm"
  97.377 +    using FE E_norm by (rule subspace_normed_vs)
  97.378 +  have ge_zero: "0 \<le> \<parallel>f\<parallel>\<hyphen>F"
  97.379 +    by (rule normed_vectorspace_with_fn_norm.fn_norm_ge_zero
  97.380 +      [OF normed_vectorspace_with_fn_norm.intro,
  97.381 +       OF F_norm `continuous F norm f` , folded B_def fn_norm_def])
  97.382 +  txt {* We define a function @{text p} on @{text E} as follows:
  97.383 +    @{text "p x = \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"} *}
  97.384 +  def p \<equiv> "\<lambda>x. \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  97.385 +
  97.386 +  txt {* @{text p} is a seminorm on @{text E}: *}
  97.387 +  have q: "seminorm E p"
  97.388 +  proof
  97.389 +    fix x y a assume x: "x \<in> E" and y: "y \<in> E"
  97.390 +    
  97.391 +    txt {* @{text p} is positive definite: *}
  97.392 +    have "0 \<le> \<parallel>f\<parallel>\<hyphen>F" by (rule ge_zero)
  97.393 +    moreover from x have "0 \<le> \<parallel>x\<parallel>" ..
  97.394 +    ultimately show "0 \<le> p x"  
  97.395 +      by (simp add: p_def zero_le_mult_iff)
  97.396 +
  97.397 +    txt {* @{text p} is absolutely homogenous: *}
  97.398 +
  97.399 +    show "p (a \<cdot> x) = \<bar>a\<bar> * p x"
  97.400 +    proof -
  97.401 +      have "p (a \<cdot> x) = \<parallel>f\<parallel>\<hyphen>F * \<parallel>a \<cdot> x\<parallel>" by (simp only: p_def)
  97.402 +      also from x have "\<parallel>a \<cdot> x\<parallel> = \<bar>a\<bar> * \<parallel>x\<parallel>" by (rule abs_homogenous)
  97.403 +      also have "\<parallel>f\<parallel>\<hyphen>F * (\<bar>a\<bar> * \<parallel>x\<parallel>) = \<bar>a\<bar> * (\<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>)" by simp
  97.404 +      also have "\<dots> = \<bar>a\<bar> * p x" by (simp only: p_def)
  97.405 +      finally show ?thesis .
  97.406 +    qed
  97.407 +
  97.408 +    txt {* Furthermore, @{text p} is subadditive: *}
  97.409 +
  97.410 +    show "p (x + y) \<le> p x + p y"
  97.411 +    proof -
  97.412 +      have "p (x + y) = \<parallel>f\<parallel>\<hyphen>F * \<parallel>x + y\<parallel>" by (simp only: p_def)
  97.413 +      also have a: "0 \<le> \<parallel>f\<parallel>\<hyphen>F" by (rule ge_zero)
  97.414 +      from x y have "\<parallel>x + y\<parallel> \<le> \<parallel>x\<parallel> + \<parallel>y\<parallel>" ..
  97.415 +      with a have " \<parallel>f\<parallel>\<hyphen>F * \<parallel>x + y\<parallel> \<le> \<parallel>f\<parallel>\<hyphen>F * (\<parallel>x\<parallel> + \<parallel>y\<parallel>)"
  97.416 +        by (simp add: mult_left_mono)
  97.417 +      also have "\<dots> = \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel> + \<parallel>f\<parallel>\<hyphen>F * \<parallel>y\<parallel>" by (simp only: right_distrib)
  97.418 +      also have "\<dots> = p x + p y" by (simp only: p_def)
  97.419 +      finally show ?thesis .
  97.420 +    qed
  97.421 +  qed
  97.422 +
  97.423 +  txt {* @{text f} is bounded by @{text p}. *}
  97.424 +
  97.425 +  have "\<forall>x \<in> F. \<bar>f x\<bar> \<le> p x"
  97.426 +  proof
  97.427 +    fix x assume "x \<in> F"
  97.428 +    with `continuous F norm f` and linearform
  97.429 +    show "\<bar>f x\<bar> \<le> p x"
  97.430 +      unfolding p_def by (rule normed_vectorspace_with_fn_norm.fn_norm_le_cong
  97.431 +        [OF normed_vectorspace_with_fn_norm.intro,
  97.432 +         OF F_norm, folded B_def fn_norm_def])
  97.433 +  qed
  97.434 +
  97.435 +  txt {* Using the fact that @{text p} is a seminorm and @{text f} is bounded
  97.436 +    by @{text p} we can apply the Hahn-Banach Theorem for real vector
  97.437 +    spaces. So @{text f} can be extended in a norm-preserving way to
  97.438 +    some function @{text g} on the whole vector space @{text E}. *}
  97.439 +
  97.440 +  with E FE linearform q obtain g where
  97.441 +      linearformE: "linearform E g"
  97.442 +    and a: "\<forall>x \<in> F. g x = f x"
  97.443 +    and b: "\<forall>x \<in> E. \<bar>g x\<bar> \<le> p x"
  97.444 +    by (rule abs_HahnBanach [elim_format]) iprover
  97.445 +
  97.446 +  txt {* We furthermore have to show that @{text g} is also continuous: *}
  97.447 +
  97.448 +  have g_cont: "continuous E norm g" using linearformE
  97.449 +  proof
  97.450 +    fix x assume "x \<in> E"
  97.451 +    with b show "\<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  97.452 +      by (simp only: p_def)
  97.453 +  qed
  97.454 +
  97.455 +  txt {* To complete the proof, we show that @{text "\<parallel>g\<parallel> = \<parallel>f\<parallel>"}. *}
  97.456 +
  97.457 +  have "\<parallel>g\<parallel>\<hyphen>E = \<parallel>f\<parallel>\<hyphen>F"
  97.458 +  proof (rule order_antisym)
  97.459 +    txt {*
  97.460 +      First we show @{text "\<parallel>g\<parallel> \<le> \<parallel>f\<parallel>"}.  The function norm @{text
  97.461 +      "\<parallel>g\<parallel>"} is defined as the smallest @{text "c \<in> \<real>"} such that
  97.462 +      \begin{center}
  97.463 +      \begin{tabular}{l}
  97.464 +      @{text "\<forall>x \<in> E. \<bar>g x\<bar> \<le> c \<cdot> \<parallel>x\<parallel>"}
  97.465 +      \end{tabular}
  97.466 +      \end{center}
  97.467 +      \noindent Furthermore holds
  97.468 +      \begin{center}
  97.469 +      \begin{tabular}{l}
  97.470 +      @{text "\<forall>x \<in> E. \<bar>g x\<bar> \<le> \<parallel>f\<parallel> \<cdot> \<parallel>x\<parallel>"}
  97.471 +      \end{tabular}
  97.472 +      \end{center}
  97.473 +    *}
  97.474 +
  97.475 +    have "\<forall>x \<in> E. \<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  97.476 +    proof
  97.477 +      fix x assume "x \<in> E"
  97.478 +      with b show "\<bar>g x\<bar> \<le> \<parallel>f\<parallel>\<hyphen>F * \<parallel>x\<parallel>"
  97.479 +        by (simp only: p_def)
  97.480 +    qed
  97.481 +    from g_cont this ge_zero
  97.482 +    show "\<parallel>g\<parallel>\<hyphen>E \<le> \<parallel>f\<parallel>\<hyphen>F"
  97.483 +      by (rule fn_norm_least [of g, folded B_def fn_norm_def])
  97.484 +
  97.485 +    txt {* The other direction is achieved by a similar argument. *}
  97.486 +
  97.487 +    show "\<parallel>f\<parallel>\<hyphen>F \<le> \<parallel>g\<parallel>\<hyphen>E"
  97.488 +    proof (rule normed_vectorspace_with_fn_norm.fn_norm_least
  97.489 +	[OF normed_vectorspace_with_fn_norm.intro,
  97.490 +	 OF F_norm, folded B_def fn_norm_def])
  97.491 +      show "\<forall>x \<in> F. \<bar>f x\<bar> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>"
  97.492 +      proof
  97.493 +	fix x assume x: "x \<in> F"
  97.494 +	from a x have "g x = f x" ..
  97.495 +	then have "\<bar>f x\<bar> = \<bar>g x\<bar>" by (simp only:)
  97.496 +	also from g_cont
  97.497 +	have "\<dots> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>"
  97.498 +	proof (rule fn_norm_le_cong [of g, folded B_def fn_norm_def])
  97.499 +	  from FE x show "x \<in> E" ..
  97.500 +	qed
  97.501 +	finally show "\<bar>f x\<bar> \<le> \<parallel>g\<parallel>\<hyphen>E * \<parallel>x\<parallel>" .
  97.502 +      qed
  97.503 +      show "0 \<le> \<parallel>g\<parallel>\<hyphen>E"
  97.504 +	using g_cont
  97.505 +	by (rule fn_norm_ge_zero [of g, folded B_def fn_norm_def])
  97.506 +      show "continuous F norm f" by fact
  97.507 +    qed
  97.508 +  qed
  97.509 +  with linearformE a g_cont show ?thesis by blast
  97.510 +qed
  97.511 +
  97.512 +end
    98.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    98.2 +++ b/src/HOL/HahnBanach/HahnBanachExtLemmas.thy	Tue Dec 30 11:10:01 2008 +0100
    98.3 @@ -0,0 +1,280 @@
    98.4 +(*  Title:      HOL/Real/HahnBanach/HahnBanachExtLemmas.thy
    98.5 +    Author:     Gertrud Bauer, TU Munich
    98.6 +*)
    98.7 +
    98.8 +header {* Extending non-maximal functions *}
    98.9 +
   98.10 +theory HahnBanachExtLemmas
   98.11 +imports FunctionNorm
   98.12 +begin
   98.13 +
   98.14 +text {*
   98.15 +  In this section the following context is presumed.  Let @{text E} be
   98.16 +  a real vector space with a seminorm @{text q} on @{text E}. @{text
   98.17 +  F} is a subspace of @{text E} and @{text f} a linear function on
   98.18 +  @{text F}. We consider a subspace @{text H} of @{text E} that is a
   98.19 +  superspace of @{text F} and a linear form @{text h} on @{text
   98.20 +  H}. @{text H} is a not equal to @{text E} and @{text "x\<^sub>0"} is
   98.21 +  an element in @{text "E - H"}.  @{text H} is extended to the direct
   98.22 +  sum @{text "H' = H + lin x\<^sub>0"}, so for any @{text "x \<in> H'"}
   98.23 +  the decomposition of @{text "x = y + a \<cdot> x"} with @{text "y \<in> H"} is
   98.24 +  unique. @{text h'} is defined on @{text H'} by @{text "h' x = h y +
   98.25 +  a \<cdot> \<xi>"} for a certain @{text \<xi>}.
   98.26 +
   98.27 +  Subsequently we show some properties of this extension @{text h'} of
   98.28 +  @{text h}.
   98.29 +
   98.30 +  \medskip This lemma will be used to show the existence of a linear
   98.31 +  extension of @{text f} (see page \pageref{ex-xi-use}). It is a
   98.32 +  consequence of the completeness of @{text \<real>}. To show
   98.33 +  \begin{center}
   98.34 +  \begin{tabular}{l}
   98.35 +  @{text "\<exists>\<xi>. \<forall>y \<in> F. a y \<le> \<xi> \<and> \<xi> \<le> b y"}
   98.36 +  \end{tabular}
   98.37 +  \end{center}
   98.38 +  \noindent it suffices to show that
   98.39 +  \begin{center}
   98.40 +  \begin{tabular}{l}
   98.41 +  @{text "\<forall>u \<in> F. \<forall>v \<in> F. a u \<le> b v"}
   98.42 +  \end{tabular}
   98.43 +  \end{center}
   98.44 +*}
   98.45 +
   98.46 +lemma ex_xi:
   98.47 +  assumes "vectorspace F"
   98.48 +  assumes r: "\<And>u v. u \<in> F \<Longrightarrow> v \<in> F \<Longrightarrow> a u \<le> b v"
   98.49 +  shows "\<exists>xi::real. \<forall>y \<in> F. a y \<le> xi \<and> xi \<le> b y"
   98.50 +proof -
   98.51 +  interpret vectorspace F by fact
   98.52 +  txt {* From the completeness of the reals follows:
   98.53 +    The set @{text "S = {a u. u \<in> F}"} has a supremum, if it is
   98.54 +    non-empty and has an upper bound. *}
   98.55 +
   98.56 +  let ?S = "{a u | u. u \<in> F}"
   98.57 +  have "\<exists>xi. lub ?S xi"
   98.58 +  proof (rule real_complete)
   98.59 +    have "a 0 \<in> ?S" by blast
   98.60 +    then show "\<exists>X. X \<in> ?S" ..
   98.61 +    have "\<forall>y \<in> ?S. y \<le> b 0"
   98.62 +    proof
   98.63 +      fix y assume y: "y \<in> ?S"
   98.64 +      then obtain u where u: "u \<in> F" and y: "y = a u" by blast
   98.65 +      from u and zero have "a u \<le> b 0" by (rule r)
   98.66 +      with y show "y \<le> b 0" by (simp only:)
   98.67 +    qed
   98.68 +    then show "\<exists>u. \<forall>y \<in> ?S. y \<le> u" ..
   98.69 +  qed
   98.70 +  then obtain xi where xi: "lub ?S xi" ..
   98.71 +  {
   98.72 +    fix y assume "y \<in> F"
   98.73 +    then have "a y \<in> ?S" by blast
   98.74 +    with xi have "a y \<le> xi" by (rule lub.upper)
   98.75 +  } moreover {
   98.76 +    fix y assume y: "y \<in> F"
   98.77 +    from xi have "xi \<le> b y"
   98.78 +    proof (rule lub.least)
   98.79 +      fix au assume "au \<in> ?S"
   98.80 +      then obtain u where u: "u \<in> F" and au: "au = a u" by blast
   98.81 +      from u y have "a u \<le> b y" by (rule r)
   98.82 +      with au show "au \<le> b y" by (simp only:)
   98.83 +    qed
   98.84 +  } ultimately show "\<exists>xi. \<forall>y \<in> F. a y \<le> xi \<and> xi \<le> b y" by blast
   98.85 +qed
   98.86 +
   98.87 +text {*
   98.88 +  \medskip The function @{text h'} is defined as a @{text "h' x = h y
   98.89 +  + a \<cdot> \<xi>"} where @{text "x = y + a \<cdot> \<xi>"} is a linear extension of
   98.90 +  @{text h} to @{text H'}.
   98.91 +*}
   98.92 +
   98.93 +lemma h'_lf:
   98.94 +  assumes h'_def: "h' \<equiv> \<lambda>x. let (y, a) =
   98.95 +      SOME (y, a). x = y + a \<cdot> x0 \<and> y \<in> H in h y + a * xi"
   98.96 +    and H'_def: "H' \<equiv> H + lin x0"
   98.97 +    and HE: "H \<unlhd> E"
   98.98 +  assumes "linearform H h"
   98.99 +  assumes x0: "x0 \<notin> H"  "x0 \<in> E"  "x0 \<noteq> 0"
  98.100 +  assumes E: "vectorspace E"
  98.101 +  shows "linearform H' h'"
  98.102 +proof -
  98.103 +  interpret linearform H h by fact
  98.104 +  interpret vectorspace E by fact
  98.105 +  show ?thesis
  98.106 +  proof
  98.107 +    note E = `vectorspace E`
  98.108 +    have H': "vectorspace H'"
  98.109 +    proof (unfold H'_def)
  98.110 +      from `x0 \<in> E`
  98.111 +      have "lin x0 \<unlhd> E" ..
  98.112 +      with HE show "vectorspace (H + lin x0)" using E ..
  98.113 +    qed
  98.114 +    {
  98.115 +      fix x1 x2 assume x1: "x1 \<in> H'" and x2: "x2 \<in> H'"
  98.116 +      show "h' (x1 + x2) = h' x1 + h' x2"
  98.117 +      proof -
  98.118 +	from H' x1 x2 have "x1 + x2 \<in> H'"
  98.119 +          by (rule vectorspace.add_closed)
  98.120 +	with x1 x2 obtain y y1 y2 a a1 a2 where
  98.121 +          x1x2: "x1 + x2 = y + a \<cdot> x0" and y: "y \<in> H"
  98.122 +          and x1_rep: "x1 = y1 + a1 \<cdot> x0" and y1: "y1 \<in> H"
  98.123 +          and x2_rep: "x2 = y2 + a2 \<cdot> x0" and y2: "y2 \<in> H"
  98.124 +          unfolding H'_def sum_def lin_def by blast
  98.125 +	
  98.126 +	have ya: "y1 + y2 = y \<and> a1 + a2 = a" using E HE _ y x0
  98.127 +	proof (rule decomp_H') txt_raw {* \label{decomp-H-use} *}
  98.128 +          from HE y1 y2 show "y1 + y2 \<in> H"
  98.129 +            by (rule subspace.add_closed)
  98.130 +          from x0 and HE y y1 y2
  98.131 +          have "x0 \<in> E"  "y \<in> E"  "y1 \<in> E"  "y2 \<in> E" by auto
  98.132 +          with x1_rep x2_rep have "(y1 + y2) + (a1 + a2) \<cdot> x0 = x1 + x2"
  98.133 +            by (simp add: add_ac add_mult_distrib2)
  98.134 +          also note x1x2
  98.135 +          finally show "(y1 + y2) + (a1 + a2) \<cdot> x0 = y + a \<cdot> x0" .
  98.136 +	qed
  98.137 +	
  98.138 +	from h'_def x1x2 E HE y x0
  98.139 +	have "h' (x1 + x2) = h y + a * xi"
  98.140 +          by (rule h'_definite)
  98.141 +	also have "\<dots> = h (y1 + y2) + (a1 + a2) * xi"
  98.142 +          by (simp only: ya)
  98.143 +	also from y1 y2 have "h (y1 + y2) = h y1 + h y2"
  98.144 +          by simp
  98.145 +	also have "\<dots> + (a1 + a2) * xi = (h y1 + a1 * xi) + (h y2 + a2 * xi)"
  98.146 +          by (simp add: left_distrib)
  98.147 +	also from h'_def x1_rep E HE y1 x0
  98.148 +	have "h y1 + a1 * xi = h' x1"
  98.149 +          by (rule h'_definite [symmetric])
  98.150 +	also from h'_def x2_rep E HE y2 x0
  98.151 +	have "h y2 + a2 * xi = h' x2"
  98.152 +          by (rule h'_definite [symmetric])
  98.153 +	finally show ?thesis .
  98.154 +      qed
  98.155 +    next
  98.156 +      fix x1 c assume x1: "x1 \<in> H'"
  98.157 +      show "h' (c \<cdot> x1) = c * (h' x1)"
  98.158 +      proof -
  98.159 +	from H' x1 have ax1: "c \<cdot> x1 \<in> H'"
  98.160 +          by (rule vectorspace.mult_closed)
  98.161 +	with x1 obtain y a y1 a1 where
  98.162 +            cx1_rep: "c \<cdot> x1 = y + a \<cdot> x0" and y: "y \<in> H"
  98.163 +          and x1_rep: "x1 = y1 + a1 \<cdot> x0" and y1: "y1 \<in> H"
  98.164 +          unfolding H'_def sum_def lin_def by blast
  98.165 +	
  98.166 +	have ya: "c \<cdot> y1 = y \<and> c * a1 = a" using E HE _ y x0
  98.167 +	proof (rule decomp_H')
  98.168 +          from HE y1 show "c \<cdot> y1 \<in> H"
  98.169 +            by (rule subspace.mult_closed)
  98.170 +          from x0 and HE y y1
  98.171 +          have "x0 \<in> E"  "y \<in> E"  "y1 \<in> E" by auto
  98.172 +          with x1_rep have "c \<cdot> y1 + (c * a1) \<cdot> x0 = c \<cdot> x1"
  98.173 +            by (simp add: mult_assoc add_mult_distrib1)
  98.174 +          also note cx1_rep
  98.175 +          finally show "c \<cdot> y1 + (c * a1) \<cdot> x0 = y + a \<cdot> x0" .
  98.176 +	qed
  98.177 +	
  98.178 +	from h'_def cx1_rep E HE y x0 have "h' (c \<cdot> x1) = h y + a * xi"
  98.179 +          by (rule h'_definite)
  98.180 +	also have "\<dots> = h (c \<cdot> y1) + (c * a1) * xi"
  98.181 +          by (simp only: ya)
  98.182 +	also from y1 have "h (c \<cdot> y1) = c * h y1"
  98.183 +          by simp
  98.184 +	also have "\<dots> + (c * a1) * xi = c * (h y1 + a1 * xi)"
  98.185 +          by (simp only: right_distrib)
  98.186 +	also from h'_def x1_rep E HE y1 x0 have "h y1 + a1 * xi = h' x1"
  98.187 +          by (rule h'_definite [symmetric])
  98.188 +	finally show ?thesis .
  98.189 +      qed
  98.190 +    }
  98.191 +  qed
  98.192 +qed
  98.193 +
  98.194 +text {* \medskip The linear extension @{text h'} of @{text h}
  98.195 +  is bounded by the seminorm @{text p}. *}
  98.196 +
  98.197 +lemma h'_norm_pres:
  98.198 +  assumes h'_def: "h' \<equiv> \<lambda>x. let (y, a) =
  98.199 +      SOME (y, a). x = y + a \<cdot> x0 \<and> y \<in> H in h y + a * xi"
  98.200 +    and H'_def: "H' \<equiv> H + lin x0"
  98.201 +    and x0: "x0 \<notin> H"  "x0 \<in> E"  "x0 \<noteq> 0"
  98.202 +  assumes E: "vectorspace E" and HE: "subspace H E"
  98.203 +    and "seminorm E p" and "linearform H h"
  98.204 +  assumes a: "\<forall>y \<in> H. h y \<le> p y"
  98.205 +    and a': "\<forall>y \<in> H. - p (y + x0) - h y \<le> xi \<and> xi \<le> p (y + x0) - h y"
  98.206 +  shows "\<forall>x \<in> H'. h' x \<le> p x"
  98.207 +proof -
  98.208 +  interpret vectorspace E by fact
  98.209 +  interpret subspace H E by fact
  98.210 +  interpret seminorm E p by fact
  98.211 +  interpret linearform H h by fact
  98.212 +  show ?thesis
  98.213 +  proof
  98.214 +    fix x assume x': "x \<in> H'"
  98.215 +    show "h' x \<le> p x"
  98.216 +    proof -
  98.217 +      from a' have a1: "\<forall>ya \<in> H. - p (ya + x0) - h ya \<le> xi"
  98.218 +	and a2: "\<forall>ya \<in> H. xi \<le> p (ya + x0) - h ya" by auto
  98.219 +      from x' obtain y a where
  98.220 +          x_rep: "x = y + a \<cdot> x0" and y: "y \<in> H"
  98.221 +	unfolding H'_def sum_def lin_def by blast
  98.222 +      from y have y': "y \<in> E" ..
  98.223 +      from y have ay: "inverse a \<cdot> y \<in> H" by simp
  98.224 +      
  98.225 +      from h'_def x_rep E HE y x0 have "h' x = h y + a * xi"
  98.226 +	by (rule h'_definite)
  98.227 +      also have "\<dots> \<le> p (y + a \<cdot> x0)"
  98.228 +      proof (rule linorder_cases)
  98.229 +	assume z: "a = 0"
  98.230 +	then have "h y + a * xi = h y" by simp
  98.231 +	also from a y have "\<dots> \<le> p y" ..
  98.232 +	also from x0 y' z have "p y = p (y + a \<cdot> x0)" by simp
  98.233 +	finally show ?thesis .
  98.234 +      next
  98.235 +	txt {* In the case @{text "a < 0"}, we use @{text "a\<^sub>1"}
  98.236 +          with @{text ya} taken as @{text "y / a"}: *}
  98.237 +	assume lz: "a < 0" then have nz: "a \<noteq> 0" by simp
  98.238 +	from a1 ay
  98.239 +	have "- p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y) \<le> xi" ..
  98.240 +	with lz have "a * xi \<le>
  98.241 +          a * (- p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y))"
  98.242 +          by (simp add: mult_left_mono_neg order_less_imp_le)
  98.243 +	
  98.244 +	also have "\<dots> =
  98.245 +          - a * (p (inverse a \<cdot> y + x0)) - a * (h (inverse a \<cdot> y))"
  98.246 +	  by (simp add: right_diff_distrib)
  98.247 +	also from lz x0 y' have "- a * (p (inverse a \<cdot> y + x0)) =
  98.248 +          p (a \<cdot> (inverse a \<cdot> y + x0))"
  98.249 +          by (simp add: abs_homogenous)
  98.250 +	also from nz x0 y' have "\<dots> = p (y + a \<cdot> x0)"
  98.251 +          by (simp add: add_mult_distrib1 mult_assoc [symmetric])
  98.252 +	also from nz y have "a * (h (inverse a \<cdot> y)) =  h y"
  98.253 +          by simp
  98.254 +	finally have "a * xi \<le> p (y + a \<cdot> x0) - h y" .
  98.255 +	then show ?thesis by simp
  98.256 +      next
  98.257 +	txt {* In the case @{text "a > 0"}, we use @{text "a\<^sub>2"}
  98.258 +          with @{text ya} taken as @{text "y / a"}: *}
  98.259 +	assume gz: "0 < a" then have nz: "a \<noteq> 0" by simp
  98.260 +	from a2 ay
  98.261 +	have "xi \<le> p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y)" ..
  98.262 +	with gz have "a * xi \<le>
  98.263 +          a * (p (inverse a \<cdot> y + x0) - h (inverse a \<cdot> y))"
  98.264 +          by simp
  98.265 +	also have "\<dots> = a * p (inverse a \<cdot> y + x0) - a * h (inverse a \<cdot> y)"
  98.266 +	  by (simp add: right_diff_distrib)
  98.267 +	also from gz x0 y'
  98.268 +	have "a * p (inverse a \<cdot> y + x0) = p (a \<cdot> (inverse a \<cdot> y + x0))"
  98.269 +          by (simp add: abs_homogenous)
  98.270 +	also from nz x0 y' have "\<dots> = p (y + a \<cdot> x0)"
  98.271 +          by (simp add: add_mult_distrib1 mult_assoc [symmetric])
  98.272 +	also from nz y have "a * h (inverse a \<cdot> y) = h y"
  98.273 +          by simp
  98.274 +	finally have "a * xi \<le> p (y + a \<cdot> x0) - h y" .
  98.275 +	then show ?thesis by simp
  98.276 +      qed
  98.277 +      also from x_rep have "\<dots> = p x" by (simp only:)
  98.278 +      finally show ?thesis .
  98.279 +    qed
  98.280 +  qed
  98.281 +qed
  98.282 +
  98.283 +end
    99.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    99.2 +++ b/src/HOL/HahnBanach/HahnBanachLemmas.thy	Tue Dec 30 11:10:01 2008 +0100
    99.3 @@ -0,0 +1,4 @@
    99.4 +(*<*)
    99.5 +theory HahnBanachLemmas imports HahnBanachSupLemmas HahnBanachExtLemmas begin
    99.6 +end
    99.7 +(*>*)
    99.8 \ No newline at end of file
   100.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
   100.2 +++ b/src/HOL/HahnBanach/HahnBanachSupLemmas.thy	Tue Dec 30 11:10:01 2008 +0100
   100.3 @@ -0,0 +1,446 @@
   100.4 +(*  Title:      HOL/Real/HahnBanach/HahnBanachSupLemmas.thy
   100.5 +    ID:         $Id$
   100.6 +    Author:     Gertrud Bauer, TU Munich
   100.7 +*)
   100.8 +
   100.9 +header {* The supremum w.r.t.~the function order *}
  100.10 +
  100.11 +theory HahnBanachSupLemmas
  100.12 +imports FunctionNorm ZornLemma
  100.13 +begin
  100.14 +
  100.15 +text {*
  100.16 +  This section contains some lemmas that will be used in the proof of
  100.17 +  the Hahn-Banach Theorem.  In this section the following context is
  100.18 +  presumed.  Let @{text E} be a real vector space with a seminorm
  100.19 +  @{text p} on @{text E}.  @{text F} is a subspace of @{text E} and
  100.20 +  @{text f} a linear form on @{text F}. We consider a chain @{text c}
  100.21 +  of norm-preserving extensions of @{text f}, such that @{text "\<Union>c =
  100.22 +  graph H h"}.  We will show some properties about the limit function
  100.23 +  @{text h}, i.e.\ the supremum of the chain @{text c}.
  100.24 +
  100.25 +  \medskip Let @{text c} be a chain of norm-preserving extensions of
  100.26 +  the function @{text f} and let @{text "graph H h"} be the supremum
  100.27 +  of @{text c}.  Every element in @{text H} is member of one of the
  100.28 +  elements of the chain.
  100.29 +*}
  100.30 +lemmas [dest?] = chainD
  100.31 +lemmas chainE2 [elim?] = chainD2 [elim_format, standard]
  100.32 +
  100.33 +lemma some_H'h't:
  100.34 +  assumes M: "M = norm_pres_extensions E p F f"
  100.35 +    and cM: "c \<in> chain M"
  100.36 +    and u: "graph H h = \<Union>c"
  100.37 +    and x: "x \<in> H"
  100.38 +  shows "\<exists>H' h'. graph H' h' \<in> c
  100.39 +    \<and> (x, h x) \<in> graph H' h'
  100.40 +    \<and> linearform H' h' \<and> H' \<unlhd> E
  100.41 +    \<and> F \<unlhd> H' \<and> graph F f \<subseteq> graph H' h'
  100.42 +    \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
  100.43 +proof -
  100.44 +  from x have "(x, h x) \<in> graph H h" ..
  100.45 +  also from u have "\<dots> = \<Union>c" .
  100.46 +  finally obtain g where gc: "g \<in> c" and gh: "(x, h x) \<in> g" by blast
  100.47 +
  100.48 +  from cM have "c \<subseteq> M" ..
  100.49 +  with gc have "g \<in> M" ..
  100.50 +  also from M have "\<dots> = norm_pres_extensions E p F f" .
  100.51 +  finally obtain H' and h' where g: "g = graph H' h'"
  100.52 +    and * : "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
  100.53 +      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x" ..
  100.54 +
  100.55 +  from gc and g have "graph H' h' \<in> c" by (simp only:)
  100.56 +  moreover from gh and g have "(x, h x) \<in> graph H' h'" by (simp only:)
  100.57 +  ultimately show ?thesis using * by blast
  100.58 +qed
  100.59 +
  100.60 +text {*
  100.61 +  \medskip Let @{text c} be a chain of norm-preserving extensions of
  100.62 +  the function @{text f} and let @{text "graph H h"} be the supremum
  100.63 +  of @{text c}.  Every element in the domain @{text H} of the supremum
  100.64 +  function is member of the domain @{text H'} of some function @{text
  100.65 +  h'}, such that @{text h} extends @{text h'}.
  100.66 +*}
  100.67 +
  100.68 +lemma some_H'h':
  100.69 +  assumes M: "M = norm_pres_extensions E p F f"
  100.70 +    and cM: "c \<in> chain M"
  100.71 +    and u: "graph H h = \<Union>c"
  100.72 +    and x: "x \<in> H"
  100.73 +  shows "\<exists>H' h'. x \<in> H' \<and> graph H' h' \<subseteq> graph H h
  100.74 +    \<and> linearform H' h' \<and> H' \<unlhd> E \<and> F \<unlhd> H'
  100.75 +    \<and> graph F f \<subseteq> graph H' h' \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
  100.76 +proof -
  100.77 +  from M cM u x obtain H' h' where
  100.78 +      x_hx: "(x, h x) \<in> graph H' h'"
  100.79 +    and c: "graph H' h' \<in> c"
  100.80 +    and * : "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
  100.81 +      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x"
  100.82 +    by (rule some_H'h't [elim_format]) blast
  100.83 +  from x_hx have "x \<in> H'" ..
  100.84 +  moreover from cM u c have "graph H' h' \<subseteq> graph H h"
  100.85 +    by (simp only: chain_ball_Union_upper)
  100.86 +  ultimately show ?thesis using * by blast
  100.87 +qed
  100.88 +
  100.89 +text {*
  100.90 +  \medskip Any two elements @{text x} and @{text y} in the domain
  100.91 +  @{text H} of the supremum function @{text h} are both in the domain
  100.92 +  @{text H'} of some function @{text h'}, such that @{text h} extends
  100.93 +  @{text h'}.
  100.94 +*}
  100.95 +
  100.96 +lemma some_H'h'2:
  100.97 +  assumes M: "M = norm_pres_extensions E p F f"
  100.98 +    and cM: "c \<in> chain M"
  100.99 +    and u: "graph H h = \<Union>c"
 100.100 +    and x: "x \<in> H"
 100.101 +    and y: "y \<in> H"
 100.102 +  shows "\<exists>H' h'. x \<in> H' \<and> y \<in> H'
 100.103 +    \<and> graph H' h' \<subseteq> graph H h
 100.104 +    \<and> linearform H' h' \<and> H' \<unlhd> E \<and> F \<unlhd> H'
 100.105 +    \<and> graph F f \<subseteq> graph H' h' \<and> (\<forall>x \<in> H'. h' x \<le> p x)"
 100.106 +proof -
 100.107 +  txt {* @{text y} is in the domain @{text H''} of some function @{text h''},
 100.108 +  such that @{text h} extends @{text h''}. *}
 100.109 +
 100.110 +  from M cM u and y obtain H' h' where
 100.111 +      y_hy: "(y, h y) \<in> graph H' h'"
 100.112 +    and c': "graph H' h' \<in> c"
 100.113 +    and * :
 100.114 +      "linearform H' h'"  "H' \<unlhd> E"  "F \<unlhd> H'"
 100.115 +      "graph F f \<subseteq> graph H' h'"  "\<forall>x \<in> H'. h' x \<le> p x"
 100.116 +    by (rule some_H'h't [elim_format]) blast
 100.117 +
 100.118 +  txt {* @{text x} is in the domain @{text H'} of some function @{text h'},
 100.119 +    such that @{text h} extends @{text h'}. *}
 100.120 +
 100.121 +  from M cM u and x obtain H'' h'' where
 100.122 +      x_hx: "(x, h x) \<in> graph H'' h''"
 100.123 +    and c'': "graph H'' h'' \<in> c"
 100.124 +    and ** :
 100.125 +      "linearform H'' h''"  "H'' \<unlhd> E"  "F \<unlhd> H''"
 100.126 +      "graph F f \<subseteq> graph H'' h''"  "\<forall>x \<in> H''. h'' x \<le> p x"
 100.127 +    by (rule some_H'h't [elim_format]) blast
 100.128 +
 100.129 +  txt {* Since both @{text h'} and @{text h''} are elements of the chain,
 100.130 +    @{text h''} is an extension of @{text h'} or vice versa. Thus both
 100.131 +    @{text x} and @{text y} are contained in the greater
 100.132 +    one. \label{cases1}*}
 100.133 +
 100.134 +  from cM c'' c' have "graph H'' h'' \<subseteq> graph H' h' \<or> graph H' h' \<subseteq> graph H'' h''"
 100.135 +    (is "?case1 \<or> ?case2") ..
 100.136 +  then show ?thesis
 100.137 +  proof
 100.138 +    assume ?case1
 100.139 +    have "(x, h x) \<in> graph H'' h''" by fact
 100.140 +    also have "\<dots> \<subseteq> graph H' h'" by fact
 100.141 +    finally have xh:"(x, h x) \<in> graph H' h'" .
 100.142 +    then have "x \<in> H'" ..
 100.143 +    moreover from y_hy have "y \<in> H'" ..
 100.144 +    moreover from cM u and c' have "graph H' h' \<subseteq> graph H h"
 100.145 +      by (simp only: chain_ball_Union_upper)
 100.146 +    ultimately show ?thesis using * by blast
 100.147 +  next
 100.148 +    assume ?case2
 100.149 +    from x_hx have "x \<in> H''" ..
 100.150 +    moreover {
 100.151 +      have "(y, h y) \<in> graph H' h'" by (rule y_hy)
 100.152 +      also have "\<dots> \<subseteq> graph H'' h''" by fact
 100.153 +      finally have "(y, h y) \<in> graph H'' h''" .
 100.154 +    } then have "y \<in> H''" ..
 100.155 +    moreover from cM u and c'' have "graph H'' h'' \<subseteq> graph H h"
 100.156 +      by (simp only: chain_ball_Union_upper)
 100.157 +    ultimately show ?thesis using ** by blast
 100.158 +  qed
 100.159 +qed
 100.160 +
 100.161 +text {*
 100.162 +  \medskip The relation induced by the graph of the supremum of a
 100.163 +  chain @{text c} is definite, i.~e.~t is the graph of a function.
 100.164 +*}
 100.165 +
 100.166 +lemma sup_definite:
 100.167 +  assumes M_def: "M \<equiv> norm_pres_extensions E p F f"
 100.168 +    and cM: "c \<in> chain M"
 100.169 +    and xy: "(x, y) \<in> \<Union>c"
 100.170 +    and xz: "(x, z) \<in> \<Union>c"
 100.171 +  shows "z = y"
 100.172 +proof -
 100.173 +  from cM have c: "c \<subseteq> M" ..
 100.174 +  from xy obtain G1 where xy': "(x, y) \<in> G1" and G1: "G1 \<in> c" ..
 100.175 +  from xz obtain G2 where xz': "(x, z) \<in> G2" and G2: "G2 \<in> c" ..
 100.176 +
 100.177 +  from G1 c have "G1 \<in> M" ..
 100.178 +  then obtain H1 h1 where G1_rep: "G1 = graph H1 h1"
 100.179 +    unfolding M_def by blast
 100.180 +
 100.181 +  from G2 c have "G2 \<in> M" ..
 100.182 +  then obtain H2 h2 where G2_rep: "G2 = graph H2 h2"
 100.183 +    unfolding M_def by blast
 100.184 +
 100.185 +  txt {* @{text "G\<^sub>1"} is contained in @{text "G\<^sub>2"}
 100.186 +    or vice versa, since both @{text "G\<^sub>1"} and @{text
 100.187 +    "G\<^sub>2"} are members of @{text c}. \label{cases2}*}
 100.188 +
 100.189 +  from cM G1 G2 have "G1 \<subseteq> G2 \<or> G2 \<subseteq> G1" (is "?case1 \<or> ?case2") ..
 100.190 +  then show ?thesis
 100.191 +  proof
 100.192 +    assume ?case1
 100.193 +    with xy' G2_rep have "(x, y) \<in> graph H2 h2" by blast
 100.194 +    then have "y = h2 x" ..
 100.195 +    also
 100.196 +    from xz' G2_rep have "(x, z) \<in> graph H2 h2" by (simp only:)
 100.197 +    then have "z = h2 x" ..
 100.198 +    finally show ?thesis .
 100.199 +  next
 100.200 +    assume ?case2
 100.201 +    with xz' G1_rep have "(x, z) \<in> graph H1 h1" by blast
 100.202 +    then have "z = h1 x" ..
 100.203 +    also
 100.204 +    from xy' G1_rep have "(x, y) \<in> graph H1 h1" by (simp only:)
 100.205 +    then have "y = h1 x" ..